mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-30 01:47:56 +00:00
191 lines
4 KiB
Perl
191 lines
4 KiB
Perl
package File::Glob;
|
|
|
|
use strict;
|
|
our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS,
|
|
$AUTOLOAD, $DEFAULT_FLAGS);
|
|
|
|
use XSLoader ();
|
|
|
|
@ISA = qw(Exporter);
|
|
|
|
# NOTE: The glob() export is only here for compatibility with 5.6.0.
|
|
# csh_glob() should not be used directly, unless you know what you're doing.
|
|
|
|
@EXPORT_OK = qw(
|
|
csh_glob
|
|
bsd_glob
|
|
glob
|
|
GLOB_ABEND
|
|
GLOB_ALPHASORT
|
|
GLOB_ALTDIRFUNC
|
|
GLOB_BRACE
|
|
GLOB_CSH
|
|
GLOB_ERR
|
|
GLOB_ERROR
|
|
GLOB_LIMIT
|
|
GLOB_MARK
|
|
GLOB_NOCASE
|
|
GLOB_NOCHECK
|
|
GLOB_NOMAGIC
|
|
GLOB_NOSORT
|
|
GLOB_NOSPACE
|
|
GLOB_QUOTE
|
|
GLOB_TILDE
|
|
);
|
|
|
|
%EXPORT_TAGS = (
|
|
'glob' => [ qw(
|
|
GLOB_ABEND
|
|
GLOB_ALPHASORT
|
|
GLOB_ALTDIRFUNC
|
|
GLOB_BRACE
|
|
GLOB_CSH
|
|
GLOB_ERR
|
|
GLOB_ERROR
|
|
GLOB_LIMIT
|
|
GLOB_MARK
|
|
GLOB_NOCASE
|
|
GLOB_NOCHECK
|
|
GLOB_NOMAGIC
|
|
GLOB_NOSORT
|
|
GLOB_NOSPACE
|
|
GLOB_QUOTE
|
|
GLOB_TILDE
|
|
glob
|
|
bsd_glob
|
|
) ],
|
|
);
|
|
|
|
$VERSION = '1.06';
|
|
|
|
sub import {
|
|
require Exporter;
|
|
my $i = 1;
|
|
while ($i < @_) {
|
|
if ($_[$i] =~ /^:(case|nocase|globally)$/) {
|
|
splice(@_, $i, 1);
|
|
$DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case';
|
|
$DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase';
|
|
if ($1 eq 'globally') {
|
|
local $^W;
|
|
*CORE::GLOBAL::glob = \&File::Glob::csh_glob;
|
|
}
|
|
next;
|
|
}
|
|
++$i;
|
|
}
|
|
goto &Exporter::import;
|
|
}
|
|
|
|
sub AUTOLOAD {
|
|
# This AUTOLOAD is used to 'autoload' constants from the constant()
|
|
# XS function. If a constant is not found then control is passed
|
|
# to the AUTOLOAD in AutoLoader.
|
|
|
|
my $constname;
|
|
($constname = $AUTOLOAD) =~ s/.*:://;
|
|
my ($error, $val) = constant($constname);
|
|
if ($error) {
|
|
require Carp;
|
|
Carp::croak($error);
|
|
}
|
|
eval "sub $AUTOLOAD { $val }";
|
|
goto &$AUTOLOAD;
|
|
}
|
|
|
|
XSLoader::load 'File::Glob', $VERSION;
|
|
|
|
# Preloaded methods go here.
|
|
|
|
sub GLOB_ERROR {
|
|
return (constant('GLOB_ERROR'))[1];
|
|
}
|
|
|
|
sub GLOB_CSH () {
|
|
GLOB_BRACE()
|
|
| GLOB_NOMAGIC()
|
|
| GLOB_QUOTE()
|
|
| GLOB_TILDE()
|
|
| GLOB_ALPHASORT()
|
|
}
|
|
|
|
$DEFAULT_FLAGS = GLOB_CSH();
|
|
if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) {
|
|
$DEFAULT_FLAGS |= GLOB_NOCASE();
|
|
}
|
|
|
|
# Autoload methods go after =cut, and are processed by the autosplit program.
|
|
|
|
sub bsd_glob {
|
|
my ($pat,$flags) = @_;
|
|
$flags = $DEFAULT_FLAGS if @_ < 2;
|
|
return doglob($pat,$flags);
|
|
}
|
|
|
|
# File::Glob::glob() is deprecated because its prototype is different from
|
|
# CORE::glob() (use bsd_glob() instead)
|
|
sub glob {
|
|
splice @_, 1; # don't pass PL_glob_index as flags!
|
|
goto &bsd_glob;
|
|
}
|
|
|
|
## borrowed heavily from gsar's File::DosGlob
|
|
my %iter;
|
|
my %entries;
|
|
|
|
sub csh_glob {
|
|
my $pat = shift;
|
|
my $cxix = shift;
|
|
my @pat;
|
|
|
|
# glob without args defaults to $_
|
|
$pat = $_ unless defined $pat;
|
|
|
|
# extract patterns
|
|
$pat =~ s/^\s+//; # Protect against empty elements in
|
|
$pat =~ s/\s+$//; # things like < *.c> and <*.c >.
|
|
# These alone shouldn't trigger ParseWords.
|
|
if ($pat =~ /\s/) {
|
|
# XXX this is needed for compatibility with the csh
|
|
# implementation in Perl. Need to support a flag
|
|
# to disable this behavior.
|
|
require Text::ParseWords;
|
|
@pat = Text::ParseWords::parse_line('\s+',0,$pat);
|
|
}
|
|
|
|
# assume global context if not provided one
|
|
$cxix = '_G_' unless defined $cxix;
|
|
$iter{$cxix} = 0 unless exists $iter{$cxix};
|
|
|
|
# if we're just beginning, do it all first
|
|
if ($iter{$cxix} == 0) {
|
|
if (@pat) {
|
|
$entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ];
|
|
}
|
|
else {
|
|
$entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ];
|
|
}
|
|
}
|
|
|
|
# chuck it all out, quick or slow
|
|
if (wantarray) {
|
|
delete $iter{$cxix};
|
|
return @{delete $entries{$cxix}};
|
|
}
|
|
else {
|
|
if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
|
|
return shift @{$entries{$cxix}};
|
|
}
|
|
else {
|
|
# return undef for EOL
|
|
delete $iter{$cxix};
|
|
delete $entries{$cxix};
|
|
return undef;
|
|
}
|
|
}
|
|
}
|
|
|
|
1;
|
|
__END__
|
|
|