Khaaaaan! Change 34230 wasn't right. The tests all passed because I

[p5sagit/p5-mst-13.2.git] / lib / Text / ParseWords.pm

diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm
index 2f6812a..6235d3c 100644 (file)
--- a/lib/Text/ParseWords.pm
+++ b/lib/Text/ParseWords.pm
@@ -1,7 +1,7 @@
 package Text::ParseWords;
 
 use vars qw($VERSION @ISA @EXPORT $PERL_SINGLE_QUOTE);
-$VERSION = "3.24";
+$VERSION = "3.26";
 
 require 5.000;
 
@@ -12,9 +12,17 @@ use Exporter;
 
 
 sub shellwords {
-    my(@lines) = @_;
-    $lines[$#lines] =~ s/\s+$//;
-    return(quotewords('\s+', 0, @lines));
+    my (@lines) = @_;
+    my @allwords;
+
+    foreach my $line (@lines) {
+       $line =~ s/^\s+//;
+       my @words = parse_line('\s+', 0, $line);
+       pop @words if (@words and !defined $words[-1]);
+       return() unless (@words || !length($line));
+       push(@allwords, @words);
+    }
+    return(@allwords);
 }
 
 
@@ -53,15 +61,35 @@ sub parse_line {
     no warnings 'uninitialized';       # we will be testing undef strings
 
     while (length($line)) {
-       $line =~ s/^(["'])                      # a $quote
-                   ((?:\\.|(?!\1)[^\\])*)      # and $quoted text
-                   \1                          # followed by the same quote
-                  |                            # --OR--
-                  ^((?:\\.|[^\\"'])*?)         # an $unquoted text
-                   (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["']))  
-                                               # plus EOL, delimiter, or quote
-                 //xs or return;               # extended layout
-       my($quote, $quoted, $unquoted, $delim) = ($1, $2, $3, $4);
+        # This pattern is optimised to be stack conservative on older perls.
+        # Do not refactor without being careful and testing it on very long strings.
+        # See Perl bug #42980 for an example of a stack busting input.
+        $line =~ s/^
+                    (?: 
+                        # double quoted string
+                        (")                             # $quote
+                        ((?>[^\\"]*(?:\\.[^\\"]*)*))"   # $quoted 
+                   |   # --OR--
+                        # singe quoted string
+                        (')                             # $quote
+                        ((?>[^\\']*(?:\\.[^\\']*)*))'   # $quoted
+                    |   # --OR--
+                        # unquoted string
+                       (                               # $unquoted 
+                            (?:\\.|[^\\"'])*?           
+                        )              
+                        # followed by
+                       (                               # $delim
+                            \Z(?!\n)                    # EOL
+                        |   # --OR--
+                            (?-x:$delimiter)            # delimiter
+                        |   # --OR--                    
+                            (?!^)(?=["'])               # a quote
+                        )  
+                   )//xs or return;            # extended layout                  
+        my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6);
+
+
        return() unless( defined($quote) || length($unquoted) || length($delim));
 
         if ($keep) {
@@ -125,7 +153,7 @@ sub old_shellwords {
                Carp::carp("Unmatched single quote: $_");
                return();
            }
-           elsif (s/\A\\(.)//s) {
+           elsif (s/\A\\(.?)//s) {
                $snippet = $1;
            }
            elsif (s/\A([^\s\\'"]+)//) {