This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
File::Basename::dirname bugs
[perl5.git] / lib / File / Basename.pm
CommitLineData
a0d0e21e
LW
1package File::Basename;
2
f06db76b
AD
3=head1 NAME
4
f06db76b
AD
5fileparse - split a pathname into pieces
6
7basename - extract just the filename from a path
8
9dirname - extract just the directory from a path
10
11=head1 SYNOPSIS
12
13 use File::Basename;
14
15 ($name,$path,$suffix) = fileparse($fullname,@suffixlist)
16 fileparse_set_fstype($os_string);
17 $basename = basename($fullname,@suffixlist);
18 $dirname = dirname($fullname);
19
20 ($name,$path,$suffix) = fileparse("lib/File/Basename.pm","\.pm");
21 fileparse_set_fstype("VMS");
22 $basename = basename("lib/File/Basename.pm",".pm");
23 $dirname = dirname("lib/File/Basename.pm");
24
25=head1 DESCRIPTION
26
27These routines allow you to parse file specifications into useful
28pieces using the syntax of different operating systems.
29
30=over 4
31
32=item fileparse_set_fstype
33
34You select the syntax via the routine fileparse_set_fstype().
35If the argument passed to it contains one of the substrings
55497cff
PP
36"VMS", "MSDOS", "MacOS" or "AmigaOS", the file specification
37syntax of that operating system is used in future calls to
38fileparse(), basename(), and dirname(). If it contains none of
39these substrings, UNIX syntax is used. This pattern matching is
f06db76b
AD
40case-insensitive. If you've selected VMS syntax, and the file
41specification you pass to one of these routines contains a "/",
42they assume you are using UNIX emulation and apply the UNIX syntax
43rules instead, for that function call only.
44
45If you haven't called fileparse_set_fstype(), the syntax is chosen
f0c6ccdf 46by examining the builtin variable C<$^O> according to these rules.
f06db76b
AD
47
48=item fileparse
49
50The fileparse() routine divides a file specification into three
51parts: a leading B<path>, a file B<name>, and a B<suffix>. The
52B<path> contains everything up to and including the last directory
53separator in the input file specification. The remainder of the input
54file specification is then divided into B<name> and B<suffix> based on
55the optional patterns you specify in C<@suffixlist>. Each element of
56this list is interpreted as a regular expression, and is matched
57against the end of B<name>. If this succeeds, the matching portion of
58B<name> is removed and prepended to B<suffix>. By proper use of
59C<@suffixlist>, you can remove file types or versions for examination.
60
61You are guaranteed that if you concatenate B<path>, B<name>, and
7e2183d3
PP
62B<suffix> together in that order, the result will denote the same
63file as the input file specification.
f06db76b
AD
64
65=back
66
67=head1 EXAMPLES
68
69Using UNIX file syntax:
70
7e2183d3 71 ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',
f06db76b
AD
72 '\.book\d+');
73
74would yield
75
76 $base eq 'draft'
7e2183d3 77 $path eq '/virgil/aeneid/',
f0542300 78 $type eq '.book7'
f06db76b
AD
79
80Similarly, using VMS syntax:
81
82 ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh',
83 '\..*');
84
85would yield
86
87 $name eq 'Rhetoric'
88 $dir eq 'Doc_Root:[Help]'
89 $type eq '.Rnh'
90
91=item C<basename>
92
93The basename() routine returns the first element of the list produced
94by calling fileparse() with the same arguments. It is provided for
95compatibility with the UNIX shell command basename(1).
96
97=item C<dirname>
98
99The dirname() routine returns the directory portion of the input file
100specification. When using VMS or MacOS syntax, this is identical to the
101second element of the list produced by calling fileparse() with the same
7e2183d3
PP
102input file specification. (Under VMS, if there is no directory information
103in the input file specification, then the current default device and
104directory are returned.) When using UNIX or MSDOS syntax, the return
f06db76b
AD
105value conforms to the behavior of the UNIX shell command dirname(1). This
106is usually the same as the behavior of fileparse(), but differs in some
107cases. For example, for the input file specification F<lib/>, fileparse()
108considers the directory name to be F<lib/>, while dirname() considers the
109directory name to be F<.>).
110
111=cut
112
f0c6ccdf 113require 5.002;
a0d0e21e
LW
114require Exporter;
115@ISA = qw(Exporter);
748a9306 116@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
7e2183d3
PP
117#use strict;
118#use vars qw($VERSION $Fileparse_fstype);
f0542300 119$VERSION = "2.4";
7e2183d3 120
a0d0e21e
LW
121
122# fileparse_set_fstype() - specify OS-based rules used in future
123# calls to routines in this package
124#
125# Currently recognized values: VMS, MSDOS, MacOS
126# Any other name uses Unix-style rules
127
128sub fileparse_set_fstype {
748a9306
LW
129 my($old) = $Fileparse_fstype;
130 $Fileparse_fstype = $_[0] if $_[0];
131 $old;
a0d0e21e
LW
132}
133
134# fileparse() - parse file specification
135#
f0542300 136# Version 2.4 27-Sep-1996 Charles Bailey bailey@genetics.upenn.edu
a0d0e21e
LW
137
138
139sub fileparse {
140 my($fullname,@suffices) = @_;
141 my($fstype) = $Fileparse_fstype;
7e2183d3 142 my($dirpath,$tail,$suffix,$basename);
a0d0e21e
LW
143
144 if ($fstype =~ /^VMS/i) {
145 if ($fullname =~ m#/#) { $fstype = '' } # We're doing Unix emulation
146 else {
f0542300 147 ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/);
a0d0e21e
LW
148 }
149 }
150 if ($fstype =~ /^MSDOS/i) {
f0542300 151 ($dirpath,$basename) = ($fullname =~ /^(.*[:\\\/])?(.*)/);
42568e28 152 $dirpath .= '.\\' unless $dirpath =~ /[\\\/]$/;
a0d0e21e 153 }
7e2183d3 154 elsif ($fstype =~ /^MacOS/i) {
f0542300 155 ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/);
a0d0e21e 156 }
55497cff
PP
157 elsif ($fstype =~ /^AmigaOS/i) {
158 ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/);
159 }
748a9306 160 elsif ($fstype !~ /^VMS/i) { # default to Unix
f0542300 161 ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#);
f0c6ccdf 162 $dirpath = './' unless $dirpath;
a0d0e21e
LW
163 }
164
165 if (@suffices) {
f06db76b 166 $tail = '';
a0d0e21e 167 foreach $suffix (@suffices) {
7e2183d3
PP
168 if ($basename =~ /([\x00-\xff]*?)($suffix)$/) {
169 $tail = $2 . $tail;
170 $basename = $1;
a0d0e21e
LW
171 }
172 }
173 }
174
748a9306 175 wantarray ? ($basename,$dirpath,$tail) : $basename;
a0d0e21e
LW
176
177}
178
179
180# basename() - returns first element of list returned by fileparse()
181
182sub basename {
748a9306
LW
183 my($name) = shift;
184 (fileparse($name, map("\Q$_\E",@_)))[0];
a0d0e21e 185}
7e2183d3 186
a0d0e21e
LW
187
188# dirname() - returns device and directory portion of file specification
189# Behavior matches that of Unix dirname(1) exactly for Unix and MSDOS
748a9306
LW
190# filespecs except for names ending with a separator, e.g., "/xx/yy/".
191# This differs from the second element of the list returned
a0d0e21e
LW
192# by fileparse() in that the trailing '/' (Unix) or '\' (MSDOS) (and
193# the last directory name if the filespec ends in a '/' or '\'), is lost.
194
195sub dirname {
196 my($basename,$dirname) = fileparse($_[0]);
197 my($fstype) = $Fileparse_fstype;
198
199 if ($fstype =~ /VMS/i) {
748a9306 200 if ($_[0] =~ m#/#) { $fstype = '' }
7e2183d3 201 else { return $dirname || $ENV{DEFAULT} }
a0d0e21e
LW
202 }
203 if ($fstype =~ /MacOS/i) { return $dirname }
204 elsif ($fstype =~ /MSDOS/i) {
42568e28
RB
205 $dirname =~ s/([^:])[\\\/]*$/$1/;
206 unless( length($basename) ) {
207 ($basename,$dirname) = fileparse $dirname;
208 $dirname =~ s/([^:])[\\\/]*$/$1/;
209 }
a0d0e21e 210 }
55497cff
PP
211 elsif ($fstype =~ /AmigaOS/i) {
212 if ( $dirname =~ /:$/) { return $dirname }
213 chop $dirname;
214 $dirname =~ s#[^:/]+$## unless length($basename);
215 }
a0d0e21e 216 else {
42568e28
RB
217 $dirname =~ s:(.)/*$:$1:;
218 unless( length($basename) ) {
219 local($File::Basename::Fileparse_fstype) = $fstype;
220 ($basename,$dirname) = fileparse $dirname;
221 $dirname =~ s:(.)/*$:$1:;
222 }
a0d0e21e
LW
223 }
224
225 $dirname;
226}
227
f0c6ccdf 228$Fileparse_fstype = $^O;
a0d0e21e
LW
229
2301;