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 The encoding pragma affects this feature, see L<encoding>.
 342
 343 =head1 DIAGNOSTICS
 344
 345 bsd_glob() returns a list of matching paths, possibly zero length.  If an
 346 error occurred, &File::Glob::GLOB_ERROR will be non-zero and C<$!> will be
 347 set.  &File::Glob::GLOB_ERROR is guaranteed to be zero if no error occurred,
 348 or one of the following values otherwise:
 349
 350 =over 4
 351
 352 =item C<GLOB_NOSPACE>
 353
 354 An attempt to allocate memory failed.
 355
 356 =item C<GLOB_ABEND>
 357
 358 The glob was stopped because an error was encountered.
 359
 360 =back
 361
 362 In the case where bsd_glob() has found some matching paths, but is
 363 interrupted by an error, it will return a list of filenames B<and>
 364 set &File::Glob::ERROR.
 365
 366 Note that bsd_glob() deviates from POSIX and FreeBSD glob(3) behaviour
 367 by not considering C<ENOENT> and C<ENOTDIR> as errors - bsd_glob() will
 368 continue processing despite those errors, unless the C<GLOB_ERR> flag is
 369 set.
 370
 371 Be aware that all filenames returned from File::Glob are tainted.
 372
 373 =head1 NOTES
 374
 375 =over 4
 376
 377 =item *
 378
 379 If you want to use multiple patterns, e.g. C<bsd_glob "a* b*">, you should
 380 probably throw them in a set as in C<bsd_glob "{a*,b*}">.  This is because
 381 the argument to bsd_glob() isn't subjected to parsing by the C shell.
 382 Remember that you can use a backslash to escape things.
 383
 384 =item *
 385
 386 On DOSISH systems, backslash is a valid directory separator character.
 387 In this case, use of backslash as a quoting character (via GLOB_QUOTE)
 388 interferes with the use of backslash as a directory separator. The
 389 best (simplest, most portable) solution is to use forward slashes for
 390 directory separators, and backslashes for quoting. However, this does
 391 not match "normal practice" on these systems. As a concession to user
 392 expectation, therefore, backslashes (under GLOB_QUOTE) only quote the
 393 glob metacharacters '[', ']', '{', '}', '-', '~', and backslash itself.
 394 All other backslashes are passed through unchanged.
 395
 396 =item *
 397
 398 Win32 users should use the real slash.  If you really want to use
 399 backslashes, consider using Sarathy's File::DosGlob, which comes with
 400 the standard Perl distribution.
 401
 402 =item *
 403
 404 Mac OS (Classic) users should note a few differences. Since
 405 Mac OS is not Unix, when the glob code encounters a tilde glob (e.g.
 406 ~user) and the C<GLOB_TILDE> flag is used, it simply returns that
 407 pattern without doing any expansion.
 408
 409 Glob on Mac OS is case-insensitive by default (if you don't use any
 410 flags). If you specify any flags at all and still want glob
 411 to be case-insensitive, you must include C<GLOB_NOCASE> in the flags.
 412
 413 The path separator is ':' (aka colon), not '/' (aka slash). Mac OS users
 414 should be careful about specifying relative pathnames. While a full path
 415 always begins with a volume name, a relative pathname should always
 416 begin with a ':'.  If specifying a volume name only, a trailing ':' is
 417 required.
 418
 419 The specification of pathnames in glob patterns adheres to the usual Mac
 420 OS conventions: The path separator is a colon ':', not a slash '/'. A
 421 full path always begins with a volume name. A relative pathname on Mac
 422 OS must always begin with a ':', except when specifying a file or
 423 directory name in the current working directory, where the leading colon
 424 is optional. If specifying a volume name only, a trailing ':' is
 425 required. Due to these rules, a glob like E<lt>*:E<gt> will find all
 426 mounted volumes, while a glob like E<lt>*E<gt> or E<lt>:*E<gt> will find
 427 all files and directories in the current directory.
 428
 429 Note that updirs in the glob pattern are resolved before the matching begins,
 430 i.e. a pattern like "*HD:t?p::a*" will be matched as "*HD:a*". Note also,
 431 that a single trailing ':' in the pattern is ignored (unless it's a volume
 432 name pattern like "*HD:"), i.e. a glob like E<lt>:*:E<gt> will find both
 433 directories I<and> files (and not, as one might expect, only directories).
 434 You can, however, use the C<GLOB_MARK> flag to distinguish (without a file
 435 test) directory names from file names.
 436
 437 If the C<GLOB_MARK> flag is set, all directory paths will have a ':' appended.
 438 Since a directory like 'lib:' is I<not> a valid I<relative> path on Mac OS,
 439 both a leading and a trailing colon will be added, when the directory name in
 440 question doesn't contain any colons (e.g. 'lib' becomes ':lib:').
 441
 442 =back
 443
 444 =head1 AUTHOR
 445
 446 The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
 447 and is released under the artistic license.  Further modifications were
 448 made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt>, Gurusamy Sarathy
 449 E<lt>gsar@activestate.comE<gt>, and Thomas Wegner
 450 E<lt>wegner_thomas@yahoo.comE<gt>.  The C glob code has the
 451 following copyright:
 452
 453     Copyright (c) 1989, 1993 The Regents of the University of California.
 454     All rights reserved.
 455
 456     This code is derived from software contributed to Berkeley by
 457     Guido van Rossum.
 458
 459     Redistribution and use in source and binary forms, with or without
 460     modification, are permitted provided that the following conditions
 461     are met:
 462
 463     1. Redistributions of source code must retain the above copyright
 464        notice, this list of conditions and the following disclaimer.
 465     2. Redistributions in binary form must reproduce the above copyright
 466        notice, this list of conditions and the following disclaimer in the
 467        documentation and/or other materials provided with the distribution.
 468     3. Neither the name of the University nor the names of its contributors
 469        may be used to endorse or promote products derived from this software
 470        without specific prior written permission.
 471
 472     THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
 473     ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 474     IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 475     ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
 476     FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 477     DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 478     OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 479     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 480     LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 481     OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 482     SUCH DAMAGE.
 483
 484 =cut