File Coverage

blib/lib/File/Basename/Extra.pm
Criterion Covered Total %
statement 42 44 95.4
branch 15 16 93.7
condition 3 3 100.0
subroutine 13 13 100.0
pod 9 9 100.0
total 82 85 96.4


line stmt bran cond sub pod time code
1             package File::Basename::Extra;
2 1     1   13063 use strict;
  1         2  
  1         22  
3 1     1   3 use warnings;
  1         1  
  1         44  
4              
5             # ABSTRACT: Extension to File::Basename, adds named access to file parts and handling of filename suffixes
6             our $VERSION = '0.003'; # VERSION
7              
8             #pod =head1 SYNOPSIS
9             #pod
10             #pod # Note: by default no symbols get exported so make sure you export
11             #pod # the ones you need!
12             #pod use File::Basename::Extra qw(basename);
13             #pod
14             #pod # basename and friends
15             #pod my $file = basename('/foo/bar/file.txt'); # "file.txt"
16             #pod my $fileext = basename_suffix('/foo/bar/file.txt'); # ".txt"
17             #pod my $filenoext = basename_nosuffix('/foo/bar/file.txt'); # "file"
18             #pod
19             #pod # dirname
20             #pod my $dir = dirname('/foo/bar/file.txt'); # "/foo/bar/"
21             #pod
22             #pod # fileparse
23             #pod my ($filename, $dirs, $suffix) = fileparse('/foo/bar/file.txt', qr/\.[^.]*/);
24             #pod # ("file", "/foo/bar/", ".txt")
25             #pod
26             #pod # pathname
27             #pod my $path = pathname('/foo/bar/file.txt'); # "/foo/bar/"
28             #pod
29             #pod # fullname and friends
30             #pod my $full = fullname('/foo/bar/file.txt'); # "/foo/bar/file.txt"
31             #pod my $fullext = fullname_suffix('/foo/bar/file.txt'); # ".txt"
32             #pod my $fullnoext = fullname_nosuffix('/foo/bar/file.txt'); # "/foo/bar/file"
33             #pod
34             #pod # getting/setting the default suffix patterns
35             #pod my @patterns = default_suffix_patterns(); # Returns the currently active patterns
36             #pod
37             #pod # setting the default suffix patterns
38             #pod my @previous = default_suffix_patterns(qr/[._]bar/, '\.baz');
39             #pod # Now only .bar, _bar, and .baz are matched suffixes
40             #pod
41             #pod =head1 DESCRIPTION
42             #pod
43             #pod This module provides functionalty for handling file name suffixes (aka
44             #pod file name extensions).
45             #pod
46             #pod =head1 SEE ALSO
47             #pod
48             #pod L for the suffix matching and platform specific details.
49             #pod
50             #pod =cut
51              
52 1     1   4 use File::Basename 2.74; # For _strip_trailing_sep
  1         19  
  1         491  
53              
54             our @ISA = qw(Exporter File::Basename);
55             our @EXPORT = ();
56             our @EXPORT_OK = (@File::Basename::EXPORT,
57             qw(basename_suffix basename_nosuffix
58             filename filename_suffix filename_nosuffix
59             pathname
60             fullname fullname_suffix fullname_nosuffix
61             default_suffix_patterns));
62              
63             my @default_suffix_patterns = (qr/\.[^.]*/);
64              
65             # Special version of the fileparse function, used in the basename versions of the functions
66             sub _basename_fileparse {
67 20     20   21 my $path = shift;
68 20 100       44 my @suffix_patterns = @_ ? map { "\Q$_\E" } @_ : @default_suffix_patterns;
  8         21  
69              
70             # "hidden" function in File::Basename, strips final path separator
71             # (e.g., / or \)
72 20         146 File::Basename::_strip_trailing_sep($path);
73              
74 20         393 my($basename, $dirname, $suffix) = fileparse( $path, @suffix_patterns );
75              
76             # The suffix is not stripped if it is identical to the remaining
77             # characters in string.
78 20 100 100     79 if( length $suffix and !length $basename ) {
79 6         4 $basename = $suffix;
80 6         7 $suffix = '';
81             }
82              
83             # Ensure that basename '/' == '/'
84 20 50       33 if( !length $basename ) {
85 0         0 $basename = $dirname;
86 0         0 $dirname = '';
87             }
88              
89 20         35 return ($basename, $dirname, $suffix);
90             }
91              
92             #pod =func fileparse FILEPATH
93             #pod
94             #pod =func fileparse FILEPATH PATTERN_LIST
95             #pod
96             #pod =func basename FILEPATH
97             #pod
98             #pod =func basename FILEPATH PATTERN_LIST
99             #pod
100             #pod =func dirname FILEPATH
101             #pod
102             #pod =func fileparse_set_fstype FSTYPE
103             #pod
104             #pod These functions are exactly the same as the corresponding ones from
105             #pod L except that they aren't exported by default.
106             #pod
107             #pod =func basename_suffix FILEPATH
108             #pod
109             #pod =func basename_suffix FILEPATH PATTERN_LIST
110             #pod
111             #pod Returns the file name suffix part of the given filepath. The default
112             #pod suffix patterns are used if none are provided. Behaves the same as
113             #pod C, i.e., it uses the last last level of a filepath as
114             #pod filename, even if the last level is clearly directory.
115             #pod
116             #pod Also, like C, files that consist of only a matched suffix
117             #pod are treated as if they do not have a suffix. So, using the default
118             #pod suffix pattern, C would
119             #pod return an empty string.
120             #pod
121             #pod Note: Like the original C function from L,
122             #pod suffix patterns are automatically escaped so pattern C<.bar> only
123             #pod matches C<.bar> and not e.g., C<_bar> (this is B done for the
124             #pod default suffix patterns, nor for patterns provided to the non-basename
125             #pod family functions of this module!).
126             #pod
127             #pod =cut
128              
129             sub basename_suffix {
130 10     10 1 623 my (undef, undef, $suffix) = _basename_fileparse(@_);
131 10         29 return $suffix;
132             }
133              
134             #pod =func basename_nosuffix FILEPATH
135             #pod
136             #pod =func basename_nosuffix FILEPATH PATTERN_LIST
137             #pod
138             #pod Acts basically the same as the original C function, except
139             #pod that the default suffix patterns are used to strip the name of its
140             #pod suffixes when none are provided.
141             #pod
142             #pod Also, like C, files that consist of only a matched suffix
143             #pod are treated as if they do not have a suffix. So, using the default
144             #pod suffix pattern, C would
145             #pod return C<.profile>.
146             #pod
147             #pod Note: Like the original C function from L,
148             #pod suffix patterns are automatically escaped so pattern C<.bar> only
149             #pod matches C<.bar> and not e.g., C<_bar> (this is B done for the
150             #pod default suffix patterns, nor for patterns provided to the non-basename
151             #pod family of functions of this module!).
152             #pod
153             #pod =cut
154              
155             sub basename_nosuffix {
156 10     10 1 19 my ($name, undef, undef) = _basename_fileparse(@_);
157 10         33 return $name;
158             }
159              
160             #pod =func filename FILEPATH
161             #pod
162             #pod =func filename FILEPATH PATTERN_LIST
163             #pod
164             #pod Returns just the filename of the filepath, optionally stripping the
165             #pod suffix when it matches a provided suffix patterns. Basically the same
166             #pod as calling C in scalar context.
167             #pod
168             #pod =cut
169              
170             sub filename {
171 5     5 1 75 my ($filename, undef, undef) = fileparse(@_);
172 5         16 return $filename;
173             }
174              
175             #pod =func filename_suffix FILEPATH
176             #pod
177             #pod =func filename_suffix FILEPATH PATTERN_LIST
178             #pod
179             #pod Returns the matched suffix of the filename. The default suffix
180             #pod patterns are used when none are provided.
181             #pod
182             #pod =cut
183              
184             sub filename_suffix {
185 30     30 1 34 my $fullname = shift;
186 30 100       598 my (undef, undef, $suffix) = fileparse($fullname, (@_ ? @_ : @default_suffix_patterns));
187 30         78 return $suffix;
188             }
189              
190             #pod =func filename_nosuffix FILEPATH
191             #pod
192             #pod =func filename_nosuffix FILEPATH PATTERN_LIST
193             #pod
194             #pod Returns the filename with the the matched suffix stripped. The default
195             #pod suffix patterns are used when none are provided.
196             #pod
197             #pod =cut
198              
199             sub filename_nosuffix {
200 11     11 1 12 my $fullname = shift;
201 11 100       214 my ($filename, undef, undef) = fileparse($fullname, (@_ ? @_ : @default_suffix_patterns));
202 11         37 return $filename;
203             }
204              
205             #pod =func pathname FILEPATH
206             #pod
207             #pod Returns the path part of the file. Contrary to C, a filepath
208             #pod that is clearly a directory, is treated as such (e.g., on Unix,
209             #pod C returns C).
210             #pod
211             #pod =cut
212              
213             sub pathname {
214 2     2 1 24 my (undef, $pathname, undef) = fileparse(@_);
215 2         6 return $pathname;
216             }
217              
218             #pod =func fullname FILEPATH
219             #pod
220             #pod =func fullname FILEPATH PATTERN_LIST
221             #pod
222             #pod Returns the provided filepath, optionally stripping the filename of
223             #pod its matching suffix.
224             #pod
225             #pod =cut
226              
227             sub fullname {
228 4     4 1 4 my $fullname = shift;
229 4 100       14 return @_ ? fullname_nosuffix($fullname, @_) : $fullname;
230             }
231              
232             #pod =func fullname_suffix FILEPATH
233             #pod
234             #pod =func fullname_suffix FILEPATH PATTERN_LIST
235             #pod
236             #pod Synonym for filename_suffix.
237             #pod
238             #pod =cut
239              
240             *fullname_suffix = *filename_suffix;
241              
242             #pod =func fullname_nosuffix FILEPATH
243             #pod
244             #pod =func fullname_nosuffix FILEPATH PATTERN_LIST
245             #pod
246             #pod Returns the full filepath with the the matched suffix stripped. The
247             #pod default suffix patterns are used when none are provided.
248             #pod
249             #pod =cut
250              
251             sub fullname_nosuffix {
252 10     10 1 12 my $fullname = shift;
253 10         17 my $suffix = filename_suffix($fullname, @_);
254 10 100       91 $fullname =~ s/\Q$suffix\E$// if $suffix;
255 10         39 return $fullname;
256             }
257              
258             #pod =func default_suffix_patterns
259             #pod
260             #pod =func default_suffix_patterns NEW_PATTERN_LIST
261             #pod
262             #pod The default suffix pattern list (see the C function in
263             #pod L for details) is C. Meaning that this
264             #pod defines the suffix as the part of the filename from (and including)
265             #pod the last dot. In other words, the part of a filename that is popularly
266             #pod known as the file extension.
267             #pod
268             #pod You can alter the suffix matching by proving this function with a
269             #pod different pattern list.
270             #pod
271             #pod This function returns the pattern list that was effective I
272             #pod optionally changing it.
273             #pod
274             #pod =cut
275              
276             sub default_suffix_patterns {
277 3     3 1 5 my @org_suffix_patterns = @default_suffix_patterns;
278 3 100       8 @default_suffix_patterns = @_ if @_;
279 3         14 return @org_suffix_patterns;
280             }
281              
282             1;
283              
284             __END__