introduce as_escape

lib/Data/ObjectDriver/SQL.pm

@@ -147,6 +147,15 @@ sub as_sql_having {
         '';
 }
 
+sub as_escape {
+    my ($stmt, $escape_char) = @_;
+
+    # escape_char can be ''(two quotes), or \\ for mysql and \ for others, but it doesn't accept any injections.
+    die 'escape_char length must be up to two characters' if defined($escape_char) && length($escape_char) > 2;
+
+    return " ESCAPE '$escape_char'";
+}
+
 sub add_where {
     my $stmt = shift;
     ## xxx Need to support old range and transform behaviors.
@@ -270,6 +279,7 @@ sub _mk_term {
                 $term = "$c $val->{op} " . ${$val->{value}};
             } else {
                 $term = "$c $val->{op} ?";
+                $term .= $stmt->as_escape($val->{escape}) if $val->{escape} && $op =~ /^(?:NOT\s+)?I?LIKE$/;
                 push @bind, $val->{value};
             }
         }

t/11-sql.t

@@ -3,7 +3,7 @@
 use strict;
 
 use Data::ObjectDriver::SQL;
-use Test::More tests => 95;
+use Test::More tests => 103;
 
 my $stmt = ns();
 ok($stmt, 'Created SQL object');
@@ -231,6 +231,28 @@ is($stmt->as_sql_where, "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?))\n");
 $stmt->add_where(%terms);
 is($stmt->as_sql_where, "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?)) AND ((foo = ?) AND (foo = ?) AND (foo = ?))\n");
 
+## as_escape
+$stmt = ns();
+$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => '\\' });
+is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\')\n");
+is($stmt->bind->[0],    '100%');                               # escape doesn't automatically escape the value
+$stmt = ns();
+$stmt->add_where(foo => { op => 'LIKE', value => '100\\%', escape => '\\' });
+is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\')\n");
+is($stmt->bind->[0],    '100\\%');
+$stmt = ns();
+$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => '!' });
+is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '!')\n");
+$stmt = ns();
+$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => "''" });
+is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '''')\n");
+$stmt = ns();
+$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => "\\'" });
+is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\'')\n");
+$stmt = ns();
+eval { $stmt->add_where(foo => { op => 'LIKE', value => '_', escape => "!!!" }); };
+like($@, qr/length/, 'right error');
+
 $stmt = ns();
 $stmt->add_select(foo => 'foo');
 $stmt->add_select('bar');

t/61-escape.t

@@ -0,0 +1,96 @@
+# $Id$
+
+use strict;
+use warnings;
+use lib 't/lib';
+use lib 't/lib/escape';
+use Test::More;
+use DodTestUtil;
+
+BEGIN {
+    DodTestUtil->check_driver;
+}
+
+plan tests => 6;
+
+use Foo;
+
+setup_dbs({ global => ['foo'] });
+
+my $percent = Foo->new;
+$percent->name('percent');
+$percent->text('100%');
+$percent->save;
+
+my $underscore = Foo->new;
+$underscore->name('underscore');
+$underscore->text('100_');
+$underscore->save;
+
+my $exclamation = Foo->new;
+$exclamation->name('exclamation');
+$exclamation->text('100!');
+$exclamation->save;
+
+subtest 'escape_char 1' => sub {
+    my @got = Foo->search({ text => { op => 'LIKE', value => '100!%', escape => '!' } });
+    is scalar(@got),  1,         'right number';
+    is $got[0]->name, 'percent', 'right name';
+};
+
+subtest 'escape_char 2' => sub {
+    my @got = Foo->search({ text => { op => 'LIKE', value => '100#_', escape => '#' } });
+    is scalar(@got),  1,            'right number';
+    is $got[0]->name, 'underscore', 'right name';
+};
+
+subtest 'self escape' => sub {
+    my @got = Foo->search({ text => { op => 'LIKE', value => '100!!', escape => '!' } });
+    is scalar(@got),  1,             'right number';
+    is $got[0]->name, 'exclamation', 'right name';
+};
+
+subtest 'use wildcard charactor as escapr_char' => sub {
+    plan skip_all => 'MariaDB does not support it' if Foo->driver->dbh->{Driver}->{Name} eq 'MariaDB';
+    my @got = Foo->search({ text => { op => 'LIKE', value => '100_%', escape => '_' } });
+    is scalar(@got),  1,         'right number';
+    is $got[0]->name, 'percent', 'right name';
+};
+
+subtest 'use of special characters' => sub {
+    subtest 'escape_char single quote' => sub {
+        my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "''" } });
+        is scalar(@got),  1,            'right number';
+        is $got[0]->name, 'underscore', 'right name';
+    };
+
+    if (Foo->driver->dbh->{Driver}->{Name} =~ /mysql|mariadb/i) {
+        subtest 'escape_char single quote' => sub {
+            my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "\\'" } });
+            is scalar(@got),  1,            'right number';
+            is $got[0]->name, 'underscore', 'right name';
+        };
+
+        subtest 'escape_char backslash' => sub {
+            my @got = Foo->search({ text => { op => 'LIKE', value => '100\\_', escape => '\\\\' } });
+            is scalar(@got),  1,            'right number';
+            is $got[0]->name, 'underscore', 'right name';
+        };
+    } else {
+        subtest 'escape_char backslash' => sub {
+            my @got = Foo->search({ text => { op => 'LIKE', value => '100\\_', escape => '\\' } });
+            is scalar(@got),  1,            'right number';
+            is $got[0]->name, 'underscore', 'right name';
+        };
+    }
+};
+
+subtest 'is safe' => sub {
+    eval { Foo->search({ text => { op => 'LIKE', value => '_', escape => q{!');select 'vulnerable'; -- } } }); };
+    like $@, qr/escape_char length must be up to two characters/, 'error occurs';
+};
+
+END {
+    disconnect_all(qw/Foo/);
+    teardown_dbs(qw( global ));
+}

t/lib/escape/Foo.pm

@@ -0,0 +1,22 @@
+# $Id$
+
+package Foo;
+use strict;
+use warnings;
+use Data::ObjectDriver::Driver::DBI;
+use DodTestUtil;
+use base qw( Data::ObjectDriver::BaseObject );
+
+__PACKAGE__->install_properties({
+    columns     => ['id', 'name', 'text'],
+    column_defs => {
+        'id'   => 'integer not null auto_increment',
+        'name' => 'string(25)',
+        'text' => 'text',
+    },
+    datasource  => 'foo',
+    primary_key => 'id',
+    driver      => Data::ObjectDriver::Driver::DBI->new(dsn => DodTestUtil::dsn('global')),
+});
+
+1;

t/schemas/foo.sql

@@ -0,0 +1,5 @@
+CREATE TABLE foo (
+  id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
+  name VARCHAR(25),
+  text MEDIUMTEXT
+)