r21033 - in /trunk/libdbd-mock-perl: .shipit Build.PL Changes MANIFEST META.yml Makefile.PL debian/changelog 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:51:46 UTC 2008


Author: gregoa
Date: Sat Jun 14 18:51:46 2008
New Revision: 21033

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=21033
Log:
New upstream release.

Added:
    trunk/libdbd-mock-perl/.shipit
      - copied unchanged from r21032, branches/upstream/libdbd-mock-perl/current/.shipit
    trunk/libdbd-mock-perl/t/026_st_bind_col.t
      - copied unchanged from r21032, branches/upstream/libdbd-mock-perl/current/t/026_st_bind_col.t
Modified:
    trunk/libdbd-mock-perl/Build.PL
    trunk/libdbd-mock-perl/Changes
    trunk/libdbd-mock-perl/MANIFEST
    trunk/libdbd-mock-perl/META.yml
    trunk/libdbd-mock-perl/Makefile.PL
    trunk/libdbd-mock-perl/debian/changelog
    trunk/libdbd-mock-perl/lib/DBD/Mock.pm
    trunk/libdbd-mock-perl/t/021_DBD_Mock_Session.t
    trunk/libdbd-mock-perl/t/022_DBD_Mock_Session_bound_params.t
    trunk/libdbd-mock-perl/t/024_selcol_fetchhash.t
    trunk/libdbd-mock-perl/t/bug_0001.t

Modified: trunk/libdbd-mock-perl/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbd-mock-perl/Build.PL?rev=21033&op=diff
==============================================================================
--- trunk/libdbd-mock-perl/Build.PL (original)
+++ trunk/libdbd-mock-perl/Build.PL Sat Jun 14 18:51:46 2008
@@ -20,7 +20,7 @@
     create_makefile_pl => 'traditional',
     recursive_test_files => 1,
     add_to_cleanup => [
-        'META.yml', '*.bak', '*.gz', 'Makefile.PL',
+        '*.bak',
     ],
 );
 

Modified: trunk/libdbd-mock-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbd-mock-perl/Changes?rev=21033&op=diff
==============================================================================
--- trunk/libdbd-mock-perl/Changes (original)
+++ trunk/libdbd-mock-perl/Changes Sat Jun 14 18:51:46 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: trunk/libdbd-mock-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbd-mock-perl/MANIFEST?rev=21033&op=diff
==============================================================================
--- trunk/libdbd-mock-perl/MANIFEST (original)
+++ trunk/libdbd-mock-perl/MANIFEST Sat Jun 14 18:51:46 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: trunk/libdbd-mock-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbd-mock-perl/META.yml?rev=21033&op=diff
==============================================================================
--- trunk/libdbd-mock-perl/META.yml (original)
+++ trunk/libdbd-mock-perl/META.yml Sat Jun 14 18:51:46 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: trunk/libdbd-mock-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbd-mock-perl/Makefile.PL?rev=21033&op=diff
==============================================================================
--- trunk/libdbd-mock-perl/Makefile.PL (original)
+++ trunk/libdbd-mock-perl/Makefile.PL Sat Jun 14 18:51:46 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: trunk/libdbd-mock-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbd-mock-perl/debian/changelog?rev=21033&op=diff
==============================================================================
--- trunk/libdbd-mock-perl/debian/changelog (original)
+++ trunk/libdbd-mock-perl/debian/changelog Sat Jun 14 18:51:46 2008
@@ -1,3 +1,9 @@
+libdbd-mock-perl (1.37-1) UNRELEASED; urgency=low
+
+  * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org>  Sat, 14 Jun 2008 20:50:51 +0200
+
 libdbd-mock-perl (1.36-1) unstable; urgency=low
 
   * Initial Release. (Closes: #408229, #468638)

Modified: trunk/libdbd-mock-perl/lib/DBD/Mock.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbd-mock-perl/lib/DBD/Mock.pm?rev=21033&op=diff
==============================================================================
--- trunk/libdbd-mock-perl/lib/DBD/Mock.pm (original)
+++ trunk/libdbd-mock-perl/lib/DBD/Mock.pm Sat Jun 14 18:51:46 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: trunk/libdbd-mock-perl/t/021_DBD_Mock_Session.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbd-mock-perl/t/021_DBD_Mock_Session.t?rev=21033&op=diff
==============================================================================
--- trunk/libdbd-mock-perl/t/021_DBD_Mock_Session.t (original)
+++ trunk/libdbd-mock-perl/t/021_DBD_Mock_Session.t Sat Jun 14 18:51:46 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: trunk/libdbd-mock-perl/t/022_DBD_Mock_Session_bound_params.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbd-mock-perl/t/022_DBD_Mock_Session_bound_params.t?rev=21033&op=diff
==============================================================================
--- trunk/libdbd-mock-perl/t/022_DBD_Mock_Session_bound_params.t (original)
+++ trunk/libdbd-mock-perl/t/022_DBD_Mock_Session_bound_params.t Sat Jun 14 18:51:46 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: trunk/libdbd-mock-perl/t/024_selcol_fetchhash.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbd-mock-perl/t/024_selcol_fetchhash.t?rev=21033&op=diff
==============================================================================
--- trunk/libdbd-mock-perl/t/024_selcol_fetchhash.t (original)
+++ trunk/libdbd-mock-perl/t/024_selcol_fetchhash.t Sat Jun 14 18:51:46 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,

Modified: trunk/libdbd-mock-perl/t/bug_0001.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdbd-mock-perl/t/bug_0001.t?rev=21033&op=diff
==============================================================================
--- trunk/libdbd-mock-perl/t/bug_0001.t (original)
+++ trunk/libdbd-mock-perl/t/bug_0001.t Sat Jun 14 18:51:46 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