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