diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-10-24 16:03:55 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-10-24 16:32:23 -0700 |
commit | 0b0e6d70fad47cd67e69fd39ca89beb755332502 (patch) | |
tree | b09a776419cc2289edf00f77d45ec754b72b2a36 | |
parent | 9913adee522ad312f60d0f24722d0144ffb12656 (diff) | |
download | perl-0b0e6d70fad47cd67e69fd39ca89beb755332502.tar.gz |
Make File::Glob::csh_glob consisent wrt '"\
File::Glob::csh_glob, which is the routine implementing Perl’s own
glob function, is not consistent in its treatment of quotation marks
and backslashes. It differs depending on whether there are white-
space characters in the pattern both preceded and followed by non-
whitespace.
Without whitespace, quotation marks are treated literally and back-
slashes are treated as escapes that cause metacharacters to be treated
literally. So
<"foo*">
looks for files with literal quotation marks in their name.
With whitespace, quotation marks are treated as word delimiters, so
<"foo copy*">
will find file names matching /^foo copy/. Backslash escapes are pro-
cessed twice, so one has to write
glob '\\\** .\\\**'
to find files beginning with a literal ‘*’ or ‘.*’. But simply
glob '\**'
to find files beginning with ‘*’. (Note that <> is a double-quotish
operator, so in <> those would have to be quadruple and double back-
slashes, respectively.)
There are two problems with the code:
1) Text::Parsewords is only used when there is whitespace present. It
should be used also for quotation marks, too, if they exist.
2) Text::Parsewords should not be removing backslash escapes.
3) Actually, there’s a third. A final escaped space should also go
through Text::ParseWords, instead of being stripped.
This commit fixes both things.
-rw-r--r-- | ext/File-Glob/Glob.pm | 15 | ||||
-rw-r--r-- | ext/File-Glob/t/basic.t | 11 |
2 files changed, 20 insertions, 6 deletions
diff --git a/ext/File-Glob/Glob.pm b/ext/File-Glob/Glob.pm index af17cffa76..30263d92a8 100644 --- a/ext/File-Glob/Glob.pm +++ b/ext/File-Glob/Glob.pm @@ -36,7 +36,7 @@ use feature 'switch'; @EXPORT_OK = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob'); -$VERSION = '1.13'; +$VERSION = '1.14'; sub import { require Exporter; @@ -84,14 +84,19 @@ sub csh_glob { # extract patterns $pat =~ s/^\s+//; # Protect against empty elements in - $pat =~ s/\s+$//; # things like < *.c> and <*.c >. - # These alone shouldn't trigger ParseWords. - if ($pat =~ /\s/) { + # things like < *.c>, which alone + # shouldn't trigger ParseWords. Patterns + # with a trailing space must be passed + # to ParseWords, in case it is escaped, + # as in <\ >. + if ($pat =~ /[\s"']/) { # XXX this is needed for compatibility with the csh # implementation in Perl. Need to support a flag # to disable this behavior. require Text::ParseWords; - @pat = Text::ParseWords::parse_line('\s+',0,$pat); + for (@pat = Text::ParseWords::parse_line('\s+',1,$pat)) { + s/^['"]// and chop; + } } # assume global context if not provided one diff --git a/ext/File-Glob/t/basic.t b/ext/File-Glob/t/basic.t index c40b1d5de2..bdf0d9497c 100644 --- a/ext/File-Glob/t/basic.t +++ b/ext/File-Glob/t/basic.t @@ -10,7 +10,7 @@ BEGIN { } } use strict; -use Test::More tests => 18; +use Test::More tests => 23; BEGIN {use_ok('File::Glob', ':glob')}; use Cwd (); @@ -233,3 +233,12 @@ pass("Don't panic"); # This used to segfault. my $i = bsd_glob('*', GLOB_ALTDIRFUNC); is(&File::Glob::GLOB_ERROR, 0, "Successfuly ignored unsupported flag"); + +package frimpy; # get away from the glob override, so we can test csh_glob, +use Test::More; # which is perl's default + +is +(glob "a'b'")[0], (<a'b' c>)[0], "a'b' with and without spaces"; +is +(<a"b">)[0], (<a"b" c>)[0], 'a"b" with and without spaces'; +is <\\*>, '*', 'backslashes without spaces'; +is_deeply [sort <\\* .\\*>], [sort qw<* .*>], 'backslashes with spaces'; +is <\\ >, ' ', 'final escaped space'; |