| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Template::Flute::Utils; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 3 | use strict; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 22 |  | 
| 4 | 1 |  |  | 1 |  | 3 | use warnings; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 18 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 1 |  |  | 1 |  | 3 | use File::Basename; | 
|  | 1 |  |  |  |  | 0 |  | 
|  | 1 |  |  |  |  | 54 |  | 
| 7 | 1 |  |  | 1 |  | 3 | use File::Spec; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 134 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | =head1 NAME | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | Template::Flute::Utils - Template::Flute utility functions | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | =head1 FUNCTIONS | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | =head2 derive_filename FILENAME SUFFIX [FULL] [ARGS] | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | Derives a filename with a different SUFFIX from FILENAME, e.g. | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | derive_filename('templates/helloworld.html', '.xml') | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | returns | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | templates/helloworld.xml | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | With the FULL parameter set it can be used to produce a path | 
| 26 |  |  |  |  |  |  | for a relative filename from another filename with a directory, | 
| 27 |  |  |  |  |  |  | e.g. | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | derive_filename('templates/helloworld.html', 'foobar.png', 1) | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | returns | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | templates/foobar.png | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | Also, with the C argument a SUFFIX containing | 
| 36 |  |  |  |  |  |  | an absolute file path will be returned verbatim, e.g. | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | derive_filename('templates/helloword.html', | 
| 39 |  |  |  |  |  |  | '/home/racke/components/login.html', | 
| 40 |  |  |  |  |  |  | 1, | 
| 41 |  |  |  |  |  |  | pass_absolute => 1) | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | produces | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | /home/racke/components/login.html | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | =cut | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | sub derive_filename { | 
| 50 | 0 |  |  | 0 | 1 |  | my ($orig_filename, $suffix, $full, %args) = @_; | 
| 51 | 0 |  |  |  |  |  | my ($orig_dir, @frags); | 
| 52 |  |  |  |  |  |  |  | 
| 53 | 0 | 0 | 0 |  |  |  | if ($args{pass_absolute} && File::Spec->file_name_is_absolute($suffix)) { | 
| 54 |  |  |  |  |  |  | # pass through suffixes with absolute file paths | 
| 55 | 0 |  |  |  |  |  | return $suffix; | 
| 56 |  |  |  |  |  |  | } | 
| 57 |  |  |  |  |  |  |  | 
| 58 | 0 |  |  |  |  |  | @frags = fileparse($orig_filename, qr/\.[^.]*/); | 
| 59 |  |  |  |  |  |  |  | 
| 60 | 0 | 0 |  |  |  |  | if ($full) { | 
| 61 | 0 |  |  |  |  |  | return $frags[1] . $suffix; | 
| 62 |  |  |  |  |  |  | } | 
| 63 |  |  |  |  |  |  | else { | 
| 64 | 0 |  |  |  |  |  | return $frags[1] . $frags[0] . $suffix; | 
| 65 |  |  |  |  |  |  | } | 
| 66 |  |  |  |  |  |  | } | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | =head1 AUTHOR | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | Stefan Hornburg (Racke), | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | =head1 LICENSE AND COPYRIGHT | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | Copyright 2010-2016 Stefan Hornburg (Racke) . | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | This program is free software; you can redistribute it and/or modify it | 
| 77 |  |  |  |  |  |  | under the terms of either: the GNU General Public License as published | 
| 78 |  |  |  |  |  |  | by the Free Software Foundation; or the Artistic License. | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | See http://dev.perl.org/licenses/ for more information. | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | =cut | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  | 1; |