Merge pull request #1 from sixapart/master

sewi-cpan · web-flow · commit 90097e9d9da7 · 2019-05-24T13:32:09.000+02:00
Update to upstream
diff --git a/.gitignore b/.gitignore
@@ -16,3 +16,4 @@
 !LICENSE
 /cpanfile.snapshot
 /local
+/*.db
diff --git a/.travis.yml b/.travis.yml
@@ -6,6 +6,8 @@ perl:
   - "5.16"
   - "5.18"
   - "5.20"
+  - "5.22"
+  - "5.24"
 before_install:
   - cpanm -n DBD::SQLite Devel::Cover::Report::Coveralls
 script:
diff --git a/Changes b/Changes
@@ -1,5 +1,18 @@
 {{$NEXT}}
 
+0.17 2019-03-12T04:24:20Z
+
+    - Bump version
+
+0.16 2019-03-07T07:07:14Z
+
+    - Avoid SQL syntax error: column IN () (charsbar) #26
+    - Add disconnect method explicitly to pass tests for windows (twata1) #25
+
+0.15 2017-04-19T01:41:02Z
+
+    - Fix failed tests with Perl 5.25.11 (miniuchi) #24
+
 0.14 2016-01-14T03:03:02Z
 
     - Fix test for SQLite 3.10 compatibility (ziguzagu) #21
diff --git a/META.json b/META.json
@@ -4,13 +4,13 @@
       "-2006"
    ],
    "dynamic_config" : 0,
-   "generated_by" : "Minilla/v3.0.1, CPAN::Meta::Converter version 2.150001",
+   "generated_by" : "Minilla/v3.1.4, CPAN::Meta::Converter version 2.150010",
    "license" : [
       "artistic_2"
    ],
    "meta-spec" : {
       "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
-      "version" : "2"
+      "version" : 2
    },
    "name" : "Data-ObjectDriver",
    "no_index" : {
@@ -79,31 +79,37 @@
          "web" : "https://github.com/sixapart/data-objectdriver"
       }
    },
-   "version" : "0.14",
+   "version" : "0.17",
    "x_authority" : "cpan:SIXAPART",
    "x_contributors" : [
-      "Mart Atkins <matkins@sixapart.com>",
-      "Jonathan Steinert <jsteinert@sixapart.com>",
-      "Paul Lindner <paul@inuus.com>",
+      "Adam Thomason <athomason@sixapart.com>",
+      "Akira Sawada <akira@peatix.com>",
+      "Ben Trott <ben@sixapart.com>",
+      "Brad Choate <bchoate@sixapart.com>",
       "Brad Fitzpatrick <brad@danga.com>",
-      "Mischa <none@sixapart.com>",
+      "Brad Whitaker <whitaker@sixapart.com>",
+      "David Steinbrunner <dsteinbrunner@pobox.com>",
       "Garth Webb <gwebb@sixapart.com>",
       "Graham Blankenbaker <gblankenbaker@sixapart.com>",
-      "Brad Choate <bchoate@sixapart.com>",
+      "Jonathan Steinert <jsteinert@sixapart.com>",
+      "Kenichi Ishigaki <ishigaki@cpan.org>",
+      "Kevin Goess <kgoess@sixapart.com>",
       "Mark Paschal <mpaschal@sixapart.com>",
+      "Mart Atkins <matkins@sixapart.com>",
+      "Masahiro Iuchi <miuchi@sixapart.com>",
+      "Mischa <none@sixapart.com>",
+      "Paul Lindner <paul@inuus.com>",
       "Sekimura <sekimura@sixapart.com>",
       "Simon Wistow <swistow@sixapart.com>",
+      "Takatsugu Shigeta <shigeta@cpan.org>",
+      "Takatsugu Shigeta <tshigeta@sixapart.com>",
+      "Taku AMANO <taku@toi-planning.net>",
       "Tatsuhiko Miyagawa <miyagawa@sixapart.com>",
-      "Ben Trott <ben@sixapart.com>",
-      "Kevin Goess <kgoess@sixapart.com>",
-      "Adam Thomason <athomason@sixapart.com>",
-      "Brad Whitaker <whitaker@sixapart.com>",
+      "Tsuyoshi Watanabe <twata_1@yahoo.co.jp>",
       "Yann Kerherve <yann@cyberion.net>",
-      "Taku AMANO <taku@toi-planning.net>",
       "ambs <ambs@cpan.org>",
-      "David Steinbrunner <dsteinbrunner@pobox.com>",
-      "Akira Sawada <akira@peatix.com>",
-      "Masahiro Iuchi <miuchi@sixapart.com>",
       "ziguzagu <ziguzagu@gmail.com>"
-   ]
+   ],
+   "x_serialization_backend" : "JSON::PP version 2.97001",
+   "x_static_install" : 1
 }
diff --git a/lib/Data/ObjectDriver.pm b/lib/Data/ObjectDriver.pm
@@ -11,7 +11,7 @@ use Data::ObjectDriver::Iterator;
 
 __PACKAGE__->mk_accessors(qw( pk_generator txn_active ));
 
-our $VERSION = '0.14';
+our $VERSION = '0.17';
 our $DEBUG = $ENV{DOD_DEBUG} || 0;
 our $PROFILE = $ENV{DOD_PROFILE} || 0;
 our $PROFILER;
diff --git a/lib/Data/ObjectDriver/SQL.pm b/lib/Data/ObjectDriver/SQL.pm
@@ -247,25 +247,65 @@ sub _mk_term {
             $term = join " $logic ", @terms;
         } else {
             $col = $m->($col) if $m = $stmt->column_mutator;
-            $term = "$col IN (".join(',', ('?') x scalar @$val).')';
+            $term = $stmt->_mk_term_arrayref($col, 'IN', $val);
             @bind = @$val;
         }
     } elsif (ref($val) eq 'HASH') {
         my $c = $val->{column} || $col;
         $c = $m->($c) if $m = $stmt->column_mutator;
-        $term = "$c $val->{op} ?";
-        push @bind, $val->{value};
+        my $op = uc $val->{op};
+        if (($op eq 'IN' or $op eq 'NOT IN') and ref $val->{value} eq 'ARRAY') {
+            $term = $stmt->_mk_term_arrayref($c, $op, $val->{value});
+            push @bind, @{$val->{value}};
+        } elsif (($op eq 'IN' or $op eq 'NOT IN') and ref $val->{value} eq 'REF') {
+            my @values = @{${$val->{value}}};
+            $term = "$c $op (" . (shift @values) . ")";
+            push @bind, @values;
+        } elsif ($op eq 'BETWEEN' and ref $val->{value} eq 'ARRAY') {
+            Carp::croak "USAGE: foo => {op => 'BETWEEN', value => [\$a, \$b]}" if @{$val->{value}} != 2;
+            $term = "$c $op ? AND ?";
+            push @bind, @{$val->{value}};
+        } else {
+            if (ref $val->{value} eq 'SCALAR') {
+                $term = "$c $val->{op} " . ${$val->{value}};
+            } else {
+                $term = "$c $val->{op} ?";
+                push @bind, $val->{value};
+            }
+        }
     } elsif (ref($val) eq 'SCALAR') {
         $col = $m->($col) if $m = $stmt->column_mutator;
         $term = "$col $$val";
+    } elsif (ref($val) eq 'REF') {
+        $col = $m->($col) if $m = $stmt->column_mutator;
+        my @values = @{$$val};
+        $term = "$col " . (shift @values);
+        push @bind, @values;
     } else {
         $col = $m->($col) if $m = $stmt->column_mutator;
-        $term = "$col = ?";
-        push @bind, $val;
+        if (defined $val) {
+            $term = "$col = ?";
+            push @bind, $val;
+        } else {
+            $term = "$col IS NULL";
+        }
     }
     ($term, \@bind, $col);
 }
 
+sub _mk_term_arrayref {
+    my ($stmt, $col, $op, $val) = @_;
+    if (@$val) {
+        return "$col $op (".join(',', ('?') x scalar @$val).')';
+    } else {
+        if ($op eq 'IN') {
+            return '0 = 1';
+        } elsif ($op eq 'NOT IN') {
+            return '1 = 1';
+        }
+    }
+}
+
 sub _add_index_hint {
     my $stmt = shift;
     my ($tbl_name) = @_;
diff --git a/t/01-col-inheritance.t b/t/01-col-inheritance.t
@@ -4,7 +4,7 @@ use strict;
 
 use lib 't/lib';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 use Test::More;
 unless (eval { require DBD::SQLite }) {
diff --git a/t/02-basic.t b/t/02-basic.t
@@ -5,7 +5,7 @@ use strict;
 use lib 't/lib';
 use lib 't/lib/cached';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 use Test::More;
 use Test::Exception;
diff --git a/t/03-primary-keys.t b/t/03-primary-keys.t
@@ -5,7 +5,7 @@ use strict;
 use lib 't/lib';
 use lib 't/lib/cached';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 use Test::More;
 use Test::Exception;
diff --git a/t/04-clone.t b/t/04-clone.t
@@ -5,7 +5,7 @@ use strict;
 use lib 't/lib';
 use lib 't/lib/cached';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 use Test::More;
 use Test::Exception;
diff --git a/t/05-deflate.t b/t/05-deflate.t
@@ -5,7 +5,7 @@ use strict;
 use lib 't/lib';
 use lib 't/lib/cached';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 use Test::More;
 use Test::Exception;
diff --git a/t/06-errors.t b/t/06-errors.t
@@ -3,7 +3,7 @@
 use strict;
 
 use lib 't/lib';
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 use Test::More;
 use Test::Exception;
diff --git a/t/07-has-a-cached.t b/t/07-has-a-cached.t
@@ -5,7 +5,7 @@ use strict;
 use lib 't/lib';
 use lib 't/lib/cached';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 use Test::More;
 use Test::Exception;
diff --git a/t/07-has-a.t b/t/07-has-a.t
@@ -5,7 +5,7 @@ use strict;
 use lib 't/lib';
 use lib 't/lib/cached';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 use Test::More;
 use Test::Exception;
diff --git a/t/08-iterator.t b/t/08-iterator.t
@@ -5,7 +5,7 @@ use strict;
 use lib 't/lib';
 use lib 't/lib/cached';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 use Test::More;
 use Test::Exception;
diff --git a/t/09-resultset.t b/t/09-resultset.t
@@ -4,7 +4,7 @@ use strict;
 
 use lib 't/lib';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 $Data::ObjectDriver::DEBUG = 0;
 use Test::More;
@@ -173,4 +173,5 @@ $result->rewind;
     diag "calling next() after add_term() with 'op'" . $result->next; ## this should return the object which has "rating == 3".
 }
 
+$wine->driver->dbh->disconnect;
 teardown_dbs(qw( global ));
diff --git a/t/10-resultset-peek.t b/t/10-resultset-peek.t
@@ -7,7 +7,7 @@ use strict;
 
 use lib 't/lib';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 $Data::ObjectDriver::DEBUG = 0;
 use Test::More;
@@ -147,4 +147,5 @@ is $result->peek_next->name, 'Stags Leap', 'the next one will be Stags Leap';
 is $result->next->name, 'Stags Leap';
 ok ! $result->peek_next, "Stags Leap was the last one";
 
+$wine->driver->dbh->disconnect;
 teardown_dbs(qw( global ));
diff --git a/t/11-sql.t b/t/11-sql.t
@@ -3,7 +3,7 @@
 use strict;
 
 use Data::ObjectDriver::SQL;
-use Test::More tests => 68;
+use Test::More tests => 93;
 
 my $stmt = ns();
 ok($stmt, 'Created SQL object');
@@ -128,6 +128,27 @@ is(scalar @{ $stmt->bind }, 2);
 is($stmt->bind->[0], 'bar');
 is($stmt->bind->[1], 'baz');
 
+$stmt = ns(); $stmt->add_where(foo => { op => 'IN', value => ['bar'] });
+is($stmt->as_sql_where, "WHERE (foo IN (?))\n");
+is(scalar @{ $stmt->bind }, 1);
+is($stmt->bind->[0], 'bar');
+
+$stmt = ns(); $stmt->add_where(foo => { op => 'NOT IN', value => ['bar'] });
+is($stmt->as_sql_where, "WHERE (foo NOT IN (?))\n");
+is(scalar @{ $stmt->bind }, 1);
+is($stmt->bind->[0], 'bar');
+
+$stmt = ns(); $stmt->add_where(foo => { op => 'BETWEEN', value => ['bar', 'baz'] });
+is($stmt->as_sql_where, "WHERE (foo BETWEEN ? AND ?)\n");
+is(scalar @{ $stmt->bind }, 2);
+is($stmt->bind->[0], 'bar');
+is($stmt->bind->[1], 'baz');
+
+$stmt = ns(); $stmt->add_where(foo => { op => 'LIKE', value => 'bar%' });
+is($stmt->as_sql_where, "WHERE (foo LIKE ?)\n");
+is(scalar @{ $stmt->bind }, 1);
+is($stmt->bind->[0], 'bar%');
+
 $stmt = ns(); $stmt->add_where(foo => { op => '!=', value => 'bar' });
 is($stmt->as_sql_where, "WHERE (foo != ?)\n");
 is(scalar @{ $stmt->bind }, 1);
@@ -174,6 +195,34 @@ is($stmt->bind->[0], 'foo');
 is($stmt->bind->[1], 'bar');
 is($stmt->bind->[2], 'baz');
 
+$stmt = ns();
+$stmt->add_where(foo => \['IN (SELECT foo FROM bar WHERE t=?)', 'foo']);
+is($stmt->as_sql_where, "WHERE (foo IN (SELECT foo FROM bar WHERE t=?))\n");
+is(scalar @{ $stmt->bind }, 1);
+is($stmt->bind->[0], 'foo');
+
+$stmt = ns();
+$stmt->add_where(foo => { op => 'IN', value => \['(SELECT foo FROM bar WHERE t=?)', 'foo']});
+is($stmt->as_sql_where, "WHERE (foo IN ((SELECT foo FROM bar WHERE t=?)))\n");
+is(scalar @{ $stmt->bind }, 1);
+is($stmt->bind->[0], 'foo');
+
+$stmt = ns();
+$stmt->add_where(foo => { op => 'IN', value => \'(SELECT foo FROM bar)'});
+is($stmt->as_sql_where, "WHERE (foo IN (SELECT foo FROM bar))\n");
+is(scalar @{ $stmt->bind }, 0);
+
+$stmt = ns();
+$stmt->add_where(foo => undef);
+is($stmt->as_sql_where, "WHERE (foo IS NULL)\n");
+is(scalar @{ $stmt->bind }, 0);
+
+## avoid syntax error
+$stmt = ns();
+$stmt->add_where(foo => []);
+is($stmt->as_sql_where, "WHERE (0 = 1)\n"); # foo IN ()
+is(scalar @{ $stmt->bind }, 0);
+
 ## regression bug. modified parameters
 my %terms = ( foo => [-and => 'foo', 'bar', 'baz']);
 $stmt = ns();
diff --git a/t/12-windows.t b/t/12-windows.t
@@ -6,7 +6,7 @@ use Data::Dumper;
 use lib 't/lib';
 use lib 't/lib/cached';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 use Test::More;
 use Test::Exception;
@@ -99,6 +99,8 @@ ok( !$iter->(), "No third row; limit argument respected" );
 is( $load_count, 2, "2 objects loaded; limit argument respected");
 $iter->end;
 
+$r->driver->dbh->disconnect;
+$i->driver->dbh->disconnect;
 teardown_dbs(qw( global ));
 
 print Dumper( Data::ObjectDriver->profiler->query_log ) if $ENV{DOD_PROFILE};
diff --git a/t/20-driver-sqlite.t b/t/20-driver-sqlite.t
@@ -4,7 +4,7 @@ use strict;
 
 use lib 't/lib';
 
-require 't/lib/db-common.pl';
+require './t/lib/db-common.pl';
 
 $Data::ObjectDriver::DEBUG = 0;
 use Test::More;
diff --git a/t/31-cached.t b/t/31-cached.t
diff --git a/t/32-partitioned.t b/t/32-partitioned.t
diff --git a/t/33-views.t b/t/33-views.t
diff --git a/t/34-both.t b/t/34-both.t
diff --git a/t/35-multiplexed.t b/t/35-multiplexed.t
diff --git a/t/41-callbacks.t b/t/41-callbacks.t
diff --git a/t/42-callbacks-multi-pk.t b/t/42-callbacks-multi-pk.t
diff --git a/t/50-profiling.t b/t/50-profiling.t
