[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