[Bast-commits] r5179 - in
DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class: . Relationship
castaway at dev.catalyst.perl.org
castaway at dev.catalyst.perl.org
Sat Nov 22 22:36:58 GMT 2008
Author: castaway
Date: 2008-11-22 22:36:58 +0000 (Sat, 22 Nov 2008)
New Revision: 5179
Modified:
DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/Relationship/Base.pm
DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/ResultSource.pm
DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/Row.pm
Log:
Crazy ass multi create fixes..
1. pass back temp objects when checking pks for rels
2. sanitise (!?) pk_depends_on
3. set in_storage(1) just after actual insert, before inserting related objs
Modified: DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/Relationship/Base.pm
===================================================================
--- DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/Relationship/Base.pm 2008-11-22 18:56:26 UTC (rev 5178)
+++ DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/Relationship/Base.pm 2008-11-22 22:36:58 UTC (rev 5179)
@@ -403,9 +403,11 @@
$self->throw_exception( "Object $f_obj isn't a ".$f_class )
unless Scalar::Util::blessed($f_obj) and $f_obj->isa($f_class);
}
+# print STDERR "set_from_related: ", $rel, Data::Dumper::Dumper({$f_obj->get_columns});
$self->set_columns(
$self->result_source->resolve_condition(
$rel_obj->{cond}, $f_obj, $rel));
+# print STDERR "set_: ", Data::Dumper::Dumper({$self->get_columns});
return 1;
}
Modified: DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/ResultSource.pm 2008-11-22 18:56:26 UTC (rev 5178)
+++ DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/ResultSource.pm 2008-11-22 22:36:58 UTC (rev 5179)
@@ -778,12 +778,16 @@
Determines whether a relation is dependent on an object from this source
having already been inserted. Takes the name of the relationship and a
-hashref of columns of the related object.
+hashref of already known columns of the related object.
=cut
+## true if: our PK depends on the data from the given rel
+## AND its not yet in the rel_data passed
+## pk_still_unsolved? pk_has_unmet_deps?
sub pk_depends_on {
- my ($self, $relname, $rel_data) = @_;
+ my ($self, $relname, $rel_data, $existing_data) = @_;
+# print STDERR "Rel $relname on ", $self->source_name, " ", Data::Dumper::Dumper($self->relationship_info($relname));
my $cond = $self->relationship_info($relname)->{cond};
return 0 unless ref($cond) eq 'HASH';
@@ -799,16 +803,81 @@
my $rel_source = $self->related_source($relname);
foreach my $p ($self->primary_columns) {
- if (exists $keyhash->{$p}) {
- unless (defined($rel_data->{$keyhash->{$p}})
- || $rel_source->column_info($keyhash->{$p})
- ->{is_auto_increment}) {
- return 0;
+# print "Checking if $p is still needed\n";
+
+ if (exists $keyhash->{$p}) {
+ my $rel_val = $keyhash->{$p};
+# print STDERR "PK col $p, val=$rel_val\n";
+ # This column of self is autoinc. It is never needed.
+ if ($self->column_info($p)->{is_auto_increment}) {
+# print STDERR "$p is autoinc, already resolved\n";
+ next;
+ }
+
+ # This column already has data provided. (Existing_data should
+ # be hard data only, not refs to things not yet there!)
+ if (defined $existing_data->{$p}) {
+# print STDERR "$p is in existing data, already resolved\n";
+ next;
+ }
+
+ # Already is provided for by this relationship.
+ if (defined $rel_data->{$rel_val}) {
+# print STDERR "$p is already resolved by this relationship (to $relname.$rel_val)\n";
+ next;
+ }
+
+ # Can be provided by the relationship that we are currently
+ # looking at. Money-shot.
+ if ($rel_source->column_info($rel_val)->{is_auto_increment}) {
+# print STDERR "$p *WOULD BE* resolved by this relationship (but isn't yet).\n";
+ return 1;
+ }
+
+ # Can this be provided by the relationship that we are
+ # currently looking at? Well, first the thing this is
+ # related to needs to be able to provide it for
+ # itself... which is what the function we are now writing is
+ # supposed to find out. Recurse.
+ for ($rel_source->relationships) {
+ # We need to skip the reverse relationship, or we will
+ # often recurse infinitely.
+ next if $_ eq (keys %{$self->reverse_relationship_info($relname)})[0];
+ # Do we need to skip the entire call stack's worth of
+ # backrelationships? If so, we need a skiplist argument
+ # to this function -- easy to do, since we don't have
+ # any final arguments.
+ if ($rel_source->pk_depends_on($_, {}, $rel_data)) {
+ # If this relationship can resolve it, then this pk field
+ # can be resolved by $relname.
+# print "$p *WOULD BE* resolved by this relationship (but isn't yet).\n";
+ return 1;
+ }
+ }
+
+ # Bad, we are dependent.
+# print "Unresolved PK column $p, but it cannot be resolved by this relationship\n";
+ return 0;
+# unless (defined($rel_data->{$keyhash->{$p}})
+# # foreign col might be an fk itself, and not auto-inc!
+# || $rel_source->column_info($keyhash->{$p})
+# ->{is_auto_increment}
+# # but only if its not an fk to the one we were asking about!
+# || ( $rel_source->column_info($keyhash->{$p})
+# ->{is_foreign_key}
+# && $self->relationship_info($relname)->{attrs}{accessor} eq 'single'
+# )) {
+# # This needs to be true if this col is an fk on rel_source
+# # || !$rel_source->relationship_info($p) ) {
+# print STDERR "not dependant\n";
+# return 0;
+# # return $p;
+# }
}
- }
}
- return 1;
+# print STDERR "not dependant\n";
+ return 0;
}
=head2 resolve_condition
Modified: DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/Row.pm 2008-11-22 18:56:26 UTC (rev 5178)
+++ DBIx-Class/0.08/branches/multicreate/lib/DBIx/Class/Row.pm 2008-11-22 22:36:58 UTC (rev 5179)
@@ -78,17 +78,21 @@
sub __new_related_find_or_new_helper {
my ($self, $relname, $data) = @_;
if ($self->__their_pk_needs_us($relname, $data)) {
+# print STDERR "PK needs us\n";
+# print STDERR "Data: ", Data::Dumper::Dumper($data);
return $self->result_source
->related_source($relname)
->resultset
->new_result($data);
}
if ($self->result_source->pk_depends_on($relname, $data)) {
+# print STDERR "PK depends on\n";
return $self->result_source
->related_source($relname)
->resultset
->find_or_create($data);
}
+# print STDERR "Neither, find_or_new\n";
return $self->find_or_new_related($relname, $data);
}
@@ -96,12 +100,20 @@
my ($self, $relname, $data) = @_;
my $source = $self->result_source;
my $reverse = $source->reverse_relationship_info($relname);
+# print STDERR "Found reverse rel info: ", Data::Dumper::Dumper($reverse);
my $rel_source = $source->related_source($relname);
my $us = { $self->get_columns };
+# print STDERR "Test on self cols: ", Data::Dumper::Dumper($us);
foreach my $key (keys %$reverse) {
# if their primary key depends on us, then we have to
# just create a result and we'll fill it out afterwards
- return 1 if $rel_source->pk_depends_on($key, $us);
+ my $dep = $rel_source->pk_depends_on($key, $us);
+ if($dep) {
+# print STDERR "Assigning $self to $key\n";
+ $data->{$key} = $self;
+ return 1;
+ }
+# return 1 if $rel_source->pk_depends_on($key, $us);
}
return 0;
}
@@ -124,6 +136,7 @@
$new->result_source($source);
}
+# print "Source ", $source->source_name, " is $new\n";
if ($attrs) {
$new->throw_exception("attrs must be a hashref")
unless ref($attrs) eq 'HASH';
@@ -140,6 +153,8 @@
if ($info && $info->{attrs}{accessor}
&& $info->{attrs}{accessor} eq 'single')
{
+# print STDERR "Single $key ", Data::Dumper::Dumper($attrs);
+# print STDERR "from $class to: $info->{class}\n";
my $rel_obj = delete $attrs->{$key};
if(!Scalar::Util::blessed($rel_obj)) {
$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
@@ -149,10 +164,13 @@
$new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
$related->{$key} = $rel_obj;
+# print STDERR "Related :", join(", ", keys %$related), "\n";
next;
} elsif ($info && $info->{attrs}{accessor}
&& $info->{attrs}{accessor} eq 'multi'
&& ref $attrs->{$key} eq 'ARRAY') {
+# print STDERR "Multi $key ", Data::Dumper::Dumper($attrs);
+# print STDERR "from $class to: $info->{class}\n";
my $others = delete $attrs->{$key};
foreach my $rel_obj (@$others) {
if(!Scalar::Util::blessed($rel_obj)) {
@@ -163,6 +181,7 @@
$new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
}
$related->{$key} = $others;
+# print STDERR "Related :", join(", ", keys %$related), "\n";
next;
} elsif ($info && $info->{attrs}{accessor}
&& $info->{attrs}{accessor} eq 'filter')
@@ -180,6 +199,7 @@
$inflated->{$key} = $attrs->{$key};
next;
}
+# print STDERR "Done :", join(", ", keys %$related), "\n";
}
$new->throw_exception("No such column $key on $class")
unless $class->has_column($key);
@@ -246,24 +266,33 @@
my @pri = $self->primary_columns;
REL: foreach my $relname (keys %related_stuff) {
-
+# print STDERR "Looking at: $relname\n";
my $rel_obj = $related_stuff{$relname};
next REL unless (Scalar::Util::blessed($rel_obj)
&& $rel_obj->isa('DBIx::Class::Row'));
+# print STDERR "Check pk: from ", $source->source_name, " to $relname\n";
+# print STDERR "With ", Data::Dumper::Dumper({ $rel_obj->get_columns });
next REL unless $source->pk_depends_on(
$relname, { $rel_obj->get_columns }
);
-
+# print STDERR "$rel_obj\n";
+# print STDERR "in_storage: ", $rel_obj->in_storage, "\n";
+# print STDERR "Inserting $relname\n";
$rel_obj->insert();
$self->set_from_related($relname, $rel_obj);
delete $related_stuff{$relname};
}
}
+# print STDERR "self $self\n";
+# print STDERR "self in_storage ", $self->in_storage, "\n";
+# print STDERR "Ran out of rels, insert ", $source->source_name, "\n";
my $updated_cols = $source->storage->insert($source, { $self->get_columns });
$self->set_columns($updated_cols);
+ $self->in_storage(1);
+# print STDERR "$self\n";
## PK::Auto
my @auto_pri = grep {
@@ -302,10 +331,15 @@
my $reverse = $source->reverse_relationship_info($relname);
foreach my $obj (@cands) {
$obj->set_from_related($_, $self) for keys %$reverse;
- my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
+# my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
+ my $them = { $obj->get_inflated_columns };
+# print STDERR "Does $relname need our PK?\n";
if ($self->__their_pk_needs_us($relname, $them)) {
- $obj = $self->find_or_create_related($relname, $them);
+# print STDERR "Yes\n";
+ # $obj = $self->find_or_create_related($relname, $them);
+ $obj->insert();
} else {
+# print STDERR "No\n";
$obj->insert();
}
}
@@ -314,7 +348,7 @@
$rollback_guard->commit;
}
- $self->in_storage(1);
+# $self->in_storage(1);
undef $self->{_orig_ident};
return $self;
}
More information about the Bast-commits
mailing list