r2252 - in packages/libsql-statement-perl/branches/upstream/current: . lib/SQL t

Krzysztof Krzyzaniak eloy at costa.debian.org
Thu Mar 2 12:36:15 UTC 2006


Author: eloy
Date: 2006-03-02 12:36:14 +0000 (Thu, 02 Mar 2006)
New Revision: 2252

Modified:
   packages/libsql-statement-perl/branches/upstream/current/Changes
   packages/libsql-statement-perl/branches/upstream/current/META.yml
   packages/libsql-statement-perl/branches/upstream/current/lib/SQL/Statement.pm
   packages/libsql-statement-perl/branches/upstream/current/t/03executeDBD.t
   packages/libsql-statement-perl/branches/upstream/current/t/04names.t
   packages/libsql-statement-perl/branches/upstream/current/t/05create.t
   packages/libsql-statement-perl/branches/upstream/current/t/06group.t
   packages/libsql-statement-perl/branches/upstream/current/t/07case.t
   packages/libsql-statement-perl/branches/upstream/current/t/08join.t
   packages/libsql-statement-perl/branches/upstream/current/t/14allcols.t
Log:
Load /tmp/tmp.5RW2Z5/libsql-statement-perl-1.15 into
packages/libsql-statement-perl/branches/upstream/current.


Modified: packages/libsql-statement-perl/branches/upstream/current/Changes
===================================================================
--- packages/libsql-statement-perl/branches/upstream/current/Changes	2006-03-01 16:03:09 UTC (rev 2251)
+++ packages/libsql-statement-perl/branches/upstream/current/Changes	2006-03-02 12:36:14 UTC (rev 2252)
@@ -1,5 +1,10 @@
 Changes log for Perl extension SQL::Statement
 
+Version 1.15, released 2 February, 2006
+----------------------------------------
+* fixed placeholder bug in SQL::Statement::UPDATE
+  thanks for bug report Tanktalus
+
 Version 1.14, released 21 April, 2005
 ----------------------------------------
  * fixed circular dependency in tests (one mistakenly required AnyData)

Modified: packages/libsql-statement-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libsql-statement-perl/branches/upstream/current/META.yml	2006-03-01 16:03:09 UTC (rev 2251)
+++ packages/libsql-statement-perl/branches/upstream/current/META.yml	2006-03-02 12:36:14 UTC (rev 2252)
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         SQL-Statement
-version:      1.14
+version:      1.15
 version_from: ./lib/SQL/Statement.pm
 installdirs:  site
 requires:

Modified: packages/libsql-statement-perl/branches/upstream/current/lib/SQL/Statement.pm
===================================================================
--- packages/libsql-statement-perl/branches/upstream/current/lib/SQL/Statement.pm	2006-03-01 16:03:09 UTC (rev 2251)
+++ packages/libsql-statement-perl/branches/upstream/current/lib/SQL/Statement.pm	2006-03-02 12:36:14 UTC (rev 2252)
@@ -31,7 +31,7 @@
 
 #use locale;
 
-$VERSION = '1.14';
+$VERSION = '1.15';
 $dlm = '~';
 $arg_num=0;
 $warg_num=0;
@@ -387,10 +387,12 @@
 sub UPDATE ($$$) {
     my($self, $data, $params) = @_;
     my $valnum = $self->{num_val_placeholders};
+    my @val_params;
     if ($valnum) {
-        my @val_params   = splice @$params, 0,$valnum;
-        @$params = (@$params, at val_params);
-#        my @where_params = $params->[$valnum+1..scalar @$params-1];
+         @val_params   = splice @$params, 0,$valnum;
+#        @$params = (@$params, at val_params);
+
+#         my @where_params = $params->[$valnum+1..scalar @$params-1];
 #        @$params = (@where_params, at val_params);
     }
     my($eval,$all_cols) = $self->open_tables($data, 0, 1);
@@ -426,10 +428,12 @@
                 $col = $self->columns($i);
                 $val = $self->row_values($i);
                 if (ref($val) eq 'SQL::Statement::Param') {
-                    $val = $eval->param($val->num());
+#                    $val = $eval->param($val->num());
+                    $val = shift @val_params;
                 }
                 elsif ($val->{type} eq 'placeholder') {
-                    $val = $eval->param($param_num++);
+#                    $val = $eval->param($param_num++);
+                    $val = shift @val_params;
 	        }
                 else {
      	            $val = $self->get_row_value($val,$eval,$rowhash);
@@ -1293,13 +1297,13 @@
 
         # The old way, now replaced, called get_row_value everytime
         #
-        # my $val1 = $self->get_row_value( $pred->{"arg1"}, $eval, $rowhash );
-        # my $val2 = $self->get_row_value( $pred->{"arg2"}, $eval, $rowhash );
+         my $val1 = $self->get_row_value( $pred->{"arg1"}, $eval, $rowhash );
+         my $val2 = $self->get_row_value( $pred->{"arg2"}, $eval, $rowhash );
 
         # define types that we only need to call get_row_value on once
         # per execute
         #
-        my %is_value = map {$_=>1} qw(placeholder string number null);
+##        my %is_value = map {$_=>1} qw(placeholder string number null);
 
         # use a reuse value if defined, get_row_value() otherwise
         #
@@ -1310,22 +1314,23 @@
         # $new_execute is set to 1 at the start of execute()
         # and set to 0 at the end of  eval_where()
         #
-        my $val1 = (!$new_execute and defined $pred->{arg1}->{reuse})
-                 ? $pred->{arg1}->{reuse}
-	         : $self->get_row_value( $pred->{"arg1"}, $eval, $rowhash );
-        my $val2 = (!$new_execute and defined $pred->{arg2}->{reuse})
-                 ? $pred->{arg2}->{reuse}
-	         : $self->get_row_value( $pred->{"arg2"}, $eval, $rowhash );
 
+##        my $val1 = (!$new_execute and defined $pred->{arg1}->{reuse})
+##                 ? $pred->{arg1}->{reuse}
+##	         : $self->get_row_value( $pred->{"arg1"}, $eval, $rowhash );
+##        my $val2 = (!$new_execute and defined $pred->{arg2}->{reuse})
+##                 ? $pred->{arg2}->{reuse}
+##	         : $self->get_row_value( $pred->{"arg2"}, $eval, $rowhash );
+
         # the first time we call get_row_value, we set the reuse value
         # for the argument object with its scalar value
         #
-        my $type1 = $pred->{arg1}->{type} if ref($pred->{arg1}) eq 'HASH';
-        my $type2 = $pred->{arg2}->{type} if ref($pred->{arg2}) eq 'HASH';
-	$pred->{arg1}->{reuse} = $val1
-                              if $type1 and $is_value{$type1} and $new_execute;
-	$pred->{arg2}->{reuse} = $val2
-                              if $type2 and $is_value{$type2} and $new_execute;
+##        my $type1 = $pred->{arg1}->{type} if ref($pred->{arg1}) eq 'HASH';
+##        my $type2 = $pred->{arg2}->{type} if ref($pred->{arg2}) eq 'HASH';
+##	$pred->{arg1}->{reuse} = $val1
+##                              if $type1 and $is_value{$type1} and $new_execute;
+##	$pred->{arg2}->{reuse} = $val2
+##                              if $type2 and $is_value{$type2} and $new_execute;
 
         my $op     = $pred->{op};
         my $opfunc = $op;

Modified: packages/libsql-statement-perl/branches/upstream/current/t/03executeDBD.t
===================================================================
--- packages/libsql-statement-perl/branches/upstream/current/t/03executeDBD.t	2006-03-01 16:03:09 UTC (rev 2251)
+++ packages/libsql-statement-perl/branches/upstream/current/t/03executeDBD.t	2006-03-02 12:36:14 UTC (rev 2252)
@@ -7,16 +7,31 @@
 eval {
     require DBI;
     require DBD::File;
+    require IO::File;
 };
 if ($@) {
         plan skip_all => "Requires DBI and DBD::File";
 }
 else {
-    plan tests => 16;
+    plan tests => 22;
 }
 my($sth,$str);
 my $dbh = DBI->connect('dbi:File(RaiseError=1):');
 
+$dbh->do(q{ CREATE TEMP TABLE Tmp (id INT,phrase VARCHAR(30)) } );
+ok($dbh->do(q{ INSERT INTO Tmp (id,phrase) VALUES (?,?) },{},9,'yyy'),'placeholder insert with named cols');
+ok($dbh->do(q{ INSERT INTO Tmp VALUES(?,?) },{},2,'zzz'),'placeholder insert without named cols');
+$dbh->do(q{ INSERT INTO Tmp (id,phrase) VALUES (?,?) },{},3,'baz');
+ok($dbh->do(q{ DELETE FROM Tmp WHERE id=? or phrase=? },{},3,'baz'),'placeholder delete');
+ok($dbh->do(q{ UPDATE Tmp SET phrase=? WHERE id=?},{},'bar',2),'placeholder update');
+ok($dbh->do(q{ UPDATE Tmp SET phrase=?,id=? WHERE id=? and phrase=?},{},'foo',1,9,'yyy'),'placeholder update');
+$sth = $dbh->prepare("SELECT id,phrase FROM Tmp");
+$sth->execute;
+$str = '';
+while (my $r=$sth->fetch) { $str.="@$r^"; }
+ok($str eq '1 foo^2 bar^','Placeholders');
+$dbh->do(q{ DROP TABLE IF EXISTS Tmp } );
+
 ########################################
 # CREATE, INSERT, UPDATE, DELETE, SELECT
 ########################################

Modified: packages/libsql-statement-perl/branches/upstream/current/t/04names.t
===================================================================
--- packages/libsql-statement-perl/branches/upstream/current/t/04names.t	2006-03-01 16:03:09 UTC (rev 2251)
+++ packages/libsql-statement-perl/branches/upstream/current/t/04names.t	2006-03-02 12:36:14 UTC (rev 2252)
@@ -3,7 +3,7 @@
 use strict;
 use Test::More;
 use lib  qw( ../lib );
-eval {require DBI; require DBD::File;};
+eval {require DBI; require DBD::File; require IO::File;};
 if ($@) {
     plan skip_all => "DBI or DBD::File not available";
 }

Modified: packages/libsql-statement-perl/branches/upstream/current/t/05create.t
===================================================================
--- packages/libsql-statement-perl/branches/upstream/current/t/05create.t	2006-03-01 16:03:09 UTC (rev 2251)
+++ packages/libsql-statement-perl/branches/upstream/current/t/05create.t	2006-03-02 12:36:14 UTC (rev 2252)
@@ -2,7 +2,7 @@
 $|=1;
 use strict;
 use Test::More;
-eval { require DBI; require DBD::File; };
+eval { require DBI; require DBD::File; require IO::File;};
 if ($@) {
         plan skip_all => "No DBI or DBD::File available";
 }

Modified: packages/libsql-statement-perl/branches/upstream/current/t/06group.t
===================================================================
--- packages/libsql-statement-perl/branches/upstream/current/t/06group.t	2006-03-01 16:03:09 UTC (rev 2251)
+++ packages/libsql-statement-perl/branches/upstream/current/t/06group.t	2006-03-02 12:36:14 UTC (rev 2252)
@@ -4,7 +4,7 @@
 use Test::More;
 use lib  qw( ../lib );
 use vars qw($DEBUG);
-eval { require DBI; require DBD::File; };
+eval { require DBI; require DBD::File; require IO::File; };
 if ($@) {
         plan skip_all => "No DBI or DBD::File available";
 }

Modified: packages/libsql-statement-perl/branches/upstream/current/t/07case.t
===================================================================
--- packages/libsql-statement-perl/branches/upstream/current/t/07case.t	2006-03-01 16:03:09 UTC (rev 2251)
+++ packages/libsql-statement-perl/branches/upstream/current/t/07case.t	2006-03-02 12:36:14 UTC (rev 2252)
@@ -4,7 +4,7 @@
 use lib  qw( ../lib );
 use vars qw($DEBUG);
 use Test::More;
-eval { require DBI; require DBD::File;};
+eval { require DBI; require DBD::File; require IO::File; };
 if ($@) {
     plan skip_all => "No DBI or DBD::File available";
 }

Modified: packages/libsql-statement-perl/branches/upstream/current/t/08join.t
===================================================================
--- packages/libsql-statement-perl/branches/upstream/current/t/08join.t	2006-03-01 16:03:09 UTC (rev 2251)
+++ packages/libsql-statement-perl/branches/upstream/current/t/08join.t	2006-03-02 12:36:14 UTC (rev 2252)
@@ -3,7 +3,7 @@
 use strict;
 use Test::More;
 use lib  qw( ../lib );
-eval { require DBI; require DBD::File;};
+eval { require DBI; require DBD::File; require IO::File };
 if ($@) {
         plan skip_all => "No DBD::File available";
 }

Modified: packages/libsql-statement-perl/branches/upstream/current/t/14allcols.t
===================================================================
--- packages/libsql-statement-perl/branches/upstream/current/t/14allcols.t	2006-03-01 16:03:09 UTC (rev 2251)
+++ packages/libsql-statement-perl/branches/upstream/current/t/14allcols.t	2006-03-02 12:36:14 UTC (rev 2252)
@@ -5,7 +5,7 @@
 $|=1;
 use strict;
 use Test::More;
-eval { require DBI; require DBD::File; };
+eval { require DBI; require DBD::File;  require IO::File; };
 if ($@) {
         plan skip_all => "No DBI or DBD::File available";
 }




More information about the Pkg-perl-cvs-commits mailing list