In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/2f3c8ce922663caa9b02d9fddae7536225b6f95d?hp=51622cce73d97f3450a8abf6607c5d7a8fb35452>
- Log ----------------------------------------------------------------- commit 2f3c8ce922663caa9b02d9fddae7536225b6f95d Author: Alex Davies <[email protected]> Date: Thu Sep 23 22:08:28 2010 -0700 [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. ----------------------------------------------------------------------- Summary of changes: lib/File/DosGlob.pm | 9 +++++++-- lib/File/DosGlob.t | 45 ++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 51 insertions(+), 3 deletions(-) diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm index 0963b39..ac25979 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 625d107..71a5db6 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"; +} -- Perl5 Master Repository
