ext/File/Glob/Glob.pm

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