v1.27 30.05.2011

  - fetch() : do not allow undefs in primary key
  - reuseRow() : hash key names are taken from $sth->{FetchHashKeyName};
  - bug fix: -resultAs => flat_arrayref does preserve column order
  - $schema->dbh(undef) erases the current $dbh

Changes

@@ -1,5 +1,11 @@
 Revision history for Perl extension DBIx::DataModel.
 
+v1.27 30.05.2011
+  - fetch() : do not allow undefs in primary key
+  - reuseRow() : hash key names are taken from $sth->{FetchHashKeyName};
+  - bug fix: -resultAs => flat_arrayref does preserve column order
+  - $schema->dbh(undef) erases the current $dbh
+
 v1.26 31.10.2010
   - -postFetch renamed as -postBless
   - no longer import deprecated UNIVERSAL qw/isa/

MANIFEST

@@ -29,3 +29,4 @@ t/MsAccess.t
 t/ParentClasses.t
 t/pod.t
 t/Storable.t
+META.json

Makefile.PL

@@ -1,4 +1,4 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.3607
+# Note: this file was auto-generated by Module::Build::Compat version 0.3800
 require 5.006;
 use ExtUtils::MakeMaker;
 WriteMakefile

lib/DBIx/DataModel.pm

@@ -8,7 +8,7 @@ use warnings;
 use strict;
 use DBIx::DataModel::Schema;
 
-our $VERSION = '1.26';
+our $VERSION = '1.27';
 
 sub Schema {
   my $class = shift;

lib/DBIx/DataModel/Doc/Design.pod

@@ -1008,4 +1008,4 @@ a future release C<DBIx::DataModel> :
     ->select(..., -resultAs => 'statement'); but needs that
        - -resultAs => 'statement' does 'refine' but not 'sqlize'
        - next() accepts an unexecuted statement and automatically executes it
-  - dbh(undef) should erase the current $dbh
+  - inheritance between tables: a) support for Postgres; b) support for DB views

lib/DBIx/DataModel/Doc/Reference.pod

@@ -1025,6 +1025,8 @@ However, a nested transaction may temporarily change
 the database handle by supplying it as argument to the 
 L</doTransaction> method.
 
+To unset the database handle, call C<< $schema->dbh(undef) >>.
+
 =head2 schema
 
   $schema = $class->schema;
@@ -2111,4 +2113,10 @@ L<DBIx::DataModel::Statement|DBIx::DataModel::Statement> API.
 C<preselectWhere> is no longer needed (superseded by the
 C<Statement::refine> method).
 
+=item *
+
+C<-postFetch> in C<< select(..., -postFetch => sub {... } ... ) >>
+is now called C<-postBless>
+
+
 =back

lib/DBIx/DataModel/Schema.pm

@@ -565,25 +565,32 @@ sub dbh {
   my ($class, $dbh, %dbh_options) = @_;
   my $classData = $class->classData;
 
-  if ($dbh) {
+  if (@_ > 1) {
 
     # also support syntax ->dbh([$dbh, %dbh_options])
-    ($dbh, %dbh_options) = @$dbh if ref $dbh eq 'ARRAY' && ! keys %dbh_options;
+    ($dbh, %dbh_options) = @$dbh 
+      if $dbh && ref $dbh eq 'ARRAY' && ! keys %dbh_options;
 
     # forbid change of dbh while doing a transaction
     not $classData->{dbh} or $classData->{dbh}[0]{AutoCommit}
       or croak "cannot change dbh(..) while in a transaction";
 
-    # $dbh must be a database handle
-    $dbh->isa('DBI::db')
-      or croak "invalid dbh argument";
+    if ($dbh) {
+      # $dbh must be a database handle
+      $dbh->isa('DBI::db')
+        or croak "invalid dbh argument";
 
-    # only accept $dbh with RaiseError set
-    $dbh->{RaiseError} 
-      or croak "arg to dbh(..) must have RaiseError=1";
+      # only accept $dbh with RaiseError set
+      $dbh->{RaiseError} 
+        or croak "arg to dbh(..) must have RaiseError=1";
 
-    # store the dbh
-    $classData->{dbh} = [$dbh, %dbh_options];
+      # store the dbh
+      $classData->{dbh} = [$dbh, %dbh_options];
+    }
+    else {
+      # $dbh was undef, so remove previous dbh
+      delete $classData->{dbh};
+    }
   }
 
   my $return_dbh = $classData->{dbh} || [];

lib/DBIx/DataModel/Statement.pm

@@ -157,6 +157,10 @@ sub refine {
         @pk_columns == @$primKey
           or croak sprintf "fetch from %s: primary key should have %d values",
                            $self->{source}, scalar(@pk_columns);
+        foreach my $val (@$primKey) {
+          defined $val
+            or croak "fetch from $self->{source}: undefined val in primary key";
+        }
         my %where = ();
         @where{@pk_columns} = @$primKey;
         $self->_add_conditions(\%where);
@@ -445,11 +449,13 @@ sub select {
     # CASE flat_arrayref : flattened columns from each row
     /^flat(?:_array(?:ref)?)?$/ and do {
       $self->reuseRow;
-      my @cols;
+      my @vals;
+      my $hash_key_name = $self->{sth}{FetchHashKeyName} || 'NAME';
+      my $cols = $self->{sth}{$hash_key_name};
       while (my $row = $self->next) {
-        push @cols, values %$row;
+        push @vals, @{$row}{@$cols};
       }
-      return \@cols;
+      return \@vals;
     };
 
 
@@ -467,7 +473,8 @@ sub reuseRow {
 
   # create a reusable hash and bind_columns to it (see L<DBI/bind_columns>)
   my %row;
-  $self->{sth}->bind_columns(\(@row{@{$self->{sth}{NAME}}}));
+  my $hash_key_name = $self->{sth}{FetchHashKeyName} || 'NAME';
+  $self->{sth}->bind_columns(\(@row{@{$self->{sth}{$hash_key_name}}}));
   $self->{reuseRow} = \%row; 
 }
 

t/DBIx-DataModel.t

@@ -6,7 +6,7 @@ use Data::Dumper;
 use SQL::Abstract::Test import => [qw/is_same_sql_bind/];
 use Storable qw/dclone/;
 
-use constant N_DBI_MOCK_TESTS => 99;
+use constant N_DBI_MOCK_TESTS => 101;
 use constant N_BASIC_TESTS    => 15;
 
 use Test::More tests => (N_BASIC_TESTS + N_DBI_MOCK_TESTS);
@@ -118,7 +118,7 @@ SKIP: {
   eval "use DBD::Mock 1.36; 1"
     or skip "DBD::Mock 1.36 does not seem to be installed", N_DBI_MOCK_TESTS;
 
-  my $dbh = DBI->connect('DBI:Mock:', '', '', {RaiseError => 1});
+  my $dbh = DBI->connect('DBI:Mock:', '', '', {RaiseError => 1, AutoCommit => 1});
 
   # sqlLike : takes a list of SQL regex and bind params, and a test msg.
   # Checks if those match with the DBD::Mock history.
@@ -140,6 +140,10 @@ SKIP: {
   HR->dbh($dbh);
   isa_ok(HR->dbh, 'DBI::db', 'dbh handle');
 
+  HR->dbh(undef);
+  is(HR->dbh, undef, 'dbh handle was unset');
+
+  HR->dbh($dbh);
 
   $lst = HR::Employee->select;
   sqlLike('SELECT * FROM T_Employee', [], 'empty select');
@@ -227,9 +231,7 @@ SKIP: {
           [""], 'fetch (empty string)');
 
 
-  $emp2 = HR::Employee->fetch(undef);
-  sqlLike('SELECT * FROM T_Employee WHERE (emp_id IS NULL)', 
-          [], 'fetch (undef)');
+  die_ok {$emp2 = HR::Employee->fetch(undef)};
 
 
   # successive calls to fetch_cached 
@@ -362,8 +364,13 @@ die_ok {$emp->emp_id};
 
     my $pairs = HR::Employee->select(-columns  => [qw/col1 col2/],
                                      -resultAs => 'flat_arrayref');
-    my %hash = @$pairs;
-    is_deeply(\%hash, {foo1 => 'foo2', bar1 => 'bar2'}, "resultAs => 'flat_arrayref'");
+    is_deeply($pairs, [qw/foo1 foo2 bar1 bar2/], "resultAs => 'flat_arrayref'");
+
+    $dbh->{mock_clear_history} = 1;
+    $dbh->{mock_add_resultset} = [map {[reverse @$_]} @fake_rs];
+    $pairs = HR::Employee->select(-columns  => [qw/col2 col1/],
+                                  -resultAs => 'flat_arrayref');
+    is_deeply($pairs, [qw/foo2 foo1 bar2 bar1/], "resultAs => 'flat_arrayref'");
   }