X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=424d750eab6c7b1665474be292421b39e873c233;hb=370f2ba2727791641c350a20e4fd09469503dbae;hp=84e6f93e12fbc97074efae8bf9c195cd828dfc7a;hpb=977e7403180fde3a28de835d709c87568dedc2f0;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index 84e6f93..424d750 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -46,17 +46,52 @@ 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)) { + return $self->result_source + ->related_source($relname) + ->resultset + ->new_result($data); + } + if ($self->result_source->pk_depends_on($relname, $data)) { + return $self->result_source + ->related_source($relname) + ->resultset + ->find_or_new($data); + } + 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; - my $new = { _column_data => {} }; + my $new = { + _column_data => {}, + }; bless $new, $class; 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); } @@ -71,18 +106,19 @@ 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); - $new->set_from_related($key, $rel_obj); + $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage; $related->{$key} = $rel_obj; next; } elsif ($info && $info->{attrs}{accessor} @@ -91,11 +127,11 @@ sub new { my $others = delete $attrs->{$key}; foreach my $rel_obj (@$others) { 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); + $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage; } $related->{$key} = $others; next; @@ -105,9 +141,9 @@ 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); } + $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage); $inflated->{$key} = $rel_obj; next; } elsif ($class->has_column($key) @@ -138,6 +174,9 @@ 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). +To fetch an uninserted row object, call +L on a resultset. + This will also insert any uninserted, related objects held inside this one, see L for more details. @@ -159,11 +198,9 @@ sub insert { %{$self->{_inflated_column} || {}}); if(!$self->{_rel_in_storage}) { - $source->storage->txn_begin; # The guard will save us if we blow out of this scope via die - - $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback }); + $rollback_guard = $source->storage->txn_scope_guard; ## Should all be in relationship_data, but we need to get rid of the ## 'filter' reltype.. @@ -178,27 +215,9 @@ 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 ref($cond) eq 'HASH'; - - # 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; - } - } - } + next REL unless $source->pk_depends_on( + $relname, { $rel_obj->get_columns } + ); $rel_obj->insert(); $self->set_from_related($relname, $rel_obj); @@ -206,7 +225,8 @@ sub insert { } } - $source->storage->insert($source, { $self->get_columns }); + my $updated_cols = $source->storage->insert($source, { $self->get_columns }); + $self->set_columns($updated_cols); ## PK::Auto my @auto_pri = grep { @@ -227,6 +247,9 @@ sub insert { $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids; } + $self->{_dirty_columns} = {}; + $self->{related_resultsets} = {}; + if(!$self->{_rel_in_storage}) { ## Now do the has_many rels, that need $selfs ID. foreach my $relname (keys %related_stuff) { @@ -242,17 +265,19 @@ 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->get_columns }; + if ($self->__their_pk_needs_us($relname, $them)) { + $obj = $self->find_or_create_related($relname, $them); + } else { + $obj->insert(); + } } } } - $source->storage->txn_commit; - $rollback_guard->dismiss; + $rollback_guard->commit; } $self->in_storage(1); - $self->{_dirty_columns} = {}; - $self->{related_resultsets} = {}; undef $self->{_orig_ident}; return $self; } @@ -262,7 +287,13 @@ sub insert { $obj->in_storage; # Get value $obj->in_storage(1); # Set value -Indicates whether the object exists as a row in the database or not +Indicates whether the object exists as a row in the database or +not. This is set to true when L, +L or L +are used. + +Creating a row object using L, or calling +L on one, sets it to false. =cut @@ -281,9 +312,25 @@ UPDATE query to commit any changes to the object to the database if required. Also takes an options hashref of C<< column_name => value> pairs >> to update -first. But be aware that this hashref might be edited 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 } } ) +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 } } ) + +If the values passed or any of the column values set on the object +contain scalar references, eg: + + $obj->last_modified(\'NOW()'); + # OR + $obj->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 +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(); =cut @@ -294,38 +341,7 @@ sub update { $self->throw_exception("Cannot safely update a row in a PK-less table") if ! keys %$ident_cond; - if ($upd) { - foreach my $key (keys %$upd) { - if (ref $upd->{$key}) { - my $info = $self->relationship_info($key); - if ($info && $info->{attrs}{accessor} - && $info->{attrs}{accessor} eq 'single') - { - my $rel = delete $upd->{$key}; - $self->set_from_related($key => $rel); - $self->{_relationship_data}{$key} = $rel; - } elsif ($info && $info->{attrs}{accessor} - && $info->{attrs}{accessor} eq 'multi' - && ref $upd->{$key} eq 'ARRAY') { - my $others = delete $upd->{$key}; - foreach my $rel_obj (@$others) { - if(!Scalar::Util::blessed($rel_obj)) { - $rel_obj = $self->create_related($key, $rel_obj); - } - } - $self->{_relationship_data}{$key} = $others; -# $related->{$key} = $others; - next; - } - elsif ($self->has_column($key) - && exists $self->column_info($key)->{_inflate_info}) - { - $self->set_inflated_column($key, delete $upd->{$key}); - } - } - } - $self->set_columns($upd); - } + $self->set_inflated_columns($upd) if $upd; my %to_update = $self->get_dirty_columns; return $self unless keys %to_update; my $rows = $self->result_source->storage->update( @@ -386,10 +402,11 @@ sub delete { my $val = $obj->get_column($col); -Gets a column value from a row object. Does not do any queries; the column -must have already been fetched from the database and stored in the object. If -there is an inflated value stored that has not yet been deflated, it is deflated -when the method is invoked. +Returns a raw column value from the row object, if it has already +been fetched from the database or set by an accessor. + +If an L has been set, it +will be deflated and returned. =cut @@ -427,7 +444,7 @@ sub has_column_loaded { my %data = $obj->get_columns; -Does C, for all column values at once. +Does C, for all loaded column values at once. =cut @@ -456,11 +473,26 @@ sub get_dirty_columns { keys %{$self->{_dirty_columns}}; } +=head2 make_column_dirty + +Marks a column dirty regardless if it has really changed. Throws an +exception if the column does not exist. + +=cut +sub make_column_dirty { + my ($self, $column) = @_; + + $self->throw_exception( "No such column '${column}'" ) + unless exists $self->{_column_data}{$column} || $self->has_column($column); + $self->{_dirty_columns}{$column} = 1; +} + =head2 get_inflated_columns - my $inflated_data = $obj->get_inflated_columns; + my %inflated_data = $obj->get_inflated_columns; -Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values. +Similar to get_columns but objects are returned for inflated columns +instead of their raw non-inflated values. =cut @@ -476,9 +508,13 @@ sub get_inflated_columns { $obj->set_column($col => $val); -Sets a column value. If the new value is different from the old one, +Sets a raw column value. If the new value is different from the old one, the column is marked as dirty for when you next call $obj->update. +If passed an object or reference, this will happily attempt store the +value, and a later insert/update will try and stringify/numify as +appropriate. + =cut sub set_column { @@ -488,7 +524,11 @@ sub set_column { my $old = $self->get_column($column); my $ret = $self->store_column(@_); $self->{_dirty_columns}{$column} = 1 - if (defined $old ^ defined $ret) || (defined $old && $old ne $ret); + if (defined $old xor defined $ret) || (defined $old && $old ne $ret); + + # XXX clear out the relation cache for this column + delete $self->{related_resultsets}{$column}; + return $ret; } @@ -508,11 +548,59 @@ sub set_columns { return $self; } +=head2 set_inflated_columns + + my $copy = $orig->set_inflated_columns({ $col => $val, $rel => $obj, ... }); + +Sets more than one column value at once, taking care to respect inflations and +relationships if relevant. Be aware that this hashref might be edited 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 } } ) + +=cut + +sub set_inflated_columns { + my ( $self, $upd ) = @_; + foreach my $key (keys %$upd) { + if (ref $upd->{$key}) { + my $info = $self->relationship_info($key); + if ($info && $info->{attrs}{accessor} + && $info->{attrs}{accessor} eq 'single') + { + my $rel = delete $upd->{$key}; + $self->set_from_related($key => $rel); + $self->{_relationship_data}{$key} = $rel; + } elsif ($info && $info->{attrs}{accessor} + && $info->{attrs}{accessor} eq 'multi' + && ref $upd->{$key} eq 'ARRAY') { + my $others = delete $upd->{$key}; + foreach my $rel_obj (@$others) { + if(!Scalar::Util::blessed($rel_obj)) { + $rel_obj = $self->create_related($key, $rel_obj); + } + } + $self->{_relationship_data}{$key} = $others; +# $related->{$key} = $others; + next; + } + elsif ($self->has_column($key) + && exists $self->column_info($key)->{_inflate_info}) + { + $self->set_inflated_column($key, delete $upd->{$key}); + } + } + } + $self->set_columns($upd); +} + =head2 copy my $copy = $orig->copy({ change => $to, ... }); -Inserts a new row with the specified changes. +Inserts a new row with the specified changes. If the row has related +objects in a C then those objects may be copied too depending +on the C relationship attribute. =cut @@ -529,7 +617,7 @@ sub copy { bless $new, ref $self; $new->result_source($self->result_source); - $new->set_columns($changes); + $new->set_inflated_columns($changes); $new->insert; # Its possible we'll have 2 relations to the same Source. We need to make @@ -646,7 +734,8 @@ sub inflate_result { $obj->update_or_insert -Updates the object if it's already in the db, else inserts it. +Updates the object if it's already in the database, according to +L, else inserts it. =head2 insert_or_update @@ -656,7 +745,8 @@ Alias for L =cut -*insert_or_update = \&update_or_insert; +sub insert_or_update { shift->update_or_insert(@_) } + sub update_or_insert { my $self = shift; return ($self->in_storage ? $self->update : $self->insert); @@ -732,6 +822,29 @@ sub register_column { $class->mk_group_accessors('column' => $acc); } +=head2 get_from_storage ($attrs) + +Returns a new Row which is whatever the Storage has for the currently created +Row object. You can use this to see if the storage has become inconsistent with +whatever your Row object is. + +$attrs is expected to be a hashref of attributes suitable for passing as the +second argument to $resultset->search($cond, $attrs); + +=cut + +sub get_from_storage { + my $self = shift @_; + my $attrs = shift @_; + my @primary_columns = map { $self->$_ } $self->primary_columns; + my $resultset = $self->result_source->resultset; + + if(defined $attrs) { + $resultset = $resultset->search(undef, $attrs); + } + + return $resultset->find(@primary_columns); +} =head2 throw_exception @@ -748,6 +861,22 @@ sub throw_exception { } } +=head2 id + +Returns the primary key(s) for a row. Can't be called as a class method. +Actually implemented in L + +=head2 discard_changes + +Re-selects the row from the database, losing any changes that had +been made. + +This method can also be used to refresh from storage, retrieving any +changes made since the row was last read from storage. Actually +implemented in L + +=cut + 1; =head1 AUTHORS