A little cleanup of ->id callsites (incomplete)
Peter Rabbitson [Tue, 29 Jul 2014 02:17:04 +0000 (04:17 +0200)]
This is just to stave off an unlikely but possible 'id' colname masking a
multicol PK

The real workaround is to do something akin to Moose's ->meta, but that's
another battle.

lib/DBIx/Class.pm
lib/DBIx/Class/InflateColumn/File.pm
lib/DBIx/Class/PK.pm
lib/DBIx/Class/Row.pm
t/82cascade_copy.t
t/lib/DBICTest/Schema/CD.pm
t/lib/DBICTest/Schema/TwoKeys.pm

index 63630fd..91e2807 100644 (file)
@@ -396,6 +396,8 @@ Grant Street Group L<http://www.grantstreet.com/>
 
 groditi: Guillermo Roditi <groditi@cpan.org>
 
+guacamole: Fred Steinberg <fred.steinberg@gmail.com>
+
 Haarg: Graham Knop <haarg@haarg.org>
 
 hobbs: Andrew Rodland <arodland@cpan.org>
index 195e6ef..d4984f8 100644 (file)
@@ -47,6 +47,10 @@ sub _file_column_file {
 
     return unless $column_info->{is_file_column};
 
+    # DO NOT CHANGE
+    # This call to id() is generally incorrect - will not DTRT on
+    # multicolumn key. However changing this may introduce
+    # backwards-comp regressions, thus leaving as is
     my $id = $self->id || $self->throw_exception(
         'id required for filename generation'
     );
index cb204b7..c45071f 100644 (file)
@@ -87,7 +87,7 @@ sub ID {
 
 sub _create_ID {
   my ($self, %vals) = @_;
-  return undef unless 0 == grep { !defined } values %vals;
+  return undef if grep { !defined } values %vals;
   return join '|', ref $self || $self, $self->result_source->name,
     map { $_ . '=' . $vals{$_} } sort keys %vals;
 }
index 6dfe30e..f785773 100644 (file)
@@ -1180,10 +1180,8 @@ sub copy {
 
     my $copied = $rel_names_copied->{ $rel_info->{source} } ||= {};
     foreach my $related ($self->search_related($rel_name)->all) {
-      my $id_str = join("\0", $related->id);
-      next if $copied->{$id_str};
-      $copied->{$id_str} = 1;
-      my $rel_copy = $related->copy($resolved);
+      $related->copy($resolved)
+        unless $copied->{$related->ID}++;
     }
 
   }
index 14c4762..ec3ba92 100644 (file)
@@ -17,10 +17,24 @@ cmp_ok($cover_band->id, '!=', $artist->id, 'ok got new column id...');
 is($cover_cds->count, $artist_cds->count, 'duplicated rows count ok');
 
 #check multi-keyed
-cmp_ok($cover_band->search_related('twokeys')->count, '>', 0, 'duplicated multiPK ok');
+is(
+  $cover_band->search_related('twokeys')->count,
+  $artist->search_related('twokeys')->count,
+  'duplicated multiPK ok'
+);
 
 #and check copying a few relations away
 cmp_ok($cover_cds->search_related('tags')->count, '==',
    $artist_cds->search_related('tags')->count , 'duplicated count ok');
 
+
+# check from the other side
+my $cd = $schema->resultset('CD')->find(1);
+my $dup_cd = $cd->copy ({ title => 'ha!' });
+is(
+  $dup_cd->search_related('twokeys')->count,
+  $cd->search_related('twokeys')->count,
+  'duplicated multiPK ok'
+);
+
 done_testing;
index e7cccca..190f11d 100644 (file)
@@ -69,6 +69,9 @@ __PACKAGE__->has_many(
     cd_to_producer => 'DBICTest::Schema::CD_to_Producer' => 'cd'
 );
 
+__PACKAGE__->has_many( twokeys => 'DBICTest::Schema::TwoKeys', 'cd' );
+
+
 # the undef condition in this rel is *deliberate*
 # tests oddball legacy syntax
 __PACKAGE__->might_have(
index ff8f980..d28cf60 100644 (file)
@@ -18,7 +18,7 @@ __PACKAGE__->belongs_to(
     {'foreign.artistid'=>'self.artist'},
 );
 
-__PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD', undef, { is_deferrable => 0, add_fk_index => 0 } );
+__PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD', undef, { is_deferrable => 0, on_update => undef, on_delete => undef, add_fk_index => 0 } );
 
 __PACKAGE__->has_many(
   'fourkeys_to_twokeys', 'DBICTest::Schema::FourKeys_to_TwoKeys', {