This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
0678ade5ecaa4587a1ba5e626d1096c989e1c576
[perl5.git] / ext / File / Glob / Glob.pm
1 package File::Glob;
2
3 use strict;
4 use Carp;
5 our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS,
6     $AUTOLOAD, $DEFAULT_FLAGS);
7
8 require Exporter;
9 use XSLoader ();
10 require AutoLoader;
11
12 @ISA = qw(Exporter AutoLoader);
13
14 @EXPORT_OK   = qw(
15     csh_glob
16     glob
17     GLOB_ABEND
18     GLOB_ALTDIRFUNC
19     GLOB_BRACE
20     GLOB_CSH
21     GLOB_ERR
22     GLOB_ERROR
23     GLOB_MARK
24     GLOB_NOCASE
25     GLOB_NOCHECK
26     GLOB_NOMAGIC
27     GLOB_NOSORT
28     GLOB_NOSPACE
29     GLOB_QUOTE
30     GLOB_TILDE
31 );
32
33 %EXPORT_TAGS = (
34     'glob' => [ qw(
35         GLOB_ABEND
36         GLOB_ALTDIRFUNC
37         GLOB_BRACE
38         GLOB_CSH
39         GLOB_ERR
40         GLOB_ERROR
41         GLOB_MARK
42         GLOB_NOCASE
43         GLOB_NOCHECK
44         GLOB_NOMAGIC
45         GLOB_NOSORT
46         GLOB_NOSPACE
47         GLOB_QUOTE
48         GLOB_TILDE
49         glob
50     ) ],
51 );
52
53 $VERSION = '0.991';
54
55 sub import {
56     my $i = 1;
57     while ($i < @_) {
58         if ($_[$i] =~ /^:(case|nocase|globally)$/) {
59             splice(@_, $i, 1);
60             $DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case';
61             $DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase';
62             if ($1 eq 'globally') {
63                 local $^W;
64                 *CORE::GLOBAL::glob = \&File::Glob::csh_glob;
65             }
66             next;
67         }
68         ++$i;
69     }
70     goto &Exporter::import;
71 }
72
73 sub AUTOLOAD {
74     # This AUTOLOAD is used to 'autoload' constants from the constant()
75     # XS function.  If a constant is not found then control is passed
76     # to the AUTOLOAD in AutoLoader.
77
78     my $constname;
79     ($constname = $AUTOLOAD) =~ s/.*:://;
80     my $val = constant($constname, @_ ? $_[0] : 0);
81     if ($! != 0) {
82         if ($! =~ /Invalid/) {
83             $AutoLoader::AUTOLOAD = $AUTOLOAD;
84             goto &AutoLoader::AUTOLOAD;
85         }
86         else {
87                 croak "Your vendor has not defined File::Glob macro $constname";
88         }
89     }
90     eval "sub $AUTOLOAD { $val }";
91     goto &$AUTOLOAD;
92 }
93
94 XSLoader::load 'File::Glob', $VERSION;
95
96 # Preloaded methods go here.
97
98 sub GLOB_ERROR {
99     return constant('GLOB_ERROR', 0);
100 }
101
102 sub GLOB_CSH () { GLOB_BRACE() | GLOB_NOMAGIC() | GLOB_QUOTE() | GLOB_TILDE() }
103
104 $DEFAULT_FLAGS = GLOB_CSH();
105 if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
106     $DEFAULT_FLAGS |= GLOB_NOCASE();
107 }
108
109 # Autoload methods go after =cut, and are processed by the autosplit program.
110
111 sub glob {
112     my ($pat,$flags) = @_;
113     $flags = $DEFAULT_FLAGS if @_ < 2;
114     if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
115         $flags |= GLOB_NOCASE();
116     }
117     return doglob($pat,$flags);
118 }
119
120 ## borrowed heavily from gsar's File::DosGlob
121 my %iter;
122 my %entries;
123
124 sub csh_glob {
125     my $pat = shift;
126     my $cxix = shift;
127     my @pat;
128
129     # glob without args defaults to $_
130     $pat = $_ unless defined $pat;
131
132     # extract patterns
133     if ($pat =~ /\s/) {
134         # XXX this is needed for compatibility with the csh
135         # implementation in Perl.  Need to support a flag
136         # to disable this behavior.
137         require Text::ParseWords;
138         @pat = Text::ParseWords::parse_line('\s+',0,$pat);
139     }
140
141     # assume global context if not provided one
142     $cxix = '_G_' unless defined $cxix;
143     $iter{$cxix} = 0 unless exists $iter{$cxix};
144
145     # if we're just beginning, do it all first
146     if ($iter{$cxix} == 0) {
147         if (@pat) {
148             $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ];
149         }
150         else {
151             $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ];
152         }
153     }
154
155     # chuck it all out, quick or slow
156     if (wantarray) {
157         delete $iter{$cxix};
158         return @{delete $entries{$cxix}};
159     }
160     else {
161         if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
162             return shift @{$entries{$cxix}};
163         }
164         else {
165             # return undef for EOL
166             delete $iter{$cxix};
167             delete $entries{$cxix};
168             return undef;
169         }
170     }
171 }
172
173 1;
174 __END__
175
176 =head1 NAME
177
178 File::Glob - Perl extension for BSD glob routine
179
180 =head1 SYNOPSIS
181
182   use File::Glob ':glob';
183   @list = glob('*.[ch]');
184   $homedir = glob('~gnat', GLOB_TILDE | GLOB_ERR);
185   if (GLOB_ERROR) {
186     # an error occurred reading $homedir
187   }
188
189   ## override the core glob (core glob() does this automatically
190   ## by default anyway, since v5.6.0)
191   use File::Glob ':globally';
192   my @sources = <*.{c,h,y}>
193
194   ## override the core glob, forcing case sensitivity
195   use File::Glob qw(:globally :case);
196   my @sources = <*.{c,h,y}>
197
198   ## override the core glob forcing case insensitivity
199   use File::Glob qw(:globally :nocase);
200   my @sources = <*.{c,h,y}>
201
202 =head1 DESCRIPTION
203
204 File::Glob implements the FreeBSD glob(3) routine, which is a superset
205 of the POSIX glob() (described in IEEE Std 1003.2 "POSIX.2").  The
206 glob() routine takes a mandatory C<pattern> argument, and an optional
207 C<flags> argument, and returns a list of filenames matching the
208 pattern, with interpretation of the pattern modified by the C<flags>
209 variable.  The POSIX defined flags are:
210
211 =over 4
212
213 =item C<GLOB_ERR>
214
215 Force glob() to return an error when it encounters a directory it
216 cannot open or read.  Ordinarily glob() continues to find matches.
217
218 =item C<GLOB_MARK>
219
220 Each pathname that is a directory that matches the pattern has a slash
221 appended.
222
223 =item C<GLOB_NOCASE>
224
225 By default, file names are assumed to be case sensitive; this flag
226 makes glob() treat case differences as not significant.
227
228 =item C<GLOB_NOCHECK>
229
230 If the pattern does not match any pathname, then glob() returns a list
231 consisting of only the pattern.  If C<GLOB_QUOTE> is set, its effect
232 is present in the pattern returned.
233
234 =item C<GLOB_NOSORT>
235
236 By default, the pathnames are sorted in ascending ASCII order; this
237 flag prevents that sorting (speeding up glob()).
238
239 =back
240
241 The FreeBSD extensions to the POSIX standard are the following flags:
242
243 =over 4
244
245 =item C<GLOB_BRACE>
246
247 Pre-process the string to expand C<{pat,pat,...}> strings like csh(1).
248 The pattern '{}' is left unexpanded for historical reasons (and csh(1)
249 does the same thing to ease typing of find(1) patterns).
250
251 =item C<GLOB_NOMAGIC>
252
253 Same as C<GLOB_NOCHECK> but it only returns the pattern if it does not
254 contain any of the special characters "*", "?" or "[".  C<NOMAGIC> is
255 provided to simplify implementing the historic csh(1) globbing
256 behaviour and should probably not be used anywhere else.
257
258 =item C<GLOB_QUOTE>
259
260 Use the backslash ('\') character for quoting: every occurrence of a
261 backslash followed by a character in the pattern is replaced by that
262 character, avoiding any special interpretation of the character.
263 (But see below for exceptions on DOSISH systems).
264
265 =item C<GLOB_TILDE>
266
267 Expand patterns that start with '~' to user name home directories.
268
269 =item C<GLOB_CSH>
270
271 For convenience, C<GLOB_CSH> is a synonym for
272 C<GLOB_BRACE | GLOB_NOMAGIC | GLOB_QUOTE | GLOB_TILDE>.
273
274 =back
275
276 The POSIX provided C<GLOB_APPEND>, C<GLOB_DOOFFS>, and the FreeBSD
277 extensions C<GLOB_ALTDIRFUNC>, and C<GLOB_MAGCHAR> flags have not been
278 implemented in the Perl version because they involve more complex
279 interaction with the underlying C structures.
280
281 =head1 DIAGNOSTICS
282
283 glob() returns a list of matching paths, possibly zero length.  If an
284 error occurred, &File::Glob::GLOB_ERROR will be non-zero and C<$!> will be
285 set.  &File::Glob::GLOB_ERROR is guaranteed to be zero if no error occurred,
286 or one of the following values otherwise:
287
288 =over 4
289
290 =item C<GLOB_NOSPACE>
291
292 An attempt to allocate memory failed.
293
294 =item C<GLOB_ABEND>
295
296 The glob was stopped because an error was encountered.
297
298 =back
299
300 In the case where glob() has found some matching paths, but is
301 interrupted by an error, glob() will return a list of filenames B<and>
302 set &File::Glob::ERROR.
303
304 Note that glob() deviates from POSIX and FreeBSD glob(3) behaviour by
305 not considering C<ENOENT> and C<ENOTDIR> as errors - glob() will
306 continue processing despite those errors, unless the C<GLOB_ERR> flag is
307 set.
308
309 Be aware that all filenames returned from File::Glob are tainted.
310
311 =head1 NOTES
312
313 =over 4
314
315 =item *
316
317 If you want to use multiple patterns, e.g. C<glob "a* b*">, you should
318 probably throw them in a set as in C<glob "{a*,b*}>.  This is because
319 the argument to glob isn't subjected to parsing by the C shell.  Remember
320 that you can use a backslash to escape things.
321
322 =item *
323
324 On DOSISH systems, backslash is a valid directory separator character.
325 In this case, use of backslash as a quoting character (via GLOB_QUOTE)
326 interferes with the use of backslash as a directory separator. The
327 best (simplest, most portable) solution is to use forward slashes for
328 directory separators, and backslashes for quoting. However, this does
329 not match "normal practice" on these systems. As a concession to user
330 expectation, therefore, backslashes (under GLOB_QUOTE) only quote the
331 glob metacharacters '[', ']', '{', '}', '-', '~', and backslash itself.
332 All other backslashes are passed through unchanged.
333
334 =item *
335
336 Win32 users should use the real slash.  If you really want to use
337 backslashes, consider using Sarathy's File::DosGlob, which comes with
338 the standard Perl distribution.
339
340 =back
341
342 =head1 AUTHOR
343
344 The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
345 and is released under the artistic license.  Further modifications were
346 made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt> and Gurusamy Sarathy
347 E<lt>gsar@activestate.comE<gt>.  The C glob code has the
348 following copyright:
349
350     Copyright (c) 1989, 1993 The Regents of the University of California.
351     All rights reserved.
352
353     This code is derived from software contributed to Berkeley by
354     Guido van Rossum.
355
356     Redistribution and use in source and binary forms, with or without
357     modification, are permitted provided that the following conditions
358     are met:
359
360     1. Redistributions of source code must retain the above copyright
361        notice, this list of conditions and the following disclaimer.
362     2. Redistributions in binary form must reproduce the above copyright
363        notice, this list of conditions and the following disclaimer in the
364        documentation and/or other materials provided with the distribution.
365     3. Neither the name of the University nor the names of its contributors
366        may be used to endorse or promote products derived from this software
367        without specific prior written permission.
368
369     THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
370     ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
371     IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
372     ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
373     FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
374     DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
375     OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
376     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
377     LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
378     OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
379     SUCH DAMAGE.
380
381 =cut