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