X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFile%2FDosGlob.pm;h=d7dea7b46cf3af82c2dbc4b48de70daafc4cfe55;hb=f41820981f84708ef067a8bea41c79da755543c1;hp=a27dad9030c8b7953a8efe1b52b17f96a877ab57;hpb=dfb634a9eac93365588858d3fa4687b4ce993eb7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm
index a27dad9..d7dea7b 100644
--- a/lib/File/DosGlob.pm
+++ b/lib/File/DosGlob.pm
@@ -19,13 +19,18 @@ sub doglob {
 	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";
@@ -35,7 +40,7 @@ sub doglob {
 		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;
 	}
 	#
@@ -61,7 +66,7 @@ sub doglob {
 	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) {
@@ -97,17 +102,27 @@ 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)];
+	$entries{$cxix} = [doglob(1,@pat)];
     }
 
     # chuck it all out, quick or slow
@@ -130,10 +145,10 @@ sub glob {
 
 sub import {
     my $pkg = shift;
-    my $callpkg = caller(0);
+    return unless @_;
     my $sym = shift;
-    *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym}
-	if defined($sym) and $sym eq 'glob';
+    my $callpkg = ($sym =~ s/^GLOBAL_//s ? 'CORE::GLOBAL' : caller(0));
+    *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob';
 }
 
 1;
@@ -147,13 +162,16 @@ File::DosGlob - DOS like globbing and then some
 =head1 SYNOPSIS
 
     require 5.004;
-    
+
     # 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 (overrides only in main::)
     > perl -MFile::DosGlob=glob -e "print <../pe*/*p?>"
 
@@ -171,6 +189,15 @@ backslashes and forward slashes are both accepted, and preserved.
 You may have to double the backslashes if you are putting them in
 literally, due to double-quotish parsing of the pattern by perl.
 
+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 EXPORTS (by request only)
@@ -184,7 +211,7 @@ pandering to DOS habits.  Needs a dose of optimizium too.
 
 =head1 AUTHOR
 
-Gurusamy Sarathy <gsar@umich.edu>
+Gurusamy Sarathy <gsar@activestate.com>
 
 =head1 HISTORY
 
@@ -192,6 +219,10 @@ Gurusamy Sarathy <gsar@umich.edu>
 
 =item *
 
+Support for globally overriding glob() (GSAR 3-JUN-98)
+
+=item *
+
 Scalar context, independent iterator context fixes (GSAR 15-SEP-97)
 
 =item *
@@ -217,5 +248,7 @@ perl
 
 perlglob.bat
 
+Text::ParseWords
+
 =cut