X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=2b90433ee5114fa78d40a83dfd740ec996d589b9;hb=de404241cdaea8c3c680ddfdf738c9f0c83ddee0;hp=d58d95771199f9d3372135a997c3dd582a8b249a;hpb=6dbea98e46d81ecc75a3d0dad994aef882426d35;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index d58d957..2b90433 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -8,6 +8,13 @@ use Carp::Clan qw/^DBIx::Class/; 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 @@ -21,13 +28,42 @@ DBIx::Class::Row - Basic row methods This class is responsible for defining and doing basic operations on rows derived from L objects. +Row objects are returned from Ls using the +L, L, +L and L methods, +as well as invocations of 'single' ( +L, +L or +L) +relationship accessors of L objects. + =head1 METHODS =head2 new - my $obj = My::Class->new($attrs); + my $row = My::Class->new(\%attrs); + + my $row = $schema->resultset('MySource')->new(\%colsandvalues); + +=over + +=item Arguments: \%attrs or \%colsandvalues -Creates a new row object from column => value mappings passed as a hash ref +=item Returns: A Row object + +=back + +While you can create a new row object by calling C directly on +this class, you are better off calling it on a +L object. + +When calling it directly, you will not get a complete, usable row +object until you pass or set the C attribute, to a +L instance that is attached to a +L with a valid connection. + +C<$attrs> is a hashref of column name, value data. It can also contain +some other attributes such as the C. Passing an object, or an arrayref of objects as a value will call L for you. When @@ -46,6 +82,40 @@ For a more involved explanation, see L. ## check Relationship::CascadeActions and Relationship::Accessor for compat ## tests! +sub __new_related_find_or_new_helper { + my ($self, $relname, $data) = @_; + if ($self->__their_pk_needs_us($relname, $data)) { + MULTICREATE_DEBUG and warn "MC $self constructing $relname via new_result"; + return $self->result_source + ->related_source($relname) + ->resultset + ->new_result($data); + } + if ($self->result_source->pk_depends_on($relname, $data)) { + MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new"; + return $self->result_source + ->related_source($relname) + ->resultset + ->find_or_new($data); + } + MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new_related"; + return $self->find_or_new_related($relname, $data); +} + +sub __their_pk_needs_us { # this should maybe be in resultsource. + my ($self, $relname, $data) = @_; + my $source = $self->result_source; + my $reverse = $source->reverse_relationship_info($relname); + my $rel_source = $source->related_source($relname); + my $us = { $self->get_columns }; + 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); + } + return 0; +} + sub new { my ($class, $attrs) = @_; $class = ref $class if ref $class; @@ -58,10 +128,16 @@ sub new { if (my $handle = delete $attrs->{-source_handle}) { $new->_source_handle($handle); } - if (my $source = delete $attrs->{-result_source}) { + + my $source; + if ($source = delete $attrs->{-result_source}) { $new->result_source($source); } + if (my $related = delete $attrs->{-from_resultset}) { + @{$new->{_ignore_at_insert}={}}{@$related} = (); + } + if ($attrs) { $new->throw_exception("attrs must be a hashref") unless ref($attrs) eq 'HASH'; @@ -73,33 +149,48 @@ sub new { foreach my $key (keys %$attrs) { if (ref $attrs->{$key}) { ## Can we extract this lot to use with update(_or .. ) ? - my $info = $class->relationship_info($key); + confess "Can't do multi-create without result source" unless $source; + my $info = $source->relationship_info($key); if ($info && $info->{attrs}{accessor} && $info->{attrs}{accessor} eq 'single') { my $rel_obj = delete $attrs->{$key}; if(!Scalar::Util::blessed($rel_obj)) { - $rel_obj = $new->find_or_new_related($key, $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\n"; + } - $new->set_from_related($key, $rel_obj); $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($key, $rel_obj); - $new->{_rel_in_storage} = 0; + $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+1)} 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') @@ -107,8 +198,11 @@ sub new { ## 'filter' should disappear and get merged in with 'single' above! my $rel_obj = delete $attrs->{$key}; if(!Scalar::Util::blessed($rel_obj)) { - $rel_obj = $new->find_or_new_related($key, $rel_obj); - $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage); + $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj); + } + 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; @@ -132,13 +226,21 @@ sub new { =head2 insert - $obj->insert; + $row->insert; + +=over + +=item Arguments: none + +=item Returns: The Row object + +=back -Inserts an object into the database if it isn't already in -there. Returns the object itself. Requires the object's result source to -be set, or the class to have a result_source_instance method. To insert -an entirely new object into the database, use C (see -L). +Inserts an object previously created by L into the database if +it isn't already in there. Returns the object itself. Requires the +object's result source to be set, or the class to have a +result_source_instance method. To insert an entirely new row into +the database, use C (see L). To fetch an uninserted row object, call L on a resultset. @@ -181,36 +283,28 @@ sub insert { next REL unless (Scalar::Util::blessed($rel_obj) && $rel_obj->isa('DBIx::Class::Row')); - my $cond = $source->relationship_info($relname)->{cond}; + next REL unless $source->pk_depends_on( + $relname, { $rel_obj->get_columns } + ); - next REL unless ref($cond) eq 'HASH'; + MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n"; - # map { foreign.foo => 'self.bar' } to { bar => 'foo' } - - my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond }; - - # assume anything that references our PK probably is dependent on us - # rather than vice versa, unless the far side is (a) defined or (b) - # auto-increment - - foreach my $p (@pri) { - if (exists $keyhash->{$p}) { - unless (defined($rel_obj->get_column($keyhash->{$p})) - || $rel_obj->column_info($keyhash->{$p}) - ->{is_auto_increment}) { - next REL; - } - } - } - - $rel_obj->insert(); + my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_inflated_columns }; + my $re = $self->find_or_create_related($relname, $them); + %{$rel_obj} = %{$re}; $self->set_from_related($relname, $rel_obj); delete $related_stuff{$relname}; } } + MULTICREATE_DEBUG and do { + no warnings 'uninitialized'; + warn "MC $self inserting (".join(', ', $self->get_columns).")\n"; + }; my $updated_cols = $source->storage->insert($source, { $self->get_columns }); - $self->set_columns($updated_cols); + foreach my $col (keys %$updated_cols) { + $self->store_column($col, $updated_cols->{$col}); + } ## PK::Auto my @auto_pri = grep { @@ -221,7 +315,7 @@ sub insert { 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'); @@ -229,10 +323,15 @@ sub insert { $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} = {}; + if(!$self->{_rel_in_storage}) { - ## Now do the has_many rels, that need $selfs ID. + ## Now do the relationships that need our ID (has_many etc.) foreach my $relname (keys %related_stuff) { my $rel_obj = $related_stuff{$relname}; my @cands; @@ -246,24 +345,47 @@ sub insert { my $reverse = $source->reverse_relationship_info($relname); foreach my $obj (@cands) { $obj->set_from_related($_, $self) for keys %$reverse; - $obj->insert() unless ($obj->in_storage || $obj->result_source->resultset->search({$obj->get_columns})->count); + my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns }; + if ($self->__their_pk_needs_us($relname, $them)) { + if (exists $self->{_ignore_at_insert}{$relname}) { + MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname"; + } else { + MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj"; + my $re = $self->result_source + ->related_source($relname) + ->resultset + ->find_or_create($them); + %{$obj} = %{$re}; + MULTICREATE_DEBUG and warn "MC $self new $relname $obj"; + } + } else { + MULTICREATE_DEBUG and warn "MC $self post-inserting $obj"; + $obj->insert(); + } } } } + delete $self->{_ignore_at_insert}; $rollback_guard->commit; } $self->in_storage(1); - $self->{_dirty_columns} = {}; - $self->{related_resultsets} = {}; undef $self->{_orig_ident}; return $self; } =head2 in_storage - $obj->in_storage; # Get value - $obj->in_storage(1); # Set value + $row->in_storage; # Get value + $row->in_storage(1); # Set value + +=over + +=item Arguments: none or 1|0 + +=item Returns: 1|0 + +=back Indicates whether the object exists as a row in the database or not. This is set to true when L, @@ -283,24 +405,35 @@ sub in_storage { =head2 update - $obj->update \%columns?; + $row->update(\%columns?) + +=over -Must be run on an object that is already in the database; issues an SQL -UPDATE query to commit any changes to the object to the database if -required. +=item Arguments: none or a hashref -Also takes an options hashref of C<< column_name => value> pairs >> to update -first. But be aware that the hashref will be passed to -C, which might edit it in place, so dont rely on it being -the same after a call to C. If you need to preserve the hashref, it is -sufficient to pass a shallow copy to C, e.g. ( { %{ $href } } ) +=item Returns: The Row object + +=back + +Throws an exception if the row object is not yet in the database, +according to L. + +This method issues an SQL UPDATE query to commit any changes to the +object to the database if required. + +Also takes an optional hashref of C<< column_name => value> >> pairs +to update on the object first. Be aware that the hashref will be +passed to C, which might edit it in place, so +don't rely on it being the same after a call to C. If you +need to preserve the hashref, it is sufficient to pass a shallow copy +to C, e.g. ( { %{ $href } } ) If the values passed or any of the column values set on the object contain scalar references, eg: - $obj->last_modified(\'NOW()'); + $row->last_modified(\'NOW()'); # OR - $obj->update({ last_modified => \'NOW()' }); + $row->update({ last_modified => \'NOW()' }); The update will pass the values verbatim into SQL. (See L docs). The values in your Row object will NOT change @@ -308,7 +441,15 @@ as a result of the update call, if you want the object to be updated with the actual values from the database, call L after the update. - $obj->update()->discard_changes(); + $row->update()->discard_changes(); + +To determine before calling this method, which column values have +changed and will be updated, call L. + +To check if any columns will be updated, call L. + +To force a column to be updated, call L before +this method. =cut @@ -339,16 +480,40 @@ sub update { =head2 delete - $obj->delete + $row->delete + +=over + +=item Arguments: none + +=item Returns: The Row object + +=back + +Throws an exception if the object is not in the database according to +L. Runs an SQL DELETE statement using the primary key +values to locate the row. -Deletes the object from the database. The object is still perfectly -usable, but C<< ->in_storage() >> will now return 0 and the object must -reinserted using C<< ->insert() >> before C<< ->update() >> can be used -on it. If you delete an object in a class with a C -relationship, all the related objects will be deleted as well. To turn -this behavior off, pass C<< cascade_delete => 0 >> in the C<$attr> -hashref. Any database-level cascade or restrict will take precedence -over a DBIx-Class-based cascading delete. See also L. +The object is still perfectly usable, but L will +now return 0 and the object must be reinserted using L +before it can be used to L the row again. + +If you delete an object in a class with a C relationship, an +attempt is made to delete all the related objects as well. To turn +this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr> +hashref of the relationship, see L. Any +database-level cascade or restrict will take precedence over a +DBIx-Class-based cascading delete. + +If you delete an object within a txn_do() (see L) +and the transaction subsequently fails, the row object will remain marked as +not being in storage. If you know for a fact that the object is still in +storage (i.e. by inspecting the cause of the transaction's failure), you can +use C<< $obj->in_storage(1) >> to restore consistency between the object and +the database. This would allow a subsequent C<< $obj->delete >> to work +as expected. + +See also L. =cut @@ -356,7 +521,7 @@ sub delete { my $self = shift; if (ref $self) { $self->throw_exception( "Not in database" ) unless $self->in_storage; - my $ident_cond = $self->ident_condition; + my $ident_cond = $self->{_orig_ident} || $self->ident_condition; $self->throw_exception("Cannot safely delete a row in a PK-less table") if ! keys %$ident_cond; foreach my $column (keys %$ident_cond) { @@ -378,7 +543,18 @@ sub delete { =head2 get_column - my $val = $obj->get_column($col); + my $val = $row->get_column($col); + +=over + +=item Arguments: $columnname + +=item Returns: The value of the column + +=back + +Throws an exception if the column name given doesn't exist according +to L. Returns a raw column value from the row object, if it has already been fetched from the database or set by an accessor. @@ -386,6 +562,13 @@ been fetched from the database or set by an accessor. If an L has been set, it will be deflated and returned. +Note that if you used the C or the C