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

diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm
index e5a2467..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;
 	}
 	#
@@ -142,7 +147,7 @@ sub import {
     my $pkg = shift;
     return unless @_;
     my $sym = shift;
-    my $callpkg = ($sym =~ s/^GLOBAL_// ? 'CORE::GLOBAL' : caller(0));
+    my $callpkg = ($sym =~ s/^GLOBAL_//s ? 'CORE::GLOBAL' : caller(0));
     *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob';
 }