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