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