home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / lib / perl / 5.8.8 / File / Glob.pm
Encoding:
Perl POD Document  |  2006-07-07  |  4.0 KB  |  191 lines
  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.05';
  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.     splice @_, 1; # don't pass PL_glob_index as flags!
  129.     goto &bsd_glob;
  130. }
  131.  
  132. ## borrowed heavily from gsar's File::DosGlob
  133. my %iter;
  134. my %entries;
  135.  
  136. sub csh_glob {
  137.     my $pat = shift;
  138.     my $cxix = shift;
  139.     my @pat;
  140.  
  141.     # glob without args defaults to $_
  142.     $pat = $_ unless defined $pat;
  143.  
  144.     # extract patterns
  145.     $pat =~ s/^\s+//;    # Protect against empty elements in
  146.     $pat =~ s/\s+$//;    # things like < *.c> and <*.c >.
  147.             # These alone shouldn't trigger ParseWords.
  148.     if ($pat =~ /\s/) {
  149.         # XXX this is needed for compatibility with the csh
  150.     # implementation in Perl.  Need to support a flag
  151.     # to disable this behavior.
  152.     require Text::ParseWords;
  153.     @pat = Text::ParseWords::parse_line('\s+',0,$pat);
  154.     }
  155.  
  156.     # assume global context if not provided one
  157.     $cxix = '_G_' unless defined $cxix;
  158.     $iter{$cxix} = 0 unless exists $iter{$cxix};
  159.  
  160.     # if we're just beginning, do it all first
  161.     if ($iter{$cxix} == 0) {
  162.     if (@pat) {
  163.         $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ];
  164.     }
  165.     else {
  166.         $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ];
  167.     }
  168.     }
  169.  
  170.     # chuck it all out, quick or slow
  171.     if (wantarray) {
  172.         delete $iter{$cxix};
  173.         return @{delete $entries{$cxix}};
  174.     }
  175.     else {
  176.         if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
  177.             return shift @{$entries{$cxix}};
  178.         }
  179.         else {
  180.             # return undef for EOL
  181.             delete $iter{$cxix};
  182.             delete $entries{$cxix};
  183.             return undef;
  184.         }
  185.     }
  186. }
  187.  
  188. 1;
  189. __END__
  190.  
  191.