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 );
  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/foo) 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 =back
 401
 402 =head1 AUTHOR
 403
 404 The Perl interface was written by Nathan Torkington E<lt>gnat@frii.comE<gt>,
 405 and is released under the artistic license.  Further modifications were
 406 made by Greg Bacon E<lt>gbacon@cs.uah.eduE<gt>, Gurusamy Sarathy
 407 E<lt>gsar@activestate.comE<gt>, and Thomas Wegner
 408 E<lt>wegner_thomas@yahoo.comE<gt>.  The C glob code has the
 409 following copyright:
 410
 411     Copyright (c) 1989, 1993 The Regents of the University of California.
 412     All rights reserved.
 413
 414     This code is derived from software contributed to Berkeley by
 415     Guido van Rossum.
 416
 417     Redistribution and use in source and binary forms, with or without
 418     modification, are permitted provided that the following conditions
 419     are met:
 420
 421     1. Redistributions of source code must retain the above copyright
 422        notice, this list of conditions and the following disclaimer.
 423     2. Redistributions in binary form must reproduce the above copyright
 424        notice, this list of conditions and the following disclaimer in the
 425        documentation and/or other materials provided with the distribution.
 426     3. Neither the name of the University nor the names of its contributors
 427        may be used to endorse or promote products derived from this software
 428        without specific prior written permission.
 429
 430     THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
 431     ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 432     IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 433     ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
 434     FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 435     DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 436     OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 437     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 438     LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 439     OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 440     SUCH DAMAGE.
 441
 442 =cut