[Rt-commit] rt branch, 3.8/perlcritic, updated. rt-3.8.10-62-gfeb22e9

Alex Vandiver alexmv at bestpractical.com
Mon Jul 11 13:41:50 EDT 2011


The branch, 3.8/perlcritic has been updated
       via  feb22e93a7771e0b07b32ee385fe41fb799e70b0 (commit)
      from  43a418fb49c8cd6a11ab4d8bddb2694cd6ae7e83 (commit)

Summary of changes:
 bin/rt.in                                |   79 ++++++++++++++++--------------
 lib/RT/Interface/REST.pm                 |   53 ++++++++++++++++---
 share/html/REST/1.0/Forms/ticket/default |   32 +------------
 3 files changed, 87 insertions(+), 77 deletions(-)

- Log -----------------------------------------------------------------
commit feb22e93a7771e0b07b32ee385fe41fb799e70b0
Author: Alex Vandiver <alexmv at bestpractical.com>
Date:   Mon Jul 11 12:16:51 2011 -0400

    Move to a regex-based quoting parser for vsplit
    
    This also merges the 2.5 versions of the code.
    (cherry picked from commit 20434a7fecad957d333785eb6e669668aed30934)

diff --git a/bin/rt.in b/bin/rt.in
index c46c799..a85c27a 100755
--- a/bin/rt.in
+++ b/bin/rt.in
@@ -1526,47 +1526,52 @@ sub vpush {
 
 # "Normalise" a hash key that's known to be multi-valued.
 sub vsplit {
-    my ($val) = @_;
-    my ($word, @words);
-    my @values = ref $val eq 'ARRAY' ? @$val : $val;
-
-    foreach my $line (map {split /\n/} @values) {
-        # XXX: This should become a real parser, à la Text::ParseWords.
-        $line =~ s/^\s+//;
-        $line =~ s/\s+$//;
-        my ( $a, $b ) = split /\s*,\s*/, $line, 2;
-
-        while ($a) {
-            no warnings 'uninitialized';
-            if ( $a =~ /^'/ ) {
-                my $s = $a;
-                while ( $a !~ /'$/ || (   $a !~ /(\\\\)+'$/
-                            && $a =~ /(\\)+'$/ )) {
-                    ( $a, $b ) = split /\s*,\s*/, $b, 2;
-                    $s .= ',' . $a;
-                }
-                push @words, $s;
-            }
-            elsif ( $a =~ /^q{/ ) {
-                my $s = $a;
-                while ( $a !~ /}$/ ) {
-                    ( $a, $b ) =
-                      split /\s*,\s*/, $b, 2;
-                    $s .= ',' . $a;
-                }
-                $s =~ s/^q{/'/;
-                $s =~ s/}/'/;
-                push @words, $s;
+    my ($val, $strip) = @_;
+    my @words;
+    my @values = map {split /\n/} (ref $val eq 'ARRAY' ? @$val : $val);
+
+    foreach my $line (@values) {
+        while ($line =~ /\S/) {
+            $line =~ s/^
+                       \s*   # Trim leading whitespace
+                       (?:
+                           (")   # Quoted string
+                           ((?>[^\\"]*(?:\\.[^\\"]*)*))"
+                       |
+                           (')   # Single-quoted string
+                           ((?>[^\\']*(?:\\.[^\\']*)*))'
+                       |
+                           q{(.*?)}  # A perl-ish q{} string; this does
+                                     # no paren balancing, however, and
+                                     # only exists for back-compat
+                       |
+                           (.*?)     # Anything else, until the next comma
+                       )
+                       \s*   # Trim trailing whitespace
+                       (?:
+                           \Z  # Finish at end-of-line
+                       |
+                           ,   # Or a comma
+                       )
+                      //xs or last; # There should be no way this match
+                                    # fails, but add a failsafe to
+                                    # prevent infinite-looping if it
+                                    # somehow does.
+            my ($quote, $quoted) = ($1 ? ($1, $2) : $3 ? ($3, $4) : ('', $5 || $6));
+            # Only unquote the quote character, or the backslash -- and
+            # only if we were originally quoted..
+            if ($5) {
+                $quoted =~ s/([\\'])/\\$1/g;
+                $quote = "'";
             }
-            else {
-                push @words, $a;
+            if ($strip) {
+                $quoted =~ s/\\([\\$quote])/$1/g if $quote;
+                push @words, $quoted;
+            } else {
+                push @words, "$quote$quoted$quote";
             }
-            ( $a, $b ) = split /\s*,\s*/, $b, 2;
         }
-
-
     }
-
     return \@words;
 }
 
diff --git a/lib/RT/Interface/REST.pm b/lib/RT/Interface/REST.pm
index 1f7295d..47c8de2 100755
--- a/lib/RT/Interface/REST.pm
+++ b/lib/RT/Interface/REST.pm
@@ -292,17 +292,52 @@ sub vpush {
 
 # "Normalise" a hash key that's known to be multi-valued.
 sub vsplit {
-    my ($val) = @_;
+    my ($val, $strip) = @_;
     my @words;
-
-    foreach my $line (map {split /\n/} (ref $val eq 'ARRAY') ? @$val : ($val||''))
-    {
-        # XXX: This should become a real parser, ? la Text::ParseWords.
-        $line =~ s/^\s+//;
-        $line =~ s/\s+$//;
-        push @words, split /\s*,\s*/, $line;
+    my @values = map {split /\n/} (ref $val eq 'ARRAY' ? @$val : $val);
+
+    foreach my $line (@values) {
+        while ($line =~ /\S/) {
+            $line =~ s/^
+                       \s*   # Trim leading whitespace
+                       (?:
+                           (")   # Quoted string
+                           ((?>[^\\"]*(?:\\.[^\\"]*)*))"
+                       |
+                           (')   # Single-quoted string
+                           ((?>[^\\']*(?:\\.[^\\']*)*))'
+                       |
+                           q{(.*?)}  # A perl-ish q{} string; this does
+                                     # no paren balancing, however, and
+                                     # only exists for back-compat
+                       |
+                           (.*?)     # Anything else, until the next comma
+                       )
+                       \s*   # Trim trailing whitespace
+                       (?:
+                           \Z  # Finish at end-of-line
+                       |
+                           ,   # Or a comma
+                       )
+                      //xs or last; # There should be no way this match
+                                    # fails, but add a failsafe to
+                                    # prevent infinite-looping if it
+                                    # somehow does.
+            my ($quote, $quoted) = ($1 ? ($1, $2) : $3 ? ($3, $4) : ('', $5 || $6));
+            # Only unquote the quote character, or the backslash -- and
+            # only if we were originally quoted..
+            if ($5) {
+                $quoted =~ s/([\\'])/\\$1/g;
+                $quote = "'";
+            }
+            if ($strip) {
+                $quoted =~ s/\\([\\$quote])/$1/g if $quote;
+                push @words, $quoted;
+            } else {
+                push @words, "$quote$quoted$quote";
+            }
+        }
     }
-
     return \@words;
 }
 
diff --git a/share/html/REST/1.0/Forms/ticket/default b/share/html/REST/1.0/Forms/ticket/default
index 34c4e1a..36ccf11 100755
--- a/share/html/REST/1.0/Forms/ticket/default
+++ b/share/html/REST/1.0/Forms/ticket/default
@@ -367,37 +367,7 @@ else {
                     }
                 }
                 else {
-                    my @new;
-                    my ( $a, $b ) = split /\s*,\s*/, $val, 2;
-                    while ($a) {
-                        no warnings 'uninitialized';
-                        if ( $a =~ /^'/ ) {
-                            my $s = $a;
-                            while ( $a !~ /'$/ || ( $a !~ /(\\\\)+'$/
-                                            && $a =~ /(\\)+'$/ ) ) {
-                                ( $a, $b ) = split /\s*,\s*/, $b, 2;
-                                $s .= ',' . $a;
-                            }
-                            $s =~ s/^'//;
-                            $s =~ s/'$//;
-                            $s =~ s/\\'/'/g;
-                            push @new, $s;
-                        }
-                        elsif ( $a =~ /^q{/ ) {
-                            my $s = $a;
-                            while ( $a !~ /}$/ ) {
-                                ( $a, $b ) = split /\s*,\s*/, $b, 2;
-                                $s .= ',' . $a;
-                            }
-                            $s =~ s/^q{//;
-                            $s =~ s/}//;
-                            push @new, $s;
-                        }
-                        else {
-                            push @new, $a;
-                        }
-                        ( $a, $b ) = split /\s*,\s*/, $b, 2;
-                    }
+                    my @new = @{vsplit($val, 1)};
 
                     my %new;
                     $new{$_}++ for @new;

-----------------------------------------------------------------------


More information about the Rt-commit mailing list