package File::DosGlob;
-unless (caller) {
- $| = 1;
- while (@ARGV) {
- #
- # We have to do this one by one for compatibility reasons.
- # If an arg doesn't match anything, we are supposed to return
- # the original arg. I know, it stinks, eh?
- #
- my $arg = shift;
- my @m = doglob(1,$arg);
- print (@m ? join("\0", sort @m) : $arg);
- print "\0" if @ARGV;
- }
-}
-
sub doglob {
my $cond = shift;
my @retval = ();
my $sepchr = '/';
next OUTER unless defined $_ and $_ ne '';
# if arg is within quotes strip em and do no globbing
- if (/^"(.*)"$/) {
+ if (/^"(.*)"\z/s) {
$_ = $1;
if ($cond eq 'd') { push(@retval, $_) if -d $_ }
else { push(@retval, $_) if -e $_ }
next OUTER;
}
- if (m|^(.*)([\\/])([^\\/]*)$|) {
+ # wildcards with a drive prefix such as h:*.pm must be changed
+ # to h:./*.pm to expand correctly
+ if (m|^([A-Za-z]:)[^/\\]|s) {
+ substr($_,0,2) = $1 . "./";
+ }
+ if (m|^(.*)([\\/])([^\\/]*)\z|s) {
my $tail;
($head, $sepchr, $tail) = ($1,$2,$3);
#print "div: |$head|$sepchr|$tail|\n";
push(@retval, doglob($cond, map {"$_$sepchr$tail"} @globdirs)),
next OUTER if @globdirs;
}
- $head .= $sepchr if $head eq '' or $head =~ /^[A-Za-z]:$/;
+ $head .= $sepchr if $head eq '' or $head =~ /^[A-Za-z]:\z/s;
$_ = $tail;
}
#
s/\?/.?/g;
#print "regex: '$_', head: '$head'\n";
- my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '$|io }';
+ my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '\\z|ios }';
warn($@), next OUTER if $@;
INNER:
for my $e (@leaves) {
}
#
-# this can be used to override CORE::glob
-# by saying C<use File::DosGlob 'glob';>.
+# this can be used to override CORE::glob in a specific
+# package by saying C<use File::DosGlob 'glob';> in that
+# namespace.
#
-sub glob { doglob(1,@_) }
+
+# context (keyed by second cxix arg provided by core)
+my %iter;
+my %entries;
+
+sub glob {
+ my $pat = shift;
+ my $cxix = shift;
+ my @pat;
+
+ # glob without args defaults to $_
+ $pat = $_ unless defined $pat;
+
+ # extract patterns
+ if ($pat =~ /\s/) {
+ require Text::ParseWords;
+ @pat = Text::ParseWords::parse_line('\s+',0,$pat);
+ }
+ else {
+ push @pat, $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) {
+ $entries{$cxix} = [doglob(1,@pat)];
+ }
+
+ # 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;
+ }
+ }
+}
sub import {
my $pkg = shift;
- my $callpkg = caller(0);
+ return unless @_;
my $sym = shift;
+ my $callpkg = ($sym =~ s/^GLOBAL_//s ? 'CORE::GLOBAL' : caller(0));
*{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob';
}
File::DosGlob - DOS like globbing and then some
-perlglob.bat - a more capable perlglob.exe replacement
-
=head1 SYNOPSIS
require 5.004;
- use File::DosGlob 'glob'; # override CORE::glob
+
+ # override CORE::glob in current package
+ use File::DosGlob 'glob';
+
+ # override CORE::glob in ALL packages (use with extreme caution!)
+ use File::DosGlob 'GLOBAL_glob';
+
@perlfiles = glob "..\\pe?l/*.p?";
print <..\\pe?l/*.p?>;
-
- # from the command line
+
+ # from the command line (overrides only in main::)
> perl -MFile::DosGlob=glob -e "print <../pe*/*p?>"
-
- > perlglob ../pe*/*p?
=head1 DESCRIPTION
A module that implements DOS-like globbing with a few enhancements.
-This file is also a portable replacement for perlglob.exe. It
-is largely compatible with perlglob.exe (the M$ setargv.obj
+It is largely compatible with perlglob.exe (the M$ setargv.obj
version) in all but one respect--it understands wildcards in
directory components.
You may have to double the backslashes if you are putting them in
literally, due to double-quotish parsing of the pattern by perl.
-When invoked as a program, it will print null-separated filenames
-to standard output.
-
-While one may replace perlglob.exe with this, usage by overriding
-CORE::glob via importation should be much more efficient, because
-it avoids launching a separate process, and is therefore strongly
-recommended.
+Spaces in the argument delimit distinct patterns, so
+C<glob('*.exe *.dll')> globs all filenames that end in C<.exe>
+or C<.dll>. If you want to put in literal spaces in the glob
+pattern, you can escape them with either double quotes, or backslashes.
+e.g. C<glob('c:/"Program Files"/*/*.dll')>, or
+C<glob('c:/Program\ Files/*/*.dll')>. The argument is tokenized using
+C<Text::ParseWords::parse_line()>, so see L<Text::ParseWords> for details
+of the quoting rules used.
Extending it to csh patterns is left as an exercise to the reader.
=head1 AUTHOR
-Gurusamy Sarathy <gsar@umich.edu>
+Gurusamy Sarathy <gsar@activestate.com>
=head1 HISTORY
=item *
+Support for globally overriding glob() (GSAR 3-JUN-98)
+
+=item *
+
+Scalar context, independent iterator context fixes (GSAR 15-SEP-97)
+
+=item *
+
A few dir-vs-file optimizations result in glob importation being
10 times faster than using perlglob.exe, and using perlglob.bat is
only twice as slow as perlglob.exe (GSAR 28-MAY-97)
perl
+perlglob.bat
+
+Text::ParseWords
+
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff