3 File::Basename - Parse file paths into directory, filename and suffix.
9 ($name,$path,$suffix) = fileparse($fullname,@suffixlist);
10 $name = fileparse($fullname,@suffixlist);
12 $basename = basename($fullname,@suffixlist);
13 $dirname = dirname($fullname);
18 These routines allow you to parse file paths into their directory, filename
21 B<NOTE>: C<dirname()> and C<basename()> emulate the behaviours, and quirks, of
22 the shell and C functions of the same name. See each function's documention
28 package File::Basename;
30 # A bit of juggling to insure that C<use re 'taint';> always works, since
31 # File::Basename is used during the Perl build, when the re extension may
34 unless (eval { require re; })
35 { eval ' sub re::import { $^H |= 0x00100000; } ' } # HINT_RE_TAINT
43 our(@ISA, @EXPORT, $VERSION, $Fileparse_fstype, $Fileparse_igncase);
46 @EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
49 fileparse_set_fstype($^O);
56 my($filename, $directories, $suffix) = fileparse($path);
57 my($filename, $directories, $suffix) = fileparse($path, @suffixes);
58 my $filename = fileparse($path, @suffixes);
60 The C<fileparse()> routine divides a file path into its $directories, $filename
61 and (optionally) the filename $suffix.
63 $directories contains everything up to and including the last
64 directory separator in the $path including the volume (if applicable).
65 The remainder of the $path is the $filename.
67 # On Unix returns ("baz", "/foo/bar/", "")
68 fileparse("/foo/bar/baz");
70 # On Windows returns ("baz", "C:\foo\bar\", "")
71 fileparse("C:\foo\bar\baz");
73 # On Unix returns ("", "/foo/bar/baz/", "")
74 fileparse("/foo/bar/baz/");
76 If @suffixes are given each element is a pattern (either a string or a
77 C<qr//>) matched against the end of the $filename. The matching
78 portion is removed and becomes the $suffix.
80 # On Unix returns ("baz", "/foo/bar", ".txt")
81 fileparse("/foo/bar/baz", qr/\.[^.]*/);
83 If type is non-Unix (see C<fileparse_set_fstype()>) then the pattern
84 matching for suffix removal is performed case-insensitively, since
85 those systems are not case-sensitive when opening existing files.
87 You are guaranteed that C<$directories . $filename . $suffix> will
88 denote the same location as the original $path.
94 my($fullname,@suffices) = @_;
96 unless (defined $fullname) {
98 Carp::croak("fileparse(): need a valid pathname");
102 my($type,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
104 my($taint) = substr($fullname,0,0); # Is $fullname tainted?
106 if ($type eq "VMS" and $fullname =~ m{/} ) {
107 # We're doing Unix emulation
112 my($dirpath, $basename);
114 if (grep { $type eq $_ } qw(MSDOS DOS MSWin32 Epoc)) {
115 ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s);
116 $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/;
118 elsif ($type eq "OS2") {
119 ($dirpath,$basename) = ($fullname =~ m#^((?:.*[:\\/])?)(.*)#s);
120 $dirpath = './' unless $dirpath; # Can't be 0
121 $dirpath .= '/' unless $dirpath =~ m#[\\/]\z#;
123 elsif ($type eq "MacOS") {
124 ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
125 $dirpath = ':' unless $dirpath;
127 elsif ($type eq "AmigaOS") {
128 ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s);
129 $dirpath = './' unless $dirpath;
131 elsif ($type eq 'VMS' ) {
132 ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/s);
133 $dirpath ||= ''; # should always be defined
135 else { # Default to Unix semantics.
136 ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#s);
137 if ($orig_type eq 'VMS' and $fullname =~ m:^(/[^/]+/000000(/|$))(.*):) {
138 # dev:[000000] is top of VMS tree, similar to Unix '/'
139 # so strip it off and treat the rest as "normal"
142 ($dirpath,$basename) = ($remainder =~ m#^(.*/)?(.*)#s);
143 $dirpath ||= ''; # should always be defined
144 $dirpath = $devspec.$dirpath;
146 $dirpath = './' unless $dirpath;
153 foreach $suffix (@suffices) {
154 my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
155 if ($basename =~ s/$pat//s) {
156 $taint .= substr($suffix,0,0);
162 # Ensure taint is propgated from the path to its pieces.
163 $tail .= $taint if defined $tail; # avoid warning if $tail == undef
164 wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail)
165 : ($basename .= $taint);
172 my $filename = basename($path);
173 my $filename = basename($path, @suffixes);
175 C<basename()> works just like C<fileparse()> in scalar context - you only get
176 the $filename - except that it always quotes metacharacters in the @suffixes.
178 # These two function calls are equivalent.
179 my $filename = basename("/foo/bar/baz.txt", ".txt");
180 my $filename = fileparse("/foo/bar/baz.txt", qr/\Q.txt\E/);
182 This function is provided for compatibility with the Unix shell command
190 (fileparse($name, map("\Q$_\E",@_)))[0];
197 This function is provided for compatibility with the Unix shell
198 command C<dirname(1)> and has inherited some of its quirks. In spite of
199 its name it does B<NOT> always return the directory name as you might
200 expect. To be safe, if you want the directory name of a path use
203 Only on VMS (where there is no ambiguity between the file and directory
204 portions of a path) and AmigaOS (possibly due to an implementation quirk in
205 this module) does C<dirname()> work like C<fileparse($path)>, returning just the
209 my $directories = dirname($path);
211 When using Unix or MSDOS syntax this emulates the C<dirname(1)> shell function
212 which is subtly different from how C<fileparse()> works. It returns all but
213 the last level of a file path even if the last level is clearly a directory.
214 In effect, it is not returning the directory portion but simply the path one
215 level up acting like C<chop()> for file paths.
217 Also unlike C<fileparse()>, C<dirname()> does not include a trailing slash on
220 # returns /foo/bar. fileparse() would return /foo/bar/
221 dirname("/foo/bar/baz");
223 # also returns /foo/bar despite the fact that baz is clearly a
224 # directory. fileparse() would return /foo/bar/baz/
225 dirname("/foo/bar/baz/");
227 # returns '.'. fileparse() would return 'foo/'
230 Under VMS, if there is no directory information in the $path, then the
231 current default device and directory is used.
239 my($type) = $Fileparse_fstype;
241 if( $type eq 'VMS' and $path =~ m{/} ) {
243 local($File::Basename::Fileparse_fstype) = '';
244 return dirname($path);
247 my($basename, $dirname) = fileparse($path);
249 if ($type eq 'VMS') {
250 $dirname ||= $ENV{DEFAULT};
252 elsif ($type eq 'MacOS') {
253 if( !length($basename) && $dirname !~ /^[^:]+:\z/) {
254 $dirname =~ s/([^:]):\z/$1/s;
255 ($basename,$dirname) = fileparse $dirname;
257 $dirname .= ":" unless $dirname =~ /:\z/;
259 elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
260 $dirname =~ s/([^:])[\\\/]*\z/$1/;
261 unless( length($basename) ) {
262 ($basename,$dirname) = fileparse $dirname;
263 $dirname =~ s/([^:])[\\\/]*\z/$1/;
266 elsif ($type eq 'AmigaOS') {
267 if ( $dirname =~ /:\z/) { return $dirname }
269 $dirname =~ s#[^:/]+\z## unless length($basename);
272 $dirname =~ s{(.)/*\z}{$1}s;
273 unless( length($basename) ) {
274 ($basename,$dirname) = fileparse $dirname;
275 $dirname =~ s{(.)/*\z}{$1}s;
283 =item C<fileparse_set_fstype>
285 my $type = fileparse_set_fstype();
286 my $previous_type = fileparse_set_fstype($type);
288 Normally File::Basename will assume a file path type native to your current
289 operating system (ie. /foo/bar style on Unix, \foo\bar on Windows, etc...).
290 With this function you can override that assumption.
292 Valid $types are "MacOS", "VMS", "AmigaOS", "OS2", "RISCOS",
293 "MSWin32", "DOS" (also "MSDOS" for backwards bug compatibility),
294 "Epoc" and "Unix" (all case-insensitive). If an unrecognized $type is
295 given "Unix" will be assumed.
297 If you've selected VMS syntax, and the file specification you pass to
298 one of these routines contains a "/", they assume you are using Unix
299 emulation and apply the Unix syntax rules instead, for that function
309 my @Ignore_Case = qw(MacOS VMS AmigaOS OS2 RISCOS MSWin32 MSDOS DOS Epoc);
310 my @Types = (@Ignore_Case, qw(Unix));
312 sub fileparse_set_fstype {
313 my $old = $Fileparse_fstype;
316 my $new_type = shift;
318 $Fileparse_fstype = 'Unix'; # default
319 foreach my $type (@Types) {
320 $Fileparse_fstype = $type if $new_type =~ /^$type/i;
324 (grep $Fileparse_fstype eq $_, @Ignore_Case) ? 1 : 0;