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 AutoLoader);
  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.0';
  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 $val = constant($constname, @_ ? $_[0] : 0);
  88     if ($! != 0) {
  89         if ($! =~ /Invalid/ || $!{EINVAL}) {
  90             require AutoLoader;
  91             $AutoLoader::AUTOLOAD = $AUTOLOAD;
  92             goto &AutoLoader::AUTOLOAD;
  93         }
  94         else {
  95             require Carp;
  96             Carp::croak("Your vendor has not defined File::Glob macro $constname");
  97         }
  98     }
  99     eval "sub $AUTOLOAD { $val }";
 100     goto &$AUTOLOAD;
 101 }
 102
 103 XSLoader::load 'File::Glob', $VERSION;
 104
 105 # Preloaded methods go here.
 106
 107 sub GLOB_ERROR {
 108     return constant('GLOB_ERROR', 0);
 109 }
 110
 111 sub GLOB_CSH () {
 112     GLOB_BRACE()
 113         | GLOB_NOMAGIC()
 114         | GLOB_QUOTE()
 115         | GLOB_TILDE()
 116         | GLOB_ALPHASORT()
 117 }
 118
 119 $DEFAULT_FLAGS = GLOB_CSH();
 120 if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
 121     $DEFAULT_FLAGS |= GLOB_NOCASE();
 122 }
 123
 124 # Autoload methods go after =cut, and are processed by the autosplit program.
 125
 126 sub bsd_glob {
 127     my ($pat,$flags) = @_;
 128     $flags = $DEFAULT_FLAGS if @_ < 2;
 129     return doglob($pat,$flags);
 130 }
 131
 132 # File::Glob::glob() is deprecated because its prototype is different from
 133 # CORE::glob() (use bsd_glob() instead)
 134 sub glob {
 135     goto &bsd_glob;
 136 }
 137
 138 ## borrowed heavily from gsar's File::DosGlob
 139 my %iter;
 140 my %entries;
 141
 142 sub csh_glob {
 143     my $pat = shift;
 144     my $cxix = shift;
 145     my @pat;
 146
 147     # glob without args defaults to $_
 148     $pat = $_ unless defined $pat;
 149
 150     # extract patterns
 151     $pat =~ s/^\s+//;   # Protect against empty elements in
 152     $pat =~ s/\s+$//;   # things like < *.c> and <*.c >.
 153                         # These alone shouldn't trigger ParseWords.
 154     if ($pat =~ /\s/) {
 155         # XXX this is needed for compatibility with the csh
 156         # implementation in Perl.  Need to support a flag
 157         # to disable this behavior.
 158         require Text::ParseWords;
 159         @pat = Text::ParseWords::parse_line('\s+',0,$pat);
 160     }
 161
 162     # assume global context if not provided one
 163     $cxix = '_G_' unless defined $cxix;
 164     $iter{$cxix} = 0 unless exists $iter{$cxix};
 165
 166     # if we're just beginning, do it all first
 167     if ($iter{$cxix} == 0) {
 168         if (@pat) {
 169             $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ];
 170         }
 171         else {
 172             $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ];
 173         }
 174     }
 175
 176     # chuck it all out, quick or slow
 177     if (wantarray) {
 178         delete $iter{$cxix};
 179         return @{delete $entries{$cxix}};
 180     }
 181     else {
 182         if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
 183             return shift @{$entries{$cxix}};
 184         }
 185         else {
 186             # return undef for EOL
 187             delete $iter{$cxix};
 188             delete $entries{$cxix};
 189             return undef;
 190         }
 191     }
 192 }
 193
 194 1;
 195 __END__
 196
 197 =head1 NAME
 198
 199 File::Glob - Perl extension for BSD glob routine
 200
 201 =head1 SYNOPSIS
 202
 203   use File::Glob ':glob';
 204   @list = bsd_glob('*.[ch]');
 205   $homedir = bsd_glob('~gnat', GLOB_TILDE | GLOB_ERR);
 206   if (GLOB_ERROR) {
 207     # an error occurred reading $homedir
 208   }
 209
 210   ## override the core glob (CORE::glob() does this automatically
 211   ## by default anyway, since v5.6.0)
 212   use File::Glob ':globally';
 213   my @sources = <*.{c,h,y}>
 214
 215   ## override the core glob, forcing case sensitivity
 216   use File::Glob qw(:globally :case);
 217   my @sources = <*.{c,h,y}>
 218
 219   ## override the core glob forcing case insensitivity
 220   use File::Glob qw(:globally :nocase);
 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 =head1 DIAGNOSTICS
 332
 333 bsd_glob() returns a list of matching paths, possibly zero length.  If an
 334 error occurred, &File::Glob::GLOB_ERROR will be non-zero and C<$!> will be
 335 set.  &File::Glob::GLOB_ERROR is guaranteed to be zero if no error occurred,
 336 or one of the following values otherwise:
 337
 338 =over 4
 339
 340 =item C<GLOB_NOSPACE>
 341
 342 An attempt to allocate memory failed.
 343
 344 =item C<GLOB_ABEND>
 345
 346 The glob was stopped because an error was encountered.
 347
 348 =back
 349
 350 In the case where bsd_glob() has found some matching paths, but is
 351 interrupted by an error, it will return a list of filenames B<and>
 352 set &File::Glob::ERROR.
 353
 354 Note that bsd_glob() deviates from POSIX and FreeBSD glob(3) behaviour
 355 by not considering C<ENOENT> and C<ENOTDIR> as errors - bsd_glob() will
 356 continue processing despite those errors, unless the C<GLOB_ERR> flag is
 357 set.
 358
 359 Be aware that all filenames returned from File::Glob are tainted.
 360
 361 =head1 NOTES
 362
 363 =over 4
 364
 365 =item *
 366
 367 If you want to use multiple patterns, e.g. C<bsd_glob "a* b*">, you should
 368 probably throw them in a set as in C<bsd_glob "{a*,b*}">.  This is because
 369 the argument to bsd_glob() isn't subjected to parsing by the C shell.
 370 Remember that you can use a backslash to escape things.
 371
 372 =item *
 373
 374 On DOSISH systems, backslash is a valid directory separator character.
 375 In this case, use of backslash as a quoting character (via GLOB_QUOTE)
 376 interferes with the use of backslash as a directory separator. The
 377 best (simplest, most portable) solution is to use forward slashes for
 378 directory separators, and backslashes for quoting. However, this does
 379 not match "normal practice" on these systems. As a concession to user
 380 expectation, therefore, backslashes (under GLOB_QUOTE) only quote the
 381 glob metacharacters '[', ']', '{', '}', '-', '~', and backslash itself.
 382 All other backslashes are passed through unchanged.
 383
 384 =item *
 385
 386 Win32 users should use the real slash.  If you really want to use
 387 backslashes, consider using Sarathy's File::DosGlob, which comes with
 388 the standard Perl distribution.
 389
 390 =item *
 391
 392 Mac OS (Classic) users should note a few differences. Since
 393 Mac OS is not Unix, when the glob code encounters a tilde glob (e.g.
 394 ~user/foo) and the C<GLOB_TILDE> flag is used, it simply returns that
 395 pattern without doing any expansion.
 396
 397 Glob on Mac OS is case-insensitive by default (if you don't use any
 398 flags). If you specify any flags at all and still want glob
 399 to be case-insensitive, you must include C<GLOB_NOCASE> in the flags.
 400
 401 The path separator is ':' (aka colon), not '/' (aka slash). Mac OS users
 402 should be careful about specifying relative pathnames. While a full path
 403 always begins with a volume name, a relative pathname should always
 404 begin with a ':'.  If specifying a volume name only, a trailing ':' is
 405 required.
 406
 407 =back
 408
 409 =head1 AUTHOR
 410
 411 The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
 412 and is released under the artistic license.  Further modifications were
 413 made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt>, Gurusamy Sarathy
 414 E<lt>gsar@activestate.comE<gt>, and Thomas Wegner
 415 E<lt>wegner_thomas@yahoo.comE<gt>.  The C glob code has the
 416 following copyright:
 417
 418     Copyright (c) 1989, 1993 The Regents of the University of California.
 419     All rights reserved.
 420
 421     This code is derived from software contributed to Berkeley by
 422     Guido van Rossum.
 423
 424     Redistribution and use in source and binary forms, with or without
 425     modification, are permitted provided that the following conditions
 426     are met:
 427
 428     1. Redistributions of source code must retain the above copyright
 429        notice, this list of conditions and the following disclaimer.
 430     2. Redistributions in binary form must reproduce the above copyright
 431        notice, this list of conditions and the following disclaimer in the
 432        documentation and/or other materials provided with the distribution.
 433     3. Neither the name of the University nor the names of its contributors
 434        may be used to endorse or promote products derived from this software
 435        without specific prior written permission.
 436
 437     THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
 438     ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 439     IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 440     ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
 441     FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 442     DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 443     OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 444     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 445     LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 446     OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 447     SUCH DAMAGE.
 448
 449 =cut