Merge 'trunk' into 'DBIx-Class-current'

r9713@obrien (orig r1493):  purge | 2006-04-19 19:57:26 +0100
=Test for Data::Dumper::Sortkeys incompatibility (export DATA_DUMPER_TEST=1).
r9714@obrien (orig r1494):  matthewt | 2006-04-19 21:18:18 +0100
Fix to copy
r9715@obrien (orig r1495):  matthewt | 2006-04-19 21:47:36 +0100
fixup for Dumper brain damage
r9718@obrien (orig r1496):  matthewt | 2006-04-19 23:01:31 +0100
make set_from_related handle undef
r9719@obrien (orig r1497):  matthewt | 2006-04-20 00:19:13 +0100
nuked last remaining each uses. just because.
r9720@obrien (orig r1498):  matthewt | 2006-04-20 00:45:47 +0100
Changes for 0.06002

diff --git a/Changes b/Changes
index bfd86af..e8b7378 100644 (file)
--- a/Changes
+++ b/Changes
@@ -16,7 +16,10 @@ Revision history for DBIx::Class
         - CDBICompat: override find_or_create to fix column casing when
           ColumnCase is loaded
 
-0.06002
+0.06002 2006-04-20 00:42:41
+        - fix set_from_related to accept undef
+        - fix to Dumper-induced hash iteration bug
+        - fix to copy() with non-composed resultsource
         - fix to ->search without args to clone rs but maintain cache
         - grab $self->dbh once per function in Storage::DBI
         - nuke ResultSource caching of ->resultset for consistency reasons

diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index 784c131..f141676 100644 (file)
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -13,7 +13,7 @@ sub component_base_class { 'DBIx::Class' }
 # i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
 # brain damage and presumably various other packaging systems too
 
-$VERSION = '0.06001';
+$VERSION = '0.06002';
 
 sub MODIFY_CODE_ATTRIBUTES {
     my ($class,$code,@attrs) = @_;

diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index 2f6d3a3..020a2c3 100644 (file)
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -306,9 +306,11 @@ sub set_from_related {
     "condition for $rel is of type ".
     (ref $cond ? ref $cond : 'plain scalar')
   ) unless ref $cond eq 'HASH';
-  my $f_class = $self->result_source->schema->class($rel_obj->{class});
-  $self->throw_exception( "Object $f_obj isn't a ".$f_class )
-    unless $f_obj->isa($f_class);
+  if (defined $f_obj) {
+    my $f_class = $self->result_source->schema->class($rel_obj->{class});
+    $self->throw_exception( "Object $f_obj isn't a ".$f_class )
+      unless $f_obj->isa($f_class);
+  }
   $self->set_columns(
     $self->result_source->resolve_condition(
        $rel_obj->{cond}, $f_obj, $rel));

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 32fb84e..ee55dbc 100644 (file)
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -683,7 +683,8 @@ sub resolve_condition {
   #warn %$cond;
   if (ref $cond eq 'HASH') {
     my %ret;
-    while (my ($k, $v) = each %{$cond}) {
+    foreach my $k (keys %{$cond}) {
+      my $v = $cond->{$k};
       # XXX should probably check these are valid columns
       $k =~ s/^foreign\.// ||
         $self->throw_exception("Invalid rel cond key ${k}");
@@ -693,8 +694,12 @@ sub resolve_condition {
         #warn "$self $k $for $v";
         $ret{$k} = $for->get_column($v);
         #warn %ret;
+      } elsif (!defined $for) { # undef, i.e. "no object"
+        $ret{$k} = undef;
       } elsif (ref $as) { # reverse object
         $ret{$v} = $as->get_column($k);
+      } elsif (!defined $as) { # undef, i.e. "no reverse object"
+        $ret{$v} = undef;
       } else {
         $ret{"${as}.${k}"} = "${for}.${v}";
       }

diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index d9a29c8..0752589 100644 (file)
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -38,10 +38,10 @@ sub new {
   if ($attrs) {
     $new->throw_exception("attrs must be a hashref")
       unless ref($attrs) eq 'HASH';
-    while (my ($k, $v) = each %$attrs) {
+    foreach my $k (keys %$attrs) {
       $new->throw_exception("No such column $k on $class")
         unless $class->has_column($k);
-      $new->store_column($k => $v);
+      $new->store_column($k => $attrs->{$k});
     }
   }
   return $new;
@@ -232,8 +232,8 @@ Sets more than one column value at once.
 
 sub set_columns {
   my ($self,$data) = @_;
-  while (my ($col,$val) = each %$data) {
-    $self->set_column($col,$val);
+  foreach my $col (keys %$data) {
+    $self->set_column($col,$data->{$col});
   }
   return $self;
 }
@@ -255,6 +255,7 @@ sub copy {
       if $self->result_source->column_info($col)->{is_auto_increment};
   }
   my $new = bless { _column_data => $col_data }, ref $self;
+  $new->result_source($self->result_source);
   $new->set_columns($changes);
   $new->insert;
   foreach my $rel ($self->result_source->relationships) {

diff --git a/t/26dumper.t b/t/26dumper.t
new file mode 100644 (file)
index 0000000..6904fdc
--- /dev/null
+++ b/t/26dumper.t
@@ -0,0 +1,36 @@
+use strict;
+use Test::More;
+use IO::File;
+
+use Data::Dumper;
+$Data::Dumper::Sortkeys = 1;
+
+use lib qw(t/lib);
+
+BEGIN {
+    eval "use DBD::SQLite";
+    plan $ENV{DATA_DUMPER_TEST}
+        ? ( tests => 3 )
+        : ( skip_all => 'Set $ENV{DATA_DUMPER_TEST} to run this test' );
+}
+
+
+use_ok('DBICTest');
+use_ok('DBICTest::HelperRels');
+
+
+my $rs = DBICTest::CD->search(
+           { 'artist.name' => 'We Are Goth',
+             'liner_notes.notes' => 'Kill Yourself!' },
+           { join => [ qw/artist liner_notes/ ] });
+
+Dumper($rs);
+
+$rs = DBICTest::CD->search(
+           { 'artist.name' => 'We Are Goth',
+             'liner_notes.notes' => 'Kill Yourself!' },
+           { join => [ qw/artist liner_notes/ ] });
+
+cmp_ok( $rs + 0, '==', 1, "Single record in after death with dumper");
+
+1;

diff --git a/t/run/06relationship.tl b/t/run/06relationship.tl
index 19fceb8..b85fea1 100644 (file)
--- a/t/run/06relationship.tl
+++ b/t/run/06relationship.tl
@@ -3,7 +3,7 @@ my $schema = shift;
 
 use strict;
 use warnings;  
-plan tests => 29;
+plan tests => 30;
 
 # has_a test
 my $cd = $schema->resultset("CD")->find(4);
@@ -50,12 +50,17 @@ my $track = $schema->resultset("Track")->create( {
 } );
 $track->set_from_related( cd => $cd );
 
-if ($INC{'DBICTest/HelperRels.pm'}) { # except inflated object
+if ($INC{'DBICTest/HelperRels.pm'}) { # expect inflated object
   is($track->disc->cdid, 4, 'set_from_related ok, including alternative accessor' );
 } else {
   is( $track->cd, 4, 'set_from_related ok' );
 }
 
+$track->set_from_related( cd => undef );
+
+ok( !defined($track->cd), 'set_from_related with undef ok');
+
+
 # update_from_related, the same as set_from_related, but it calls update afterwards
 $track = $schema->resultset("Track")->create( {
   trackid => 2,

diff --git a/t/run/22cascade_copy.tl b/t/run/22cascade_copy.tl
index 8c682e5..82642f2 100644 (file)
--- a/t/run/22cascade_copy.tl
+++ b/t/run/22cascade_copy.tl
@@ -7,7 +7,16 @@ my $schema = shift;
 plan tests => 4;
 my $artist = $schema->resultset('Artist')->find(1);
 my $artist_cds = $artist->search_related('cds');
-my $cover_band = $artist->copy;
+
+my $cover_band;
+
+{
+  no warnings 'redefine';
+  local *DBICTest::Artist::result_source_instance = \&DBICTest::Schema::Artist::result_source_instance;
+
+  $cover_band = $artist->copy;
+}
+
 my $cover_cds = $cover_band->search_related('cds');
 cmp_ok($cover_band->id, '!=', $artist->id, 'ok got new column id...');
 is($cover_cds->count, $artist_cds->count, 'duplicated rows count ok');