[Bast-commits] r5533 - in DBIx-Class/0.08/branches/multi_stuff: .
lib/DBIx/Class
matthewt at dev.catalyst.perl.org
matthewt at dev.catalyst.perl.org
Fri Feb 20 02:22:47 GMT 2009
Author: matthewt
Date: 2009-02-20 02:22:47 +0000 (Fri, 20 Feb 2009)
New Revision: 5533
Modified:
DBIx-Class/0.08/branches/multi_stuff/Makefile.PL
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Row.pm
Log:
add DBIC_MULTICREATE_DEBUG, fix one bug with column values not being transferred
Modified: DBIx-Class/0.08/branches/multi_stuff/Makefile.PL
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/Makefile.PL 2009-02-19 22:35:05 UTC (rev 5532)
+++ DBIx-Class/0.08/branches/multi_stuff/Makefile.PL 2009-02-20 02:22:47 UTC (rev 5533)
@@ -25,6 +25,7 @@
requires 'Path::Class' => 0;
requires 'List::Util' => 1.19;
requires 'Sub::Name' => 0.04;
+requires 'namespace::clean' => 0.09;
# Perl 5.8.0 doesn't have utf8::is_utf8()
requires 'Encode' => 0 if ($] <= 5.008000);
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm 2009-02-19 22:35:05 UTC (rev 5532)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm 2009-02-20 02:22:47 UTC (rev 5533)
@@ -1014,6 +1014,9 @@
$ret->{$otherrel} = $otherrel_info;
}
}
+use Data::Dumper;
+#warn "return for reverse_relationship_info called on ".$self->name." for $rel:\n";
+#warn Dumper($ret);
return $ret;
}
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Row.pm 2009-02-19 22:35:05 UTC (rev 5532)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Row.pm 2009-02-20 02:22:47 UTC (rev 5533)
@@ -8,6 +8,13 @@
use Scalar::Util ();
use Scope::Guard;
+BEGIN {
+ *MULTICREATE_DEBUG =
+ $ENV{DBIC_MULTICREATE_DEBUG}
+ ? sub () { 1 }
+ : sub () { 0 };
+}
+
__PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
=head1 NAME
@@ -145,24 +152,38 @@
$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
- $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+ if ($rel_obj->in_storage) {
+ $new->set_from_related($key, $rel_obj);
+ } else {
+ $new->{_rel_in_storage} = 0;
+ MULTICREATE_DEBUG and warn "MC $new: uninserted $key $rel_obj\n";
+ }
- $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
$related->{$key} = $rel_obj;
next;
} elsif ($info && $info->{attrs}{accessor}
&& $info->{attrs}{accessor} eq 'multi'
&& ref $attrs->{$key} eq 'ARRAY') {
my $others = delete $attrs->{$key};
- foreach my $rel_obj (@$others) {
+ my $total = @$others;
+ my @objects;
+ foreach my $idx (0 .. $#$others) {
+ my $rel_obj = $others->[$idx];
if(!Scalar::Util::blessed($rel_obj)) {
$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
- $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+ if ($rel_obj->in_storage) {
+ $new->set_from_related($key, $rel_obj);
+ } else {
+ $new->{_rel_in_storage} = 0;
+ MULTICREATE_DEBUG and
+ warn "MC $new: uninserted $key $rel_obj ($idx of $total)\n";
+ }
$new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
+ push(@objects, $rel_obj);
}
- $related->{$key} = $others;
+ $related->{$key} = \@objects;
next;
} elsif ($info && $info->{attrs}{accessor}
&& $info->{attrs}{accessor} eq 'filter')
@@ -172,7 +193,10 @@
if(!Scalar::Util::blessed($rel_obj)) {
$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
- $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+ unless ($rel_obj->in_storage) {
+ $new->{_rel_in_storage} = 0;
+ MULTICREATE_DEBUG and warn "MC $new: uninserted $key $rel_obj";
+ }
$inflated->{$key} = $rel_obj;
next;
} elsif ($class->has_column($key)
@@ -256,12 +280,15 @@
$relname, { $rel_obj->get_columns }
);
+ MULTICREATE_DEBUG and warn "MC $self pre-inserting $relname $rel_obj\n";
+
$rel_obj->insert();
$self->set_from_related($relname, $rel_obj);
delete $related_stuff{$relname};
}
}
+ MULTICREATE_DEBUG and warn "MC $self inserting self\n";
my $updated_cols = $source->storage->insert($source, { $self->get_columns });
foreach my $col (keys %$updated_cols) {
$self->store_column($col, $updated_cols->{$col});
@@ -276,7 +303,7 @@
if (@auto_pri) {
#$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
# if defined $too_many;
-
+ MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @auto_pri)."\n";
my $storage = $self->result_source->storage;
$self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
unless $storage->can('last_insert_id');
@@ -284,8 +311,10 @@
$self->throw_exception( "Can't get last insert id" )
unless (@ids == @auto_pri);
$self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
+#use Data::Dumper; warn Dumper($self);
}
+
$self->{_dirty_columns} = {};
$self->{related_resultsets} = {};
@@ -306,8 +335,12 @@
$obj->set_from_related($_, $self) for keys %$reverse;
my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
if ($self->__their_pk_needs_us($relname, $them)) {
- $obj = $self->find_or_create_related($relname, $them);
+ MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj";
+ my $re = $self->find_or_create_related($relname, $them);
+ $obj->{_column_data} = $re->{_column_data};
+ MULTICREATE_DEBUG and warn "MC $self new $relname $obj";
} else {
+ MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
$obj->insert();
}
}
More information about the Bast-commits
mailing list