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