Hello community, here is the log from the commit of package perl-SQL-Abstract for openSUSE:Factory checked in at 2013-07-30 14:04:22 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-SQL-Abstract (Old) and /work/SRC/openSUSE:Factory/.perl-SQL-Abstract.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-SQL-Abstract" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-SQL-Abstract/perl-SQL-Abstract.changes 2013-06-06 13:27:46.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.perl-SQL-Abstract.new/perl-SQL-Abstract.changes 2013-07-30 14:04:23.000000000 +0200 @@ -1,0 +2,9 @@ +Sat Jul 27 11:58:57 UTC 2013 - [email protected] + +- updated to 1.74 + - Fix insufficient parenthesis unroll during operator comparison + - 'ORDER BY foo' and 'ORDER BY foo ASC' are now considered equal + by default (with a switch to reenable old behavior when necessary) + - Change parser to not eagerly slurp RHS expressions it doesn't recognize + +------------------------------------------------------------------- Old: ---- SQL-Abstract-1.73.tar.gz New: ---- SQL-Abstract-1.74.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-SQL-Abstract.spec ++++++ --- /var/tmp/diff_new_pack.0HRWR5/_old 2013-07-30 14:04:24.000000000 +0200 +++ /var/tmp/diff_new_pack.0HRWR5/_new 2013-07-30 14:04:24.000000000 +0200 @@ -17,14 +17,14 @@ Name: perl-SQL-Abstract -Version: 1.73 +Version: 1.74 Release: 0 %define cpan_name SQL-Abstract Summary: Generate SQL from Perl data structures License: Artistic-1.0 or GPL-1.0+ Group: Development/Libraries/Perl Url: http://search.cpan.org/dist/SQL-Abstract/ -Source: http://www.cpan.org/authors/id/F/FR/FREW/%{cpan_name}-%{version}.tar.gz +Source: http://www.cpan.org/authors/id/R/RI/RIBASUSHI/%{cpan_name}-%{version}.tar.gz BuildArch: noarch BuildRoot: %{_tmppath}/%{name}-%{version}-build BuildRequires: perl @@ -32,6 +32,7 @@ BuildRequires: perl(Class::Accessor::Grouped) >= 0.10005 BuildRequires: perl(Getopt::Long::Descriptive) >= 0.091 BuildRequires: perl(Hash::Merge) >= 0.12 +BuildRequires: perl(Test::Deep) >= 0.101 BuildRequires: perl(Test::Exception) BuildRequires: perl(Test::More) >= 0.92 BuildRequires: perl(Test::Warn) ++++++ SQL-Abstract-1.73.tar.gz -> SQL-Abstract-1.74.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/Changes new/SQL-Abstract-1.74/Changes --- old/SQL-Abstract-1.73/Changes 2012-07-10 23:19:39.000000000 +0200 +++ new/SQL-Abstract-1.74/Changes 2013-06-05 15:25:39.000000000 +0200 @@ -1,5 +1,12 @@ Revision history for SQL::Abstract +revision 1.74 2013-06-04 +---------------------------- + - Fix insufficient parenthesis unroll during operator comparison + - 'ORDER BY foo' and 'ORDER BY foo ASC' are now considered equal + by default (with a switch to reenable old behavior when necessary) + - Change parser to not eagerly slurp RHS expressions it doesn't recognize + revision 1.73 2012-07-10 ---------------------------- - Fix parsing of ORDER BY foo + ? diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/MANIFEST new/SQL-Abstract-1.74/MANIFEST --- old/SQL-Abstract-1.73/MANIFEST 2012-07-10 23:22:19.000000000 +0200 +++ new/SQL-Abstract-1.74/MANIFEST 2013-06-05 15:25:54.000000000 +0200 @@ -42,7 +42,6 @@ t/20injection_guard.t t/21op_ident.t t/22op_value.t -t/23reassembly-bugs.t t/90pod.t t/91podcoverage.t t/dbic/bulk-insert.t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/META.yml new/SQL-Abstract-1.74/META.yml --- old/SQL-Abstract-1.73/META.yml 2012-07-10 23:22:17.000000000 +0200 +++ new/SQL-Abstract-1.74/META.yml 2013-06-05 15:25:52.000000000 +0200 @@ -5,13 +5,14 @@ build_requires: ExtUtils::MakeMaker: 6.59 Storable: 0 + Test::Deep: 0.101 Test::Exception: 0 Test::More: 0.92 Test::Warn: 0 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module -dynamic_config: 1 +dynamic_config: 0 generated_by: 'Module::Install version 1.06' license: perl meta-spec: @@ -36,4 +37,4 @@ bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Abstract license: http://dev.perl.org/licenses/ repository: git://git.shadowcat.co.uk/dbsrgits/SQL-Abstract.git -version: 1.73 +version: 1.74 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/Makefile.PL new/SQL-Abstract-1.74/Makefile.PL --- old/SQL-Abstract-1.73/Makefile.PL 2012-06-15 03:07:59.000000000 +0200 +++ new/SQL-Abstract-1.74/Makefile.PL 2013-06-05 15:25:39.000000000 +0200 @@ -13,6 +13,8 @@ all_from 'lib/SQL/Abstract.pm'; +dynamic_config 0; + requires 'List::Util' => 0; requires 'Scalar::Util' => 0; requires 'Class::Accessor::Grouped' => 0.10005; @@ -22,6 +24,7 @@ test_requires "Test::More" => 0.92; test_requires "Test::Exception" => 0; test_requires "Test::Warn" => 0; +test_requires "Test::Deep" => '0.101'; test_requires "Storable" => 0; # for cloning in tests no_index package => 'DBIx::Class::Storage::Debug::PrettyPrint'; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/lib/SQL/Abstract/Test.pm new/SQL-Abstract-1.74/lib/SQL/Abstract/Test.pm --- old/SQL-Abstract-1.73/lib/SQL/Abstract/Test.pm 2012-06-15 03:07:59.000000000 +0200 +++ new/SQL-Abstract-1.74/lib/SQL/Abstract/Test.pm 2013-06-05 15:25:39.000000000 +0200 @@ -5,6 +5,7 @@ use base qw/Test::Builder::Module Exporter/; use Data::Dumper; use Test::Builder; +use Test::Deep (); use SQL::Abstract::Tree; our @EXPORT_OK = qw/&is_same_sql_bind &is_same_sql &is_same_bind @@ -15,6 +16,8 @@ our $case_sensitive = 0; our $parenthesis_significant = 0; +our $order_by_asc_significant = 0; + our $sql_differ; # keeps track of differing portion between SQLs our $tb = __PACKAGE__->builder; @@ -102,14 +105,7 @@ } -sub eq_bind { - my ($bind_ref1, $bind_ref2) = @_; - - local $Data::Dumper::Useqq = 1; - local $Data::Dumper::Sortkeys = 1; - - return Dumper($bind_ref1) eq Dumper($bind_ref2); -} +sub eq_bind { goto &Test::Deep::eq_deeply }; sub eq_sql { my ($sql1, $sql2) = @_; @@ -179,6 +175,11 @@ $sqlat->_parenthesis_unroll($_) for $left, $right; } + # unroll ASC order by's + unless ($order_by_asc_significant) { + $sqlat->_strip_asc_from_order_by($_) for $left, $right; + } + if ( $left->[0] ne $right->[0] ) { $sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n", $sqlat->unparse($left), @@ -332,6 +333,11 @@ parenthesis. Useful while testing C<IN (( x ))> vs C<IN ( x )>. Defaults to false; +=head2 $order_by_asc_significant + +If true SQL comparison will consider C<ORDER BY foo ASC> and +C<ORDER BY foo> to be different. Default is false; + =head2 $sql_differ When L</eq_sql> returns false, the global variable diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/lib/SQL/Abstract/Tree.pm new/SQL-Abstract-1.74/lib/SQL/Abstract/Tree.pm --- old/SQL-Abstract-1.73/lib/SQL/Abstract/Tree.pm 2012-06-15 03:07:59.000000000 +0200 +++ new/SQL-Abstract-1.74/lib/SQL/Abstract/Tree.pm 2013-06-05 15:25:39.000000000 +0200 @@ -97,19 +97,19 @@ # * AS is not really an operator but is handled here as it's also LHS/RHS # this will be included in the $binary_op_re, the distinction is interesting during -# testing as one is tighter than the other, plus mathops have different look -# ahead/behind (e.g. "x"="y" ) -my @math_op_keywords = (qw/ - + < > != <> = <= >= /); -my $math_op_re = join ("\n\t|\n", map +# testing as one is tighter than the other, plus alphanum cmp ops have different +# look ahead/behind (e.g. "x"="y" ) +my @alphanum_cmp_op_keywords = (qw/< > != <> = <= >= /); +my $alphanum_cmp_op_re = join ("\n\t|\n", map { "(?: (?<= [\\w\\s] | $quote_right ) | \\A )" . quotemeta ($_) . "(?: (?= [\\w\\s] | $quote_left ) | \\z )" } - @math_op_keywords + @alphanum_cmp_op_keywords ); -$math_op_re = qr/$math_op_re/x; +$alphanum_cmp_op_re = qr/$alphanum_cmp_op_re/x; my $binary_op_re = '(?: NOT \s+)? (?:' . join ('|', qw/IN BETWEEN R?LIKE/) . ')'; $binary_op_re = join "\n\t|\n", "$op_look_behind (?i: $binary_op_re | AS ) $op_look_ahead", - $math_op_re, + $alphanum_cmp_op_re, $op_look_behind . 'IS (?:\s+ NOT)?' . "(?= \\s+ NULL \\b | $op_look_ahead )", ; $binary_op_re = qr/$binary_op_re/x; @@ -129,7 +129,7 @@ $unary_op_re, $asc_desc_re, $and_or_re, - "$op_look_behind \\* $op_look_ahead", + $op_look_behind . ' \* ' . $op_look_ahead, (map { quotemeta $_ } qw/, ( )/), $placeholder_re, ); @@ -149,8 +149,7 @@ my $expr_term_re = qr/$expr_start_re | \)/x; my $rhs_term_re = qr/ $expr_term_re | $binary_op_re | $unary_op_re | $asc_desc_re | $and_or_re | \, /x; -my $common_single_args_re = qr/ \* | $placeholder_re /x; -my $all_std_keywords_re = qr/ $rhs_term_re | \( | $common_single_args_re /x; +my $all_std_keywords_re = qr/ $rhs_term_re | \( | $placeholder_re /x; # anchor everything - even though keywords are separated by the tokenizer, leakage may occur for ( @@ -158,14 +157,13 @@ $quote_right, $placeholder_re, $expr_start_re, - $math_op_re, + $alphanum_cmp_op_re, $binary_op_re, $unary_op_re, $asc_desc_re, $and_or_re, $expr_term_re, $rhs_term_re, - $common_single_args_re, $all_std_keywords_re, ) { $_ = qr/ \A $_ \z /x; @@ -444,18 +442,28 @@ } # check if the current token is an unknown op-start - elsif (@$tokens and ($tokens->[0] eq '(' or $tokens->[0] =~ $common_single_args_re ) ) { + elsif (@$tokens and ($tokens->[0] eq '(' or $tokens->[0] =~ $placeholder_re ) ) { push @left, [ $token => [ $self->_recurse_parse($tokens, PARSE_RHS) ] ]; } # we're now in "unknown token" land - start eating tokens until - # we see something familiar + # we see something familiar, OR in the case of RHS (binop) stop + # after the first token + # Also stop processing when we could end up with an unknown func else { my @lits = [ -LITERAL => [$token] ]; - while (@$tokens and $tokens->[0] !~ $all_std_keywords_re) { - push @lits, [ -LITERAL => [ shift @$tokens ] ]; - } + unless ( $state == PARSE_RHS ) { + while ( + @$tokens + and + $tokens->[0] !~ $all_std_keywords_re + and + ! ( @$tokens > 1 and $tokens->[1] eq '(' ) + ) { + push @lits, [ -LITERAL => [ shift @$tokens ] ]; + } + } if (@left == 1) { unshift @lits, pop @left; @@ -466,21 +474,14 @@ push @left, @lits; } - # deal with post-fix operators (only when sql is sane - i.e. we have one element to apply to) - if (@left == 1 and @$tokens) { + if (@$tokens) { - # asc/desc + # deal with post-fix operators (asc/desc) if ($tokens->[0] =~ $asc_desc_re) { - my $op = shift @$tokens; - - # if -MISC - this is a literal collection, do not promote asc/desc to an op - if ($left[0][0] eq '-MISC') { - push @{$left[0][1]}, [ -LITERAL => [ $op ] ]; - } - else { - @left = [ ('-' . uc ($op)) => [ @left ] ]; - } + @left = [ ('-' . uc (shift @$tokens)) => [ @left ] ]; } + + return @left if $state == PARSE_RHS and $left[-1][0] eq '-LITERAL'; } } } @@ -596,14 +597,17 @@ } else { my ($l, $r) = @{$self->pad_keyword($op, $depth)}; - return sprintf "$l%s%s%s$r", - $self->format_keyword($op), + + my $rhs = $self->_unparse($args, $bindargs, $depth); + + return sprintf "$l%s$r", join( ( ref $args eq 'ARRAY' and @{$args} == 1 and $args->[0][0] eq '-PAREN' ) ? '' # mysql-- : ' ' , - $self->_unparse($args, $bindargs, $depth), - ; + $self->format_keyword($op), + (length $rhs ? $rhs : () ), + ); } } @@ -695,9 +699,9 @@ @{$child->[1][0][1]} == 2 and ! ( - $child->[1][0][0] =~ $math_op_re + $child->[1][0][0] =~ $alphanum_cmp_op_re and - $ast->[0] =~ $math_op_re + $ast->[0] =~ $alphanum_cmp_op_re ) ) { push @children, @{$child->[1]}; @@ -715,9 +719,9 @@ and @{$child->[1][0][1]} == 1 and - $ast->[0] =~ $math_op_re + $ast->[0] =~ $alphanum_cmp_op_re and - $child->[1][0][0] !~ $math_op_re + $child->[1][0][0] !~ $alphanum_cmp_op_re and ( $child->[1][0][1][0][0] eq '-PAREN' @@ -731,6 +735,23 @@ $changes++; } + # a construct of ... ( somefunc ( ... ) ) ... can safely lose the outer parens + # except for the case of ( NOT ( ... ) ) which has already been handled earlier + elsif ( + @{$child->[1]} == 1 + and + @{$child->[1][0][1]} == 1 + and + $child->[1][0][0] ne 'NOT' + and + ref $child->[1][0][1][0] eq 'ARRAY' + and + $child->[1][0][1][0][0] eq '-PAREN' + ) { + push @children, @{$child->[1]}; + $changes++; + } + # otherwise no more mucking for this pass else { @@ -743,6 +764,30 @@ } while ($changes); } +sub _strip_asc_from_order_by { + my ($self, $ast) = @_; + + return $ast if ( + ref $ast ne 'ARRAY' + or + $ast->[0] ne 'ORDER BY' + ); + + + my $to_replace; + + if (@{$ast->[1]} == 1 and $ast->[1][0][0] eq '-ASC') { + $to_replace = [ $ast->[1][0] ]; + } + elsif (@{$ast->[1]} == 1 and $ast->[1][0][0] eq '-LIST') { + $to_replace = [ grep { $_->[0] eq '-ASC' } @{$ast->[1][0][1]} ]; + } + + @$_ = @{$_->[1][0]} for @$to_replace; + + $ast; +} + sub format { my $self = shift; $self->unparse($self->parse($_[0]), $_[1]) } 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/lib/SQL/Abstract.pm new/SQL-Abstract-1.74/lib/SQL/Abstract.pm --- old/SQL-Abstract-1.73/lib/SQL/Abstract.pm 2012-07-10 23:19:51.000000000 +0200 +++ new/SQL-Abstract-1.74/lib/SQL/Abstract.pm 2013-06-05 15:25:39.000000000 +0200 @@ -15,7 +15,7 @@ # GLOBALS #====================================================================== -our $VERSION = '1.73'; +our $VERSION = '1.74'; # This would confuse some packagers $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases @@ -1510,7 +1510,7 @@ my $sql = SQL::Abstract->new; - my($stmt, @bind) = $sql->select($table, \@fields, \%where, \@order); + my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order); my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values); @@ -1938,8 +1938,8 @@ The argument can be either an arrayref (interpreted as a list of field names, will be joined by commas and quoted), or a plain scalar (literal SQL, not quoted). -Please observe that this API is not as flexible as for -the first argument C<$table>, for backwards compatibility reasons. +Please observe that this API is not as flexible as that of +the first argument C<$source>, for backwards compatibility reasons. =item $where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/t/04modifiers.t new/SQL-Abstract-1.74/t/04modifiers.t --- old/SQL-Abstract-1.73/t/04modifiers.t 2012-06-15 03:07:59.000000000 +0200 +++ new/SQL-Abstract-1.74/t/04modifiers.t 2013-06-05 15:25:39.000000000 +0200 @@ -7,9 +7,10 @@ use SQL::Abstract::Test import => ['is_same_sql_bind']; use Data::Dumper; -use Storable qw/dclone/; use SQL::Abstract; +my $dclone = eval { require Storable; \&Storable::dclone }; + #### WARNING #### # # -nest has been undocumented on purpose, but is still supported for the @@ -380,8 +381,6 @@ }, ); -plan tests => @and_or_tests*4 + @numbered_mods*4 + @nest_tests*2; - for my $case (@and_or_tests) { TODO: { local $TODO = $case->{todo} if $case->{todo}; @@ -392,7 +391,9 @@ local $SIG{__WARN__} = sub { push @w, @_ }; my $sql = SQL::Abstract->new ($case->{args} || {}); - my $where_copy = dclone($case->{where}); + + my $where_copy = $dclone->($case->{where}) + if $dclone;; lives_ok (sub { my ($stmt, @bind) = $sql->where($case->{where}); @@ -407,7 +408,8 @@ is (@w, 0, 'No warnings within and-or tests') || diag join "\n", 'Emitted warnings:', @w; - is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged'); + is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged') + if $dclone; } } @@ -469,3 +471,4 @@ } } +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/t/10test.t new/SQL-Abstract-1.74/t/10test.t --- old/SQL-Abstract-1.73/t/10test.t 2012-06-15 03:07:59.000000000 +0200 +++ new/SQL-Abstract-1.74/t/10test.t 2013-06-05 15:25:39.000000000 +0200 @@ -153,7 +153,7 @@ }, { equal => 0, - parenthesis_significant => 1, + opts => { parenthesis_significant => 1 }, statements => [ q/SELECT foo FROM bar WHERE a = 1 AND b = 1 AND c = 1/, q/SELECT foo FROM bar WHERE (a = 1 AND b = 1 AND c = 1)/, @@ -164,7 +164,7 @@ }, { equal => 0, - parenthesis_significant => 1, + opts => { parenthesis_significant => 1 }, statements => [ q/SELECT foo FROM bar WHERE a = 1 OR b = 1 OR c = 1/, q/SELECT foo FROM bar WHERE (a = 1 OR b = 1) OR c = 1/, @@ -174,7 +174,7 @@ }, { equal => 0, - parenthesis_significant => 1, + opts => { parenthesis_significant => 1 }, statements => [ q/SELECT foo FROM bar WHERE (a = 1) AND (b = 1 OR c = 1 OR d = 1) AND (e = 1 AND f = 1)/, q/SELECT foo FROM bar WHERE a = 1 AND (b = 1 OR c = 1 OR d = 1) AND e = 1 AND (f = 1)/, @@ -260,7 +260,7 @@ }, { equal => 0, - parenthesis_significant => 1, + opts => { parenthesis_significant => 1 }, statements => [ q/SELECT foo FROM bar WHERE a IN (1,2,3)/, q/SELECT foo FROM bar WHERE a IN (1,3,2)/, @@ -592,6 +592,34 @@ ] }, + # order by + { + equal => 1, + statements => [ + q/SELECT * FROM foo ORDER BY bar/, + q/SELECT * FROM foo ORDER BY bar ASC/, + q/SELECT * FROM foo ORDER BY bar asc/, + ], + }, + { + equal => 1, + statements => [ + q/SELECT * FROM foo ORDER BY bar, baz ASC/, + q/SELECT * FROM foo ORDER BY bar ASC, baz/, + q/SELECT * FROM foo ORDER BY bar asc, baz ASC/, + q/SELECT * FROM foo ORDER BY bar, baz/, + ], + }, + { + equal => 0, + opts => { order_by_asc_significant => 1 }, + statements => [ + q/SELECT * FROM foo ORDER BY bar/, + q/SELECT * FROM foo ORDER BY bar ASC/, + q/SELECT * FROM foo ORDER BY bar desc/, + ], + }, + # list permutations { equal => 0, @@ -711,7 +739,26 @@ 'WHERE ( foo GLOB ? )', 'WHERE foo GLOB ?', ], - } + }, + { + equal => 1, + statements => [ + 'SELECT FIRST ? SKIP ? [me].[id], [me].[owner] + FROM [books] [me] + WHERE ( ( (EXISTS ( + SELECT FIRST ? SKIP ? [owner].[id] + FROM [owners] [owner] + WHERE ( [books].[owner] = [owner].[id] ) + )) AND [source] = ? ) )', + 'SELECT FIRST ? SKIP ? [me].[id], [me].[owner] + FROM [books] [me] + WHERE ( ( EXISTS ( + SELECT FIRST ? SKIP ? [owner].[id] + FROM [owners] [owner] + WHERE ( [books].[owner] = [owner].[id] ) + ) AND [source] = ? ) )', + ], + }, ); my @bind_tests = ( @@ -924,14 +971,23 @@ )]); for my $test (@sql_tests) { + + # this does not work on 5.8.8 and earlier :( + #local @{*SQL::Abstract::Test::}{keys %{$test->{opts}}} = map { \$_ } values %{$test->{opts}} + # if $test->{opts}; + + my %restore_globals; + + for (keys %{$test->{opts} || {} }) { + $restore_globals{$_} = ${${*SQL::Abstract::Test::}{$_}}; + ${*SQL::Abstract::Test::}{$_} = \ do { my $cp = $test->{opts}{$_} }; + } + my $statements = $test->{statements}; while (@$statements) { my $sql1 = shift @$statements; foreach my $sql2 (@$statements) { - 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); TODO: { @@ -956,6 +1012,9 @@ } } } + + ${*SQL::Abstract::Test::}{$_} = \$restore_globals{$_} + for keys %restore_globals; } for my $test (@bind_tests) { diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/t/11parser.t new/SQL-Abstract-1.74/t/11parser.t --- old/SQL-Abstract-1.73/t/11parser.t 2012-06-15 03:07:59.000000000 +0200 +++ new/SQL-Abstract-1.74/t/11parser.t 2013-06-05 15:25:39.000000000 +0200 @@ -619,18 +619,211 @@ ] ], 'Lists parsed correctly'); -is_deeply($sqlat->parse("SELECT * * FROM (SELECT *, FROM foobar baz buzz) foo bar WHERE NOT NOT NOT EXISTS (SELECT 'cr,ap') AND foo.a = ? and not (foo.b LIKE 'station') and x = y and a = b and GROUP BY , ORDER BY x x1 x2 y asc, max(y) desc x z desc"), [ +is_deeply($sqlat->parse('SELECT foo FROM bar ORDER BY x + ? DESC, oomph, y - ? DESC, unf, baz.g / ? ASC, buzz * 0 DESC, foo DESC, ickk ASC'), [ [ "SELECT", [ [ - "*", + "-LITERAL", + [ + "foo" + ] + ] + ] + ], + [ + "FROM", + [ + [ + "-LITERAL", + [ + "bar" + ] + ] + ] + ], + [ + "ORDER BY", + [ + [ + "-LIST", + [ + [ + "-DESC", + [ + [ + "-MISC", + [ + [ + "-LITERAL", + [ + "x" + ] + ], + [ + "-LITERAL", + [ + "+" + ] + ] + ] + ], + [ + "-PLACEHOLDER", + [ + "?" + ] + ] + ] + ], + [ + "-LITERAL", + [ + "oomph" + ] + ], + [ + "-DESC", + [ + [ + "-MISC", + [ + [ + "-LITERAL", + [ + "y" + ] + ], + [ + "-LITERAL", + [ + "-" + ] + ] + ] + ], + [ + "-PLACEHOLDER", + [ + "?" + ] + ] + ] + ], + [ + "-LITERAL", + [ + "unf" + ] + ], + [ + "-ASC", + [ + [ + "-MISC", + [ + [ + "-LITERAL", + [ + "baz.g" + ] + ], + [ + "-LITERAL", + [ + "/" + ] + ] + ] + ], + [ + "-PLACEHOLDER", + [ + "?" + ] + ] + ] + ], + [ + "-DESC", + [ + [ + "-MISC", + [ + [ + "-LITERAL", + [ + "buzz" + ] + ], + [ + "-LITERAL", + [ + "*" + ] + ], + [ + "-LITERAL", + [ + 0 + ] + ] + ] + ] + ] + ], + [ + "-DESC", + [ + [ + "-LITERAL", + [ + "foo" + ] + ] + ] + ], + [ + "-ASC", + [ + [ + "-LITERAL", + [ + "ickk" + ] + ] + ] + ] + ] + ] + ] + ] +], 'Crazy ORDER BY parsed correctly'); + +is_deeply( $sqlat->parse("META SELECT * * FROM (SELECT *, FROM foobar baz buzz) foo bar WHERE NOT NOT NOT EXISTS (SELECT 'cr,ap') AND foo.a = ? STUFF moar(stuff) and not (foo.b LIKE 'station') and x = y and a = b and GROUP BY , ORDER BY x x1 x2 y asc, max(y) desc x z desc"), [ + [ + "-LITERAL", + [ + "META" + ] + ], + [ + "SELECT", + [ + [ + "-MISC", [ [ "-LITERAL", [ "*" ] + ], + [ + "-LITERAL", + [ + "*" + ] ] ] ] @@ -764,9 +957,36 @@ ] ], [ - "-PLACEHOLDER", + "-MISC", [ - "?" + [ + "-PLACEHOLDER", + [ + "?" + ] + ], + [ + "-LITERAL", + [ + "STUFF" + ] + ] + ], + ], + [ + 'moar', + [ + [ + '-PAREN', + [ + [ + '-LITERAL', + [ + 'stuff' + ] + ] + ] + ] ] ] ] @@ -855,78 +1075,81 @@ "-LIST", [ [ - "-MISC", - [ - [ - "-LITERAL", - [ - "x" - ] - ], - [ - "-LITERAL", - [ - "x1" - ] - ], - [ - "-LITERAL", - [ - "x2" - ] - ], - [ - "-LITERAL", - [ - "y" - ] - ], - [ - "-LITERAL", - [ - "asc" - ] - ] - ] - ], - [ - "max", + "-ASC", [ [ "-MISC", [ [ - "-DESC", + "-LITERAL", [ - [ - "-PAREN", - [ - [ - "-LITERAL", - [ - "y" - ] - ] - ] - ] + "x" ] ], [ "-LITERAL", [ - "x" + "x1" ] ], [ "-LITERAL", [ - "z" + "x2" ] ], [ "-LITERAL", [ - "desc" + "y" + ] + ] + ] + ], + ], + ], + [ + "max", + [ + [ + "-DESC", + [ + [ + "-MISC", + [ + [ + "-MISC", + [ + [ + "-DESC", + [ + [ + "-PAREN", + [ + [ + "-LITERAL", + [ + "y" + ] + ] + ] + ] + ] + ], + [ + "-LITERAL", + [ + "x" + ] + ], + ] + ], + [ + "-LITERAL", + [ + "z" + ] + ] ] ] ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/t/14roundtrippin.t new/SQL-Abstract-1.74/t/14roundtrippin.t --- old/SQL-Abstract-1.73/t/14roundtrippin.t 2012-06-15 03:07:59.000000000 +0200 +++ new/SQL-Abstract-1.74/t/14roundtrippin.t 2013-06-05 15:25:39.000000000 +0200 @@ -1,4 +1,5 @@ -#!/usr/bin/env perl +use warnings; +use strict; use Test::More; use Test::Exception; @@ -11,25 +12,51 @@ my @sql = ( "INSERT INTO artist DEFAULT VALUES", "INSERT INTO artist VALUES ()", - "SELECT a, b, c FROM foo WHERE foo.a =1 and foo.b LIKE 'station'", + "SELECT a, b, c FROM foo WHERE foo.a = 1 and foo.b LIKE 'station'", "SELECT COUNT( * ) FROM foo", + "SELECT COUNT( * ), SUM( blah ) FROM foo", "SELECT * FROM (SELECT * FROM foobar) WHERE foo.a = 1 and foo.b LIKE 'station'", - "SELECT * FROM lolz WHERE ( foo.a =1 ) and foo.b LIKE 'station'", + "SELECT * FROM lolz WHERE ( foo.a = 1 ) and foo.b LIKE 'station'", "SELECT [screen].[id], [screen].[name], [screen].[section_id], [screen].[xtype] FROM [users_roles] [me] JOIN [roles] [role] ON [role].[id] = [me].[role_id] JOIN [roles_permissions] [role_permissions] ON [role_permissions].[role_id] = [role].[id] JOIN [permissions] [permission] ON [permission].[id] = [role_permissions].[permission_id] JOIN [permissionscreens] [permission_screens] ON [permission_screens].[permission_id] = [permission].[id] JOIN [screens] [screen] ON [screen].[id] = [permission_screens].[screen_id] WHERE ( [me].[user_id] = ? ) GROUP BY [screen].[id], [screen].[name], [screen].[section_id], [screen].[xtype]", "SELECT * FROM foo WHERE NOT EXISTS (SELECT bar FROM baz)", "SELECT * FROM (SELECT SUM (CASE WHEN me.artist = 'foo' THEN 1 ELSE 0 END AS artist_sum) FROM foobar) WHERE foo.a = 1 and foo.b LIKE 'station'", "SELECT COUNT( * ) FROM foo me JOIN bar rel_bar ON rel_bar.id_bar = me.fk_bar WHERE NOT EXISTS (SELECT inner_baz.id_baz FROM baz inner_baz WHERE ( ( inner_baz.fk_a != ? AND ( fk_bar = me.fk_bar AND name = me.name ) ) ) )", + "SELECT foo AS bar FROM baz ORDER BY x + ? DESC, oomph, y - ? DESC, unf, baz.g / ? ASC, buzz * 0 DESC, foo DESC, ickk ASC", + "SELECT inner_forum_roles.forum_id FROM forum_roles AS inner_forum_roles LEFT JOIN user_roles AS inner_user_roles USING(user_role_type_id) WHERE inner_user_roles.user_id = users__row.user_id", + "SELECT * FROM foo WHERE foo.a @@ to_tsquery('word')", ); -for (@sql) { - # Needs whitespace preservation in the AST to work, pending - #local $SQL::Abstract::Test::mysql_functions = 1; - is_same_sql ($sqlat->format($_), $_, sprintf 'roundtrip works (%s...)', substr $_, 0, 20); -} +# FIXME FIXME FIXME +# The formatter/unparser accumulated a ton of technical debt, +# and I don't have time to fix it all :( Some of the problems: +# - format() does an implicit parenthesis unroll for prettyness +# which makes it hard to do exact comparisons +# - there is no space preservation framework (also makes comparisons +# problematic) +# - there is no operator case preservation framework either +# +# So what we do instead is resort to some monkey patching and +# lowercasing and stuff to get something we can compare to the +# original SQL string +# Ugly but somewhat effective + +for my $orig (@sql) { + my $plain_formatted = $sqlat->format($orig); + is_same_sql( $plain_formatted, $orig, 'Formatted string is_same_sql()-matched' ); + + my $ast = $sqlat->parse($orig); + my $reassembled = do { + no warnings 'redefine'; + local *SQL::Abstract::Tree::_parenthesis_unroll = sub {}; + $sqlat->unparse($ast); + }; + + # deal with parenthesis readjustment + $_ =~ s/\s*([\(\)])\s*/$1 /g + for ($orig, $reassembled); -# delete this test when mysql_functions gets implemented -my $sql = 'SELECT COUNT( * ), SUM( blah ) FROM foo'; -is($sqlat->format($sql), $sql, 'Roundtripping to mysql-compatible paren. syntax'); + is (lc($reassembled), lc($orig), sprintf 'roundtrip works (%s...)', substr $orig, 0, 20); +} lives_ok { $sqlat->unparse( $sqlat->parse( <<'EOS' ) ) } 'Able to parse/unparse grossly malformed sql'; SELECT diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.73/t/23reassembly-bugs.t new/SQL-Abstract-1.74/t/23reassembly-bugs.t --- old/SQL-Abstract-1.73/t/23reassembly-bugs.t 2012-06-15 03:07:59.000000000 +0200 +++ new/SQL-Abstract-1.74/t/23reassembly-bugs.t 1970-01-01 01:00:00.000000000 +0100 @@ -1,15 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use SQL::Abstract::Tree; - -my $sqlat = SQL::Abstract::Tree->new({}); - -is( - $sqlat->format('SELECT foo AS bar FROM baz ORDER BY x + ? DESC, baz.g'), - 'SELECT foo AS bar FROM baz ORDER BY x + ? DESC, baz.g', - 'complex order by correctly reassembled' -); - -done_testing; -- To unsubscribe, e-mail: [email protected] For additional commands, e-mail: [email protected]
