Hello community, here is the log from the commit of package perl-SQL-Abstract for openSUSE:Factory checked in at 2018-02-02 22:23:13 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-SQL-Abstract (Old) and /work/SRC/openSUSE:Factory/.perl-SQL-Abstract.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-SQL-Abstract" Fri Feb 2 22:23:13 2018 rev:13 rq:572022 version:1.85 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-SQL-Abstract/perl-SQL-Abstract.changes 2017-04-11 12:43:49.421949659 +0200 +++ /work/SRC/openSUSE:Factory/.perl-SQL-Abstract.new/perl-SQL-Abstract.changes 2018-02-02 22:23:32.802333710 +0100 @@ -1,0 +2,10 @@ +Wed Jan 31 12:46:25 UTC 2018 - [email protected] + +- updated to 1.85 + see /usr/share/doc/packages/perl-SQL-Abstract/Changes + + 1.85 - 2018-01-27 + - Restore perl version requirement missed in the Distar port + - Factor out the SET ... part of UPDATE for subclassability (GH#12) + +------------------------------------------------------------------- Old: ---- SQL-Abstract-1.84.tar.gz New: ---- SQL-Abstract-1.85.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-SQL-Abstract.spec ++++++ --- /var/tmp/diff_new_pack.PySH80/_old 2018-02-02 22:23:33.530299729 +0100 +++ /var/tmp/diff_new_pack.PySH80/_new 2018-02-02 22:23:33.534299541 +0100 @@ -1,7 +1,7 @@ # # spec file for package perl-SQL-Abstract # -# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,7 +17,7 @@ Name: perl-SQL-Abstract -Version: 1.84 +Version: 1.85 Release: 0 %define cpan_name SQL-Abstract Summary: Generate SQL from Perl data structures ++++++ SQL-Abstract-1.84.tar.gz -> SQL-Abstract-1.85.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/Changes new/SQL-Abstract-1.85/Changes --- old/SQL-Abstract-1.84/Changes 2017-04-03 17:28:06.000000000 +0200 +++ new/SQL-Abstract-1.85/Changes 2018-01-27 12:10:35.000000000 +0100 @@ -1,5 +1,9 @@ Revision history for SQL::Abstract +1.85 - 2018-01-27 + - Restore perl version requirement missed in the Distar port + - Factor out the SET ... part of UPDATE for subclassability (GH#12) + 1.84 - 2017-04-03 - Restore 'dynamic_config => 0' missed in the Distar port diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/META.json new/SQL-Abstract-1.85/META.json --- old/SQL-Abstract-1.84/META.json 2017-04-03 17:29:18.000000000 +0200 +++ new/SQL-Abstract-1.85/META.json 2018-01-27 12:15:01.000000000 +0100 @@ -33,7 +33,13 @@ } }, "develop" : { - "requires" : {} + "requires" : { + "Pod::Coverage" : "0.19", + "Test::EOL" : "1.0", + "Test::NoTabs" : "0.9", + "Test::Pod" : "1.14", + "Test::Pod::Coverage" : "1.04" + } }, "runtime" : { "requires" : { @@ -44,7 +50,8 @@ "Moo" : "2.000001", "Scalar::Util" : "0", "Sub::Quote" : "2.000001", - "Text::Balanced" : "2.00" + "Text::Balanced" : "2.00", + "perl" : "5.006" } }, "test" : { @@ -73,6 +80,6 @@ }, "x_IRC" : "irc://irc.perl.org/#dbix-class" }, - "version" : "1.84", - "x_serialization_backend" : "JSON::PP version 2.27400" + "version" : "1.85", + "x_serialization_backend" : "JSON::PP version 2.27400_02" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/META.yml new/SQL-Abstract-1.85/META.yml --- old/SQL-Abstract-1.84/META.yml 2017-04-03 17:29:18.000000000 +0200 +++ new/SQL-Abstract-1.85/META.yml 2018-01-27 12:15:01.000000000 +0100 @@ -33,10 +33,11 @@ Scalar::Util: '0' Sub::Quote: '2.000001' Text::Balanced: '2.00' + perl: '5.006' resources: IRC: irc://irc.perl.org/#dbix-class bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=SQL-Abstract license: http://dev.perl.org/licenses/ repository: https://github.com/dbsrgits/sql-abstract.git -version: '1.84' +version: '1.85' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/Makefile.PL new/SQL-Abstract-1.85/Makefile.PL --- old/SQL-Abstract-1.84/Makefile.PL 2017-04-03 17:26:38.000000000 +0200 +++ new/SQL-Abstract-1.85/Makefile.PL 2017-04-14 15:36:07.000000000 +0200 @@ -34,10 +34,17 @@ 'Sub::Quote' => '2.000001', 'Hash::Merge' => '0.12', 'Text::Balanced' => '2.00', + 'perl' => '5.006', }, }, develop => { - requires => {}, + requires => { + 'Test::Pod' => '1.14', + 'Test::Pod::Coverage' => '1.04', + 'Pod::Coverage' => '0.19', + 'Test::EOL' => '1.0', + 'Test::NoTabs' => '0.9', + }, }, }, resources => { @@ -54,7 +61,7 @@ license => [ 'http://dev.perl.org/licenses/' ], }, no_index => { - package => 'DBIx::Class::Storage::Debug::PrettyPrint', + package => [ 'DBIx::Class::Storage::Debug::PrettyPrint' ], directory => [ 't', 'xt', 'examples' ], }, ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/README new/SQL-Abstract-1.85/README --- old/SQL-Abstract-1.84/README 2017-04-03 17:29:18.000000000 +0200 +++ new/SQL-Abstract-1.85/README 2018-01-27 12:15:01.000000000 +0100 @@ -318,7 +318,7 @@ When opening-closing-style quoting is used ("quote_char" is an arrayref) this parameter defaults to the closing (right) - "quote_char". Occurences of the opening (left) "quote_char" within + "quote_char". Occurrences of the opening (left) "quote_char" within the identifier are currently left untouched. The default for opening-closing-style quotes may change in future versions, thus you are strongly encouraged to specify the escape character explicitly. @@ -491,7 +491,7 @@ * The value is of the form "{ -value => $anything }" - On failure returns "undef", on sucess returns a scalar reference to the + On failure returns "undef", on success returns a scalar reference to the original supplied argument. * Note @@ -540,7 +540,7 @@ * "\[ $sql_string, @bind_values ]" - On failure returns "undef", on sucess returns an array reference + On failure returns "undef", on success returns an array reference containing the unpacked version of the supplied literal SQL and bind values. @@ -1195,7 +1195,7 @@ When supplied with a method name, it is simply called on the SQL::Abstract object as: - $self->$method_name ($field, $op, $arg) + $self->$method_name($field, $op, $arg) Where: @@ -1261,7 +1261,7 @@ When supplied with a method name, it is simply called on the SQL::Abstract object as: - $self->$method_name ($op, $arg) + $self->$method_name($op, $arg) Where: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/lib/DBIx/Class/Storage/Debug/PrettyPrint.pm new/SQL-Abstract-1.85/lib/DBIx/Class/Storage/Debug/PrettyPrint.pm --- old/SQL-Abstract-1.84/lib/DBIx/Class/Storage/Debug/PrettyPrint.pm 2013-06-04 15:13:27.000000000 +0200 +++ new/SQL-Abstract-1.85/lib/DBIx/Class/Storage/Debug/PrettyPrint.pm 2017-04-14 15:36:07.000000000 +0200 @@ -73,7 +73,7 @@ sub query_start { my ($self, $string, @bind) = @_; - if(defined $self->callback) { + if (defined $self->callback) { $string =~ m/^(\w+)/; $self->callback->($1, "$string: ".join(', ', @bind)."\n"); return; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/lib/SQL/Abstract/Test.pm new/SQL-Abstract-1.85/lib/SQL/Abstract/Test.pm --- old/SQL-Abstract-1.84/lib/SQL/Abstract/Test.pm 2014-05-29 11:32:03.000000000 +0200 +++ new/SQL-Abstract-1.85/lib/SQL/Abstract/Test.pm 2017-04-14 15:36:07.000000000 +0200 @@ -28,7 +28,7 @@ for (1,2) { my $chunk = shift @_; - if ( ref $chunk eq 'REF' and ref $$chunk eq 'ARRAY' ) { + if (ref $chunk eq 'REF' and ref $$chunk eq 'ARRAY') { my ($sql, @bind) = @$$chunk; push @args, ($sql, \@bind); } @@ -112,14 +112,14 @@ } sub diag_where{ - $tb->diag( "Search term:\n" . &dumper ); + $tb->diag("Search term:\n" . &dumper); } sub _sql_differ_diag { my $sql1 = shift || ''; my $sql2 = shift || ''; - $tb->${\( $tb->in_todo ? 'note' : 'diag')} ( + $tb->${\($tb->in_todo ? 'note' : 'diag')} ( "SQL expressions differ\n" ." got: $sql1\n" ."want: $sql2\n" @@ -130,7 +130,7 @@ sub _bind_differ_diag { my ($bind_ref1, $bind_ref2) = @_; - $tb->${\( $tb->in_todo ? 'note' : 'diag')} ( + $tb->${\($tb->in_todo ? 'note' : 'diag')} ( "BIND values differ " . dumper({ got => $bind_ref1, want => $bind_ref2 }) ); } @@ -159,8 +159,8 @@ my ($left, $right) = @_; # one is defined the other not - if ( (defined $left) xor (defined $right) ) { - $sql_differ = sprintf ("[%s] != [%s]\n", map { defined $_ ? $sqlat->unparse ($_) : 'N/A' } ($left, $right) ); + if ((defined $left) xor (defined $right)) { + $sql_differ = sprintf ("[%s] != [%s]\n", map { defined $_ ? $sqlat->unparse($_) : 'N/A' } ($left, $right) ); return 0; } @@ -176,14 +176,14 @@ # one is empty if (@$left == 0 or @$right == 0) { - $sql_differ = sprintf ("left: %s\nright: %s\n", map { @$_ ? $sqlat->unparse ($_) : 'N/A'} ($left, $right) ); + $sql_differ = sprintf ("left: %s\nright: %s\n", map { @$_ ? $sqlat->unparse($_) : 'N/A'} ($left, $right) ); return 0; } # one is a list, the other is an op with a list elsif (ref $left->[0] xor ref $right->[0]) { $sql_differ = sprintf ("[%s] != [%s]\nleft: %s\nright: %s\n", map - { ref $_ ? $sqlat->unparse ($_) : $_ } + { ref $_ ? $sqlat->unparse($_) : $_ } ($left->[0], $right->[0], $left, $right) ); return 0; @@ -196,7 +196,7 @@ if (! $sql_differ or $sql_differ !~ /left\:\s .+ right:\s/xs) { $sql_differ ||= ''; $sql_differ .= "\n" unless $sql_differ =~ /\n\z/; - $sql_differ .= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) ); + $sql_differ .= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse($_) } ($left, $right) ); } return 0; } @@ -208,7 +208,7 @@ else { # unroll parenthesis if possible/allowed - unless ( $parenthesis_significant ) { + unless ($parenthesis_significant) { $sqlat->_parenthesis_unroll($_) for $left, $right; } @@ -217,7 +217,7 @@ $sqlat->_strip_asc_from_order_by($_) for $left, $right; } - if ( $left->[0] ne $right->[0] ) { + if ($left->[0] ne $right->[0]) { $sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n", $sqlat->unparse($left), $sqlat->unparse($right) @@ -237,7 +237,7 @@ # if operators are identical, compare operands else { my $eq = _eq_sql($left->[1], $right->[1]); - $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) ) if not $eq; + $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse($_) } ($left, $right) ) if not $eq; return $eq; } } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/lib/SQL/Abstract/Tree.pm new/SQL-Abstract-1.85/lib/SQL/Abstract/Tree.pm --- old/SQL-Abstract-1.84/lib/SQL/Abstract/Tree.pm 2016-05-06 17:16:41.000000000 +0200 +++ new/SQL-Abstract-1.85/lib/SQL/Abstract/Tree.pm 2017-04-14 15:36:07.000000000 +0200 @@ -340,7 +340,7 @@ my @left; while (1) { # left-associative parsing - if ( ! @$tokens + if (! @$tokens or ($state == PARSE_IN_PARENS && $tokens->[0] eq ')') or @@ -418,19 +418,19 @@ } # unary op keywords - elsif ( $token =~ $unary_op_re ) { + 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); + my @right = $self->_recurse_parse($tokens, PARSE_RHS); push @left, [ $op => \@right ]; } # expression terminator keywords - elsif ( $token =~ $expr_start_re ) { + elsif ($token =~ $expr_start_re) { my $op = uc $token; my @right = $self->_recurse_parse($tokens, PARSE_IN_EXPR); @@ -438,7 +438,7 @@ } # a '?' - elsif ( $token =~ $placeholder_re) { + elsif ($token =~ $placeholder_re) { push @left, [ -PLACEHOLDER => [ $token ] ]; } @@ -462,7 +462,7 @@ and $tokens->[0] !~ $all_std_keywords_re and - ! ( @$tokens > 1 and $tokens->[1] eq '(' ) + ! (@$tokens > 1 and $tokens->[1] eq '(') ) { push @lits, [ -LITERAL => [ shift @$tokens ] ]; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/lib/SQL/Abstract.pm new/SQL-Abstract-1.85/lib/SQL/Abstract.pm --- old/SQL-Abstract-1.84/lib/SQL/Abstract.pm 2017-04-03 17:28:00.000000000 +0200 +++ new/SQL-Abstract-1.85/lib/SQL/Abstract.pm 2018-01-27 12:10:01.000000000 +0100 @@ -27,7 +27,7 @@ # GLOBALS #====================================================================== -our $VERSION = '1.84'; +our $VERSION = '1.85'; # This would confuse some packagers $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases @@ -219,7 +219,7 @@ $sql = join " ", $self->_sqlcase('insert into'), $table, $sql; if ($options->{returning}) { - my ($s, @b) = $self->_insert_returning ($options); + my ($s, @b) = $self->_insert_returning($options); $sql .= $s; push @bind, @b; } @@ -368,10 +368,32 @@ my $options = shift; # first build the 'SET' part of the sql statement - my (@set, @all_bind); puke "Unsupported data type specified to \$sql->update" unless ref $data eq 'HASH'; + my ($sql, @all_bind) = $self->_update_set_values($data); + $sql = $self->_sqlcase('update ') . $table . $self->_sqlcase(' set ') + . $sql; + + if ($where) { + my($where_sql, @where_bind) = $self->where($where); + $sql .= $where_sql; + push @all_bind, @where_bind; + } + + if ($options->{returning}) { + my ($returning_sql, @returning_bind) = $self->_update_returning($options); + $sql .= $returning_sql; + push @all_bind, @returning_bind; + } + + return wantarray ? ($sql, @all_bind) : $sql; +} + +sub _update_set_values { + my ($self, $data) = @_; + + my (@set, @all_bind); for my $k (sort keys %$data) { my $v = $data->{$k}; my $r = ref $v; @@ -406,7 +428,7 @@ if (@rest or not $op =~ /^\-(.+)/); local $self->{_nested_func_lhs} = $k; - my ($sql, @bind) = $self->_where_unary_op ($1, $arg); + my ($sql, @bind) = $self->_where_unary_op($1, $arg); push @set, "$label = $sql"; push @all_bind, @bind; @@ -419,22 +441,9 @@ } # generate sql - my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ') - . join ', ', @set; - - if ($where) { - my($where_sql, @where_bind) = $self->where($where); - $sql .= $where_sql; - push @all_bind, @where_bind; - } + my $sql = join ', ', @set; - if ($options->{returning}) { - my ($returning_sql, @returning_bind) = $self->_update_returning ($options); - $sql .= $returning_sql; - push @all_bind, @returning_bind; - } - - return wantarray ? ($sql, @all_bind) : $sql; + return ($sql, @all_bind); } # So that subclasses can override UPDATE ... RETURNING separately from @@ -478,10 +487,10 @@ my $options = shift; my($where_sql, @bind) = $self->where($where); - my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql; + my $sql = $self->_sqlcase('delete from ') . $table . $where_sql; if ($options->{returning}) { - my ($returning_sql, @returning_bind) = $self->_delete_returning ($options); + my ($returning_sql, @returning_bind) = $self->_delete_returning($options); $sql .= $returning_sql; push @bind, @returning_bind; } @@ -629,7 +638,7 @@ $op =~ s/^not_/NOT /i; $self->_debug("Unary OP(-$op) within hashref, recursing..."); - my ($s, @b) = $self->_where_unary_op ($op, $v); + my ($s, @b) = $self->_where_unary_op($op, $v); # top level vs nested # we assume that handled unary ops will take care of their ()s @@ -668,9 +677,9 @@ # top level special ops are illegal in general # this includes the -ident/-value ops (dual purpose unary and special) puke "Illegal use of top-level '-$op'" - if ! defined $self->{_nested_func_lhs} and List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}}; + if ! defined $self->{_nested_func_lhs} and List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}; - if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) { + if (my $op_entry = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) { my $handler = $op_entry->{handler}; if (not ref $handler) { @@ -678,7 +687,7 @@ belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. ' . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]"; } - return $self->$handler ($op, $rhs); + return $self->$handler($op, $rhs); } elsif (ref $handler eq 'CODE') { return $handler->($self, $op, $rhs); @@ -692,7 +701,7 @@ $self->_assert_pass_injection_guard($op); - my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, { + my ($sql, @bind) = $self->_SWITCH_refkind($rhs, { SCALAR => sub { puke "Illegal use of top-level '-$op'" unless defined $self->{_nested_func_lhs}; @@ -703,11 +712,11 @@ ); }, FALLBACK => sub { - $self->_recurse_where ($rhs) + $self->_recurse_where($rhs) }, }); - $sql = sprintf ('%s %s', + $sql = sprintf('%s %s', $self->_sqlcase($op), $sql, ); @@ -724,8 +733,8 @@ }, HASHREF => sub { - return ( $op =~ /^or/i ) - ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op ) + return ($op =~ /^or/i) + ? $self->_where_ARRAYREF([ map { $_ => $v->{$_} } (sort keys %$v) ], $op) : $self->_where_HASHREF($v); }, @@ -771,7 +780,7 @@ }, FALLBACK => sub { - $self->_recurse_where ($v); + $self->_recurse_where($v); }, }); @@ -791,7 +800,7 @@ }, FALLBACK => sub { - $self->_recurse_where ($v); + $self->_recurse_where($v); }, }); @@ -834,8 +843,8 @@ } my @bind = - $self->_bindtype ( - ( defined $lhs ? $lhs : $self->{_nested_func_lhs} ), + $self->_bindtype( + (defined $lhs ? $lhs : $self->{_nested_func_lhs}), $rhs, ) ; @@ -855,7 +864,7 @@ sub _where_hashpair_ARRAYREF { my ($self, $k, $v) = @_; - if( @$v ) { + if (@$v) { my @v = @$v; # need copy because of shift below $self->_debug("ARRAY($k) means distribute over elements"); @@ -920,17 +929,17 @@ my ($sql, @bind); # CASE: col-value logic modifiers - if ( $orig_op =~ /^ \- (and|or) $/xi ) { + if ($orig_op =~ /^ \- (and|or) $/xi) { ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1); } # CASE: special operators like -in or -between - elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) { + elsif (my $special_op = List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}) { my $handler = $special_op->{handler}; if (! $handler) { puke "No handler supplied for special operator $orig_op"; } elsif (not ref $handler) { - ($sql, @bind) = $self->$handler ($k, $op, $val); + ($sql, @bind) = $self->$handler($k, $op, $val); } elsif (ref $handler eq 'CODE') { ($sql, @bind) = $handler->($self, $k, $op, $val); @@ -968,9 +977,9 @@ }, FALLBACK => sub { # CASE: col => {op/func => $stuff} - ($sql, @bind) = $self->_where_unary_op ($op, $val); + ($sql, @bind) = $self->_where_unary_op($op, $val); - $sql = join (' ', + $sql = join(' ', $self->_convert($self->_quote($k)), $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested ); @@ -1006,15 +1015,15 @@ my @vals = @$vals; #always work on a copy - if(@vals) { + if (@vals) { $self->_debug(sprintf '%s means multiple elements: [ %s ]', $vals, - join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ), + join(', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ), ); # see if the first element is an -and/-or op my $logic; - if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) { + if (defined $vals[0] && $vals[0] =~ /^ - (AND|OR) $/ix) { $logic = uc $1; shift @vals; } @@ -1027,7 +1036,7 @@ and (!$logic or $logic eq 'OR') and - ( $op =~ $self->{inequality_op} or $op =~ $self->{not_like_op} ) + ($op =~ $self->{inequality_op} or $op =~ $self->{not_like_op}) ) { my $o = uc($op); belch "A multi-element arrayref as an argument to the inequality op '$o' " @@ -1077,7 +1086,7 @@ $self->_sqlcase($self->{cmp}), $self->_convert('?'); my @bind = $self->_bindtype($k, $v); - return ( $sql, @bind); + return ($sql, @bind); } @@ -1161,9 +1170,9 @@ }, HASHREF => sub { my ($func, $arg, @rest) = %$val; - puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN") + puke "Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN" if (@rest or $func !~ /^ \- (.+)/x); - $self->_where_unary_op ($1 => $arg); + $self->_where_unary_op($1 => $arg); }, FALLBACK => sub { puke $invalid_args, @@ -1218,9 +1227,9 @@ }, HASHREF => sub { my ($func, $arg, @rest) = %$val; - puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN") + puke "Only simple { -func => arg } functions accepted as sub-arguments to IN" if (@rest or $func !~ /^ \- (.+)/x); - $self->_where_unary_op ($1 => $arg); + $self->_where_unary_op($1 => $arg); }, UNDEF => sub { puke( @@ -1236,10 +1245,10 @@ } return ( - sprintf ('%s %s ( %s )', + sprintf('%s %s ( %s )', $label, $op, - join (', ', @all_sql) + join(', ', @all_sql) ), $self->_bindtype($k, @all_bind), ); @@ -1251,13 +1260,13 @@ }, SCALARREF => sub { # literal SQL - my $sql = $self->_open_outer_paren ($$vals); + my $sql = $self->_open_outer_paren($$vals); return ("$label $op ( $sql )"); }, ARRAYREFREF => sub { # literal SQL with bind my ($sql, @bind) = @$$vals; $self->_assert_bindval_matches_bindtype(@bind); - $sql = $self->_open_outer_paren ($sql); + $sql = $self->_open_outer_paren($sql); return ("$label $op ( $sql )", @bind); }, @@ -1279,17 +1288,17 @@ sub _open_outer_paren { my ($self, $sql) = @_; - while ( my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs ) { + while (my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs) { # there are closing parens inside, need the heavy duty machinery # to reevaluate the extraction starting from $sql (full reevaluation) - if ( $inner =~ /\)/ ) { + if ($inner =~ /\)/) { require Text::Balanced; my (undef, $remainder) = do { # idiotic design - writes to $@ but *DOES NOT* throw exceptions local $@; - Text::Balanced::extract_bracketed( $sql, '()', qr/\s*/ ); + Text::Balanced::extract_bracketed($sql, '()', qr/\s*/); }; # the entire expression needs to be a balanced bracketed thing @@ -1312,17 +1321,17 @@ my ($self, $arg) = @_; my (@sql, @bind); - for my $c ($self->_order_by_chunks ($arg) ) { - $self->_SWITCH_refkind ($c, { + for my $c ($self->_order_by_chunks($arg) ) { + $self->_SWITCH_refkind($c, { SCALAR => sub { push @sql, $c }, ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c }, }); } my $sql = @sql - ? sprintf ('%s %s', + ? sprintf('%s %s', $self->_sqlcase(' order by'), - join (', ', @sql) + join(', ', @sql) ) : '' ; @@ -1336,7 +1345,7 @@ return $self->_SWITCH_refkind($arg, { ARRAYREF => sub { - map { $self->_order_by_chunks ($_ ) } @$arg; + map { $self->_order_by_chunks($_ ) } @$arg; }, ARRAYREFREF => sub { @@ -1357,17 +1366,17 @@ return () unless $key; - if ( @rest or not $key =~ /^-(desc|asc)/i ) { + if (@rest or not $key =~ /^-(desc|asc)/i) { puke "hash passed to _order_by must have exactly one key (-desc or -asc)"; } my $direction = $1; my @ret; - for my $c ($self->_order_by_chunks ($val)) { + for my $c ($self->_order_by_chunks($val)) { my ($sql, @bind); - $self->_SWITCH_refkind ($c, { + $self->_SWITCH_refkind($c, { SCALAR => sub { $sql = $c; }, @@ -1425,7 +1434,7 @@ my $esc = $_[0]->{escape_char} || $r; # parts containing * are naturally unquoted - return join( $_[0]->{name_sep}||'', map + return join($_[0]->{name_sep}||'', map +( $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } ), ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] ) ); @@ -1568,7 +1577,7 @@ unless ref $data eq 'HASH'; my @all_bind; - foreach my $k ( sort keys %$data ) { + foreach my $k (sort keys %$data) { my $v = $data->{$k}; $self->_SWITCH_refkind($v, { ARRAYREF => sub { @@ -2017,7 +2026,7 @@ character itself. When opening-closing-style quoting is used (L</quote_char> is an arrayref) -this parameter defaults to the B<closing (right)> L</quote_char>. Occurences +this parameter defaults to the B<closing (right)> L</quote_char>. Occurrences of the B<opening (left)> L</quote_char> within the identifier are currently left untouched. The default for opening-closing-style quotes may change in future versions, thus you are B<strongly encouraged> to specify the escape character @@ -2250,7 +2259,7 @@ =back -On failure returns C<undef>, on sucess returns a B<scalar> reference +On failure returns C<undef>, on success returns a B<scalar> reference to the original supplied argument. =over @@ -2308,7 +2317,7 @@ =back -On failure returns C<undef>, on sucess returns an B<array> reference +On failure returns C<undef>, on success returns an B<array> reference containing the unpacked version of the supplied literal SQL and bind values. =head1 WHERE CLAUSES @@ -3013,7 +3022,7 @@ When supplied with a method name, it is simply called on the L<SQL::Abstract> object as: - $self->$method_name ($field, $op, $arg) + $self->$method_name($field, $op, $arg) Where: @@ -3089,7 +3098,7 @@ When supplied with a method name, it is simply called on the L<SQL::Abstract> object as: - $self->$method_name ($op, $arg) + $self->$method_name($op, $arg) Where: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/t/01generate.t new/SQL-Abstract-1.85/t/01generate.t --- old/SQL-Abstract-1.84/t/01generate.t 2017-03-21 12:06:56.000000000 +0100 +++ new/SQL-Abstract-1.85/t/01generate.t 2017-04-14 15:36:07.000000000 +0200 @@ -4,7 +4,7 @@ use Test::Warn; use Test::Exception; -use SQL::Abstract::Test import => [qw( is_same_sql_bind diag_where dumper )]; +use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where dumper)]; use SQL::Abstract; @@ -619,7 +619,7 @@ ); # check is( not) => undef -for my $op ( qw(not is is_not), 'is not' ) { +for my $op (qw(not is is_not), 'is not') { (my $sop = uc $op) =~ s/_/ /gi; $sop = 'IS NOT' if $sop eq 'NOT'; @@ -638,7 +638,7 @@ } # check single-element inequality ops for no warnings -for my $op ( qw(!= <>) ) { +for my $op (qw(!= <>)) { for my $val (undef, 42) { push @tests, { func => 'where', @@ -674,7 +674,7 @@ } # check all multi-element inequality/not-like ops for warnings -for my $op ( qw(!= <> not_like not_rlike), 'not like', 'not rlike', 'is not like','is not rlike') { +for my $op (qw(!= <> not_like not_rlike), 'not like', 'not rlike', 'is not like','is not rlike') { (my $sop = uc $op) =~ s/_/ /gi; push @tests, { @@ -688,7 +688,7 @@ } # check all like/not-like ops for empty-arrayref warnings -for my $op ( qw(like rlike not_like not_rlike), 'not like', 'not rlike', 'is like', 'is not like', 'is rlike', 'is not rlike') { +for my $op (qw(like rlike not_like not_rlike), 'not like', 'not rlike', 'is like', 'is not like', 'is rlike', 'is not rlike') { (my $sop = uc $op) =~ s/_/ /gi; push @tests, { @@ -840,20 +840,20 @@ my $cref = sub { my $op = $t->{func}; - ($stmt, @bind) = $maker->$op (@ { $t->{args} } ); + ($stmt, @bind) = $maker->$op(@{ $t->{args} }); }; if (my $e = $t->{throws}) { throws_ok( sub { $cref->() }, $e, - ) || diag dumper ({ args => $t->{args}, result => $stmt }); + ) || diag dumper({ args => $t->{args}, result => $stmt }); } else { warnings_like( sub { $cref->() }, $t->{warns} || [], - ) || diag dumper ({ args => $t->{args}, result => $stmt }); + ) || diag dumper({ args => $t->{args}, result => $stmt }); is_same_sql_bind( $stmt, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/t/03values.t new/SQL-Abstract-1.85/t/03values.t --- old/SQL-Abstract-1.84/t/03values.t 2014-01-17 11:48:19.000000000 +0100 +++ new/SQL-Abstract-1.85/t/03values.t 2017-04-14 15:36:07.000000000 +0200 @@ -74,7 +74,7 @@ is ( $h_stmt, $insert_hash, 'Hash-based insert statement unchanged' ); is_deeply ( \@a_bind, \@h_bind, 'Bind values match after both insert() calls' ); - is_deeply ( [$h_sql->values ($record)] , \@h_bind, 'values() output matches bind values after insert()' ); + is_deeply ( [$h_sql->values($record)] , \@h_bind, 'values() output matches bind values after insert()' ); is ( scalar @h_bind, $numfields, 'Number of fields unchanged' ); } @@ -99,7 +99,7 @@ zzlast => 'zzstuff', }; - my ($stmt, @bind) = $sql->insert ('table', $data); + my ($stmt, @bind) = $sql->insert('table', $data); is_same_sql_bind ( $stmt, @@ -109,7 +109,7 @@ ); is_same_bind ( - [$sql->values ($data)], + [$sql->values($data)], [@bind], 'values() output matches that of initial bind' ) || diag "Corresponding SQL statement: $stmt"; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/t/04modifiers.t new/SQL-Abstract-1.85/t/04modifiers.t --- old/SQL-Abstract-1.84/t/04modifiers.t 2014-07-16 13:57:52.000000000 +0200 +++ new/SQL-Abstract-1.85/t/04modifiers.t 2017-04-14 15:36:07.000000000 +0200 @@ -382,7 +382,7 @@ TODO: { local $TODO = $case->{todo} if $case->{todo}; - my $sql = SQL::Abstract->new ($case->{args} || {}); + my $sql = SQL::Abstract->new($case->{args} || {}); my $where_copy = dclone($case->{where}); @@ -406,7 +406,7 @@ local $SQL::Abstract::Test::parenthesis_significant = 1; - my $sql = SQL::Abstract->new ($case->{args} || {}); + my $sql = SQL::Abstract->new($case->{args} || {}); lives_ok (sub { my ($stmt, @bind) = $sql->where($case->{where}); is_same_sql_bind( @@ -427,7 +427,7 @@ my @w; local $SIG{__WARN__} = sub { push @w, @_ }; - my $sql = SQL::Abstract->new ($case->{args} || {}); + my $sql = SQL::Abstract->new($case->{args} || {}); { my ($old_s, @old_b) = $sql->where($case->{backcompat}); my ($new_s, @new_b) = $sql->where($case->{correct}); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/t/05in_between.t new/SQL-Abstract-1.85/t/05in_between.t --- old/SQL-Abstract-1.84/t/05in_between.t 2015-01-06 16:05:57.000000000 +0100 +++ new/SQL-Abstract-1.85/t/05in_between.t 2017-04-14 15:36:07.000000000 +0200 @@ -296,7 +296,7 @@ local $SQL::Abstract::Test::parenthesis_significant = $case->{parenthesis_significant}; my $label = $case->{test} || 'in-between test'; - my $sql = SQL::Abstract->new ($case->{args} || {}); + my $sql = SQL::Abstract->new($case->{args} || {}); if (my $e = $case->{throws}) { my $stmt; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/t/06order_by.t new/SQL-Abstract-1.85/t/06order_by.t --- old/SQL-Abstract-1.84/t/06order_by.t 2016-05-06 17:16:42.000000000 +0200 +++ new/SQL-Abstract-1.85/t/06order_by.t 2017-04-14 15:36:07.000000000 +0200 @@ -107,7 +107,7 @@ my $sql = SQL::Abstract->new; my $sqlq = SQL::Abstract->new({quote_char => '`'}); -for my $case( @cases) { +for my $case (@cases) { my ($stat, @bind); ($stat, @bind) = $sql->where(undef, $case->{given}); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/t/10test.t new/SQL-Abstract-1.85/t/10test.t --- old/SQL-Abstract-1.84/t/10test.t 2014-05-29 11:32:03.000000000 +0200 +++ new/SQL-Abstract-1.85/t/10test.t 2017-04-14 15:36:07.000000000 +0200 @@ -972,7 +972,7 @@ }, ); -for my $test ( @sql_tests ) { +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}} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/t/21op_ident.t new/SQL-Abstract-1.85/t/21op_ident.t --- old/SQL-Abstract-1.84/t/21op_ident.t 2014-09-15 18:01:21.000000000 +0200 +++ new/SQL-Abstract-1.85/t/21op_ident.t 2017-04-14 15:36:07.000000000 +0200 @@ -17,7 +17,7 @@ $sql_maker->where({ foo => { -ident => undef } }) } qr/-ident requires a single plain scalar argument/; - my ($sql, @bind) = $sql_maker->select ('artist', '*', { 'artist.name' => { -ident => 'artist.pseudonym' } } ); + my ($sql, @bind) = $sql_maker->select('artist', '*', { 'artist.name' => { -ident => 'artist.pseudonym' } } ); is_same_sql_bind ( $sql, \@bind, @@ -28,7 +28,7 @@ [], ); - ($sql, @bind) = $sql_maker->update ('artist', + ($sql, @bind) = $sql_maker->update('artist', { 'artist.name' => { -ident => 'artist.pseudonym' } }, { 'artist.name' => { '!=' => { -ident => 'artist.pseudonym' } } }, ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/t/22op_value.t new/SQL-Abstract-1.85/t/22op_value.t --- old/SQL-Abstract-1.84/t/22op_value.t 2014-07-17 13:44:20.000000000 +0200 +++ new/SQL-Abstract-1.85/t/22op_value.t 2017-04-14 15:36:07.000000000 +0200 @@ -14,7 +14,7 @@ $col_btype ? (bindtype => 'columns') : (), ); - my ($sql, @bind) = $sql_maker->select ('artist', '*', { arr1 => { -value => [1,2] }, arr2 => { '>', { -value => [3,4] } }, field => [5,6] } ); + my ($sql, @bind) = $sql_maker->select('artist', '*', { arr1 => { -value => [1,2] }, arr2 => { '>', { -value => [3,4] } }, field => [5,6] } ); is_same_sql_bind ( $sql, @@ -44,7 +44,7 @@ { local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /Supplying an undefined argument to '(?:NOT )?LIKE'/ }; - ($sql, @bind) = $sql_maker->where ({ + ($sql, @bind) = $sql_maker->where({ c1 => undef, c2 => { -value => undef }, c3 => { '=' => { -value => undef } }, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/xt/90pod.t new/SQL-Abstract-1.85/xt/90pod.t --- old/SQL-Abstract-1.84/xt/90pod.t 2014-01-17 11:48:19.000000000 +0100 +++ new/SQL-Abstract-1.85/xt/90pod.t 2017-04-14 15:36:07.000000000 +0200 @@ -2,8 +2,6 @@ use strict; use Test::More; - -eval "use Test::Pod 1.14"; -plan skip_all => 'Test::Pod 1.14 required' if $@; +use Test::Pod 1.14; all_pod_files_ok(); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/xt/91podcoverage.t new/SQL-Abstract-1.85/xt/91podcoverage.t --- old/SQL-Abstract-1.84/xt/91podcoverage.t 2014-09-22 18:49:45.000000000 +0200 +++ new/SQL-Abstract-1.85/xt/91podcoverage.t 2017-04-14 15:36:07.000000000 +0200 @@ -3,13 +3,8 @@ use Test::More; -eval "use Pod::Coverage 0.19"; -plan skip_all => 'Pod::Coverage 0.19 required' if $@; -eval "use Test::Pod::Coverage 1.04"; -plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@; - -plan skip_all => 'set TEST_POD to enable this test' - unless ( $ENV{TEST_POD} || -e 'MANIFEST.SKIP' ); +use Pod::Coverage 0.19; +use Test::Pod::Coverage 1.04; my @modules = sort { $a cmp $b } ( Test::Pod::Coverage::all_modules() ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.84/xt/92whitespace.t new/SQL-Abstract-1.85/xt/92whitespace.t --- old/SQL-Abstract-1.84/xt/92whitespace.t 2014-07-16 13:57:52.000000000 +0200 +++ new/SQL-Abstract-1.85/xt/92whitespace.t 2017-04-14 15:36:07.000000000 +0200 @@ -3,12 +3,9 @@ use Test::More; use File::Glob 'bsd_glob'; -use lib 't/lib'; -eval "use Test::EOL 1.0 ()"; -plan skip_all => 'Test::EOL 1.0 required' if $@; -eval "use Test::NoTabs 0.9 ()"; -plan skip_all => 'Test::NoTabs 0.9 required' if $@; +use Test::EOL 1.0 (); +use Test::NoTabs 0.9 (); # FIXME - temporary workaround for RT#82032, RT#82033 # also add all scripts (no extension) and some extra extensions
