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