File Coverage

blib/lib/Template/Flute/Utils.pm
Criterion Covered Total %
statement 12 20 60.0
branch 0 4 0.0
condition 0 3 0.0
subroutine 4 5 80.0
pod 1 1 100.0
total 17 33 51.5


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;