[perl #71712] fixes for File::DosGlob

The changes are

1. Allow for parentheses in glob pattern.
2. Strip redundant "./" from drive relative glob patterns results.

2 files changed, 51 insertions, 3 deletions

diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm
index 0963b39642..ac25979584 100644
--- a/lib/File/DosGlob.pm
+++ b/lib/File/DosGlob.pm
@@ -9,13 +9,14 @@
 
 package File::DosGlob;
 
-our $VERSION = '1.02';
+our $VERSION = '1.03';
 use strict;
 use warnings;
 
 sub doglob {
     my $cond = shift;
     my @retval = ();
+    my $fix_drive_relative_paths;
     #print "doglob: ", join('|', @_), "\n";
   OUTER:
     for my $pat (@_) {
@@ -36,6 +37,7 @@ sub doglob {
 	# to h:./*.pm to expand correctly
 	if ($pat =~ m|^([A-Za-z]:)[^/\\]|s) {
 	    substr($pat,0,2) = $1 . "./";
+	    $fix_drive_relative_paths = 1;
 	}
 	if ($pat =~ m|^(.*)([\\/])([^\\/]*)\z|s) {
 	    ($head, $sepchr, $tail) = ($1,$2,$3);
@@ -66,7 +68,7 @@ sub doglob {
 	$head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
 
 	# escape regex metachars but not glob chars
-        $pat =~ s:([].+^\-\${}[|]):\\$1:g;
+	$pat =~ s:([].+^\-\${}()[|]):\\$1:g;
 	# and convert DOS-style wildcards to regex
 	$pat =~ s/\*/.*/g;
 	$pat =~ s/\?/.?/g;
@@ -91,6 +93,9 @@ sub doglob {
 	}
 	push @retval, @matched if @matched;
     }
+    if ($fix_drive_relative_paths) {
+	s|^([A-Za-z]:)\./|$1| for @retval;
+    }
     return @retval;
 }
 
diff --git a/lib/File/DosGlob.t b/lib/File/DosGlob.t
index 625d107ebe..71a5db67cb 100644
--- a/lib/File/DosGlob.t
+++ b/lib/File/DosGlob.t
@@ -9,11 +9,13 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..10\n";
+print "1..17\n";
 
 # override it in main::
 use File::DosGlob 'glob';
 
+require Cwd;
+
 # test if $_ takes as the default
 my $expected;
 if ($^O eq 'MacOS') {
@@ -160,3 +162,44 @@ if ($^O eq 'MacOS') {
 print "not " if "@r" ne "@s";
 print "ok 10\n";
 EOT
+
+# Test that a glob pattern containing ()'s works.
+# NB. The spaces in the glob patters need to be backslash escaped.
+my $filename_containing_parens = "foo (123) bar";
+open(TOUCH, ">", $filename_containing_parens) && close(TOUCH)
+    or die "can't create '$filename_containing_parens': $!";
+
+@r = ();
+eval { @r = File::DosGlob::glob("foo\\ (*") };
+print +($@ ? "not " : ""), "ok 11\n";
+print "not " unless (@r == 1 and $r[0] eq $filename_containing_parens);
+print "ok 12\n";
+
+@r = ();
+eval { @r = File::DosGlob::glob("*)\\ bar") };
+print +($@ ? "not " : ""), "ok 13\n";
+print "not " unless (@r == 1 and $r[0] eq $filename_containing_parens);
+print "ok 14\n";
+
+@r = ();
+eval { @r = File::DosGlob::glob("foo\\ (1*3)\\ bar") };
+print +($@ ? "not " : ""), "ok 15\n";
+print "not " unless (@r == 1 and $r[0] eq $filename_containing_parens);
+print "ok 16\n";
+
+unlink $filename_containing_parens;
+
+# Test the globbing of a drive relative pattern such as "c:*.pl".
+# NB. previous versions of DosGlob inserted "./ after the drive letter to
+# make the expansion process work correctly. However, while it is harmless,
+# there is no reason for it to be in the result.
+my $cwd = Cwd::cwd();
+if ($cwd =~ /^([a-zA-Z]:)/) {
+    my $drive = $1;
+    @r = ();
+    # This assumes we're in the "t" directory.
+    eval { @r = File::DosGlob::glob("${drive}io/*.t") };
+    print +((@r and !grep !m|^${drive}io/[^/]*\.t$|, @r) ? "" : "not "), "ok 17\n";
+} else {
+    print "ok 17\n";
+}