diff options
Diffstat (limited to 'lib/Text/ParseWords.pm')
-rw-r--r-- | lib/Text/ParseWords.pm | 47 |
1 files changed, 26 insertions, 21 deletions
diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm index 94e6db7bcf..c260ad52dc 100644 --- a/lib/Text/ParseWords.pm +++ b/lib/Text/ParseWords.pm @@ -12,7 +12,7 @@ use Exporter; sub shellwords { - local(@lines) = @_; + my(@lines) = @_; $lines[$#lines] =~ s/\s+$//; return(quotewords('\s+', 0, @lines)); } @@ -22,7 +22,6 @@ sub shellwords { sub quotewords { my($delim, $keep, @lines) = @_; my($line, @words, @allwords); - foreach $line (@lines) { @words = parse_line($delim, $keep, $line); @@ -37,7 +36,7 @@ sub quotewords { sub nested_quotewords { my($delim, $keep, @lines) = @_; my($i, @allwords); - + for ($i = 0; $i < @lines; $i++) { @{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]); return() unless (@{$allwords[$i]} || !length($lines[$i])); @@ -48,13 +47,11 @@ sub nested_quotewords { sub parse_line { - # We will be testing undef strings - no warnings; - use re 'taint'; # if it's tainted, leave it as such - my($delimiter, $keep, $line) = @_; my($word, @pieces); + no warnings 'uninitialized'; # we will be testing undef strings + while (length($line)) { $line =~ s/^(["']) # a $quote ((?:\\.|(?!\1)[^\\])*) # and $quoted text @@ -77,6 +74,7 @@ sub parse_line { $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'"); } } + $word .= substr($line, 0, 0); # leave results tainted $word .= defined $quote ? $quoted : $unquoted; if (length($delim)) { @@ -100,41 +98,48 @@ sub old_shellwords { # @words = old_shellwords($line); # or # @words = old_shellwords(@lines); + # or + # @words = old_shellwords(); # defaults to $_ (and clobbers it) - local($_) = join('', @_); - my(@words,$snippet,$field); + no warnings 'uninitialized'; # we will be testing undef strings + local *_ = \join('', @_) if @_; + my (@words, $snippet); - s/^\s+//; + s/\A\s+//; while ($_ ne '') { - $field = ''; + my $field = substr($_, 0, 0); # leave results tainted for (;;) { - if (s/^"(([^"\\]|\\.)*)"//) { - ($snippet = $1) =~ s#\\(.)#$1#g; + if (s/\A"(([^"\\]|\\.)*)"//s) { + ($snippet = $1) =~ s#\\(.)#$1#sg; } - elsif (/^"/) { + elsif (/\A"/) { + require Carp; + Carp::carp("Unmatched double quote: $_"); return(); } - elsif (s/^'(([^'\\]|\\.)*)'//) { - ($snippet = $1) =~ s#\\(.)#$1#g; + elsif (s/\A'(([^'\\]|\\.)*)'//s) { + ($snippet = $1) =~ s#\\(.)#$1#sg; } - elsif (/^'/) { + elsif (/\A'/) { + require Carp; + Carp::carp("Unmatched single quote: $_"); return(); } - elsif (s/^\\(.)//) { + elsif (s/\A\\(.)//s) { $snippet = $1; } - elsif (s/^([^\s\\'"]+)//) { + elsif (s/\A([^\s\\'"]+)//) { $snippet = $1; } else { - s/^\s+//; + s/\A\s+//; last; } $field .= $snippet; } push(@words, $field); } - @words; + return @words; } 1; |