Profile of File/Basename.pm

Filename	/usr/lib/perl5/5.14/File/Basename.pm
Statements	Executed 274920 statements in 952ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
10181	1	1	286ms	286ms	File::Basename::::CORE:substFile::Basename::CORE:subst (opcode)
10181	1	1	235ms	287ms	File::Basename::::fileparseFile::Basename::fileparse
10181	2	2	185ms	940ms	File::Basename::::dirnameFile::Basename::dirname
10181	1	1	140ms	468ms	File::Basename::::_strip_trailing_sepFile::Basename::_strip_trailing_sep
10191	2	1	52.0ms	52.0ms	File::Basename::::CORE:matchFile::Basename::CORE:match (opcode)
20362	1	1	42.8ms	42.8ms	File::Basename::::CORE:substcontFile::Basename::CORE:substcont (opcode)
1	1	1	231µs	231µs	File::Basename::::BEGIN@42File::Basename::BEGIN@42
1	1	1	84µs	173µs	File::Basename::::fileparse_set_fstypeFile::Basename::fileparse_set_fstype
10	1	1	76µs	76µs	File::Basename::::CORE:regcompFile::Basename::CORE:regcomp (opcode)
1	1	1	60µs	60µs	File::Basename::::BEGIN@51File::Basename::BEGIN@51
1	1	1	23µs	23µs	File::Basename::::BEGIN@371File::Basename::BEGIN@371
1	1	1	15µs	35µs	File::Basename::::BEGIN@52File::Basename::BEGIN@52
1	1	1	14µs	19µs	File::Basename::::BEGIN@50File::Basename::BEGIN@50
0	0	0	0s	0s	File::Basename::::basenameFile::Basename::basename

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					=head1 NAME
2
3					File::Basename - Parse file paths into directory, filename and suffix.
4
5					=head1 SYNOPSIS
6
7					use File::Basename;
8
9					($name,$path,$suffix) = fileparse($fullname,@suffixlist);
10					$name = fileparse($fullname,@suffixlist);
11
12					$basename = basename($fullname,@suffixlist);
13					$dirname = dirname($fullname);
14
15
16					=head1 DESCRIPTION
17
18					These routines allow you to parse file paths into their directory, filename
19					and suffix.
20
21					B<NOTE>: C<dirname()> and C<basename()> emulate the behaviours, and
22					quirks, of the shell and C functions of the same name. See each
23					function's documentation for details. If your concern is just parsing
24					paths it is safer to use L<File::Spec>'s C<splitpath()> and
25					C<splitdir()> methods.
26
27					It is guaranteed that
28
29					# Where $path_separator is / for Unix, \ for Windows, etc...
30					dirname($path) . $path_separator . basename($path);
31
32					is equivalent to the original path for all systems but VMS.
33
34
35					=cut
36
37
38					package File::Basename;
39
40					# File::Basename is used during the Perl build, when the re extension may
41					# not be available, but we only actually need it if running under tainting.
42					# spent 231µs within File::Basename::BEGIN@42 which was called: # once (231µs+0s) by File::Path::BEGIN@7 at line 47 BEGIN {
43	1	12µs			if (${^TAINT}) {
44					require re;
45					re->import('taint');
46					}
47	1	53µs	1	231µs	} # spent 231µs making 1 call to File::Basename::BEGIN@42
48
49
50	2	51µs	2	25µs	# spent 19µs (14+6) within File::Basename::BEGIN@50 which was called: # once (14µs+6µs) by File::Path::BEGIN@7 at line 50 use strict; # spent 19µs making 1 call to File::Basename::BEGIN@50 # spent 6µs making 1 call to strict::import
51	2	171µs	1	60µs	# spent 60µs within File::Basename::BEGIN@51 which was called: # once (60µs+0s) by File::Path::BEGIN@7 at line 51 use 5.006; # spent 60µs making 1 call to File::Basename::BEGIN@51
52	2	2.24ms	2	55µs	# spent 35µs (15+20) within File::Basename::BEGIN@52 which was called: # once (15µs+20µs) by File::Path::BEGIN@7 at line 52 use warnings; # spent 35µs making 1 call to File::Basename::BEGIN@52 # spent 20µs making 1 call to warnings::import
53	1	1µs			our(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase);
54	1	1µs			require Exporter;
55	1	10µs			@ISA = qw(Exporter);
56	1	3µs			@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
57	1	1µs			$VERSION = "2.82";
58
59	1	4µs	1	173µs	fileparse_set_fstype($^O); # spent 173µs making 1 call to File::Basename::fileparse_set_fstype
60
61
62					=over 4
63
64					=item C<fileparse>
65					X<fileparse>
66
67					my($filename, $directories, $suffix) = fileparse($path);
68					my($filename, $directories, $suffix) = fileparse($path, @suffixes);
69					my $filename = fileparse($path, @suffixes);
70
71					The C<fileparse()> routine divides a file path into its $directories, $filename
72					and (optionally) the filename $suffix.
73
74					$directories contains everything up to and including the last
75					directory separator in the $path including the volume (if applicable).
76					The remainder of the $path is the $filename.
77
78					# On Unix returns ("baz", "/foo/bar/", "")
79					fileparse("/foo/bar/baz");
80
81					# On Windows returns ("baz", 'C:\foo\bar\', "")
82					fileparse('C:\foo\bar\baz');
83
84					# On Unix returns ("", "/foo/bar/baz/", "")
85					fileparse("/foo/bar/baz/");
86
87					If @suffixes are given each element is a pattern (either a string or a
88					C<qr//>) matched against the end of the $filename. The matching
89					portion is removed and becomes the $suffix.
90
91					# On Unix returns ("baz", "/foo/bar/", ".txt")
92					fileparse("/foo/bar/baz.txt", qr/\.[^.]*/);
93
94					If type is non-Unix (see C<fileparse_set_fstype()>) then the pattern
95					matching for suffix removal is performed case-insensitively, since
96					those systems are not case-sensitive when opening existing files.
97
98					You are guaranteed that C<$directories . $filename . $suffix> will
99					denote the same location as the original $path.
100
101					=cut
102
103
104					# spent 287ms (235+52.0) within File::Basename::fileparse which was called 10181 times, avg 28µs/call: # 10181 times (235ms+52.0ms) by File::Basename::dirname at line 294, avg 28µs/call sub fileparse {
105	162896	302ms			my($fullname,@suffices) = @_;
106
107					unless (defined $fullname) {
108					require Carp;
109					Carp::croak("fileparse(): need a valid pathname");
110					}
111
112					my $orig_type = '';
113					my($type,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
114
115					my($taint) = substr($fullname,0,0); # Is $fullname tainted?
116
117					if ($type eq "VMS" and $fullname =~ m{/} ) {
118					# We're doing Unix emulation
119					$orig_type = $type;
120					$type = 'Unix';
121					}
122
123					my($dirpath, $basename);
124
125					if (grep { $type eq $_ } qw(MSDOS DOS MSWin32 Epoc)) {
126					($dirpath,$basename) = ($fullname =~ /^((?:.[:\\\/])?)(.)/s);
127					$dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/;
128					}
129					elsif ($type eq "OS2") {
130					($dirpath,$basename) = ($fullname =~ m#^((?:.[:\\/])?)(.)#s);
131					$dirpath = './' unless $dirpath; # Can't be 0
132					$dirpath .= '/' unless $dirpath =~ m#[\\/]\z#;
133					}
134					elsif ($type eq "MacOS") {
135					($dirpath,$basename) = ($fullname =~ /^(.:)?(.)/s);
136					$dirpath = ':' unless $dirpath;
137					}
138					elsif ($type eq "AmigaOS") {
139					($dirpath,$basename) = ($fullname =~ /(.[:\/])?(.)/s);
140					$dirpath = './' unless $dirpath;
141					}
142					elsif ($type eq 'VMS' ) {
143					($dirpath,$basename) = ($fullname =~ /^(.[:>\]])?(.)/s);
144					$dirpath \|\|= ''; # should always be defined
145					}
146					else { # Default to Unix semantics.
147			10181	52.0ms	($dirpath,$basename) = ($fullname =~ m{^(./)?(.)}s); # spent 52.0ms making 10181 calls to File::Basename::CORE:match, avg 5µs/call
148					if ($orig_type eq 'VMS' and $fullname =~ m{^(/[^/]+/000000(/\|$))(.*)}) {
149					# dev:[000000] is top of VMS tree, similar to Unix '/'
150					# so strip it off and treat the rest as "normal"
151					my $devspec = $1;
152					my $remainder = $3;
153					($dirpath,$basename) = ($remainder =~ m{^(./)?(.)}s);
154					$dirpath \|\|= ''; # should always be defined
155					$dirpath = $devspec.$dirpath;
156					}
157					$dirpath = './' unless $dirpath;
158					}
159
160
161					my $tail = '';
162					my $suffix = '';
163					if (@suffices) {
164					foreach $suffix (@suffices) {
165					my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
166					if ($basename =~ s/$pat//s) {
167					$taint .= substr($suffix,0,0);
168					$tail = $1 . $tail;
169					}
170					}
171					}
172
173					# Ensure taint is propagated from the path to its pieces.
174					$tail .= $taint;
175					wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail)
176					: ($basename .= $taint);
177					}
178
- -
181					=item C<basename>
182					X<basename> X<filename>
183
184					my $filename = basename($path);
185					my $filename = basename($path, @suffixes);
186
187					This function is provided for compatibility with the Unix shell command
188					C<basename(1)>. It does B<NOT> always return the file name portion of a
189					path as you might expect. To be safe, if you want the file name portion of
190					a path use C<fileparse()>.
191
192					C<basename()> returns the last level of a filepath even if the last
193					level is clearly directory. In effect, it is acting like C<pop()> for
194					paths. This differs from C<fileparse()>'s behaviour.
195
196					# Both return "bar"
197					basename("/foo/bar");
198					basename("/foo/bar/");
199
200					@suffixes work as in C<fileparse()> except all regex metacharacters are
201					quoted.
202
203					# These two function calls are equivalent.
204					my $filename = basename("/foo/bar/baz.txt", ".txt");
205					my $filename = fileparse("/foo/bar/baz.txt", qr/\Q.txt\E/);
206
207					Also note that in order to be compatible with the shell command,
208					C<basename()> does not strip off a suffix if it is identical to the
209					remaining characters in the filename.
210
211					=cut
212
213
214					sub basename {
215					my($path) = shift;
216
217					# From BSD basename(1)
218					# The basename utility deletes any prefix ending with the last slash `/'
219					# character present in string (after first stripping trailing slashes)
220					_strip_trailing_sep($path);
221
222					my($basename, $dirname, $suffix) = fileparse( $path, map("\Q$_\E",@_) );
223
224					# From BSD basename(1)
225					# The suffix is not stripped if it is identical to the remaining
226					# characters in string.
227					if( length $suffix and !length $basename ) {
228					$basename = $suffix;
229					}
230
231					# Ensure that basename '/' == '/'
232					if( !length $basename ) {
233					$basename = $dirname;
234					}
235
236					return $basename;
237					}
238
- -
241					=item C<dirname>
242					X<dirname>
243
244					This function is provided for compatibility with the Unix shell
245					command C<dirname(1)> and has inherited some of its quirks. In spite of
246					its name it does B<NOT> always return the directory name as you might
247					expect. To be safe, if you want the directory name of a path use
248					C<fileparse()>.
249
250					Only on VMS (where there is no ambiguity between the file and directory
251					portions of a path) and AmigaOS (possibly due to an implementation quirk in
252					this module) does C<dirname()> work like C<fileparse($path)>, returning just the
253					$directories.
254
255					# On VMS and AmigaOS
256					my $directories = dirname($path);
257
258					When using Unix or MSDOS syntax this emulates the C<dirname(1)> shell function
259					which is subtly different from how C<fileparse()> works. It returns all but
260					the last level of a file path even if the last level is clearly a directory.
261					In effect, it is not returning the directory portion but simply the path one
262					level up acting like C<chop()> for file paths.
263
264					Also unlike C<fileparse()>, C<dirname()> does not include a trailing slash on
265					its returned path.
266
267					# returns /foo/bar. fileparse() would return /foo/bar/
268					dirname("/foo/bar/baz");
269
270					# also returns /foo/bar despite the fact that baz is clearly a
271					# directory. fileparse() would return /foo/bar/baz/
272					dirname("/foo/bar/baz/");
273
274					# returns '.'. fileparse() would return 'foo/'
275					dirname("foo/");
276
277					Under VMS, if there is no directory information in the $path, then the
278					current default device and directory is used.
279
280					=cut
281
282
283					# spent 940ms (185+755) within File::Basename::dirname which was called 10181 times, avg 92µs/call: # 8601 times (155ms+639ms) by Archive::Zip::Member::extractToFileNamed at line 485 of Archive/Zip/Member.pm, avg 92µs/call # 1580 times (29.7ms+116ms) by File::Path::_mkpath at line 131 of File/Path.pm, avg 92µs/call sub dirname {
284	81448	168ms			my $path = shift;
285
286					my($type) = $Fileparse_fstype;
287
288					if( $type eq 'VMS' and $path =~ m{/} ) {
289					# Parse as Unix
290					local($File::Basename::Fileparse_fstype) = '';
291					return dirname($path);
292					}
293
294			10181	287ms	my($basename, $dirname) = fileparse($path); # spent 287ms making 10181 calls to File::Basename::fileparse, avg 28µs/call
295
296					if ($type eq 'VMS') {
297					$dirname \|\|= $ENV{DEFAULT};
298					}
299					elsif ($type eq 'MacOS') {
300					if( !length($basename) && $dirname !~ /^[^:]+:\z/) {
301					_strip_trailing_sep($dirname);
302					($basename,$dirname) = fileparse $dirname;
303					}
304					$dirname .= ":" unless $dirname =~ /:\z/;
305					}
306					elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
307					_strip_trailing_sep($dirname);
308					unless( length($basename) ) {
309					($basename,$dirname) = fileparse $dirname;
310					_strip_trailing_sep($dirname);
311					}
312					}
313					elsif ($type eq 'AmigaOS') {
314					if ( $dirname =~ /:\z/) { return $dirname }
315					chop $dirname;
316					$dirname =~ s{[^:/]+\z}{} unless length($basename);
317					}
318					else {
319			10181	468ms	_strip_trailing_sep($dirname); # spent 468ms making 10181 calls to File::Basename::_strip_trailing_sep, avg 46µs/call
320					unless( length($basename) ) {
321					($basename,$dirname) = fileparse $dirname;
322					_strip_trailing_sep($dirname);
323					}
324					}
325
326					$dirname;
327					}
328
329
330					# Strip the trailing path separator.
331					# spent 468ms (140+329) within File::Basename::_strip_trailing_sep which was called 10181 times, avg 46µs/call: # 10181 times (140ms+329ms) by File::Basename::dirname at line 319, avg 46µs/call sub _strip_trailing_sep {
332	30543	479ms			my $type = $Fileparse_fstype;
333
334					if ($type eq 'MacOS') {
335					$_[0] =~ s/([^:]):\z/$1/s;
336					}
337					elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
338					$_[0] =~ s/([^:])[\\\/]*\z/$1/;
339					}
340					else {
341			30543	329ms	$_[0] =~ s{(.)/*\z}{$1}s; # spent 286ms making 10181 calls to File::Basename::CORE:subst, avg 28µs/call # spent 42.8ms making 20362 calls to File::Basename::CORE:substcont, avg 2µs/call
342					}
343					}
344
345
346					=item C<fileparse_set_fstype>
347					X<filesystem>
348
349					my $type = fileparse_set_fstype();
350					my $previous_type = fileparse_set_fstype($type);
351
352					Normally File::Basename will assume a file path type native to your current
353					operating system (ie. /foo/bar style on Unix, \foo\bar on Windows, etc...).
354					With this function you can override that assumption.
355
356					Valid $types are "MacOS", "VMS", "AmigaOS", "OS2", "RISCOS",
357					"MSWin32", "DOS" (also "MSDOS" for backwards bug compatibility),
358					"Epoc" and "Unix" (all case-insensitive). If an unrecognized $type is
359					given "Unix" will be assumed.
360
361					If you've selected VMS syntax, and the file specification you pass to
362					one of these routines contains a "/", they assume you are using Unix
363					emulation and apply the Unix syntax rules instead, for that function
364					call only.
365
366					=back
367
368					=cut
369
370
371					# spent 23µs within File::Basename::BEGIN@371 which was called: # once (23µs+0s) by File::Path::BEGIN@7 at line 394 BEGIN {
372
373	2	20µs			my @Ignore_Case = qw(MacOS VMS AmigaOS OS2 RISCOS MSWin32 MSDOS DOS Epoc);
374					my @Types = (@Ignore_Case, qw(Unix));
375
376					# spent 173µs (84+88) within File::Basename::fileparse_set_fstype which was called: # once (84µs+88µs) by File::Path::BEGIN@7 at line 59 sub fileparse_set_fstype {
377	17	176µs			my $old = $Fileparse_fstype;
378
379					if (@_) {
380					my $new_type = shift;
381
382					$Fileparse_fstype = 'Unix'; # default
383					foreach my $type (@Types) {
384			20	88µs	$Fileparse_fstype = $type if $new_type =~ /^$type/i; # spent 76µs making 10 calls to File::Basename::CORE:regcomp, avg 8µs/call # spent 12µs making 10 calls to File::Basename::CORE:match, avg 1µs/call
385					}
386
387					$Fileparse_igncase =
388					(grep $Fileparse_fstype eq $_, @Ignore_Case) ? 1 : 0;
389					}
390
391					return $old;
392					}
393
394	1	74µs	1	23µs	} # spent 23µs making 1 call to File::Basename::BEGIN@371
395
396
397	1	27µs			1;
398
399
400					=head1 SEE ALSO
401
402					L<dirname(1)>, L<basename(1)>, L<File::Spec>

					# spent 52.0ms within File::Basename::CORE:match which was called 10191 times, avg 5µs/call: # 10181 times (52.0ms+0s) by File::Basename::fileparse at line 147, avg 5µs/call # 10 times (12µs+0s) by File::Basename::fileparse_set_fstype at line 384, avg 1µs/call sub File::Basename::CORE:match; # opcode
					# spent 76µs within File::Basename::CORE:regcomp which was called 10 times, avg 8µs/call: # 10 times (76µs+0s) by File::Basename::fileparse_set_fstype at line 384, avg 8µs/call sub File::Basename::CORE:regcomp; # opcode
					# spent 286ms within File::Basename::CORE:subst which was called 10181 times, avg 28µs/call: # 10181 times (286ms+0s) by File::Basename::_strip_trailing_sep at line 341, avg 28µs/call sub File::Basename::CORE:subst; # opcode
					# spent 42.8ms within File::Basename::CORE:substcont which was called 20362 times, avg 2µs/call: # 20362 times (42.8ms+0s) by File::Basename::_strip_trailing_sep at line 341, avg 2µs/call sub File::Basename::CORE:substcont; # opcode