Hello community,
here is the log from the commit of package perl-SQL-Abstract for
openSUSE:Factory checked in at 2014-09-17 17:26:01
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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
2014-02-28 19:16:02.000000000 +0100
+++ /work/SRC/openSUSE:Factory/.perl-SQL-Abstract.new/perl-SQL-Abstract.changes
2014-09-17 17:26:23.000000000 +0200
@@ -1,0 +2,11 @@
+Mon Sep 15 15:44:40 UTC 2014 - co...@suse.com
+
+- updated to 1.78
+ - Fix parsing of binary ops to correctly take up only a single LHS
+ element, instead of gobbling up the entire parse-to-date
+ - Explicitly handle ROW_NUMBER() OVER as the snowflake-operator it is
+ - Improve signatures/documentation of is_same_sql_bind / eq_sql_bind
+ - Retire script/format-sql - the utility needs more work to be truly
+ end-user convenient
+
+-------------------------------------------------------------------
Old:
----
SQL-Abstract-1.77.tar.gz
New:
----
SQL-Abstract-1.78.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-SQL-Abstract.spec ++++++
--- /var/tmp/diff_new_pack.Mb4uvV/_old 2014-09-17 17:26:24.000000000 +0200
+++ /var/tmp/diff_new_pack.Mb4uvV/_new 2014-09-17 17:26:24.000000000 +0200
@@ -17,7 +17,7 @@
Name: perl-SQL-Abstract
-Version: 1.77
+Version: 1.78
Release: 0
%define cpan_name SQL-Abstract
Summary: Generate SQL from Perl data structures
@@ -29,16 +29,14 @@
BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: perl
BuildRequires: perl-macros
-BuildRequires: perl(Class::Accessor::Grouped) >= 0.10005
-BuildRequires: perl(Getopt::Long::Descriptive) >= 0.091
BuildRequires: perl(Hash::Merge) >= 0.12
+BuildRequires: perl(Moo) >= 1.004002
BuildRequires: perl(Test::Deep) >= 0.101
-BuildRequires: perl(Test::Exception)
-BuildRequires: perl(Test::More) >= 0.92
+BuildRequires: perl(Test::Exception) >= 0.31
+BuildRequires: perl(Test::More) >= 0.88
BuildRequires: perl(Test::Warn)
-Requires: perl(Class::Accessor::Grouped) >= 0.10005
-Requires: perl(Getopt::Long::Descriptive) >= 0.091
Requires: perl(Hash::Merge) >= 0.12
+Requires: perl(Moo) >= 1.004002
%{perl_requires}
%description
++++++ SQL-Abstract-1.77.tar.gz -> SQL-Abstract-1.78.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/Changes
new/SQL-Abstract-1.78/Changes
--- old/SQL-Abstract-1.77/Changes 2014-01-17 02:04:54.000000000 +0100
+++ new/SQL-Abstract-1.78/Changes 2014-05-28 12:11:40.000000000 +0200
@@ -1,5 +1,14 @@
Revision history for SQL::Abstract
+revision 1.78 2014-05-28
+----------------------------
+ - Fix parsing of binary ops to correctly take up only a single LHS
+ element, instead of gobbling up the entire parse-to-date
+ - Explicitly handle ROW_NUMBER() OVER as the snowflake-operator it is
+ - Improve signatures/documentation of is_same_sql_bind / eq_sql_bind
+ - Retire script/format-sql - the utility needs more work to be truly
+ end-user convenient
+
revision 1.77 2014-01-17
----------------------------
- Reintroduce { -not => undef } column operator (regression from 1.75)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/MANIFEST
new/SQL-Abstract-1.78/MANIFEST
--- old/SQL-Abstract-1.77/MANIFEST 2014-01-17 02:06:19.000000000 +0100
+++ new/SQL-Abstract-1.78/MANIFEST 2014-05-28 12:14:07.000000000 +0200
@@ -1,6 +1,7 @@
Changes
examples/console.pl
examples/dbic-console.pl
+examples/sqla-format
inc/Module/AutoInstall.pm
inc/Module/Install.pm
inc/Module/Install/AutoInstall.pm
@@ -10,7 +11,6 @@
inc/Module/Install/Include.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
-inc/Module/Install/Scripts.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/DBIx/Class/Storage/Debug/PrettyPrint.pm
@@ -20,7 +20,6 @@
Makefile.PL
MANIFEST This list of files
META.yml
-script/format-sql
t/00new.t
t/01generate.t
t/02where.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/META.yml
new/SQL-Abstract-1.78/META.yml
--- old/SQL-Abstract-1.77/META.yml 2014-01-17 02:06:14.000000000 +0100
+++ new/SQL-Abstract-1.78/META.yml 2014-05-28 12:13:59.000000000 +0200
@@ -6,8 +6,8 @@
ExtUtils::MakeMaker: 6.59
Storable: 0
Test::Deep: 0.101
- Test::Exception: 0
- Test::More: 0.92
+ Test::Exception: 0.31
+ Test::More: 0.88
Test::Warn: 0
configure_requires:
ExtUtils::MakeMaker: 6.59
@@ -28,14 +28,13 @@
package:
- DBIx::Class::Storage::Debug::PrettyPrint
requires:
- Class::Accessor::Grouped: 0.10005
- Getopt::Long::Descriptive: 0.091
Hash::Merge: 0.12
List::Util: 0
+ Moo: 1.004002
Scalar::Util: 0
- perl: 5.6.2
+ perl: 5.6.0
resources:
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.77
+version: 1.78
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/Makefile.PL
new/SQL-Abstract-1.78/Makefile.PL
--- old/SQL-Abstract-1.77/Makefile.PL 2014-01-17 02:01:03.000000000 +0100
+++ new/SQL-Abstract-1.78/Makefile.PL 2014-05-28 12:10:34.000000000 +0200
@@ -2,9 +2,9 @@
use strict;
use warnings;
-use 5.006002;
+use 5.006;
-perl_version '5.006002';
+perl_version '5.006';
name 'SQL-Abstract';
author 'Nathan Wiger <n...@wiger.org>';
resources 'license' => 'http://dev.perl.org/licenses/';
@@ -17,21 +17,18 @@
requires 'List::Util' => 0;
requires 'Scalar::Util' => 0;
-requires 'Class::Accessor::Grouped' => 0.10005;
-requires 'Getopt::Long::Descriptive' => 0.091;
-requires 'Hash::Merge' => 0.12;
+requires 'Moo' => 1.004002;
+requires 'Hash::Merge' => 0.12;
-test_requires "Test::More" => 0.92;
-test_requires "Test::Exception" => 0;
+test_requires "Test::More" => 0.88;
+test_requires "Test::Exception" => 0.31;
test_requires "Test::Warn" => 0;
-test_requires "Test::Deep" => '0.101';
+test_requires "Test::Deep" => 0.101;
test_requires "Storable" => 0; # for cloning in tests
no_index package => 'DBIx::Class::Storage::Debug::PrettyPrint';
no_index directory => 'examples';
-install_script 'format-sql';
-
tests_recursive 't';
auto_install();
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/examples/console.pl
new/SQL-Abstract-1.78/examples/console.pl
--- old/SQL-Abstract-1.77/examples/console.pl 2012-03-09 02:04:01.000000000
+0100
+++ new/SQL-Abstract-1.78/examples/console.pl 2014-05-28 12:09:43.000000000
+0200
@@ -1,5 +1,8 @@
#!/sur/bin/env perl
+use warnings;
+use strict;
+
use SQL::Abstract::Tree;
my $sqlat = SQL::Abstract::Tree->new({ profile => 'console' });
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/examples/dbic-console.pl
new/SQL-Abstract-1.78/examples/dbic-console.pl
--- old/SQL-Abstract-1.77/examples/dbic-console.pl 2012-03-09
02:04:01.000000000 +0100
+++ new/SQL-Abstract-1.78/examples/dbic-console.pl 2014-05-28
12:09:43.000000000 +0200
@@ -1,5 +1,8 @@
#!/sur/bin/env perl
+use warnings;
+use strict;
+
use DBIx::Class::Storage::Debug::PrettyPrint;
my $pp = DBIx::Class::Storage::Debug::PrettyPrint->new({
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/examples/sqla-format
new/SQL-Abstract-1.78/examples/sqla-format
--- old/SQL-Abstract-1.77/examples/sqla-format 1970-01-01 01:00:00.000000000
+0100
+++ new/SQL-Abstract-1.78/examples/sqla-format 2014-05-28 12:09:43.000000000
+0200
@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+use Getopt::Long;
+my $p = Getopt::Long::Parser->new(config => [qw( gnu_getopt no_ignore_case )]);
+my $opts = { profile => 'console', help => \&showhelp };
+$p->getoptions( $opts, qw(
+ profile|p=s
+ help|h
+)) or showhelp();
+
+sub showhelp {
+ require Pod::Usage;
+ Pod::Usage::pod2usage( -verbose => 0, -exitval => 2 );
+}
+
+require SQL::Abstract::Tree;
+my $sqlat = SQL::Abstract::Tree->new({ profile => $opts->{profile},
fill_in_placeholders => 0 });
+
+my $chunk = '';
+my $leftover = '';
+do {
+ $chunk = $leftover . $chunk if length $leftover;
+
+ if ($chunk =~ / \A (.+?) (?:
+ (?<=\S)\:\s+\'[^\n]+ # pasting DBIC_TRACE output directly
+ |
+ \;(?: \s | \z)
+ |
+ \z
+ |
+ ^ \s* (?=SELECT|INSERT|UPDATE|DELETE)
+ ) (.*) /smix) {
+
+ $leftover = $2;
+ print $sqlat->format($1);
+ print "\n";
+ }
+ else {
+ $leftover = $chunk;
+ }
+} while ( (read *STDIN, $chunk, 4096) or length $leftover );
+
+=head1 NAME
+
+sqla-format - An intelligent SQL formatter
+
+=head1 SYNOPSIS
+
+ ~$ sqla-format << log.sql
+
+ ~$ myprogram -v | sqla-format -p html > sqltrace.html
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/inc/Module/Install/Scripts.pm
new/SQL-Abstract-1.78/inc/Module/Install/Scripts.pm
--- old/SQL-Abstract-1.77/inc/Module/Install/Scripts.pm 2014-01-17
02:06:13.000000000 +0100
+++ new/SQL-Abstract-1.78/inc/Module/Install/Scripts.pm 1970-01-01
01:00:00.000000000 +0100
@@ -1,29 +0,0 @@
-#line 1
-package Module::Install::Scripts;
-
-use strict 'vars';
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.06';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub install_script {
- my $self = shift;
- my $args = $self->makemaker_args;
- my $exe = $args->{EXE_FILES} ||= [];
- foreach ( @_ ) {
- if ( -f $_ ) {
- push @$exe, $_;
- } elsif ( -d 'script' and -f "script/$_" ) {
- push @$exe, "script/$_";
- } else {
- die("Cannot find script '$_'");
- }
- }
-}
-
-1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/lib/SQL/Abstract/Test.pm
new/SQL-Abstract-1.78/lib/SQL/Abstract/Test.pm
--- old/SQL-Abstract-1.77/lib/SQL/Abstract/Test.pm 2014-01-17
01:42:27.000000000 +0100
+++ new/SQL-Abstract-1.78/lib/SQL/Abstract/Test.pm 2014-05-28
05:48:06.000000000 +0200
@@ -3,7 +3,6 @@
use strict;
use warnings;
use base qw(Test::Builder::Module Exporter);
-use Data::Dumper;
use Test::Builder;
use Test::Deep ();
use SQL::Abstract::Tree;
@@ -23,8 +22,30 @@
our $sql_differ; # keeps track of differing portion between SQLs
our $tb = __PACKAGE__->builder;
+sub _unpack_arrayrefref {
+
+ my @args;
+ for (1,2) {
+ my $chunk = shift @_;
+
+ if ( ref $chunk eq 'REF' and ref $$chunk eq 'ARRAY' ) {
+ my ($sql, @bind) = @$$chunk;
+ push @args, ($sql, \@bind);
+ }
+ else {
+ push @args, $chunk, shift @_;
+ }
+
+ }
+
+ # maybe $msg and ... stuff
+ push @args, @_;
+
+ @args;
+}
+
sub is_same_sql_bind {
- my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = @_;
+ my ($sql1, $bind_ref1, $sql2, $bind_ref2, $msg) = &_unpack_arrayrefref;
# compare
my $same_sql = eq_sql($sql1, $sql2);
@@ -49,7 +70,7 @@
my ($sql1, $sql2, $msg) = @_;
# compare
- my $same_sql = eq_sql($sql1, $sql2);
+ my $same_sql = eq_sql($sql1, $sql2);
# call Test::Builder::ok
my $ret = $tb->ok($same_sql, $msg);
@@ -82,7 +103,12 @@
}
sub dumper {
-
Data::Dumper->new([])->Terse(1)->Indent(1)->Useqq(1)->Deparse(1)->Quotekeys(0)->Sortkeys(1)->Maxdepth(0)->Values([@_])->Dump;
+ # FIXME
+ # if we save the instance, we will end up with $VARx references
+ # no time to figure out how to avoid this (Deepcopy is *not* an option)
+ require Data::Dumper;
+
Data::Dumper->new([])->Terse(1)->Indent(1)->Useqq(1)->Deparse(1)->Quotekeys(0)->Sortkeys(1)->Maxdepth(0)
+ ->Values([@_])->Dump;
}
sub diag_where{
@@ -90,13 +116,14 @@
}
sub _sql_differ_diag {
- my ($sql1, $sql2) = @_;
+ my $sql1 = shift || '';
+ my $sql2 = shift || '';
$tb->${\( $tb->in_todo ? 'note' : 'diag')} (
"SQL expressions differ\n"
- ." got: $sql1\n"
- ."expected: $sql2\n"
- ."differing in :\n$sql_differ\n"
+ ." got: $sql1\n"
+ ."want: $sql2\n"
+ ."\nmismatch around\n$sql_differ\n"
);
}
@@ -104,14 +131,12 @@
my ($bind_ref1, $bind_ref2) = @_;
$tb->${\( $tb->in_todo ? 'note' : 'diag')} (
- "BIND values differ\n"
- ." got: " . dumper($bind_ref1)
- ."expected: " . dumper($bind_ref2)
- );
+ "BIND values differ " . dumper({ got => $bind_ref1, want => $bind_ref2 })
+ );
}
sub eq_sql_bind {
- my ($sql1, $bind_ref1, $sql2, $bind_ref2) = @_;
+ my ($sql1, $bind_ref1, $sql2, $bind_ref2) = &_unpack_arrayrefref;
return eq_sql($sql1, $sql2) && eq_bind($bind_ref1, $bind_ref2);
}
@@ -267,52 +292,83 @@
A lot of effort goes into distinguishing significant from
non-significant parenthesis, including AND/OR operator associativity.
Currently this module does not support commutativity and more
-intelligent transformations like Morgan laws, etc.
+intelligent transformations like L<De Morgan's laws
+|http://en.wikipedia.org/wiki/De_Morgan's_laws>, etc.
-For a good overview of what this test framework is capable of refer
+For a good overview of what this test framework is currently capable of refer
to C<t/10test.t>
=head1 FUNCTIONS
=head2 is_same_sql_bind
- is_same_sql_bind($given_sql, \@given_bind,
- $expected_sql, \@expected_bind, $test_msg);
+ is_same_sql_bind(
+ $given_sql, \@given_bind,
+ $expected_sql, \@expected_bind,
+ $test_msg
+ );
-Compares given and expected pairs of C<($sql, \@bind)>, and calls
-L<Test::Builder/ok> on the result, with C<$test_msg> as message. If the test
-fails, a detailed diagnostic is printed. For clients which use L<Test::More>,
-this is the one of the three functions (L</is_same_sql_bind>, L</is_same_sql>,
-L</is_same_bind>) that needs to be imported.
+ is_same_sql_bind(
+ \[$given_sql, @given_bind],
+ \[$expected_sql, @expected_bind],
+ $test_msg
+ );
+
+ is_same_sql_bind(
+ $dbic_rs->as_query
+ $expected_sql, \@expected_bind,
+ $test_msg
+ );
+
+Compares given and expected pairs of C<($sql, \@bind)> by unpacking C<@_>
+as shown in the examples above and passing the arguments to L</eq_sql> and
+L</eq_bind>. Calls L<Test::Builder/ok> with the combined result, with
+C<$test_msg> as message.
+If the test fails, a detailed diagnostic is printed.
=head2 is_same_sql
- is_same_sql($given_sql, $expected_sql, $test_msg);
+ is_same_sql(
+ $given_sql,
+ $expected_sql,
+ $test_msg
+ );
-Compares given and expected SQL statements, and calls L<Test::Builder/ok> on
-the result, with C<$test_msg> as message. If the test fails, a detailed
-diagnostic is printed. For clients which use L<Test::More>, this is the one of
-the three functions (L</is_same_sql_bind>, L</is_same_sql>, L</is_same_bind>)
-that needs to be imported.
+Compares given and expected SQL statements via L</eq_sql>, and calls
+L<Test::Builder/ok> on the result, with C<$test_msg> as message.
+If the test fails, a detailed diagnostic is printed.
=head2 is_same_bind
- is_same_bind(\@given_bind, \@expected_bind, $test_msg);
+ is_same_bind(
+ \@given_bind,
+ \@expected_bind,
+ $test_msg
+ );
-Compares given and expected bind values, and calls L<Test::Builder/ok> on the
-result, with C<$test_msg> as message. If the test fails, a detailed diagnostic
-is printed. For clients which use L<Test::More>, this is the one of the three
-functions (L</is_same_sql_bind>, L</is_same_sql>, L</is_same_bind>) that needs
-to be imported.
+Compares given and expected bind values via L</eq_bind>, and calls
+L<Test::Builder/ok> on the result, with C<$test_msg> as message.
+If the test fails, a detailed diagnostic is printed.
=head2 eq_sql_bind
- my $is_same = eq_sql_bind($given_sql, \@given_bind,
- $expected_sql, \@expected_bind);
+ my $is_same = eq_sql_bind(
+ $given_sql, \@given_bind,
+ $expected_sql, \@expected_bind,
+ );
-Compares given and expected pairs of C<($sql, \@bind)>. Similar to
-L</is_same_sql_bind>, but it just returns a boolean value and does not print
-diagnostics or talk to L<Test::Builder>.
+ my $is_same = eq_sql_bind(
+ \[$given_sql, @given_bind],
+ \[$expected_sql, @expected_bind],
+ );
+
+ my $is_same = eq_sql_bind(
+ $dbic_rs->as_query
+ $expected_sql, \@expected_bind,
+ );
+
+Unpacks C<@_> depending on the given arguments and calls L</eq_sql> and
+L</eq_bind>, returning their combined result.
=head2 eq_sql
@@ -356,14 +412,13 @@
C<$sql_differ> contains the SQL portion
where a difference was encountered.
-
=head1 SEE ALSO
L<SQL::Abstract>, L<Test::More>, L<Test::Builder>.
=head1 AUTHORS
-Laurent Dami, E<lt>laurent.dami AT etat geneve chE<gt>
+Laurent Dami <laurent.dami AT etat geneve ch>
Norbert Buchmuller <no...@nix.hu>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/lib/SQL/Abstract/Tree.pm
new/SQL-Abstract-1.78/lib/SQL/Abstract/Tree.pm
--- old/SQL-Abstract-1.77/lib/SQL/Abstract/Tree.pm 2014-01-17
01:42:27.000000000 +0100
+++ new/SQL-Abstract-1.78/lib/SQL/Abstract/Tree.pm 2014-05-28
05:48:09.000000000 +0200
@@ -1,38 +1,22 @@
package SQL::Abstract::Tree;
+# DO NOT edit away without talking to riba first, he will just put it back
+# BEGIN pre-Moo2 import block
+BEGIN {
+ require warnings;
+ my $initial_fatal_bits = (${^WARNING_BITS}||'') & $warnings::DeadBits{all};
+ local $ENV{PERL_STRICTURES_EXTRA} = 0;
+ require Moo; Moo->import;
+ require Sub::Quote; Sub::Quote->import('quote_sub');
+ ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} );
+}
+# END pre-Moo2 import block
+
use strict;
use warnings;
no warnings 'qw';
-use Carp;
-
-use Hash::Merge qw//;
-use base 'Class::Accessor::Grouped';
-
-__PACKAGE__->mk_group_accessors( simple => qw(
- newline indent_string indent_amount colormap indentmap fill_in_placeholders
- placeholder_surround
-));
-
-my $merger = Hash::Merge->new;
-
-$merger->specify_behavior({
- SCALAR => {
- SCALAR => sub { $_[1] },
- ARRAY => sub { [ $_[0], @{$_[1]} ] },
- HASH => sub { $_[1] },
- },
- ARRAY => {
- SCALAR => sub { $_[1] },
- ARRAY => sub { $_[1] },
- HASH => sub { $_[1] },
- },
- HASH => {
- SCALAR => sub { $_[1] },
- ARRAY => sub { [ values %{$_[0]}, @{$_[1]} ] },
- HASH => sub { Hash::Merge::_merge_hashes( $_[0], $_[1] ) },
- },
-}, 'SQLA::Tree Behavior' );
+use Carp;
my $op_look_ahead = '(?: (?= [\s\)\(\;] ) | \z)';
my $op_look_behind = '(?: (?<= [\,\s\)\(] ) | \A )';
@@ -83,7 +67,6 @@
'SAVEPOINT',
'RELEASE \s+ SAVEPOINT',
'RETURNING',
- 'ROW_NUMBER \s* \( \s* \) \s+ OVER',
);
my $expr_start_re = join ("\n\t|\n", @expression_start_keywords );
@@ -115,7 +98,9 @@
;
$binary_op_re = qr/$binary_op_re/x;
-my $unary_op_re = '(?: NOT \s+ EXISTS | NOT )';
+my $rno_re = qr/ROW_NUMBER \s* \( \s* \) \s+ OVER/ix;
+
+my $unary_op_re = 'NOT \s+ EXISTS | NOT | ' . $rno_re;
$unary_op_re = join "\n\t|\n",
"$op_look_behind (?i: $unary_op_re ) $op_look_ahead",
;
@@ -195,18 +180,33 @@
first => 1,
);
-my %profiles = (
- console => {
- fill_in_placeholders => 1,
- placeholder_surround => ['?/', ''],
- indent_string => ' ',
- indent_amount => 2,
- newline => "\n",
- colormap => {},
- indentmap => \%indents,
- eval { require Term::ANSIColor }
- ? do {
+has [qw(
+ newline indent_string indent_amount fill_in_placeholders placeholder_surround
+)] => (is => 'ro');
+
+has [qw( indentmap colormap )] => ( is => 'ro', default => quote_sub('{}') );
+
+# class global is in fact desired
+my $merger;
+
+sub BUILDARGS {
+ my $class = shift;
+ my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
+
+ if (my $p = delete $args->{profile}) {
+ my %extra_args;
+ if ($p eq 'console') {
+ %extra_args = (
+ fill_in_placeholders => 1,
+ placeholder_surround => ['?/', ''],
+ indent_string => ' ',
+ indent_amount => 2,
+ newline => "\n",
+ colormap => {},
+ indentmap => \%indents,
+
+ ! ( eval { require Term::ANSIColor } ) ? () : do {
my $c = \&Term::ANSIColor::color;
my $red = [$c->('red') , $c->('reset')];
@@ -251,79 +251,86 @@
offset => $green,
}
);
- } : (),
- },
- console_monochrome => {
- fill_in_placeholders => 1,
- placeholder_surround => ['?/', ''],
- indent_string => ' ',
- indent_amount => 2,
- newline => "\n",
- colormap => {},
- indentmap => \%indents,
- },
- html => {
- fill_in_placeholders => 1,
- placeholder_surround => ['<span class="placeholder">', '</span>'],
- indent_string => ' ',
- indent_amount => 2,
- newline => "<br />\n",
- colormap => {
- select => ['<span class="select">' , '</span>'],
- 'insert into' => ['<span class="insert-into">' , '</span>'],
- update => ['<span class="select">' , '</span>'],
- 'delete from' => ['<span class="delete-from">' , '</span>'],
-
- set => ['<span class="set">', '</span>'],
- from => ['<span class="from">' , '</span>'],
-
- where => ['<span class="where">' , '</span>'],
- values => ['<span class="values">', '</span>'],
-
- join => ['<span class="join">' , '</span>'],
- 'left join' => ['<span class="left-join">','</span>'],
- on => ['<span class="on">' , '</span>'],
-
- 'group by' => ['<span class="group-by">', '</span>'],
- having => ['<span class="having">', '</span>'],
- 'order by' => ['<span class="order-by">', '</span>'],
-
- skip => ['<span class="skip">', '</span>'],
- first => ['<span class="first">', '</span>'],
- limit => ['<span class="limit">', '</span>'],
- offset => ['<span class="offset">', '</span>'],
-
- 'begin work' => ['<span class="begin-work">', '</span>'],
- commit => ['<span class="commit">', '</span>'],
- rollback => ['<span class="rollback">', '</span>'],
- savepoint => ['<span class="savepoint">', '</span>'],
- 'rollback to savepoint' => ['<span class="rollback-to-savepoint">',
'</span>'],
- 'release savepoint' => ['<span class="release-savepoint">',
'</span>'],
- },
- indentmap => \%indents,
- },
- none => {
- colormap => {},
- indentmap => {},
- },
-);
-
-sub new {
- my $class = shift;
- my $args = shift || {};
+ },
+ );
+ }
+ elsif ($p eq 'console_monochrome') {
+ %extra_args = (
+ fill_in_placeholders => 1,
+ placeholder_surround => ['?/', ''],
+ indent_string => ' ',
+ indent_amount => 2,
+ newline => "\n",
+ indentmap => \%indents,
+ );
+ }
+ elsif ($p eq 'html') {
+ %extra_args = (
+ fill_in_placeholders => 1,
+ placeholder_surround => ['<span class="placeholder">', '</span>'],
+ indent_string => ' ',
+ indent_amount => 2,
+ newline => "<br />\n",
+ colormap => { map {
+ (my $class = $_) =~ s/\s+/-/g;
+ ( $_ => [ qq|<span class="$class">|, '</span>' ] )
+ } (
+ keys %indents,
+ qw(commit rollback savepoint),
+ 'begin work', 'rollback to savepoint', 'release savepoint',
+ ) },
+ indentmap => \%indents,
+ );
+ }
+ elsif ($p eq 'none') {
+ # nada
+ }
+ else {
+ croak "No such profile '$p'";
+ }
- my $profile = delete $args->{profile} || 'none';
+ # see if we got any duplicates and merge if needed
+ if (scalar grep { exists $args->{$_} } keys %extra_args) {
+ # heavy-duty merge
+ $args = ($merger ||= do {
+ require Hash::Merge;
+ my $m = Hash::Merge->new;
+
+ $m->specify_behavior({
+ SCALAR => {
+ SCALAR => sub { $_[1] },
+ ARRAY => sub { [ $_[0], @{$_[1]} ] },
+ HASH => sub { $_[1] },
+ },
+ ARRAY => {
+ SCALAR => sub { $_[1] },
+ ARRAY => sub { $_[1] },
+ HASH => sub { $_[1] },
+ },
+ HASH => {
+ SCALAR => sub { $_[1] },
+ ARRAY => sub { [ values %{$_[0]}, @{$_[1]} ] },
+ HASH => sub { Hash::Merge::_merge_hashes( $_[0], $_[1] ) },
+ },
+ }, 'SQLA::Tree Behavior' );
- die "No such profile '$profile'!" unless exists $profiles{$profile};
+ $m;
+ })->merge(\%extra_args, $args );
- my $data = $merger->merge( $profiles{$profile}, $args );
+ }
+ else {
+ $args = { %extra_args, %$args };
+ }
+ }
- bless $data, $class
+ $args;
}
sub parse {
my ($self, $s) = @_;
+ return [] unless defined $s;
+
# tokenize string, and remove all optional whitespace
my $tokens = [];
foreach my $token (split $tokenizer_re, $s) {
@@ -419,12 +426,16 @@
@right = $self->_recurse_parse($tokens, PARSE_IN_EXPR);
}
- @left = [$op => [ @left, @right ]];
+ push @left, [$op => [ (@left ? pop @left : ''), @right ]];
}
# unary op keywords
elsif ( $token =~ $unary_op_re ) {
my $op = uc $token;
+
+ # normalize RNO explicitly
+ $op = 'ROW_NUMBER() OVER' if $op =~ /^$rno_re$/;
+
my @right = $self->_recurse_parse ($tokens, PARSE_RHS);
push @left, [ $op => \@right ];
@@ -658,25 +669,38 @@
next;
}
+ my $parent_op = $ast->[0];
+
# unroll nested parenthesis
- while ( $ast->[0] ne 'IN' and @{$child->[1]} == 1 and $child->[1][0][0]
eq '-PAREN') {
+ while ( $parent_op ne 'IN' and @{$child->[1]} == 1 and $child->[1][0][0]
eq '-PAREN') {
$child = $child->[1][0];
$changes++;
}
- # if the parent operator explicitly allows it nuke the parenthesis
- if ( $ast->[0] =~ $unrollable_ops_re ) {
+ # set to CHILD in the case of PARENT ( CHILD )
+ # but NOT in the case of PARENT( CHILD1, CHILD2 )
+ my $single_child_op = (@{$child->[1]} == 1) ? $child->[1][0][0] : '';
+
+ my $child_op_argc = $single_child_op ? scalar @{$child->[1][0][1]} :
undef;
+
+ my $single_grandchild_op
+ = ( $child_op_argc||0 == 1 and ref $child->[1][0][1][0] eq 'ARRAY' )
+ ? $child->[1][0][1][0][0]
+ : ''
+ ;
+
+ # if the parent operator explicitly allows it AND the child isn't a
subselect
+ # nuke the parenthesis
+ if ($parent_op =~ $unrollable_ops_re and $single_child_op ne 'SELECT') {
push @children, @{$child->[1]};
$changes++;
}
# if the parenthesis are wrapped around an AND/OR matching the parent
AND/OR - open the parenthesis up and merge the list
elsif (
- @{$child->[1]} == 1
- and
- ( $ast->[0] eq 'AND' or $ast->[0] eq 'OR')
- and
- $child->[1][0][0] eq $ast->[0]
+ $single_child_op eq $parent_op
+ and
+ ( $parent_op eq 'AND' or $parent_op eq 'OR')
) {
push @children, @{$child->[1][0][1]};
$changes++;
@@ -685,13 +709,9 @@
# only *ONE* LITERAL or placeholder element
# as an AND/OR/NOT argument
elsif (
- @{$child->[1]} == 1 && (
- $child->[1][0][0] eq '-LITERAL'
- or
- $child->[1][0][0] eq '-PLACEHOLDER'
- ) && (
- $ast->[0] eq 'AND' or $ast->[0] eq 'OR' or $ast->[0] eq 'NOT'
- )
+ ( $single_child_op eq '-LITERAL' or $single_child_op eq '-PLACEHOLDER'
)
+ and
+ ( $parent_op eq 'AND' or $parent_op eq 'OR' or $parent_op eq 'NOT' )
) {
push @children, @{$child->[1]};
$changes++;
@@ -704,20 +724,18 @@
# break precedence) or when the child is BETWEEN (special
# case)
elsif (
- @{$child->[1]} == 1
- and
- ($ast->[0] eq 'AND' or $ast->[0] eq 'OR')
+ ($parent_op eq 'AND' or $parent_op eq 'OR')
and
- $child->[1][0][0] =~ $binary_op_re
+ $single_child_op =~ $binary_op_re
and
- $child->[1][0][0] ne 'BETWEEN'
+ $single_child_op ne 'BETWEEN'
and
- @{$child->[1][0][1]} == 2
+ $child_op_argc == 2
and
! (
- $child->[1][0][0] =~ $alphanum_cmp_op_re
+ $single_child_op =~ $alphanum_cmp_op_re
and
- $ast->[0] =~ $alphanum_cmp_op_re
+ $parent_op =~ $alphanum_cmp_op_re
)
) {
push @children, @{$child->[1]};
@@ -731,20 +749,20 @@
# or a single non-mathop with a single LITERAL ( nonmathop foo )
# or a single non-mathop with a single PLACEHOLDER ( nonmathop ? )
elsif (
- @{$child->[1]} == 1
+ $single_child_op
and
- @{$child->[1][0][1]} == 1
+ $parent_op =~ $alphanum_cmp_op_re
and
- $ast->[0] =~ $alphanum_cmp_op_re
+ $single_child_op !~ $alphanum_cmp_op_re
and
- $child->[1][0][0] !~ $alphanum_cmp_op_re
+ $child_op_argc == 1
and
(
- $child->[1][0][1][0][0] eq '-PAREN'
+ $single_grandchild_op eq '-PAREN'
or
- $child->[1][0][1][0][0] eq '-LITERAL'
+ $single_grandchild_op eq '-LITERAL'
or
- $child->[1][0][1][0][0] eq '-PLACEHOLDER'
+ $single_grandchild_op eq '-PLACEHOLDER'
)
) {
push @children, @{$child->[1]};
@@ -753,16 +771,17 @@
# a construct of ... ( somefunc ( ... ) ) ... can safely lose the outer
parens
# except for the case of ( NOT ( ... ) ) which has already been handled
earlier
+ # and except for the case of RNO, where the double are explicit syntax
elsif (
- @{$child->[1]} == 1
+ $parent_op ne 'ROW_NUMBER() OVER'
and
- @{$child->[1][0][1]} == 1
+ $single_child_op
and
- $child->[1][0][0] ne 'NOT'
+ $single_child_op ne 'NOT'
and
- ref $child->[1][0][1][0] eq 'ARRAY'
+ $child_op_argc == 1
and
- $child->[1][0][1][0][0] eq '-PAREN'
+ $single_grandchild_op eq '-PAREN'
) {
push @children, @{$child->[1]};
$changes++;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/lib/SQL/Abstract.pm
new/SQL-Abstract-1.78/lib/SQL/Abstract.pm
--- old/SQL-Abstract-1.77/lib/SQL/Abstract.pm 2014-01-17 02:05:06.000000000
+0100
+++ new/SQL-Abstract-1.78/lib/SQL/Abstract.pm 2014-05-28 12:12:07.000000000
+0200
@@ -10,7 +10,7 @@
# GLOBALS
#======================================================================
-our $VERSION = '1.77';
+our $VERSION = '1.78';
# This would confuse some packagers
$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev
releases
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/script/format-sql
new/SQL-Abstract-1.78/script/format-sql
--- old/SQL-Abstract-1.77/script/format-sql 2013-12-26 11:14:22.000000000
+0100
+++ new/SQL-Abstract-1.78/script/format-sql 1970-01-01 01:00:00.000000000
+0100
@@ -1,16 +0,0 @@
-#!/usr/bin/env perl
-
-use SQL::Abstract::Tree;
-use Getopt::Long::Descriptive;
-
-my ($opt, $usage) = describe_options(
- 'format-sql %o',
- [ 'profile|p=s', "the profile to use", { default => 'console' } ],
- [ 'help', "print usage message and exit" ],
-);
-
- print($usage->text), exit if $opt->help;
-
-my $sqlat = SQL::Abstract::Tree->new({ profile => $opt->profile,
fill_in_placeholders => 0 });
-
-print $sqlat->format($_) . "\n" while <>;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/t/10test.t
new/SQL-Abstract-1.78/t/10test.t
--- old/SQL-Abstract-1.77/t/10test.t 2014-01-17 01:42:27.000000000 +0100
+++ new/SQL-Abstract-1.78/t/10test.t 2014-05-28 05:48:06.000000000 +0200
@@ -1093,4 +1093,17 @@
'expected debug of missing branch',
);
+
+ok (eq_sql_bind (
+ \[ 'SELECT foo FROM bar WHERE baz = ? or buzz = ?', [ {} => 1 ], 2 ],
+ 'SELECT foo FROM bar WHERE (baz = ?) OR buzz = ?',
+ [ [ {} => 1 ], 2 ],
+), 'arrayrefref unpacks correctly' );
+
+is_same_sql_bind(
+ \[ 'SELECT foo FROM bar WHERE baz = ? or buzz = ?', [ {} => 1 ], 2 ],
+ \[ 'SELECT foo FROM bar WHERE (( baz = ? OR (buzz = ?) ))', [ {} => 1 ], 2 ],
+ 'double arrayrefref unpacks correctly'
+);
+
done_testing;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/t/11parser.t
new/SQL-Abstract-1.78/t/11parser.t
--- old/SQL-Abstract-1.77/t/11parser.t 2014-01-17 01:42:27.000000000 +0100
+++ new/SQL-Abstract-1.78/t/11parser.t 2014-05-21 11:10:04.000000000 +0200
@@ -533,6 +533,122 @@
]
], 'real life statement 1 parsed correctly');
+is_deeply($sqlat->parse("CASE WHEN FOO() > BAR()"), [
+ [
+ "-MISC",
+ [
+ [
+ "-LITERAL",
+ [
+ "CASE"
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ "WHEN"
+ ]
+ ]
+ ]
+ ],
+ [
+ ">",
+ [
+ [
+ "FOO",
+ [
+ [
+ "-PAREN",
+ []
+ ]
+ ]
+ ],
+ [
+ "BAR",
+ [
+ [
+ "-PAREN",
+ []
+ ]
+ ]
+ ]
+ ]
+ ]
+]);
+
+is_deeply($sqlat->parse("SELECT [me].[id], ROW_NUMBER ( ) OVER (ORDER BY
(SELECT 1)) AS [rno__row__index] FROM bar"), [
+ [
+ "SELECT",
+ [
+ [
+ "-LIST",
+ [
+ [
+ "-LITERAL",
+ [
+ "[me].[id]"
+ ]
+ ],
+ [
+ "AS",
+ [
+ [
+ "ROW_NUMBER() OVER",
+ [
+ [
+ "-PAREN",
+ [
+ [
+ "ORDER BY",
+ [
+ [
+ "-PAREN",
+ [
+ [
+ "SELECT",
+ [
+ [
+ "-LITERAL",
+ [
+ 1
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ],
+ [
+ "-LITERAL",
+ [
+ "[rno__row__index]"
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ],
+ [
+ "FROM",
+ [
+ [
+ "-LITERAL",
+ [
+ "bar"
+ ]
+ ]
+ ]
+ ]
+]);
+
+
is_deeply($sqlat->parse("SELECT x, y FROM foo WHERE x IN (?, ?, ?, ?)"), [
[
"SELECT",
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/SQL-Abstract-1.77/t/14roundtrippin.t
new/SQL-Abstract-1.78/t/14roundtrippin.t
--- old/SQL-Abstract-1.77/t/14roundtrippin.t 2014-01-17 01:42:27.000000000
+0100
+++ new/SQL-Abstract-1.78/t/14roundtrippin.t 2014-05-28 05:47:34.000000000
+0200
@@ -20,12 +20,16 @@
"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 * FROM (SELECT SUM (CASE WHEN GETUTCDATE() > DATEADD(second, 4 * 60,
last_checkin) THEN 1 ELSE 0 END) 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')",
"SELECT * FROM foo ORDER BY name + ?, [me].[id]",
"SELECT foo AS bar FROM baz ORDER BY x + ? DESC, baz.g",
+ "SELECT [me].[id], ROW_NUMBER() OVER (ORDER BY (SELECT 1)) AS
[rno__row__index] FROM ( SELECT [me].[id] FROM [LogParents] [me]) [me]",
+ # deliberate batshit insanity
+ "SELECT foo FROM bar WHERE > 12",
);
# FIXME FIXME FIXME
--
To unsubscribe, e-mail: opensuse-commit+unsubscr...@opensuse.org
For additional commands, e-mail: opensuse-commit+h...@opensuse.org
