Skip to content

Commit e3ffb0a

Browse files
jamadamjamadam
authored
Merge pull request #45 from sixapart/introduce-as_escape
introduce as_escape
2 parents 76b2e26 + 6fbf5cb commit e3ffb0a

5 files changed

Lines changed: 156 additions & 1 deletion

File tree

‎lib/Data/ObjectDriver/SQL.pm‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -147,6 +147,15 @@ sub as_sql_having {
147147
'';
148148
}
149149

150+
sub as_escape {
151+
my ($stmt, $escape_char) = @_;
152+
153+
# escape_char can be ''(two quotes), or \\ for mysql and \ for others, but it doesn't accept any injections.
154+
die 'escape_char length must be up to two characters' if defined($escape_char) && length($escape_char) > 2;
155+
156+
return " ESCAPE '$escape_char'";
157+
}
158+
150159
sub add_where {
151160
my $stmt = shift;
152161
## xxx Need to support old range and transform behaviors.
@@ -270,6 +279,7 @@ sub _mk_term {
270279
$term = "$c $val->{op} " . ${$val->{value}};
271280
} else {
272281
$term = "$c $val->{op} ?";
282+
$term .= $stmt->as_escape($val->{escape}) if $val->{escape} && $op =~ /^(?:NOT\s+)?I?LIKE$/;
273283
push @bind, $val->{value};
274284
}
275285
}

‎t/11-sql.t‎

Lines changed: 23 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
use strict;
44

55
use Data::ObjectDriver::SQL;
6-
use Test::More tests => 95;
6+
use Test::More tests => 103;
77

88
my $stmt = ns();
99
ok($stmt, 'Created SQL object');
@@ -231,6 +231,28 @@ is($stmt->as_sql_where, "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?))\n");
231231
$stmt->add_where(%terms);
232232
is($stmt->as_sql_where, "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?)) AND ((foo = ?) AND (foo = ?) AND (foo = ?))\n");
233233

234+
## as_escape
235+
$stmt = ns();
236+
$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => '\\' });
237+
is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\')\n");
238+
is($stmt->bind->[0], '100%'); # escape doesn't automatically escape the value
239+
$stmt = ns();
240+
$stmt->add_where(foo => { op => 'LIKE', value => '100\\%', escape => '\\' });
241+
is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\')\n");
242+
is($stmt->bind->[0], '100\\%');
243+
$stmt = ns();
244+
$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => '!' });
245+
is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '!')\n");
246+
$stmt = ns();
247+
$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => "''" });
248+
is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '''')\n");
249+
$stmt = ns();
250+
$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => "\\'" });
251+
is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\'')\n");
252+
$stmt = ns();
253+
eval { $stmt->add_where(foo => { op => 'LIKE', value => '_', escape => "!!!" }); };
254+
like($@, qr/length/, 'right error');
255+
234256
$stmt = ns();
235257
$stmt->add_select(foo => 'foo');
236258
$stmt->add_select('bar');

‎t/61-escape.t‎

Lines changed: 96 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,96 @@
1+
# $Id$
2+
3+
use strict;
4+
use warnings;
5+
use lib 't/lib';
6+
use lib 't/lib/escape';
7+
use Test::More;
8+
use DodTestUtil;
9+
10+
BEGIN {
11+
DodTestUtil->check_driver;
12+
}
13+
14+
plan tests => 6;
15+
16+
use Foo;
17+
18+
setup_dbs({ global => ['foo'] });
19+
20+
my $percent = Foo->new;
21+
$percent->name('percent');
22+
$percent->text('100%');
23+
$percent->save;
24+
25+
my $underscore = Foo->new;
26+
$underscore->name('underscore');
27+
$underscore->text('100_');
28+
$underscore->save;
29+
30+
my $exclamation = Foo->new;
31+
$exclamation->name('exclamation');
32+
$exclamation->text('100!');
33+
$exclamation->save;
34+
35+
subtest 'escape_char 1' => sub {
36+
my @got = Foo->search({ text => { op => 'LIKE', value => '100!%', escape => '!' } });
37+
is scalar(@got), 1, 'right number';
38+
is $got[0]->name, 'percent', 'right name';
39+
};
40+
41+
subtest 'escape_char 2' => sub {
42+
my @got = Foo->search({ text => { op => 'LIKE', value => '100#_', escape => '#' } });
43+
is scalar(@got), 1, 'right number';
44+
is $got[0]->name, 'underscore', 'right name';
45+
};
46+
47+
subtest 'self escape' => sub {
48+
my @got = Foo->search({ text => { op => 'LIKE', value => '100!!', escape => '!' } });
49+
is scalar(@got), 1, 'right number';
50+
is $got[0]->name, 'exclamation', 'right name';
51+
};
52+
53+
subtest 'use wildcard charactor as escapr_char' => sub {
54+
plan skip_all => 'MariaDB does not support it' if Foo->driver->dbh->{Driver}->{Name} eq 'MariaDB';
55+
my @got = Foo->search({ text => { op => 'LIKE', value => '100_%', escape => '_' } });
56+
is scalar(@got), 1, 'right number';
57+
is $got[0]->name, 'percent', 'right name';
58+
};
59+
60+
subtest 'use of special characters' => sub {
61+
subtest 'escape_char single quote' => sub {
62+
my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "''" } });
63+
is scalar(@got), 1, 'right number';
64+
is $got[0]->name, 'underscore', 'right name';
65+
};
66+
67+
if (Foo->driver->dbh->{Driver}->{Name} =~ /mysql|mariadb/i) {
68+
subtest 'escape_char single quote' => sub {
69+
my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "\\'" } });
70+
is scalar(@got), 1, 'right number';
71+
is $got[0]->name, 'underscore', 'right name';
72+
};
73+
74+
subtest 'escape_char backslash' => sub {
75+
my @got = Foo->search({ text => { op => 'LIKE', value => '100\\_', escape => '\\\\' } });
76+
is scalar(@got), 1, 'right number';
77+
is $got[0]->name, 'underscore', 'right name';
78+
};
79+
} else {
80+
subtest 'escape_char backslash' => sub {
81+
my @got = Foo->search({ text => { op => 'LIKE', value => '100\\_', escape => '\\' } });
82+
is scalar(@got), 1, 'right number';
83+
is $got[0]->name, 'underscore', 'right name';
84+
};
85+
}
86+
};
87+
88+
subtest 'is safe' => sub {
89+
eval { Foo->search({ text => { op => 'LIKE', value => '_', escape => q{!');select 'vulnerable'; -- } } }); };
90+
like $@, qr/escape_char length must be up to two characters/, 'error occurs';
91+
};
92+
93+
END {
94+
disconnect_all(qw/Foo/);
95+
teardown_dbs(qw( global ));
96+
}

‎t/lib/escape/Foo.pm‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
# $Id$
2+
3+
package Foo;
4+
use strict;
5+
use warnings;
6+
use Data::ObjectDriver::Driver::DBI;
7+
use DodTestUtil;
8+
use base qw( Data::ObjectDriver::BaseObject );
9+
10+
__PACKAGE__->install_properties({
11+
columns => ['id', 'name', 'text'],
12+
column_defs => {
13+
'id' => 'integer not null auto_increment',
14+
'name' => 'string(25)',
15+
'text' => 'text',
16+
},
17+
datasource => 'foo',
18+
primary_key => 'id',
19+
driver => Data::ObjectDriver::Driver::DBI->new(dsn => DodTestUtil::dsn('global')),
20+
});
21+
22+
1;

‎t/schemas/foo.sql‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
CREATE TABLE foo (
2+
id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
3+
name VARCHAR(25),
4+
text MEDIUMTEXT
5+
)

0 commit comments

Comments
 (0)