r21031 - in /branches/upstream/libdbd-mock-perl/current: .shipit Build.PL Changes MANIFEST META.yml Makefile.PL lib/DBD/Mock.pm t/021_DBD_Mock_Session.t t/022_DBD_Mock_Session_bound_params.t t/024_selcol_fetchhash.t t/026_st_bind_col.t t/bug_0001.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sat Jun 14 18:50:30 UTC 2008
Author: gregoa
Date: Sat Jun 14 18:50:30 2008
New Revision: 21031
URL: http://svn.debian.org/wsvn/?sc=1&rev=21031
Log:
[svn-upgrade] Integrating new upstream version, libdbd-mock-perl (1.37)
Added:
branches/upstream/libdbd-mock-perl/current/.shipit
branches/upstream/libdbd-mock-perl/current/t/026_st_bind_col.t
Modified:
branches/upstream/libdbd-mock-perl/current/Build.PL
branches/upstream/libdbd-mock-perl/current/Changes
branches/upstream/libdbd-mock-perl/current/MANIFEST
branches/upstream/libdbd-mock-perl/current/META.yml
branches/upstream/libdbd-mock-perl/current/Makefile.PL
branches/upstream/libdbd-mock-perl/current/lib/DBD/Mock.pm
branches/upstream/libdbd-mock-perl/current/t/021_DBD_Mock_Session.t
branches/upstream/libdbd-mock-perl/current/t/022_DBD_Mock_Session_bound_params.t
branches/upstream/libdbd-mock-perl/current/t/024_selcol_fetchhash.t
branches/upstream/libdbd-mock-perl/current/t/bug_0001.t
Added: branches/upstream/libdbd-mock-perl/current/.shipit
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/.shipit?rev=21031&op=file
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/.shipit (added)
+++ branches/upstream/libdbd-mock-perl/current/.shipit Sat Jun 14 18:50:30 2008
@@ -1,0 +1,7 @@
+# auto-generated shipit config file.
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, DistClean
+
+svn.tagpattern = %v
+svn.tagpattern = https://svn.iinteractive.com/repos/cpan/DBD-Mock/tags/%v
+
+CheckChangeLog.files = Changes
Modified: branches/upstream/libdbd-mock-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/Build.PL?rev=21031&op=diff
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/Build.PL (original)
+++ branches/upstream/libdbd-mock-perl/current/Build.PL Sat Jun 14 18:50:30 2008
@@ -20,7 +20,7 @@
create_makefile_pl => 'traditional',
recursive_test_files => 1,
add_to_cleanup => [
- 'META.yml', '*.bak', '*.gz', 'Makefile.PL',
+ '*.bak',
],
);
Modified: branches/upstream/libdbd-mock-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/Changes?rev=21031&op=diff
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/Changes (original)
+++ branches/upstream/libdbd-mock-perl/current/Changes Sat Jun 14 18:50:30 2008
@@ -1,4 +1,14 @@
Revision history for Perl extension DBD::Mock.
+
+1.37 June 12, 2008
+ - New co-maintainer (aka sucker), Dave Rolsky
+ - Added support for $sth->bind_col() and $sth->bind_cols()
+ - Fixed and clarified docs for the mock_last_insert_id and
+ mock_start_insert_id attributes. The previous docs were both
+ wrong and confusing
+ - Applied patch from RT #35145 to add support for the Column
+ attribute with selectcol_arrayref
+ - patch by Matt Lawrence
1.36 October 18, 2007
- $dbh->last_insert_id() now works as documented
Modified: branches/upstream/libdbd-mock-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/MANIFEST?rev=21031&op=diff
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/MANIFEST (original)
+++ branches/upstream/libdbd-mock-perl/current/MANIFEST Sat Jun 14 18:50:30 2008
@@ -1,8 +1,9 @@
+.shipit
Build.PL
Changes
lib/DBD/Mock.pm
Makefile.PL
-MANIFEST
+MANIFEST This list of files
META.yml
README
t/000_basic.t
@@ -31,6 +32,7 @@
t/023_statement_failure.t
t/024_selcol_fetchhash.t
t/025_mock_last_insert_id.t
+t/026_st_bind_col.t
t/998_pod.t
t/999_pod_coverage.t
t/bug_0001.t
Modified: branches/upstream/libdbd-mock-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/META.yml?rev=21031&op=diff
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/META.yml (original)
+++ branches/upstream/libdbd-mock-perl/current/META.yml Sat Jun 14 18:50:30 2008
@@ -1,6 +1,6 @@
---
name: DBD-Mock
-version: 1.36
+version: 1.37
author:
- 'Chris Winters E<lt>chris at cwinters.comE<gt>'
- 'Stevan Little E<lt>stevan at iinteractive.comE<gt>'
@@ -17,7 +17,7 @@
provides:
DBD::Mock:
file: lib/DBD/Mock.pm
- version: 1.36
+ version: 1.37
DBD::Mock::Pool:
file: lib/DBD/Mock.pm
DBD::Mock::Pool::db:
Modified: branches/upstream/libdbd-mock-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/Makefile.PL?rev=21031&op=diff
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/Makefile.PL (original)
+++ branches/upstream/libdbd-mock-perl/current/Makefile.PL Sat Jun 14 18:50:30 2008
@@ -2,14 +2,14 @@
use ExtUtils::MakeMaker;
WriteMakefile
(
- 'PL_FILES' => {},
- 'INSTALLDIRS' => 'site',
'NAME' => 'DBD::Mock',
- 'EXE_FILES' => [],
'VERSION_FROM' => 'lib/DBD/Mock.pm',
'PREREQ_PM' => {
- 'Test::More' => '0.47',
- 'DBI' => '1.3'
- }
+ 'DBI' => '1.3',
+ 'Test::More' => '0.47'
+ },
+ 'INSTALLDIRS' => 'site',
+ 'EXE_FILES' => [],
+ 'PL_FILES' => {}
)
;
Modified: branches/upstream/libdbd-mock-perl/current/lib/DBD/Mock.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/lib/DBD/Mock.pm?rev=21031&op=diff
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/lib/DBD/Mock.pm (original)
+++ branches/upstream/libdbd-mock-perl/current/lib/DBD/Mock.pm Sat Jun 14 18:50:30 2008
@@ -20,7 +20,7 @@
require DBI;
-our $VERSION = '1.36';
+our $VERSION = '1.37';
our $drh = undef; # will hold driver handle
our $err = 0; # will hold any error codes
@@ -395,9 +395,14 @@
# something went wrong, and so return undef.
return undef unless defined $a_ref || ref($a_ref) ne 'ARRAY';
+ my @cols = 0;
+ if (ref $attrib->{Columns} eq 'ARRAY') {
+ @cols = map { $_ - 1 } @{$attrib->{Columns}};
+ }
+
# if we do get something then we
# grab all the columns out of it.
- return [ map { $_->[0] } @{$a_ref} ]
+ return [ map { @$_[@cols] } @{$a_ref} ]
}
{
@@ -568,6 +573,14 @@
$DBD::Mock::st::imp_data_size = 0;
+sub bind_col {
+ my ($sth, $param_num, $ref, $attr) = @_;
+
+ my $tracker = $sth->FETCH( 'mock_my_history' );
+ $tracker->bind_col( $param_num, $ref );
+ return 1;
+}
+
sub bind_param {
my ($sth, $param_num, $val, $attr) = @_;
my $tracker = $sth->FETCH( 'mock_my_history' );
@@ -668,7 +681,16 @@
$dbh->{mock_can_fetch}++ if $dbh->{mock_can_fetch} < 0;
my $tracker = $sth->FETCH( 'mock_my_history' );
- return $tracker->next_record;
+
+ my $record = $tracker->next_record;
+
+ if ( my @cols = $tracker->bind_cols() ) {
+ for my $i ( grep { ref $cols[$_] } 0..$#cols ) {
+ ${ $cols[$i] } = $record->[$i];
+ }
+ }
+
+ return $record;
}
sub fetchrow_array {
@@ -983,6 +1005,11 @@
return scalar @{$self->{bound_params}};
}
+sub bind_col {
+ my ($self, $param_num, $ref) = @_;
+ $self->{bind_cols}->[$param_num - 1] = $ref;
+}
+
sub bound_param {
my ($self, $param_num, $value) = @_;
$self->{bound_params}->[$param_num - 1] = $value;
@@ -992,6 +1019,11 @@
sub bound_param_trailing {
my ($self, @values) = @_;
push @{$self->{bound_params}}, @values;
+}
+
+sub bind_cols {
+ my $self = shift;
+ return @{$self->{bind_cols} || []};
}
sub bind_params {
@@ -1588,9 +1620,7 @@
This attribute is incremented each time an INSERT statement is passed to C<prepare> on a per-handle basis. It's starting value can be set with the 'mock_start_insert_id' attribute (see below).
-This attribute also can be used with an ARRAY ref parameter, it's behavior is slightly different in that instead of incrementing the value for every C<prepare> it will only increment for each C<execute>. This allows it to be used over multiple C<execute> calls in a single C<$sth>. It's usage looks like this:
-
- $dbh->{mock_last_insert_id} = [ 'Foo', 10 ];
+ $dbh->{mock_start_insert_id} = 10;
my $sth = $dbh->prepare('INSERT INTO Foo (foo, bar) VALUES(?, ?)');
@@ -1605,6 +1635,25 @@
=item B<mock_start_insert_id>
This attribute can be used to set a start value for the 'mock_last_insert_id' attribute. It can also be used to effectively reset the 'mock_last_insert_id' attribute as well.
+
+This attribute also can be used with an ARRAY ref parameter, it's behavior is slightly different in that instead of incrementing the value for every C<prepare> it will only increment for each C<execute>. This allows it to be used over multiple C<execute> calls in a single C<$sth>. It's usage looks like this:
+
+ $dbh->{mock_start_insert_id} = [ 'Foo', 10 ];
+ $dbh->{mock_start_insert_id} = [ 'Baz', 20 ];
+
+ my $sth1 = $dbh->prepare('INSERT INTO Foo (foo, bar) VALUES(?, ?)');
+
+ my $sth2 = $dbh->prepare('INSERT INTO Baz (baz, buz) VALUES(?, ?)');
+
+ $sth1->execute(1, 2);
+ # $dbh->{mock_last_insert_id} == 10
+
+ $sth2->execute(3, 4);
+ # $dbh->{mock_last_insert_id} == 20
+
+Note that DBD::Mock's matching of table names in 'INSERT' statements is fairly simple, so if your table names are quoted in the insert statement (C<INSERT INTO "Foo">) then you need to quote the name for C<mock_start_insert_id>:
+
+ $dbh->{mock_start_insert_id} = [ q{"Foo"}, 10 ];
=item B<mock_add_parser>
Modified: branches/upstream/libdbd-mock-perl/current/t/021_DBD_Mock_Session.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/t/021_DBD_Mock_Session.t?rev=21031&op=diff
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/t/021_DBD_Mock_Session.t (original)
+++ branches/upstream/libdbd-mock-perl/current/t/021_DBD_Mock_Session.t Sat Jun 14 18:50:30 2008
@@ -358,4 +358,7 @@
ok(defined($@), '... got an error, as expected');
like($@, qr/^DBH->finish called when session still has states left/, '... got the error we expected');
-}
+
+ # Shuts up warning when object is destroyed
+ undef $dbh->{mock_session};
+}
Modified: branches/upstream/libdbd-mock-perl/current/t/022_DBD_Mock_Session_bound_params.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/t/022_DBD_Mock_Session_bound_params.t?rev=21031&op=diff
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/t/022_DBD_Mock_Session_bound_params.t (original)
+++ branches/upstream/libdbd-mock-perl/current/t/022_DBD_Mock_Session_bound_params.t Sat Jun 14 18:50:30 2008
@@ -42,6 +42,9 @@
cmp_ok($result, '==', 15, '... got the right value');
};
ok(!$@, '... everything worked as planned');
+
+ # Shuts up warning when object is destroyed
+ undef $dbh->{mock_session};
}
{
@@ -90,6 +93,9 @@
cmp_ok($sth->rows(), '==', 2, '... got the right number of affected rows');
};
ok(!$@, '... third state worked as planned');
+
+ # Shuts up warning when object is destroyed
+ undef $dbh->{mock_session};
}
# check some errors
@@ -118,6 +124,9 @@
like($@,
qr/Session Error\: Not the same number of bound params in current state in DBD\:\:Mock\:\:Session/,
'... everything failed as planned');
+
+ # Shuts up warning when object is destroyed
+ undef $dbh->{mock_session};
}
{
@@ -144,6 +153,9 @@
like($@,
qr/Session Error\: Bound param 0 do not match in current state in DBD\:\:Mock\:\:Session/,
'... everything failed as planned');
+
+ # Shuts up warning when object is destroyed
+ undef $dbh->{mock_session};
}
{
@@ -176,5 +188,7 @@
cmp_ok($result, '==', 15, '... second execute got the right value');
};
ok(!$@, '... everything worked as planned');
-
+
+ # Shuts up warning when object is destroyed
+ undef $dbh->{mock_session};
}
Modified: branches/upstream/libdbd-mock-perl/current/t/024_selcol_fetchhash.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/t/024_selcol_fetchhash.t?rev=21031&op=diff
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/t/024_selcol_fetchhash.t (original)
+++ branches/upstream/libdbd-mock-perl/current/t/024_selcol_fetchhash.t Sat Jun 14 18:50:30 2008
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 7;
+use Test::More tests => 8;
BEGIN {
use_ok('DBD::Mock');
@@ -69,6 +69,17 @@
is_deeply($res, \@expected, "Checking if selectcol_arrayref works.");
}
+{
+ my %expected = (1 => 'european', 27 => 'african');
+
+ my $res = eval { $dbh->selectcol_arrayref($swallow_sql, {Columns=>[1, 2]}) };
+
+ is_deeply(
+ { @{$res || []} }, \%expected,
+ 'Checking if selectcol_arrayref works with Columns attribute'
+ );
+}
+
is_deeply(
$dbh->selectall_hashref($items_sql, 'id', "Checking selectall_hashref with named key."),
{ '2' => $coco_hash,
Added: branches/upstream/libdbd-mock-perl/current/t/026_st_bind_col.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/t/026_st_bind_col.t?rev=21031&op=file
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/t/026_st_bind_col.t (added)
+++ branches/upstream/libdbd-mock-perl/current/t/026_st_bind_col.t Sat Jun 14 18:50:30 2008
@@ -1,0 +1,68 @@
+use 5.006;
+
+use strict;
+use warnings;
+
+use Test::More tests => 11;
+
+BEGIN {
+ use_ok('DBD::Mock');
+ use_ok('DBI');
+}
+
+my $dbh = DBI->connect( 'DBI:Mock:', '', '' );
+
+$dbh->{mock_add_resultset} = [
+ [ 'id', 'type', 'inventory_id' ],
+ [ '1', 'european', '42' ],
+ [ '27', 'african', '2' ],
+ ];
+
+my $sth = $dbh->prepare( 'SELECT id, type, inventory_id FROM Swallow' );
+
+$sth->execute();
+
+{
+ my ($id, $type, $inventory_id);
+
+ $sth->bind_col( 1, \$id );
+ $sth->bind_col( 2, \$type );
+ $sth->bind_col( 3, \$inventory_id );
+
+ ok( $sth->fetch(), 'fetch() returned data' );
+ is( $id, 1, 'bind_col to $id == 1' );
+ is( $type, 'european', 'bind_col to $type == "european"' );
+ is( $inventory_id, 42, 'bind_col to $inventory_id == 42' );
+}
+
+{
+ my %hash;
+
+ $sth->bind_columns( \( @hash{ qw( id type inventory_id ) } ) );
+
+ ok( $sth->fetch(), 'fetch() returned data' );
+ is( $hash{id}, 27, 'bind_columns with hash, id == 1' );
+ is( $hash{type}, 'african', 'bind_columns with hash, type == "african"' );
+ is( $hash{inventory_id}, 2, 'bind_columns with hash, inventory_id == 2' );
+}
+
+{
+ $dbh->{mock_clear_history} = 1;
+
+ my @rows =
+ ( [ '1', 'european', '42' ],
+ [ '27', 'african', '2' ],
+ );
+
+ $dbh->{mock_add_resultset} = [
+ [ 'id', 'type', 'inventory_id' ],
+ @rows,
+ ];
+
+ my $results = $dbh->selectall_arrayref( 'SELECT id, type, inventory_id FROM Swallow' );
+
+ is_deeply( $results,
+ \@rows,
+ 'bind_col implementation does not break selectall_* methods' );
+}
+
Modified: branches/upstream/libdbd-mock-perl/current/t/bug_0001.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdbd-mock-perl/current/t/bug_0001.t?rev=21031&op=diff
==============================================================================
--- branches/upstream/libdbd-mock-perl/current/t/bug_0001.t (original)
+++ branches/upstream/libdbd-mock-perl/current/t/bug_0001.t Sat Jun 14 18:50:30 2008
@@ -33,3 +33,6 @@
ok( !$sth->execute(3,4), "Bind failed" );
ok( $sth->execute(1,2), "Bind passed" );
};
+
+# Shuts up warning when object is destroyed
+undef $dbh->{mock_session};
More information about the Pkg-perl-cvs-commits
mailing list