[Bps-public-commit] r17920 - in Parse-BooleanLogic: lib/Parse

[ruz at bestpractical.com]

Author: ruz
Date: Mon Jan 26 02:13:02 2009
New Revision: 17920

Added:
   Parse-BooleanLogic/t/quotes.t
Modified:
   Parse-BooleanLogic/lib/Parse/BooleanLogic.pm

Log:
* just implement quoting and dequotin here, instead of copy&pasting
  things around all the time

Modified: Parse-BooleanLogic/lib/Parse/BooleanLogic.pm
==============================================================================
--- Parse-BooleanLogic/lib/Parse/BooleanLogic.pm	(original)
+++ Parse-BooleanLogic/lib/Parse/BooleanLogic.pm	Mon Jan 26 02:13:02 2009
@@ -52,8 +52,8 @@
 You can change literals used for boolean operators and parens. Read more
 about this in description of constructor's arguments.
 
-As you can see quoted strings are supported and based on delimited strings
-from L<Regexp::Common> with ' and " as delimiters.
+As you can see quoted strings are supported. Read about that below in
+L<Quoting and dequoting>.
 
 =cut
 
@@ -73,7 +73,7 @@
 my @tokens = qw[OPERAND OPERATOR OPEN_PAREN CLOSE_PAREN STOP];
 
 use Regexp::Common qw(delimited);
-my $re_delim = qr{$RE{delimited}{-delim=>qq{\'\"}}};
+my $re_delim = qr{$RE{delimited}{-delim=>qq{\'\"}}{-esc=>'\\'}};
 
 =head1 METHODS
 
@@ -394,6 +394,107 @@
     return join ' or ', @res;
 }
 
+=head2 Quoting and dequoting
+
+This module supports quoting with single quote ' and double ",
+literal quotes escaped with \.
+
+from L<Regexp::Common::delimited> with ' and " as delimiters.
+
+=head3 q, qq, fq and dq
+
+Four methods to work with quotes:
+
+=over 4
+
+=item q - quote a string with single quote character.
+
+=item qq - quote a string with double quote character.
+
+=item fq - quote with single if string has no single quote character, otherwisee use double quotes.
+
+=item dq - delete either single or double quotes from a string if it's quoted.
+
+=back
+
+All four works either in place or return result, for example:
+
+    $parser->q($str); # inplace
+
+    my $q = $parser->q($s); # $s is untouched
+
+=cut
+
+sub q {
+    if ( defined wantarray ) {
+        my $s = $_[1];
+        $s =~ s/(?=['\\])/\\/g;
+        return "'$s'";
+    } else {
+        $_[1] =~ s/(?=['\\])/\\/g;
+        substr($_[1], 0, 0) = "'";
+        $_[1] .= "'";
+        return;
+    }
+}
+
+sub qq {
+    if ( defined wantarray ) {
+        my $s = $_[1];
+        $s =~ s/(?=["\\])/\\/g;
+        return "\"$s\"";
+    } else {
+        $_[1] =~ s/(?=["\\])/\\/g;
+        substr($_[1], 0, 0) = '"';
+        $_[1] .= '"';
+        return;
+    }
+}
+
+sub fq {
+    if ( index( $_[1], "'" ) >= 0 ) {
+        if ( defined wantarray ) {
+            my $s = $_[1];
+            $s =~ s/(?=["\\])/\\/g;
+            return "\"$s\"";
+        } else {
+            $_[1] =~ s/(?=["\\])/\\/g;
+            substr($_[1], 0, 0) = '"';
+            $_[1] .= '"';
+            return;
+        }
+    } else {
+        if ( defined wantarray ) {
+            my $s = $_[1];
+            $s =~ s/(?=\\)/\\/g;
+            return "'$s'";
+        } else {
+            $_[1] =~ s/(?=\\)/\\/g;
+            substr($_[1], 0, 0) = "'";
+            $_[1] .= "'";
+            return;
+        }
+    }
+}
+
+sub dq {
+    return defined wantarray? $_[1] : ()
+        unless $_[1] =~ /^$re_delim$/o;
+
+    if ( defined wantarray ) {
+        my $s = $_[1];
+        my $q = substr( $s, 0, 1, '' );
+        substr( $s, -1   ) = '';
+        $s =~ s/\\([$q\\])/$1/g;
+        return $s;
+    } else {
+        my $q = substr( $_[1], 0, 1, '' );
+        substr( $_[1], -1 ) = '';
+        $_[1] =~ s/\\([$q\\])/$1/g;
+        return;
+    }
+}
+
 =head2 Tree evaluation and modification
 
 Several functions taking a tree of boolean expressions as returned by

Added: Parse-BooleanLogic/t/quotes.t
==============================================================================
--- (empty file)
+++ Parse-BooleanLogic/t/quotes.t	Mon Jan 26 02:13:02 2009
@@ -0,0 +1,47 @@
+
+use strict;
+use warnings;
+
+use Test::More tests => 45;
+BEGIN { require "t/utils.pl" };
+
+use_ok 'Parse::BooleanLogic';
+
+my $p = new Parse::BooleanLogic;
+
+sub test_quoting($$$) {
+    my ($m, $s, $qs) = @_;
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+    {
+        my $tmp = $p->$m($s);
+        is $tmp, $qs;
+        $tmp = $p->dq($tmp);
+        is $tmp, $s;
+    }
+    { # test inplace
+        my $tmp = $s;
+        $p->$m($tmp);
+        is $tmp, $qs;
+        $p->dq($tmp);
+        is $tmp, $s;
+    }
+}
+
+sub test_q($$)  { return test_quoting 'q',  $_[0], $_[1] }
+sub test_qq($$) { return test_quoting 'qq', $_[0], $_[1] }
+sub test_fq($$) { return test_quoting 'fq', $_[0], $_[1] }
+
+test_q "test", "'test'";
+test_q "te\\'st", "'te\\\\\\'st'";
+test_q 'te"st', "'te\"st'";
+test_q "test\\", "'test\\\\'";
+
+test_qq "test", '"test"';
+test_qq "test\\", '"test\\\\"';
+test_qq "te'st", '"te\'st"';
+test_qq 'te\\"st', '"te\\\\\\"st"';
+
+test_fq "test", "'test'";
+test_fq "te'st", '"te\'st"';
+test_fq 'te"st', "'te\"st'";
+