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