[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.

diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm
index 0963b39..ac25979 100644 (file)
--- 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 625d107..71a5db6 100644 (file)
--- 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";
+}