[Bast-commits] r9654 - in SQL-Abstract/1.x/branches/sqla-tree:
lib/SQL/Abstract t
frew at dev.catalyst.perl.org
frew at dev.catalyst.perl.org
Wed Aug 25 03:26:02 GMT 2010
Author: frew
Date: 2010-08-25 04:26:02 +0100 (Wed, 25 Aug 2010)
New Revision: 9654
Modified:
SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Test.pm
SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm
SQL-Abstract/1.x/branches/sqla-tree/t/00new.t
SQL-Abstract/1.x/branches/sqla-tree/t/01generate.t
SQL-Abstract/1.x/branches/sqla-tree/t/02where.t
SQL-Abstract/1.x/branches/sqla-tree/t/03values.t
SQL-Abstract/1.x/branches/sqla-tree/t/04modifiers.t
SQL-Abstract/1.x/branches/sqla-tree/t/05in_between.t
SQL-Abstract/1.x/branches/sqla-tree/t/06order_by.t
SQL-Abstract/1.x/branches/sqla-tree/t/07subqueries.t
SQL-Abstract/1.x/branches/sqla-tree/t/08special_ops.t
SQL-Abstract/1.x/branches/sqla-tree/t/10test.t
Log:
convert ::Test and ::Tree into objects instead of exporting subroutines
Modified: SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Test.pm
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Test.pm 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Test.pm 2010-08-25 03:26:02 UTC (rev 9654)
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use base qw/SQL::Abstract::Tree Test::Builder::Module Exporter/;
+use base qw/SQL::Abstract::Tree Test::Builder::Module/;
use Data::Dumper;
use Carp;
use Test::Builder;
@@ -47,21 +47,21 @@
);
sub is_same_sql_bind {
- my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;
+ my ($self, $sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;
# compare
- my $same_sql = eq_sql($sql1, $sql2);
- my $same_bind = eq_bind($bind_ref1, $bind_ref2);
+ my $same_sql = $self->eq_sql($sql1, $sql2);
+ my $same_bind = $self->eq_bind($bind_ref1, $bind_ref2);
# call Test::Builder::ok
my $ret = $tb->ok($same_sql && $same_bind, $msg);
# add debugging info
if (!$same_sql) {
- _sql_differ_diag($sql1, $sql2);
+ $self->_sql_differ_diag($sql1, $sql2);
}
if (!$same_bind) {
- _bind_differ_diag($bind_ref1, $bind_ref2);
+ $self->_bind_differ_diag($bind_ref1, $bind_ref2);
}
# pass ok() result further
@@ -69,17 +69,17 @@
}
sub is_same_sql {
- my ($sql1, $sql2, $msg) = @_;
+ my ($self, $sql1, $sql2, $msg) = @_;
# compare
- my $same_sql = eq_sql($sql1, $sql2);
+ my $same_sql = $self->eq_sql($sql1, $sql2);
# call Test::Builder::ok
my $ret = $tb->ok($same_sql, $msg);
# add debugging info
if (!$same_sql) {
- _sql_differ_diag($sql1, $sql2);
+ $self->_sql_differ_diag($sql1, $sql2);
}
# pass ok() result further
@@ -87,17 +87,17 @@
}
sub is_same_bind {
- my ($bind_ref1, $bind_ref2, $msg) = @_;
+ my ($self, $bind_ref1, $bind_ref2, $msg) = @_;
# compare
- my $same_bind = eq_bind($bind_ref1, $bind_ref2);
+ my $same_bind = $self->eq_bind($bind_ref1, $bind_ref2);
# call Test::Builder::ok
my $ret = $tb->ok($same_bind, $msg);
# add debugging info
if (!$same_bind) {
- _bind_differ_diag($bind_ref1, $bind_ref2);
+ $self->_bind_differ_diag($bind_ref1, $bind_ref2);
}
# pass ok() result further
@@ -105,7 +105,7 @@
}
sub _sql_differ_diag {
- my ($sql1, $sql2) = @_;
+ my ($self, $sql1, $sql2) = @_;
$tb->diag("SQL expressions differ\n"
." got: $sql1\n"
@@ -115,7 +115,7 @@
}
sub _bind_differ_diag {
- my ($bind_ref1, $bind_ref2) = @_;
+ my ($self, $bind_ref1, $bind_ref2) = @_;
$tb->diag("BIND values differ\n"
." got: " . Dumper($bind_ref1)
@@ -124,14 +124,14 @@
}
sub eq_sql_bind {
- my ($sql1, $bind_ref1, $sql2, $bind_ref2) = @_;
+ my ($self, $sql1, $bind_ref1, $sql2, $bind_ref2) = @_;
- return eq_sql($sql1, $sql2) && eq_bind($bind_ref1, $bind_ref2);
+ return $self->eq_sql($sql1, $sql2) && $self->eq_bind($bind_ref1, $bind_ref2);
}
sub eq_bind {
- my ($bind_ref1, $bind_ref2) = @_;
+ my ($self, $bind_ref1, $bind_ref2) = @_;
local $Data::Dumper::Useqq = 1;
local $Data::Dumper::Sortkeys = 1;
@@ -140,17 +140,17 @@
}
sub eq_sql {
- my ($sql1, $sql2) = @_;
+ my ($self, $sql1, $sql2) = @_;
# parse
- my $tree1 = parse($sql1);
- my $tree2 = parse($sql2);
+ my $tree1 = $self->parse($sql1);
+ my $tree2 = $self->parse($sql2);
- return 1 if _eq_sql($tree1, $tree2);
+ return 1 if $self->_eq_sql($tree1, $tree2);
}
sub _eq_sql {
- my ($left, $right) = @_;
+ my ($self, $left, $right) = @_;
# one is defined the other not
if ( (defined $left) xor (defined $right) ) {
@@ -162,13 +162,13 @@
}
# one is a list, the other is an op with a list
elsif (ref $left->[0] xor ref $right->[0]) {
- $sql_differ = sprintf ("left: %s\nright: %s\n", map { unparse ($_) } ($left, $right) );
+ $sql_differ = sprintf ("left: %s\nright: %s\n", map { $self->unparse ($_) } ($left, $right) );
return 0;
}
# one is a list, so is the other
elsif (ref $left->[0]) {
for (my $i = 0; $i <= $#$left or $i <= $#$right; $i++ ) {
- return 0 if (not _eq_sql ($left->[$i], $right->[$i]) );
+ return 0 if (not $self->_eq_sql ($left->[$i], $right->[$i]) );
}
return 1;
}
@@ -176,13 +176,13 @@
else {
# unroll parenthesis if possible/allowed
- _parenthesis_unroll ($_) for ($left, $right);
+ $self->_parenthesis_unroll ($_) for ($left, $right);
# if operators are different
if ( $left->[0] ne $right->[0] ) {
$sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
- unparse($left),
- unparse($right);
+ $self->unparse($left),
+ $self->unparse($right);
return 0;
}
# elsif operators are identical, compare operands
@@ -195,18 +195,16 @@
return $eq;
}
else {
- my $eq = _eq_sql($left->[1], $right->[1]);
- $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { unparse ($_) } ($left, $right) ) if not $eq;
+ my $eq = $self->_eq_sql($left->[1], $right->[1]);
+ $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { $self->unparse ($_) } ($left, $right) ) if not $eq;
return $eq;
}
}
}
}
-sub parse { goto &SQL::Abstract::Tree::parse }
-
sub _parenthesis_unroll {
- my $ast = shift;
+ my ($self, $ast) = @_;
return if $parenthesis_significant;
return unless (ref $ast and ref $ast->[1]);
@@ -278,8 +276,6 @@
}
-sub unparse { goto &SQL::Abstract::Tree::unparse }
-
1;
Modified: SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/lib/SQL/Abstract/Tree.pm 2010-08-25 03:26:02 UTC (rev 9654)
@@ -76,8 +76,10 @@
$tokenizer_re = qr/ \s* ( $tokenizer_re_str | \( | \) | \? ) \s* /xi;
}
+sub new { bless {}, shift }
+
sub parse {
- my $s = shift;
+ my ($self, $s) = @_;
# tokenize string, and remove all optional whitespace
my $tokens = [];
@@ -85,12 +87,12 @@
push @$tokens, $token if (length $token) && ($token =~ /\S/);
}
- my $tree = _recurse_parse($tokens, PARSE_TOP_LEVEL);
+ my $tree = $self->_recurse_parse($tokens, PARSE_TOP_LEVEL);
return $tree;
}
sub _recurse_parse {
- my ($tokens, $state) = @_;
+ my ($self, $tokens, $state) = @_;
my $left;
while (1) { # left-associative parsing
@@ -111,9 +113,9 @@
# nested expression in ()
if ($token eq '(' ) {
- my $right = _recurse_parse($tokens, PARSE_IN_PARENS);
- $token = shift @$tokens or croak "missing closing ')' around block " . unparse ($right);
- $token eq ')' or croak "unexpected token '$token' terminating block " . unparse ($right);
+ my $right = $self->_recurse_parse($tokens, PARSE_IN_PARENS);
+ $token = shift @$tokens or croak "missing closing ')' around block " . $self->unparse ($right);
+ $token eq ')' or croak "unexpected token '$token' terminating block " . $self->unparse ($right);
$left = $left ? [@$left, [PAREN => [$right] ]]
: [PAREN => [$right] ];
@@ -121,7 +123,7 @@
# AND/OR
elsif ($token =~ /^ (?: OR | AND ) $/xi ) {
my $op = uc $token;
- my $right = _recurse_parse($tokens, PARSE_IN_EXPR);
+ my $right = $self->_recurse_parse($tokens, PARSE_IN_EXPR);
# Merge chunks if logic matches
if (ref $right and $op eq $right->[0]) {
@@ -134,13 +136,13 @@
# binary operator keywords
elsif (grep { $token =~ /^ $_ $/xi } @binary_op_keywords ) {
my $op = uc $token;
- my $right = _recurse_parse($tokens, PARSE_RHS);
+ my $right = $self->_recurse_parse($tokens, PARSE_RHS);
# A between with a simple LITERAL for a 1st RHS argument needs a
# rerun of the search to (hopefully) find the proper AND construct
if ($op eq 'BETWEEN' and $right->[0] eq 'LITERAL') {
unshift @$tokens, $right->[1][0];
- $right = _recurse_parse($tokens, PARSE_IN_EXPR);
+ $right = $self->_recurse_parse($tokens, PARSE_IN_EXPR);
}
$left = [$op => [$left, $right] ];
@@ -148,29 +150,29 @@
# expression terminator keywords (as they start a new expression)
elsif (grep { $token =~ /^ $_ $/xi } @expression_terminator_sql_keywords ) {
my $op = uc $token;
- my $right = _recurse_parse($tokens, PARSE_IN_EXPR);
+ my $right = $self->_recurse_parse($tokens, PARSE_IN_EXPR);
$left = $left ? [ $left, [$op => [$right] ]]
: [ $op => [$right] ];
}
# NOT (last as to allow all other NOT X pieces first)
elsif ( $token =~ /^ not $/ix ) {
my $op = uc $token;
- my $right = _recurse_parse ($tokens, PARSE_RHS);
+ my $right = $self->_recurse_parse ($tokens, PARSE_RHS);
$left = $left ? [ @$left, [$op => [$right] ]]
: [ $op => [$right] ];
}
# literal (eat everything on the right until RHS termination)
else {
- my $right = _recurse_parse ($tokens, PARSE_RHS);
- $left = $left ? [ $left, [LITERAL => [join ' ', $token, unparse($right)||()] ] ]
- : [ LITERAL => [join ' ', $token, unparse($right)||()] ];
+ my $right = $self->_recurse_parse ($tokens, PARSE_RHS);
+ $left = $left ? [ $left, [LITERAL => [join ' ', $token, $self->unparse($right)||()] ] ]
+ : [ LITERAL => [join ' ', $token, $self->unparse($right)||()] ];
}
}
}
sub unparse {
- my $tree = shift;
+ my ($self, $tree) = @_;
if (not $tree ) {
return '';
@@ -185,10 +187,10 @@
return sprintf '(%s)', join (" ", map {unparse($_)} @{$tree->[1]});
}
elsif ($tree->[0] eq 'OR' or $tree->[0] eq 'AND' or (grep { $tree->[0] =~ /^ $_ $/xi } @binary_op_keywords ) ) {
- return join (" $tree->[0] ", map {unparse($_)} @{$tree->[1]});
+ return join (" $tree->[0] ", map {$self->unparse($_)} @{$tree->[1]});
}
else {
- return sprintf '%s %s', $tree->[0], unparse ($tree->[1]);
+ return sprintf '%s %s', $tree->[0], $self->unparse ($tree->[1]);
}
}
Modified: SQL-Abstract/1.x/branches/sqla-tree/t/00new.t
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/t/00new.t 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/t/00new.t 2010-08-25 03:26:02 UTC (rev 9654)
@@ -4,8 +4,10 @@
use warnings;
use Test::More;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
+use SQL::Abstract::Test;
+my $sqlat = SQL::Abstract::Test->new;
+
#LDNOTE: renamed all "bind" into "where" because that's what they are
my @handle_tests = (
@@ -15,7 +17,7 @@
# stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )'
# LDNOTE: modified the line above (changing the test suite!!!) because
# the test was not consistent with the doc: hashrefs should not be
-# influenced by the current logic, they always mean 'AND'. So
+# influenced by the current logic, they always mean 'AND'. So
# { a => 4, b => 0} should ALWAYS mean ( a = ? AND b = ? ).
#
# acked by RIBASUSHI
@@ -92,11 +94,11 @@
{
args => {convert => "upper"},
stmt => 'SELECT * FROM test WHERE ( ( UPPER(hostname) IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) AND ( ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) ) ) OR ( UPPER(tack) BETWEEN UPPER(?) AND UPPER(?) ) OR ( ( ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) ) AND ( ( UPPER(e) != UPPER(?) ) OR ( UPPER(e) != UPPER(?) ) ) AND UPPER(q) NOT IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) ) )',
- where => [ { ticket => [11, 12, 13],
+ where => [ { ticket => [11, 12, 13],
hostname => { in => ['ntf', 'avd', 'bvd', '123'] } },
{ tack => { between => [qw/tick tock/] } },
- { a => [qw/b c d/],
- e => { '!=', [qw(f g)] },
+ { a => [qw/b c d/],
+ e => { '!=', [qw(f g)] },
q => { 'not in', [14..20] } } ],
},
);
@@ -116,7 +118,7 @@
# LDNOTE: this original test suite from NWIGER did no comparisons
# on @bind values, just checking if @bind is nonempty.
# So here we just fake a [1] bind value for the comparison.
- is_same_sql_bind($stmt, [@bind ? 1 : 0], $_->{stmt}, [1]);
+ $sqlat->is_same_sql_bind($stmt, [@bind ? 1 : 0], $_->{stmt}, [1]);
}
Modified: SQL-Abstract/1.x/branches/sqla-tree/t/01generate.t
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/t/01generate.t 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/t/01generate.t 2010-08-25 03:26:02 UTC (rev 9654)
@@ -6,7 +6,8 @@
use Test::Warn;
use Test::Exception;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
+use SQL::Abstract::Test;
+my $sqlat = SQL::Abstract::Test->new;
use SQL::Abstract;
@@ -572,7 +573,7 @@
else {
$cref->();
}
- is_same_sql_bind(
+ $sqlat->is_same_sql_bind(
$stmt,
\@bind,
$quoted ? $t->{stmt_q}: $t->{stmt},
Modified: SQL-Abstract/1.x/branches/sqla-tree/t/02where.t
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/t/02where.t 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/t/02where.t 2010-08-25 03:26:02 UTC (rev 9654)
@@ -4,8 +4,10 @@
use warnings;
use Test::More;
use Test::Exception;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
+use SQL::Abstract::Test;
+my $sqlat = SQL::Abstract::Test->new;
+
use Data::Dumper;
use SQL::Abstract;
@@ -106,7 +108,7 @@
},
{
- where => {
+ where => {
priority => [ {'>', 3}, {'<', 1} ],
requestor => \'is not null',
},
@@ -116,7 +118,7 @@
},
{
- where => {
+ where => {
requestor => { '!=', ['-and', undef, ''] },
},
stmt => " WHERE ( requestor IS NOT NULL AND requestor != ? )",
@@ -124,9 +126,9 @@
},
{
- where => {
+ where => {
priority => [ {'>', 3}, {'<', 1} ],
- requestor => { '!=', undef },
+ requestor => { '!=', undef },
},
order => [qw/a b c d e f g/],
stmt => " WHERE ( ( ( priority > ? ) OR ( priority < ? ) ) AND requestor IS NOT NULL )"
@@ -135,9 +137,9 @@
},
{
- where => {
+ where => {
priority => { 'between', [1, 3] },
- requestor => { 'like', undef },
+ requestor => { 'like', undef },
},
order => \'requestor, ticket',
#LDNOTE: modified parentheses
@@ -149,12 +151,12 @@
{
- where => {
+ where => {
id => 1,
- num => {
- '<=' => 20,
- '>' => 10,
- },
+ num => {
+ '<=' => 20,
+ '>' => 10,
+ },
},
# LDNOTE : modified test below, just parentheses differ
#
@@ -390,9 +392,9 @@
local $Data::Dumper::Terse = 1;
my $sql = SQL::Abstract->new;
my($stmt, @bind);
- lives_ok (sub {
+ lives_ok (sub {
($stmt, @bind) = $sql->where($case->{where}, $case->{order});
- is_same_sql_bind($stmt, \@bind, $case->{stmt}, $case->{bind})
+ $sqlat->is_same_sql_bind($stmt, \@bind, $case->{stmt}, $case->{bind})
|| diag "Search term:\n" . Dumper $case->{where};
});
}
Modified: SQL-Abstract/1.x/branches/sqla-tree/t/03values.t
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/t/03values.t 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/t/03values.t 2010-08-25 03:26:02 UTC (rev 9654)
@@ -4,8 +4,10 @@
use warnings;
use Test::More;
-use SQL::Abstract::Test import => [qw/is_same_sql_bind is_same_bind/];
+use SQL::Abstract::Test;
+my $sqlat = SQL::Abstract::Test->new;
+
use SQL::Abstract;
my @data = (
@@ -94,7 +96,7 @@
{
my $sql = SQL::Abstract->new;
- my $data = {
+ my $data = {
event => 'rapture',
stuff => 'fluff',
time => \ 'now()',
@@ -106,14 +108,14 @@
my ($stmt, @bind) = $sql->insert ('table', $data);
- is_same_sql_bind (
+ $sqlat->is_same_sql_bind (
$stmt,
\@bind,
'INSERT INTO table ( event, stuff, time, xfunc, yfunc, zfunc, zzlast) VALUES ( ?, ?, now(), xfunc (?), yfunc(?), zfunc(?), ? )',
[qw/rapture fluff ystuff zstuff zzstuff/], # event < stuff
);
- is_same_bind (
+ $sqlat->is_same_bind (
[$sql->values ($data)],
[@bind],
'values() output matches that of initial bind'
Modified: SQL-Abstract/1.x/branches/sqla-tree/t/04modifiers.t
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/t/04modifiers.t 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/t/04modifiers.t 2010-08-25 03:26:02 UTC (rev 9654)
@@ -4,8 +4,10 @@
use warnings;
use Test::More;
use Test::Exception;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
+use SQL::Abstract::Test;
+my $sqlat = SQL::Abstract::Test->new;
+
use Data::Dumper;
use Storable qw/dclone/;
use SQL::Abstract;
@@ -17,7 +19,7 @@
limitation of one modifier type per hahsref)
* When in condition context i.e. where => { -or { a = 1 } }, each modifier
affects only the immediate element following it.
- * When in column multi-condition context i.e.
+ * When in column multi-condition context i.e.
where => { x => { '!=', [-and, [qw/1 2 3/]] } }, a modifier affects the
OUTER ARRAYREF if and only if it is the first element of said ARRAYREF
@@ -68,7 +70,7 @@
%{$and_or_args->{or}},
},
- # test modifiers within hashrefs
+ # test modifiers within hashrefs
{
where => { -or => [
[ foo => 1, bar => 2 ],
@@ -84,7 +86,7 @@
%{$and_or_args->{or_and}},
},
- # test modifiers within arrayrefs
+ # test modifiers within arrayrefs
{
where => [ -or => [
[ foo => 1, bar => 2 ],
@@ -162,8 +164,8 @@
# the -and should affect the OUTER arrayref, while the internal structures remain intact
{
- where => { x => [
- -and => [ 1, 2 ], { -like => 'x%' }
+ where => { x => [
+ -and => [ 1, 2 ], { -like => 'x%' }
]},
stmt => 'WHERE (x = ? OR x = ?) AND x LIKE ?',
bind => [qw/1 2 x%/],
@@ -209,7 +211,7 @@
bind => [1 .. 13],
},
- # 1st -and is in column mode, thus flips the entire array, whereas the
+ # 1st -and is in column mode, thus flips the entire array, whereas the
# 2nd one is just a condition modifier
{
where => [
@@ -386,9 +388,9 @@
my $sql = SQL::Abstract->new ($case->{args} || {});
my $where_copy = dclone($case->{where});
- lives_ok (sub {
+ lives_ok (sub {
my ($stmt, @bind) = $sql->where($case->{where});
- is_same_sql_bind(
+ $sqlat->is_same_sql_bind(
$stmt,
\@bind,
$case->{stmt},
@@ -413,7 +415,7 @@
my $sql = SQL::Abstract->new ($case->{args} || {});
lives_ok (sub {
my ($stmt, @bind) = $sql->where($case->{where});
- is_same_sql_bind(
+ $sqlat->is_same_sql_bind(
$stmt,
\@bind,
$case->{stmt},
@@ -439,7 +441,7 @@
lives_ok (sub {
my ($old_s, @old_b) = $sql->where($case->{backcompat});
my ($new_s, @new_b) = $sql->where($case->{correct});
- is_same_sql_bind(
+ $sqlat->is_same_sql_bind(
$old_s, \@old_b,
$new_s, \@new_b,
'Backcompat and the correct(tm) syntax result in identical statements',
Modified: SQL-Abstract/1.x/branches/sqla-tree/t/05in_between.t
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/t/05in_between.t 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/t/05in_between.t 2010-08-25 03:26:02 UTC (rev 9654)
@@ -4,8 +4,10 @@
use warnings;
use Test::More;
use Test::Exception;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
+use SQL::Abstract::Test;
+my $sqlat = SQL::Abstract::Test->new;
+
use Data::Dumper;
use SQL::Abstract;
@@ -156,9 +158,9 @@
my @w;
local $SIG{__WARN__} = sub { push @w, @_ };
my $sql = SQL::Abstract->new ($case->{args} || {});
- lives_ok (sub {
+ lives_ok (sub {
my ($stmt, @bind) = $sql->where($case->{where});
- is_same_sql_bind(
+ $sqlat->is_same_sql_bind(
$stmt,
\@bind,
$case->{stmt},
Modified: SQL-Abstract/1.x/branches/sqla-tree/t/06order_by.t
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/t/06order_by.t 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/t/06order_by.t 2010-08-25 03:26:02 UTC (rev 9654)
@@ -7,8 +7,11 @@
use SQL::Abstract;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
-my @cases =
+use SQL::Abstract::Test;
+
+my $sqlat = SQL::Abstract::Test->new;
+
+my @cases =
(
{
given => \'colA DESC',
@@ -116,7 +119,7 @@
my ($stat, @bind);
($stat, @bind) = $sql->_order_by($case->{given});
- is_same_sql_bind (
+ $sqlat->is_same_sql_bind (
$stat,
\@bind,
$case->{expects},
@@ -124,7 +127,7 @@
);
($stat, @bind) = $sqlq->_order_by($case->{given});
- is_same_sql_bind (
+ $sqlat->is_same_sql_bind (
$stat,
\@bind,
$case->{expects_quoted},
Modified: SQL-Abstract/1.x/branches/sqla-tree/t/07subqueries.t
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/t/07subqueries.t 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/t/07subqueries.t 2010-08-25 03:26:02 UTC (rev 9654)
@@ -4,8 +4,10 @@
use warnings;
use Test::More;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
+use SQL::Abstract::Test;
+my $sqlat = SQL::Abstract::Test->new;
+
use SQL::Abstract;
my $sql = SQL::Abstract->new;
@@ -27,7 +29,7 @@
#2
($sub_stmt, @sub_bind)
- = $sql->select("t1", "c1", {c2 => {"<" => 100},
+ = $sql->select("t1", "c1", {c2 => {"<" => 100},
c3 => {-like => "foo%"}});
$where = {
foo => 1234,
@@ -40,7 +42,7 @@
};
#3
-($sub_stmt, @sub_bind)
+($sub_stmt, @sub_bind)
= $sql->select("t1", "*", {c1 => 1, c2 => \"> t0.c0"});
$where = {
foo => 1234,
@@ -64,7 +66,7 @@
#5
-($sub_stmt, @sub_bind)
+($sub_stmt, @sub_bind)
= $sql->where({age => [{"<" => 10}, {">" => 20}]});
$sub_stmt =~ s/^ where //i; # don't want "WHERE" in the subclause
$where = {
@@ -96,7 +98,7 @@
for (@tests) {
my($stmt, @bind) = $sql->where($_->{where}, $_->{order});
- is_same_sql_bind($stmt, \@bind, $_->{stmt}, $_->{bind});
+ $sqlat->is_same_sql_bind($stmt, \@bind, $_->{stmt}, $_->{bind});
}
Modified: SQL-Abstract/1.x/branches/sqla-tree/t/08special_ops.t
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/t/08special_ops.t 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/t/08special_ops.t 2010-08-25 03:26:02 UTC (rev 9654)
@@ -4,14 +4,16 @@
use warnings;
use Test::More;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
+use SQL::Abstract::Test;
+my $sqlat = SQL::Abstract::Test->new;
+
use SQL::Abstract;
my $sqlmaker = SQL::Abstract->new(special_ops => [
# special op for MySql MATCH (field) AGAINST(word1, word2, ...)
- {regex => qr/^match$/i,
+ {regex => qr/^match$/i,
handler => sub {
my ($self, $field, $op, $arg) = @_;
$arg = [$arg] if not ref $arg;
@@ -26,7 +28,7 @@
},
# special op for Basis+ NATIVE
- {regex => qr/^native$/i,
+ {regex => qr/^native$/i,
handler => sub {
my ($self, $field, $op, $arg) = @_;
$arg =~ s/'/''/g;
@@ -39,7 +41,7 @@
my @tests = (
- #1
+ #1
{ where => {foo => {-match => 'foo'},
bar => {-match => [qw/foo bar/]}},
stmt => " WHERE ( MATCH (bar) AGAINST (?, ?) AND MATCH (foo) AGAINST (?) )",
@@ -60,7 +62,7 @@
for (@tests) {
my($stmt, @bind) = $sqlmaker->where($_->{where}, $_->{order});
- is_same_sql_bind($stmt, \@bind, $_->{stmt}, $_->{bind});
+ $sqlat->is_same_sql_bind($stmt, \@bind, $_->{stmt}, $_->{bind});
}
Modified: SQL-Abstract/1.x/branches/sqla-tree/t/10test.t
===================================================================
--- SQL-Abstract/1.x/branches/sqla-tree/t/10test.t 2010-08-24 04:24:16 UTC (rev 9653)
+++ SQL-Abstract/1.x/branches/sqla-tree/t/10test.t 2010-08-25 03:26:02 UTC (rev 9654)
@@ -23,7 +23,7 @@
my @sql_tests = (
- # WHERE condition - equal
+ # WHERE condition - equal
{
equal => 1,
statements => [
@@ -831,10 +831,10 @@
) +
3;
-use_ok('SQL::Abstract::Test', import => [qw(
- eq_sql_bind eq_sql eq_bind is_same_sql_bind
-)]);
+use_ok('SQL::Abstract::Test');
+my $sqlat = SQL::Abstract::Test->new;
+
for my $test (@sql_tests) {
my $statements = $test->{statements};
while (@$statements) {
@@ -844,7 +844,7 @@
no warnings qw/once/; # perl 5.10 is dumb
local $SQL::Abstract::Test::parenthesis_significant = $test->{parenthesis_significant}
if $test->{parenthesis_significant};
- my $equal = eq_sql($sql1, $sql2);
+ my $equal = $sqlat->eq_sql($sql1, $sql2);
TODO: {
local $TODO = $test->{todo} if $test->{todo};
@@ -858,8 +858,8 @@
if ($equal ^ $test->{equal}) {
diag("sql1: $sql1");
diag("sql2: $sql2");
- note('ast1: ' . Dumper SQL::Abstract::Test::parse ($sql1));
- note('ast2: ' . Dumper SQL::Abstract::Test::parse ($sql2));
+ note('ast1: ' . Dumper $sqlat->parse($sql1));
+ note('ast2: ' . Dumper $sqlat->parse($sql2));
}
}
}
@@ -871,7 +871,7 @@
while (@$bindvals) {
my $bind1 = shift @$bindvals;
foreach my $bind2 (@$bindvals) {
- my $equal = eq_bind($bind1, $bind2);
+ my $equal = $sqlat->eq_bind($bind1, $bind2);
if ($test->{equal}) {
ok($equal, "equal bind values considered equal");
} else {
@@ -886,7 +886,7 @@
}
}
-ok(eq_sql_bind(
+ok($sqlat->eq_sql_bind(
"SELECT * FROM foo WHERE id = ?", [42],
"SELECT * FROM foo WHERE (id = ?)", [42],
),
@@ -894,14 +894,14 @@
);
-ok(!eq_sql_bind(
+ok(!$sqlat->eq_sql_bind(
"SELECT * FROM foo WHERE id = ?", [42],
"SELECT * FROM foo WHERE (id = ?)", [0],
),
"eq_sql_bind considers equal SQL expressions and different bind values different"
);
-ok(!eq_sql_bind(
+ok(!$sqlat->eq_sql_bind(
"SELECT * FROM foo WHERE id = ?", [42],
"SELECT * FROM bar WHERE (id = ?)", [42],
),
More information about the Bast-commits
mailing list