Hello community, here is the log from the commit of package perl-SQL-Abstract for openSUSE:Factory checked in at 2017-03-24 02:23:27 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 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 Mar 24 02:23:27 2017 rev:11 rq:482158 version:1.82 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-SQL-Abstract/perl-SQL-Abstract.changes 2014-11-13 09:18:16.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.perl-SQL-Abstract.new/perl-SQL-Abstract.changes 2017-03-24 02:23:27.436760214 +0100 @@ -1,0 +2,19 @@ +Tue Mar 21 07:45:31 UTC 2017 - [email protected] + +- updated to 1.82 + see /usr/share/doc/packages/perl-SQL-Abstract/Changes + + revision 1.82 2017-03-20 + ------------------------- + - Add explicit dependency on Sub::Quote (GH#8) + - Fix syntax errors in ORDER BY docs (GH#7) + + revision 1.81_01 2017-02-28 + ---------------------------- + - Fix order clauses with bind parameters in ->where + - Fix ->insert($table, \@values) with >26 values (RT#112684) + - Teach ::Tree that ILIKE (PostgreSQL) and REGEXP (MySQL) are binary ops + - Support for UPDATE ... RETURNING + - Documentation improvements for ORDER BY + +------------------------------------------------------------------- Old: ---- SQL-Abstract-1.81.tar.gz New: ---- SQL-Abstract-1.82.tar.gz cpanspec.yml ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-SQL-Abstract.spec ++++++ --- /var/tmp/diff_new_pack.GDMKX7/_old 2017-03-24 02:23:27.972684384 +0100 +++ /var/tmp/diff_new_pack.GDMKX7/_new 2017-03-24 02:23:27.976683818 +0100 @@ -1,7 +1,7 @@ # # spec file for package perl-SQL-Abstract # -# Copyright (c) 2014 SUSE LINUX Products GmbH, Nuernberg, Germany. +# Copyright (c) 2017 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,45 +17,47 @@ Name: perl-SQL-Abstract -Version: 1.81 +Version: 1.82 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/R/RI/RIBASUSHI/%{cpan_name}-%{version}.tar.gz +Source0: https://cpan.metacpan.org/authors/id/I/IL/ILMARI/%{cpan_name}-%{version}.tar.gz +Source1: cpanspec.yml BuildArch: noarch BuildRoot: %{_tmppath}/%{name}-%{version}-build BuildRequires: perl BuildRequires: perl-macros BuildRequires: perl(Hash::Merge) >= 0.12 BuildRequires: perl(MRO::Compat) >= 0.12 -BuildRequires: perl(Moo) >= 1.004002 +BuildRequires: perl(Moo) >= 2.000001 +BuildRequires: perl(Sub::Quote) >= 2.000001 BuildRequires: perl(Test::Deep) >= 0.101 -BuildRequires: perl(Test::Exception) >= 0.31 +BuildRequires: perl(Test::Exception) >= 0.310000 BuildRequires: perl(Test::More) >= 0.88 BuildRequires: perl(Test::Warn) BuildRequires: perl(Text::Balanced) >= 2.00 Requires: perl(Hash::Merge) >= 0.12 Requires: perl(MRO::Compat) >= 0.12 -Requires: perl(Moo) >= 1.004002 +Requires: perl(Moo) >= 2.000001 +Requires: perl(Sub::Quote) >= 2.000001 Requires: perl(Text::Balanced) >= 2.00 %{perl_requires} %description -This module was inspired by the excellent the DBIx::Abstract manpage. -However, in using that module I found that what I really wanted to do was -generate SQL, but still retain complete control over my statement handles -and use the DBI interface. So, I set out to create an abstract SQL -generation module. - -While based on the concepts used by the DBIx::Abstract manpage, there are -several important differences, especially when it comes to WHERE clauses. I -have modified the concepts used to make the SQL easier to generate from -Perl data structures and, IMO, more intuitive. The underlying idea is for -this module to do what you mean, based on the data structures you provide -it. The big advantage is that you don't have to modify your code every time +This module was inspired by the excellent DBIx::Abstract. However, in using +that module I found that what I really wanted to do was generate SQL, but +still retain complete control over my statement handles and use the DBI +interface. So, I set out to create an abstract SQL generation module. + +While based on the concepts used by DBIx::Abstract, there are several +important differences, especially when it comes to WHERE clauses. I have +modified the concepts used to make the SQL easier to generate from Perl +data structures and, IMO, more intuitive. The underlying idea is for this +module to do what you mean, based on the data structures you provide it. +The big advantage is that you don't have to modify your code every time your data changes, as this module figures it out. To begin with, an SQL INSERT is as easy as just specifying a hash of @@ -88,7 +90,7 @@ %prep %setup -q -n %{cpan_name}-%{version} -find . -type f -print0 | xargs -0 chmod 644 +find . -type f ! -name \*.pl -print0 | xargs -0 chmod 644 %build %{__perl} Makefile.PL INSTALLDIRS=vendor ++++++ SQL-Abstract-1.81.tar.gz -> SQL-Abstract-1.82.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/Changes new/SQL-Abstract-1.82/Changes --- old/SQL-Abstract-1.81/Changes 2014-10-25 13:30:00.000000000 +0200 +++ new/SQL-Abstract-1.82/Changes 2017-03-20 18:54:36.000000000 +0100 @@ -1,5 +1,18 @@ Revision history for SQL::Abstract +revision 1.82 2017-03-20 +------------------------- + - Add explicit dependency on Sub::Quote (GH#8) + - Fix syntax errors in ORDER BY docs (GH#7) + +revision 1.81_01 2017-02-28 +---------------------------- + - Fix order clauses with bind parameters in ->where + - Fix ->insert($table, \@values) with >26 values (RT#112684) + - Teach ::Tree that ILIKE (PostgreSQL) and REGEXP (MySQL) are binary ops + - Support for UPDATE ... RETURNING + - Documentation improvements for ORDER BY + revision 1.81 2014-10-25 ---------------------------- - Fix overly-enthusiastic parenthesis unroller (RT#99503) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/META.yml new/SQL-Abstract-1.82/META.yml --- old/SQL-Abstract-1.81/META.yml 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/META.yml 2017-03-20 18:56:33.000000000 +0100 @@ -5,15 +5,15 @@ build_requires: ExtUtils::MakeMaker: 6.59 Storable: 0 - Test::Deep: 0.101 - Test::Exception: 0.31 - Test::More: 0.88 + Test::Deep: '0.101' + Test::Exception: '0.31' + Test::More: '0.88' Test::Warn: 0 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 0 -generated_by: 'Module::Install version 1.06' +generated_by: 'Module::Install version 1.17' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -28,17 +28,18 @@ package: - DBIx::Class::Storage::Debug::PrettyPrint requires: - Exporter: 5.57 - Hash::Merge: 0.12 + Exporter: '5.57' + Hash::Merge: '0.12' List::Util: 0 - MRO::Compat: 0.12 - Moo: 1.004002 + MRO::Compat: '0.12' + Moo: '2.000001' Scalar::Util: 0 - Text::Balanced: 2.00 + Sub::Quote: '2.000001' + Text::Balanced: '2.00' perl: 5.6.0 resources: IRC: irc://irc.perl.org/#dbix-class bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Abstract license: http://dev.perl.org/licenses/ repository: https://github.com/dbsrgits/sql-abstract/ -version: 1.81 +version: '1.82' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/Makefile.PL new/SQL-Abstract-1.82/Makefile.PL --- old/SQL-Abstract-1.81/Makefile.PL 2014-10-25 12:45:09.000000000 +0200 +++ new/SQL-Abstract-1.82/Makefile.PL 2017-03-01 13:18:00.000000000 +0100 @@ -20,7 +20,8 @@ requires 'Scalar::Util' => '0'; requires 'Exporter' => '5.57'; requires 'MRO::Compat' => '0.12'; -requires 'Moo' => '1.004002'; +requires 'Moo' => '2.000001'; +requires 'Sub::Quote' => '2.000001'; requires 'Hash::Merge' => '0.12'; requires 'Text::Balanced' => '2.00'; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/inc/Module/AutoInstall.pm new/SQL-Abstract-1.82/inc/Module/AutoInstall.pm --- old/SQL-Abstract-1.81/inc/Module/AutoInstall.pm 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/inc/Module/AutoInstall.pm 2017-03-20 18:56:33.000000000 +0100 @@ -8,7 +8,7 @@ use vars qw{$VERSION}; BEGIN { - $VERSION = '1.06'; + $VERSION = '1.17'; } # special map on pre-defined feature sets @@ -115,7 +115,7 @@ print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; - my $cwd = Cwd::cwd(); + my $cwd = Cwd::getcwd(); $Config = []; @@ -166,7 +166,7 @@ $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } - if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability + if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward compatibility while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { @@ -345,22 +345,26 @@ my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); - my ( @modules, @installed ); - while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { + my ( @modules, @installed, @modules_to_upgrade ); + while (my ($pkg, $ver) = splice(@_, 0, 2)) { - # grep out those already installed - if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { - push @installed, $pkg; - } - else { - push @modules, $pkg, $ver; - } - } + # grep out those already installed + if (_version_cmp(_version_of($pkg), $ver) >= 0) { + push @installed, $pkg; + if ($UpgradeDeps) { + push @modules_to_upgrade, $pkg, $ver; + } + } + else { + push @modules, $pkg, $ver; + } + } - if ($UpgradeDeps) { - push @modules, @installed; - @installed = (); - } + if ($UpgradeDeps) { + push @modules, @modules_to_upgrade; + @installed = (); + @modules_to_upgrade = (); + } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell @@ -533,7 +537,7 @@ while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^(?:force|notest)$/; # pseudo-option - $CPAN::Config->{$opt} = $arg; + $CPAN::Config->{$opt} = $opt eq 'urllist' ? [$arg] : $arg; } if ($args{notest} && (not CPAN::Shell->can('notest'))) { @@ -611,7 +615,7 @@ require Cwd; require File::Spec; - my $cwd = File::Spec->canonpath( Cwd::cwd() ); + my $cwd = File::Spec->canonpath( Cwd::getcwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); @@ -927,4 +931,4 @@ __END__ -#line 1193 +#line 1197 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/inc/Module/Install/AutoInstall.pm new/SQL-Abstract-1.82/inc/Module/Install/AutoInstall.pm --- old/SQL-Abstract-1.81/inc/Module/Install/AutoInstall.pm 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/inc/Module/Install/AutoInstall.pm 2017-03-20 18:56:33.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.06'; + $VERSION = '1.17'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/inc/Module/Install/Base.pm new/SQL-Abstract-1.82/inc/Module/Install/Base.pm --- old/SQL-Abstract-1.81/inc/Module/Install/Base.pm 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/inc/Module/Install/Base.pm 2017-03-20 18:56:33.000000000 +0100 @@ -4,7 +4,7 @@ use strict 'vars'; use vars qw{$VERSION}; BEGIN { - $VERSION = '1.06'; + $VERSION = '1.17'; } # Suspend handler for "redefined" warnings diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/inc/Module/Install/Can.pm new/SQL-Abstract-1.82/inc/Module/Install/Can.pm --- old/SQL-Abstract-1.81/inc/Module/Install/Can.pm 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/inc/Module/Install/Can.pm 2017-03-20 18:56:33.000000000 +0100 @@ -8,7 +8,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.06'; + $VERSION = '1.17'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } @@ -121,6 +121,15 @@ # Can we locate a (the) C compiler sub can_cc { my $self = shift; + + if ($^O eq 'VMS') { + require ExtUtils::CBuilder; + my $builder = ExtUtils::CBuilder->new( + quiet => 1, + ); + return $builder->have_compiler; + } + my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part @@ -151,4 +160,4 @@ __END__ -#line 236 +#line 245 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/inc/Module/Install/Fetch.pm new/SQL-Abstract-1.82/inc/Module/Install/Fetch.pm --- old/SQL-Abstract-1.81/inc/Module/Install/Fetch.pm 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/inc/Module/Install/Fetch.pm 2017-03-20 18:56:33.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.06'; + $VERSION = '1.17'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/inc/Module/Install/Include.pm new/SQL-Abstract-1.82/inc/Module/Install/Include.pm --- old/SQL-Abstract-1.81/inc/Module/Install/Include.pm 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/inc/Module/Install/Include.pm 2017-03-20 18:56:33.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.06'; + $VERSION = '1.17'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/inc/Module/Install/Makefile.pm new/SQL-Abstract-1.82/inc/Module/Install/Makefile.pm --- old/SQL-Abstract-1.81/inc/Module/Install/Makefile.pm 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/inc/Module/Install/Makefile.pm 2017-03-20 18:56:33.000000000 +0100 @@ -8,7 +8,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.06'; + $VERSION = '1.17'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } @@ -133,7 +133,7 @@ return $args; } -# For mm args that take multiple space-seperated args, +# For mm args that take multiple space-separated args, # append an argument to the current list. sub makemaker_append { my $self = shift; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/inc/Module/Install/Metadata.pm new/SQL-Abstract-1.82/inc/Module/Install/Metadata.pm --- old/SQL-Abstract-1.81/inc/Module/Install/Metadata.pm 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/inc/Module/Install/Metadata.pm 2017-03-20 18:56:33.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.06'; + $VERSION = '1.17'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } @@ -347,7 +347,7 @@ ^ \s* package \s* ([\w:]+) - \s* ; + [\s|;]* /ixms ) { my ($name, $module_name) = ($1, $1); @@ -705,7 +705,7 @@ my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; - # Overwrite the non-configure dependency hashs + # Overwrite the non-configure dependency hashes delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/inc/Module/Install/Win32.pm new/SQL-Abstract-1.82/inc/Module/Install/Win32.pm --- old/SQL-Abstract-1.81/inc/Module/Install/Win32.pm 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/inc/Module/Install/Win32.pm 2017-03-20 18:56:33.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.06'; + $VERSION = '1.17'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/inc/Module/Install/WriteAll.pm new/SQL-Abstract-1.82/inc/Module/Install/WriteAll.pm --- old/SQL-Abstract-1.81/inc/Module/Install/WriteAll.pm 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/inc/Module/Install/WriteAll.pm 2017-03-20 18:56:33.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.06'; + $VERSION = '1.17'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/inc/Module/Install.pm new/SQL-Abstract-1.82/inc/Module/Install.pm --- old/SQL-Abstract-1.81/inc/Module/Install.pm 2014-10-25 13:30:57.000000000 +0200 +++ new/SQL-Abstract-1.82/inc/Module/Install.pm 2017-03-20 18:56:33.000000000 +0100 @@ -17,7 +17,7 @@ # 3. The ./inc/ version of Module::Install loads # } -use 5.005; +use 5.006; use strict 'vars'; use Cwd (); use File::Find (); @@ -31,7 +31,7 @@ # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. - $VERSION = '1.06'; + $VERSION = '1.17'; # Storage for the pseudo-singleton $MAIN = undef; @@ -156,10 +156,10 @@ sub autoload { my $self = shift; my $who = $self->_caller; - my $cwd = Cwd::cwd(); + my $cwd = Cwd::getcwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { - my $pwd = Cwd::cwd(); + my $pwd = Cwd::getcwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; @@ -239,11 +239,13 @@ # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); - unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { + unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; + $base_path = VMS::Filespec::unixify($base_path) if $^O eq 'VMS'; + $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); @@ -322,7 +324,7 @@ my ($self, $path) = @_; my @found; - File::Find::find( sub { + File::Find::find( {no_chdir => 1, wanted => sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; @@ -336,9 +338,9 @@ # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { - my $content = Module::Install::_read($subpath . '.pm'); + my $content = Module::Install::_read($File::Find::name); my $in_pod = 0; - foreach ( split //, $content ) { + foreach ( split /\n/, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text @@ -351,7 +353,7 @@ } push @found, [ $file, $pkg ]; - }, $path ) if -d $path; + }}, $path ) if -d $path; @found; } @@ -373,24 +375,14 @@ return $call; } -# Done in evals to avoid confusing Perl::MinimumVersion -eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; + binmode FH; my $string = do { local $/; <FH> }; close FH or die "close($_[0]): $!"; return $string; } -END_NEW -sub _read { - local *FH; - open( FH, "< $_[0]" ) or die "open($_[0]): $!"; - my $string = do { local $/; <FH> }; - close FH or die "close($_[0]): $!"; - return $string; -} -END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); @@ -411,30 +403,19 @@ return $string; } -# Done in evals to avoid confusing Perl::MinimumVersion -eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; + binmode FH; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } -END_NEW -sub _write { - local *FH; - open( FH, "> $_[0]" ) or die "open($_[0]): $!"; - foreach ( 1 .. $#_ ) { - print FH $_[$_] or die "print($_[0]): $!"; - } - close FH or die "close($_[0]): $!"; -} -END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). -sub _version ($) { +sub _version { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { @@ -450,12 +431,12 @@ return $l + 0; } -sub _cmp ($$) { +sub _cmp { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS -sub _CLASS ($) { +sub _CLASS { ( defined $_[0] and diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/lib/SQL/Abstract/Tree.pm new/SQL-Abstract-1.82/lib/SQL/Abstract/Tree.pm --- old/SQL-Abstract-1.81/lib/SQL/Abstract/Tree.pm 2014-09-24 02:24:45.000000000 +0200 +++ new/SQL-Abstract-1.82/lib/SQL/Abstract/Tree.pm 2016-05-06 17:16:41.000000000 +0200 @@ -1,32 +1,10 @@ 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; - # load all of these now, so that lazy-loading does not escape - # the current PERL_STRICTURES_EXTRA setting - require Sub::Quote; - require Sub::Defer; - require Moo; - require Moo::Object; - require Method::Generate::Accessor; - require Method::Generate::Constructor; - - Moo->import; - Sub::Quote->import('quote_sub'); - ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} ); -} -# END pre-Moo2 import block - -use strict; -use warnings; +use Moo; no warnings 'qw'; use Carp; +use Sub::Quote 'quote_sub'; my $op_look_ahead = '(?: (?= [\s\)\(\;] ) | \z)'; my $op_look_behind = '(?: (?<= [\,\s\)\(] ) | \A )'; @@ -100,7 +78,7 @@ ); $alphanum_cmp_op_re = qr/$alphanum_cmp_op_re/x; -my $binary_op_re = '(?: NOT \s+)? (?:' . join ('|', qw/IN BETWEEN R?LIKE/) . ')'; +my $binary_op_re = '(?: NOT \s+)? (?:' . join ('|', qw/IN BETWEEN [RI]?LIKE REGEXP/) . ')'; $binary_op_re = join "\n\t|\n", "$op_look_behind (?i: $binary_op_re | AS ) $op_look_ahead", $alphanum_cmp_op_re, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/lib/SQL/Abstract.pm new/SQL-Abstract-1.82/lib/SQL/Abstract.pm --- old/SQL-Abstract-1.81/lib/SQL/Abstract.pm 2014-10-25 13:29:36.000000000 +0200 +++ new/SQL-Abstract-1.82/lib/SQL/Abstract.pm 2017-03-20 18:54:14.000000000 +0100 @@ -27,7 +27,7 @@ # GLOBALS #====================================================================== -our $VERSION = '1.81'; +our $VERSION = '1.82'; # This would confuse some packagers $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases @@ -227,7 +227,10 @@ return wantarray ? ($sql, @bind) : $sql; } -sub _insert_returning { +# Used by DBIx::Class::SQLMaker->insert +sub _insert_returning { shift->_returning(@_) } + +sub _returning { my ($self, $options) = @_; my $f = $options->{returning}; @@ -261,13 +264,14 @@ $self->{bindtype} ne 'columns' or belch "can't do 'columns' bindtype when called with arrayref"; - # fold the list of values into a hash of column name - value pairs - # (where the column names are artificially generated, and their - # lexicographical ordering keep the ordering of the original list) - my $i = "a"; # incremented values will be in lexicographical order - my $data_in_hash = { map { ($i++ => $_) } @$data }; - - return $self->_insert_values($data_in_hash); + my (@values, @all_bind); + foreach my $value (@$data) { + my ($values, @bind) = $self->_insert_value(undef, $value); + push @values, $values; + push @all_bind, @bind; + } + my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )"; + return ($sql, @all_bind); } sub _insert_ARRAYREFREF { # literal SQL with bind @@ -291,52 +295,60 @@ my (@values, @all_bind); foreach my $column (sort keys %$data) { - my $v = $data->{$column}; + my ($values, @bind) = $self->_insert_value($column, $data->{$column}); + push @values, $values; + push @all_bind, @bind; + } + my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )"; + return ($sql, @all_bind); +} - $self->_SWITCH_refkind($v, { +sub _insert_value { + my ($self, $column, $v) = @_; - ARRAYREF => sub { - if ($self->{array_datatypes}) { # if array datatype are activated - push @values, '?'; - push @all_bind, $self->_bindtype($column, $v); - } - else { # else literal SQL with bind - my ($sql, @bind) = @$v; - $self->_assert_bindval_matches_bindtype(@bind); - push @values, $sql; - push @all_bind, @bind; - } - }, + my (@values, @all_bind); + $self->_SWITCH_refkind($v, { - ARRAYREFREF => sub { # literal SQL with bind - my ($sql, @bind) = @${$v}; + ARRAYREF => sub { + if ($self->{array_datatypes}) { # if array datatype are activated + push @values, '?'; + push @all_bind, $self->_bindtype($column, $v); + } + else { # else literal SQL with bind + my ($sql, @bind) = @$v; $self->_assert_bindval_matches_bindtype(@bind); push @values, $sql; push @all_bind, @bind; - }, + } + }, - # THINK : anything useful to do with a HASHREF ? - HASHREF => sub { # (nothing, but old SQLA passed it through) - #TODO in SQLA >= 2.0 it will die instead - belch "HASH ref as bind value in insert is not supported"; - push @values, '?'; - push @all_bind, $self->_bindtype($column, $v); - }, + ARRAYREFREF => sub { # literal SQL with bind + my ($sql, @bind) = @${$v}; + $self->_assert_bindval_matches_bindtype(@bind); + push @values, $sql; + push @all_bind, @bind; + }, - SCALARREF => sub { # literal SQL without bind - push @values, $$v; - }, + # THINK : anything useful to do with a HASHREF ? + HASHREF => sub { # (nothing, but old SQLA passed it through) + #TODO in SQLA >= 2.0 it will die instead + belch "HASH ref as bind value in insert is not supported"; + push @values, '?'; + push @all_bind, $self->_bindtype($column, $v); + }, - SCALAR_or_UNDEF => sub { - push @values, '?'; - push @all_bind, $self->_bindtype($column, $v); - }, + SCALARREF => sub { # literal SQL without bind + push @values, $$v; + }, - }); + SCALAR_or_UNDEF => sub { + push @values, '?'; + push @all_bind, $self->_bindtype($column, $v); + }, - } + }); - my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )"; + my $sql = join(", ", @values); return ($sql, @all_bind); } @@ -348,10 +360,11 @@ sub update { - my $self = shift; - my $table = $self->_table(shift); - my $data = shift || return; - my $where = shift; + my $self = shift; + my $table = $self->_table(shift); + my $data = shift || return; + my $where = shift; + my $options = shift; # first build the 'SET' part of the sql statement my (@set, @all_bind); @@ -414,9 +427,16 @@ 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_returning { shift->_returning(@_) } @@ -477,7 +497,9 @@ # order by? if ($order) { - $sql .= $self->_order_by($order); + my ($order_sql, @order_bind) = $self->_order_by($order); + $sql .= $order_sql; + push @bind, @order_bind; } return wantarray ? ($sql, @bind) : $sql; @@ -1377,34 +1399,27 @@ return '' unless defined $_[1]; return ${$_[1]} if ref($_[1]) eq 'SCALAR'; - unless ($_[0]->{quote_char}) { - $_[0]->_assert_pass_injection_guard($_[1]); - return $_[1]; - } + $_[0]->{quote_char} or + ($_[0]->_assert_pass_injection_guard($_[1]), return $_[1]); my $qref = ref $_[0]->{quote_char}; - my ($l, $r); - if (!$qref) { - ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} ); - } - elsif ($qref eq 'ARRAY') { - ($l, $r) = @{$_[0]->{quote_char}}; - } - else { - puke "Unsupported quote_char format: $_[0]->{quote_char}"; - } + my ($l, $r) = + !$qref ? ($_[0]->{quote_char}, $_[0]->{quote_char}) + : ($qref eq 'ARRAY') ? @{$_[0]->{quote_char}} + : puke "Unsupported quote_char format: $_[0]->{quote_char}"; + my $esc = $_[0]->{escape_char} || $r; # parts containing * are naturally unquoted return join( $_[0]->{name_sep}||'', map - { $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } } + +( $_ 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] ) ); } # Conversion, if applicable -sub _convert ($) { +sub _convert { #my ($self, $arg) = @_; if ($_[0]->{convert}) { return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')'; @@ -1413,7 +1428,7 @@ } # And bindtype -sub _bindtype (@) { +sub _bindtype { #my ($self, $col, @vals) = @_; # called often - tighten code return $_[0]->{bindtype} eq 'columns' @@ -1662,7 +1677,7 @@ my $sql = SQL::Abstract->new; - my($stmt, @bind) = $sql->select($source, \@fields, \%where, \@order); + my($stmt, @bind) = $sql->select($source, \@fields, \%where, $order); my($stmt, @bind) = $sql->insert($table, \%fieldvals || \@values); @@ -1675,7 +1690,7 @@ $sth->execute(@bind); # Just generate the WHERE clause - my($stmt, @bind) = $sql->where(\%where, \@order); + my($stmt, @bind) = $sql->where(\%where, $order); # Return values in the same order, for hashed queries # See PERFORMANCE section for more details @@ -2070,7 +2085,7 @@ =back -=head2 update($table, \%fieldvals, \%where) +=head2 update($table, \%fieldvals, \%where, \%options) This takes a table, hashref of field/value pairs, and an optional hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL UPDATE function and a list @@ -2079,6 +2094,19 @@ L</"Inserting and Updating SQL"> for information on how to insert with those data types. +The optional C<\%options> hash reference may contain additional +options to generate the update SQL. Currently supported options +are: + +=over 4 + +=item returning + +See the C<returning> option to +L<insert|/insert($table, \@values || \%fieldvals, \%options)>. + +=back + =head2 select($source, $fields, $where, $order) This returns a SQL SELECT statement and associated list of bind values, as @@ -2127,7 +2155,7 @@ This takes a table name and optional hashref L<WHERE clause|/WHERE CLAUSES>. It returns an SQL DELETE statement and list of bind values. -=head2 where(\%where, \@order) +=head2 where(\%where, $order) This is used to generate just the WHERE clause. For example, if you have an arbitrary data structure and know what the @@ -2623,10 +2651,16 @@ historical reasons. So be careful : the two examples below would seem algebraically equivalent, but they are not - {col => [-and => {-like => 'foo%'}, {-like => '%bar'}]} + { col => [ -and => + { -like => 'foo%' }, + { -like => '%bar' }, + ] } # yields : WHERE ( ( col LIKE ? AND col LIKE ? ) ) - [-and => {col => {-like => 'foo%'}, {col => {-like => '%bar'}}]] + [ -and => + { col => { -like => 'foo%' } }, + { col => { -like => '%bar' } }, + ] # yields : WHERE ( ( col LIKE ? OR col LIKE ? ) ) @@ -2728,7 +2762,7 @@ @bind = ('10'); Note that you must pass the bind values in the same format as they are returned -by L<where|/where(\%where, \@order)>. This means that if you set L</bindtype> +by L<where|/where(\%where, $order)>. This means that if you set L</bindtype> to C<columns>, you must provide the bind values in the C<< [ column_meta => value ] >> format, where C<column_meta> is an opaque scalar value; most commonly the column name, but you can use any scalar value @@ -2870,32 +2904,38 @@ =head1 ORDER BY CLAUSES Some functions take an order by clause. This can either be a scalar (just a -column name,) a hash of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } >>, -or an array of either of the two previous forms. Examples: - - Given | Will Generate - ---------------------------------------------------------- - | - \'colA DESC' | ORDER BY colA DESC - | - 'colA' | ORDER BY colA - | - [qw/colA colB/] | ORDER BY colA, colB - | - {-asc => 'colA'} | ORDER BY colA ASC - | - {-desc => 'colB'} | ORDER BY colB DESC - | - ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC - | - { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC - | - [ | - { -asc => 'colA' }, | ORDER BY colA ASC, colB DESC, - { -desc => [qw/colB/], | colC ASC, colD ASC - { -asc => [qw/colC colD/],| - ] | - =========================================================== +column name), a hashref of C<< { -desc => 'col' } >> or C<< { -asc => 'col' } +>>, a scalarref, an arrayref-ref, or an arrayref of any of the previous +forms. Examples: + + Given | Will Generate + --------------------------------------------------------------- + | + 'colA' | ORDER BY colA + | + [qw/colA colB/] | ORDER BY colA, colB + | + {-asc => 'colA'} | ORDER BY colA ASC + | + {-desc => 'colB'} | ORDER BY colB DESC + | + ['colA', {-asc => 'colB'}] | ORDER BY colA, colB ASC + | + { -asc => [qw/colA colB/] } | ORDER BY colA ASC, colB ASC + | + \'colA DESC' | ORDER BY colA DESC + | + \[ 'FUNC(colA, ?)', $x ] | ORDER BY FUNC(colA, ?) + | /* ...with $x bound to ? */ + | + [ | ORDER BY + { -asc => 'colA' }, | colA ASC, + { -desc => [qw/colB/] }, | colB DESC, + { -asc => [qw/colC colD/] },| colC ASC, colD ASC, + \'colE DESC', | colE DESC, + \[ 'FUNC(colF, ?)', $x ], | FUNC(colF, ?) + ] | /* ...with $x bound to ? */ + =============================================================== diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/t/01generate.t new/SQL-Abstract-1.82/t/01generate.t --- old/SQL-Abstract-1.81/t/01generate.t 2014-09-25 13:43:08.000000000 +0200 +++ new/SQL-Abstract-1.82/t/01generate.t 2016-03-09 13:05:49.000000000 +0100 @@ -128,10 +128,10 @@ }, { func => 'insert', - args => ['test', [qw/1 2 3 4 5/]], - stmt => 'INSERT INTO test VALUES (?, ?, ?, ?, ?)', - stmt_q => 'INSERT INTO `test` VALUES (?, ?, ?, ?, ?)', - bind => [qw/1 2 3 4 5/], + args => ['test', [1..30]], + stmt => 'INSERT INTO test VALUES ('.join(', ', ('?')x30).')', + stmt_q => 'INSERT INTO `test` VALUES ('.join(', ', ('?')x30).')', + bind => [1..30], }, { func => 'insert', @@ -574,6 +574,27 @@ esc => '\\', bind => [], }, + { + func => 'update', + args => ['mytable', { foo => 42 }, { baz => 32 }, { returning => 'id' }], + stmt => 'UPDATE mytable SET foo = ? WHERE baz = ? RETURNING id', + stmt_q => 'UPDATE `mytable` SET `foo` = ? WHERE `baz` = ? RETURNING `id`', + bind => [42, 32], + }, + { + func => 'update', + args => ['mytable', { foo => 42 }, { baz => 32 }, { returning => \'*' }], + stmt => 'UPDATE mytable SET foo = ? WHERE baz = ? RETURNING *', + stmt_q => 'UPDATE `mytable` SET `foo` = ? WHERE `baz` = ? RETURNING *', + bind => [42, 32], + }, + { + func => 'update', + args => ['mytable', { foo => 42 }, { baz => 32 }, { returning => ['id','created_at'] }], + stmt => 'UPDATE mytable SET foo = ? WHERE baz = ? RETURNING id, created_at', + stmt_q => 'UPDATE `mytable` SET `foo` = ? WHERE `baz` = ? RETURNING `id`, `created_at`', + bind => [42, 32], + }, ); # check is( not) => undef diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/t/06order_by.t new/SQL-Abstract-1.82/t/06order_by.t --- old/SQL-Abstract-1.81/t/06order_by.t 2014-07-17 13:21:26.000000000 +0200 +++ new/SQL-Abstract-1.82/t/06order_by.t 2016-05-06 17:16:42.000000000 +0200 @@ -110,7 +110,7 @@ for my $case( @cases) { my ($stat, @bind); - ($stat, @bind) = $sql->_order_by($case->{given}); + ($stat, @bind) = $sql->where(undef, $case->{given}); is_same_sql_bind ( $stat, \@bind, @@ -118,7 +118,7 @@ $case->{bind} || [], ); - ($stat, @bind) = $sqlq->_order_by($case->{given}); + ($stat, @bind) = $sqlq->where(undef, $case->{given}); is_same_sql_bind ( $stat, \@bind, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/SQL-Abstract-1.81/t/14roundtrippin.t new/SQL-Abstract-1.82/t/14roundtrippin.t --- old/SQL-Abstract-1.81/t/14roundtrippin.t 2014-07-17 13:21:26.000000000 +0200 +++ new/SQL-Abstract-1.82/t/14roundtrippin.t 2016-03-09 13:05:49.000000000 +0100 @@ -30,6 +30,8 @@ "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", + 'SELECT ilike_any_or FROM bar WHERE ( baz ILIKE ANY(?) OR bat ILIKE ANY(?) )', + 'SELECT regexp_or FROM bar WHERE ( baz REGEXP ? OR bat REGEXP ? )', ); # FIXME FIXME FIXME ++++++ cpanspec.yml ++++++ --- #description_paragraphs: 3 #description: |- # override description from CPAN #summary: override summary from CPAN #no_testing: broken upstream #sources: # - source1 # - source2 #patches: # foo.patch: -p1 # bar.patch: #preamble: |- # BuildRequires: gcc-c++ #post_prep: |- # hunspell=`pkg-config --libs hunspell | sed -e 's,-l,,; s, *,,g'` # sed -i -e "s,hunspell-X,$hunspell," t/00-prereq.t Makefile.PL #post_build: |- # rm unused.files #post_install: |- # sed on %{name}.files #license: SUSE-NonFree #skip_noarch: 1 #custom_build: |- #./Build build flags=%{?_smp_mflags} --myflag #custom_test: |- #startserver && make test #ignore_requires: Bizarre::Module
