ext/File/Glob/Glob.pm

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