Profile of File/Basename.pm

← Index
NYTProf Performance Profile «line view»
For script/ponapi
Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:08 2016

Filename | /usr/share/perl/5.18/File/Basename.pm
Statements | Executed 209 statements in 1.80ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
8 | 2 | 2 | 139µs | 165µs | File::Basename::::fileparseFile::Basename::fileparse
1 | 1 | 1 | 38µs | 66µs | File::Basename::::fileparse_set_fstypeFile::Basename::fileparse_set_fstype
2 | 1 | 1 | 33µs | 43µs | File::Basename::::_strip_trailing_sepFile::Basename::_strip_trailing_sep
16 | 2 | 1 | 29µs | 29µs | File::Basename::::CORE:regcompFile::Basename::CORE:regcomp (opcode)
2 | 2 | 2 | 22µs | 104µs | File::Basename::::basenameFile::Basename::basename
18 | 2 | 1 | 19µs | 19µs | File::Basename::::CORE:matchFile::Basename::CORE:match (opcode)
8 | 2 | 1 | 17µs | 17µs | File::Basename::::CORE:substFile::Basename::CORE:subst (opcode)
1 | 1 | 1 | 10µs | 10µs | File::Basename::::BEGIN@371File::Basename::BEGIN@371
1 | 1 | 1 | 7µs | 7µs | File::Basename::::BEGIN@51File::Basename::BEGIN@51
1 | 1 | 1 | 6µs | 6µs | File::Basename::::BEGIN@42File::Basename::BEGIN@42
1 | 1 | 1 | 6µs | 8µs | File::Basename::::BEGIN@52File::Basename::BEGIN@52
1 | 1 | 1 | 5µs | 13µs | File::Basename::::BEGIN@50File::Basename::BEGIN@50
0 | 0 | 0 | 0s | 0s | File::Basename::::dirnameFile::Basename::dirname

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 6µs within File::Basename::BEGIN@42 which was called: # once (6µs+0s) by App::Cmd::BEGIN@11 at line 47 BEGIN {
43 | 1 | 4µs |  |  | if (${^TAINT}) {
44 |  |  |  |  | require re;
45 |  |  |  |  | re->import('taint');
46 |  |  |  |  | }
47 | 1 | 16µs | 1 | 6µs | } # spent 6µs making 1 call to File::Basename::BEGIN@42
48 |  |  |  |  |
49 |  |  |  |  |
50 | 2 | 16µs | 2 | 21µs | # spent 13µs (5+8) within File::Basename::BEGIN@50 which was called: # once (5µs+8µs) by App::Cmd::BEGIN@11 at line 50 use strict; # spent 13µs making 1 call to File::Basename::BEGIN@50 # spent 8µs making 1 call to strict::import
51 | 2 | 33µs | 1 | 7µs | # spent 7µs within File::Basename::BEGIN@51 which was called: # once (7µs+0s) by App::Cmd::BEGIN@11 at line 51 use 5.006; # spent 7µs making 1 call to File::Basename::BEGIN@51
52 | 2 | 910µs | 2 | 11µs | # spent 8µs (6+3) within File::Basename::BEGIN@52 which was called: # once (6µs+3µs) by App::Cmd::BEGIN@11 at line 52 use warnings; # spent 8µs making 1 call to File::Basename::BEGIN@52 # spent 3µs making 1 call to warnings::import
53 | 1 | 500ns |  |  | our(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase);
54 | 1 | 476µs |  |  | require Exporter;
55 | 1 | 4µs |  |  | @ISA = qw(Exporter);
56 | 1 | 800ns |  |  | @EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
57 | 1 | 200ns |  |  | $VERSION = "2.84";
58 |  |  |  |  |
59 | 1 | 1µs | 1 | 66µs | fileparse_set_fstype($^O); # spent 66µ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 L</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 165µs (139+26) within File::Basename::fileparse which was called 8 times, avg 21µs/call: # 6 times (106µs+21µs) by Module::Pluggable::Object::search_paths at line 193 of Module/Pluggable/Object.pm, avg 21µs/call # 2 times (33µs+5µs) by File::Basename::basename at line 222, avg 19µs/call sub fileparse {
105 | 8 | 6µs |  |  | my($fullname,@suffices) = @_;
106 |  |  |  |  |
107 | 8 | 4µs |  |  | unless (defined $fullname) {
108 |  |  |  |  | require Carp;
109 |  |  |  |  | Carp::croak("fileparse(): need a valid pathname");
110 |  |  |  |  | }
111 |  |  |  |  |
112 | 8 | 3µs |  |  | my $orig_type = '';
113 | 8 | 3µs |  |  | my($type,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
114 |  |  |  |  |
115 | 8 | 7µs |  |  | my($taint) = substr($fullname,0,0); # Is $fullname tainted?
116 |  |  |  |  |
117 | 8 | 2µs |  |  | if ($type eq "VMS" and $fullname =~ m{/} ) {
118 |  |  |  |  | # We're doing Unix emulation
119 |  |  |  |  | $orig_type = $type;
120 |  |  |  |  | $type = 'Unix';
121 |  |  |  |  | }
122 |  |  |  |  |
123 | 8 | 1µs |  |  | my($dirpath, $basename);
124 |  |  |  |  |
125 | 8 | 20µs |  |  | 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 | 8 | 35µs | 8 | 14µs | ($dirpath,$basename) = ($fullname =~ m{^(.*/)?(.*)}s); # spent 14µs making 8 calls to File::Basename::CORE:match, avg 2µs/call
148 | 8 | 3µs |  |  | 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 | 8 | 2µs |  |  | $dirpath = './' unless $dirpath;
158 |  |  |  |  | }
159 |  |  |  |  |
160 |  |  |  |  |
161 | 8 | 2µs |  |  | my $tail = '';
162 | 8 | 1µs |  |  | my $suffix = '';
163 | 8 | 3µs |  |  | if (@suffices) {
164 | 6 | 2µs |  |  | foreach $suffix (@suffices) {
165 | 6 | 5µs |  |  | my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
166 | 6 | 35µs | 12 | 12µs | if ($basename =~ s/$pat//s) { # spent 6µs making 6 calls to File::Basename::CORE:subst, avg 967ns/call # spent 6µs making 6 calls to File::Basename::CORE:regcomp, avg 950ns/call
167 | 6 | 3µs |  |  | $taint .= substr($suffix,0,0);
168 | 6 | 6µs |  |  | $tail = $1 . $tail;
169 |  |  |  |  | }
170 |  |  |  |  | }
171 |  |  |  |  | }
172 |  |  |  |  |
173 |  |  |  |  | # Ensure taint is propagated from the path to its pieces.
174 | 8 | 2µs |  |  | $tail .= $taint;
175 | 8 | 26µs |  |  | 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 |  |  |  |  | # spent 104µs (22+82) within File::Basename::basename which was called 2 times, avg 52µs/call: # once (10µs+49µs) by App::Cmd::new at line 165 of App/Cmd.pm # once (12µs+33µs) by Getopt::Long::Descriptive::BEGIN@262 at line 264 of Getopt/Long/Descriptive.pm sub basename {
215 | 2 | 2µs |  |  | 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 | 2 | 12µs | 2 | 43µs | _strip_trailing_sep($path); # spent 43µs making 2 calls to File::Basename::_strip_trailing_sep, avg 22µs/call
221 |  |  |  |  |
222 | 2 | 6µs | 2 | 38µs | my($basename, $dirname, $suffix) = fileparse( $path, map("\Q$_\E",@_) ); # spent 38µs making 2 calls to File::Basename::fileparse, avg 19µs/call
223 |  |  |  |  |
224 |  |  |  |  | # From BSD basename(1)
225 |  |  |  |  | # The suffix is not stripped if it is identical to the remaining
226 |  |  |  |  | # characters in string.
227 | 2 | 1µs |  |  | if( length $suffix and !length $basename ) {
228 |  |  |  |  | $basename = $suffix;
229 |  |  |  |  | }
230 |  |  |  |  |
231 |  |  |  |  | # Ensure that basename '/' == '/'
232 | 2 | 500ns |  |  | if( !length $basename ) {
233 |  |  |  |  | $basename = $dirname;
234 |  |  |  |  | }
235 |  |  |  |  |
236 | 2 | 6µs |  |  | 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 |  |  |  |  | sub dirname {
284 |  |  |  |  | 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 |  |  |  |  | my($basename, $dirname) = fileparse($path);
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 |  |  |  |  | _strip_trailing_sep($dirname);
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 43µs (33+11) within File::Basename::_strip_trailing_sep which was called 2 times, avg 22µs/call: # 2 times (33µs+11µs) by File::Basename::basename at line 220, avg 22µs/call sub _strip_trailing_sep {
332 | 2 | 1µs |  |  | my $type = $Fileparse_fstype;
333 |  |  |  |  |
334 | 2 | 12µs |  |  | 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 | 2 | 24µs | 2 | 11µs | $_[0] =~ s{(.)/*\z}{$1}s; # spent 11µs making 2 calls to File::Basename::CORE:subst, avg 5µ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 10µs within File::Basename::BEGIN@371 which was called: # once (10µs+0s) by App::Cmd::BEGIN@11 at line 394 BEGIN {
372 |  |  |  |  |
373 | 1 | 2µs |  |  | my @Ignore_Case = qw(MacOS VMS AmigaOS OS2 RISCOS MSWin32 MSDOS DOS Epoc);
374 | 1 | 8µs |  |  | my @Types = (@Ignore_Case, qw(Unix));
375 |  |  |  |  |
376 |  |  |  |  | # spent 66µs (38+28) within File::Basename::fileparse_set_fstype which was called: # once (38µs+28µs) by App::Cmd::BEGIN@11 at line 59 sub fileparse_set_fstype {
377 | 1 | 200ns |  |  | my $old = $Fileparse_fstype;
378 |  |  |  |  |
379 | 1 | 400ns |  |  | if (@_) {
380 | 1 | 2µs |  |  | my $new_type = shift;
381 |  |  |  |  |
382 | 1 | 200ns |  |  | $Fileparse_fstype = 'Unix'; # default
383 | 1 | 500ns |  |  | foreach my $type (@Types) {
384 | 10 | 59µs | 20 | 28µs | $Fileparse_fstype = $type if $new_type =~ /^$type/i; # spent 24µs making 10 calls to File::Basename::CORE:regcomp, avg 2µs/call # spent 5µs making 10 calls to File::Basename::CORE:match, avg 460ns/call
385 |  |  |  |  | }
386 |  |  |  |  |
387 |  |  |  |  | $Fileparse_igncase =
388 | 1 | 3µs |  |  | (grep $Fileparse_fstype eq $_, @Ignore_Case) ? 1 : 0;
389 |  |  |  |  | }
390 |  |  |  |  |
391 | 1 | 3µs |  |  | return $old;
392 |  |  |  |  | }
393 |  |  |  |  |
394 | 1 | 18µs | 1 | 10µs | } # spent 10µs making 1 call to File::Basename::BEGIN@371
395 |  |  |  |  |
396 |  |  |  |  |
397 | 1 | 4µs |  |  | 1;
398 |  |  |  |  |
399 |  |  |  |  |
400 |  |  |  |  | =head1 SEE ALSO
401 |  |  |  |  |
402 |  |  |  |  | L<dirname(1)>, L<basename(1)>, L<File::Spec>
|  |  |  |  | # spent 19µs within File::Basename::CORE:match which was called 18 times, avg 1µs/call: # 10 times (5µs+0s) by File::Basename::fileparse_set_fstype at line 384, avg 460ns/call # 8 times (14µs+0s) by File::Basename::fileparse at line 147, avg 2µs/call sub File::Basename::CORE:match; # opcode
|  |  |  |  | # spent 29µs within File::Basename::CORE:regcomp which was called 16 times, avg 2µs/call: # 10 times (24µs+0s) by File::Basename::fileparse_set_fstype at line 384, avg 2µs/call # 6 times (6µs+0s) by File::Basename::fileparse at line 166, avg 950ns/call sub File::Basename::CORE:regcomp; # opcode
|  |  |  |  | # spent 17µs within File::Basename::CORE:subst which was called 8 times, avg 2µs/call: # 6 times (6µs+0s) by File::Basename::fileparse at line 166, avg 967ns/call # 2 times (11µs+0s) by File::Basename::_strip_trailing_sep at line 341, avg 5µs/call sub File::Basename::CORE:subst; # opcode