X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=6d1b341012632c34c7634ffee58e493ad5f42d32;hb=f064a2abb15858bb39a141ad50391d4191988d2c;hp=b8c4da715ab1e600a659fd9b395da773f4d20971;hpb=a85b7ebe9762ca64a08468f6c8f27a0ae583d38c;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index b8c4da7..6d1b341 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -5,10 +5,10 @@ use warnings; use base qw/DBIx::Class/; -use DBIx::Class::Exception; use Scalar::Util 'blessed'; -use Try::Tiny; -use namespace::clean; +use DBIx::Class::_Util qw( dbic_internal_try fail_on_internal_call ); +use DBIx::Class::Carp; +use SQL::Abstract qw( is_literal_value is_plain_value ); ### ### Internal method @@ -21,7 +21,9 @@ BEGIN { : sub () { 0 }; } -__PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/); +use namespace::clean; + +__PACKAGE__->mk_group_accessors ( simple => [ in_storage => '_in_storage' ] ); =head1 NAME @@ -34,42 +36,59 @@ 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 +Result 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. +relationship accessors of L objects. + +=head1 NOTE + +All "Row objects" derived from a Schema-attached L +object (such as a typical C<< L-> +L >> call) are actually Result +instances, based on your application's +L. + +L implements most of the row-based communication with the +underlying storage, but a Result class B. +Usually, Result classes inherit from L, which in turn +combines the methods from several classes, one of them being +L. Therefore, while many of the methods available to a +L-derived Result class are described in the following +documentation, it does not detail all of the methods available to Result +objects. Refer to L for more info. =head1 METHODS =head2 new - my $row = My::Class->new(\%attrs); + my $result = My::Class->new(\%attrs); - my $row = $schema->resultset('MySource')->new(\%colsandvalues); + my $result = $schema->resultset('MySource')->new(\%colsandvalues); =over =item Arguments: \%attrs or \%colsandvalues -=item Returns: A Row object +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> =back -While you can create a new row object by calling C directly on +While you can create a new result 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 +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. +some other attributes such as the C. Passing an object, or an arrayref of objects as a value will call L for you. When @@ -99,33 +118,33 @@ with NULL as the default, and save yourself a SELECT. =cut ## It needs to store the new objects somewhere, and call insert on that list later when insert is called on this object. We may need an accessor for these so the user can retrieve them, if just doing ->new(). -## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns +## This only works because DBIC doesn't yet care to check whether the new_related objects have been passed all their mandatory columns ## When doing the later insert, we need to make sure the PKs are set. ## using _relationship_data in new and funky ways.. ## check Relationship::CascadeActions and Relationship::Accessor for compat ## tests! sub __new_related_find_or_new_helper { - my ($self, $relname, $data) = @_; + my ($self, $rel_name, $values) = @_; my $rsrc = $self->result_source; # create a mock-object so all new/set_column component overrides will run: - my $rel_rs = $rsrc->related_source($relname)->resultset; - my $new_rel_obj = $rel_rs->new_result($data); + my $rel_rs = $rsrc->related_source($rel_name)->resultset; + my $new_rel_obj = $rel_rs->new_result($values); my $proc_data = { $new_rel_obj->get_columns }; - if ($self->__their_pk_needs_us($relname)) { - MULTICREATE_DEBUG and warn "MC $self constructing $relname via new_result"; + if ($self->__their_pk_needs_us($rel_name)) { + MULTICREATE_DEBUG and print STDERR "MC $self constructing $rel_name via new_result\n"; return $new_rel_obj; } - elsif ($rsrc->_pk_depends_on($relname, $proc_data )) { + elsif ($rsrc->_pk_depends_on($rel_name, $proc_data )) { if (! keys %$proc_data) { # there is nothing to search for - blind create - MULTICREATE_DEBUG and warn "MC $self constructing default-insert $relname"; + MULTICREATE_DEBUG and print STDERR "MC $self constructing default-insert $rel_name\n"; } else { - MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new"; + MULTICREATE_DEBUG and print STDERR "MC $self constructing $rel_name via find_or_new\n"; # this is not *really* find or new, as we don't want to double-new the # data (thus potentially double encoding or whatever) my $exists = $rel_rs->find ($proc_data); @@ -136,17 +155,17 @@ sub __new_related_find_or_new_helper { else { my $us = $rsrc->source_name; $self->throw_exception ( - "Unable to determine relationship '$relname' direction from '$us', " - . "possibly due to a missing reverse-relationship on '$relname' to '$us'." + "Unable to determine relationship '$rel_name' direction from '$us', " + . "possibly due to a missing reverse-relationship on '$rel_name' to '$us'." ); } } sub __their_pk_needs_us { # this should maybe be in resultsource. - my ($self, $relname) = @_; - my $source = $self->result_source; - my $reverse = $source->reverse_relationship_info($relname); - my $rel_source = $source->related_source($relname); + my ($self, $rel_name) = @_; + my $rsrc = $self->result_source; + my $reverse = $rsrc->reverse_relationship_info($rel_name); + my $rel_source = $rsrc->related_source($rel_name); my $us = { $self->get_columns }; foreach my $key (keys %$reverse) { # if their primary key depends on us, then we have to @@ -160,36 +179,31 @@ sub new { my ($class, $attrs) = @_; $class = ref $class if ref $class; - my $new = { - _column_data => {}, - }; - bless $new, $class; - - if (my $handle = delete $attrs->{-source_handle}) { - $new->_source_handle($handle); - } - - my $source; - if ($source = delete $attrs->{-result_source}) { - $new->result_source($source); - } - - if (my $related = delete $attrs->{-cols_from_relations}) { - @{$new->{_ignore_at_insert}={}}{@$related} = (); - } + my $new = bless { _column_data => {}, _in_storage => 0 }, $class; if ($attrs) { $new->throw_exception("attrs must be a hashref") unless ref($attrs) eq 'HASH'; + my $rsrc = delete $attrs->{-result_source}; + if ( my $h = delete $attrs->{-source_handle} ) { + $rsrc ||= $h->resolve; + } + + $new->result_source($rsrc) if $rsrc; + + if (my $col_from_rel = delete $attrs->{-cols_from_relations}) { + @{$new->{_ignore_at_insert}={}}{@$col_from_rel} = (); + } + my ($related,$inflated); foreach my $key (keys %$attrs) { - if (ref $attrs->{$key}) { + if (ref $attrs->{$key} and ! is_literal_value($attrs->{$key}) ) { ## Can we extract this lot to use with update(_or .. ) ? $new->throw_exception("Can't do multi-create without result source") - unless $source; - my $info = $source->relationship_info($key); + unless $rsrc; + my $info = $rsrc->relationship_info($key); my $acc_type = $info->{attrs}{accessor} || ''; if ($acc_type eq 'single') { my $rel_obj = delete $attrs->{$key}; @@ -201,7 +215,7 @@ sub new { $new->{_rel_in_storage}{$key} = 1; $new->set_from_related($key, $rel_obj); } else { - MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj\n"; + MULTICREATE_DEBUG and print STDERR "MC $new uninserted $key $rel_obj\n"; } $related->{$key} = $rel_obj; @@ -221,7 +235,7 @@ sub new { $rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong'); } else { MULTICREATE_DEBUG and - warn "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n"; + print STDERR "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n"; } push(@objects, $rel_obj); } @@ -238,18 +252,20 @@ sub new { $new->{_rel_in_storage}{$key} = 1; } else { - MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj"; + MULTICREATE_DEBUG and print STDERR "MC $new uninserted $key $rel_obj\n"; } $inflated->{$key} = $rel_obj; next; - } elsif ($class->has_column($key) - && $class->column_info($key)->{_inflate_info}) { + } + elsif ( + $rsrc->has_column($key) + and + $rsrc->column_info($key)->{_inflate_info} + ) { $inflated->{$key} = $attrs->{$key}; next; } } - $new->throw_exception("No such column $key on $class") - unless $class->has_column($key); $new->store_column($key => $attrs->{$key}); } @@ -260,26 +276,60 @@ sub new { return $new; } +=head2 $column_accessor + + # Each pair does the same thing + + # (un-inflated, regular column) + my $val = $result->get_column('first_name'); + my $val = $result->first_name; + + $result->set_column('first_name' => $val); + $result->first_name($val); + + # (inflated column via DBIx::Class::InflateColumn::DateTime) + my $val = $result->get_inflated_column('last_modified'); + my $val = $result->last_modified; + + $result->set_inflated_column('last_modified' => $val); + $result->last_modified($val); + +=over + +=item Arguments: $value? + +=item Return Value: $value + +=back + +A column accessor method is created for each column, which is used for +getting/setting the value for that column. + +The actual method name is based on the +L name given during the +L L. Like L, this +will not store the data in the database until L or L +is called on the row. + =head2 insert - $row->insert; + $result->insert; =over =item Arguments: none -=item Returns: The Row object +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> =back 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). +it isn't already in there. Returns the object itself. To insert an +entirely new row into the database, use L. -To fetch an uninserted row object, call -L on a resultset. +To fetch an uninserted result object, call +L on a resultset. This will also insert any uninserted, related objects held inside this one, see L for more details. @@ -289,13 +339,11 @@ one, see L for more details. sub insert { my ($self) = @_; return $self if $self->in_storage; - my $source = $self->result_source; - $source ||= $self->result_source($self->result_source_instance) - if $self->can('result_source_instance'); + my $rsrc = $self->result_source; $self->throw_exception("No result_source set on this object; can't insert") - unless $source; + unless $rsrc; - my $storage = $source->storage; + my $storage = $rsrc->schema->storage; my $rollback_guard; @@ -305,27 +353,26 @@ sub insert { # insert what needs to be inserted before us my %pre_insert; - for my $relname (keys %related_stuff) { - my $rel_obj = $related_stuff{$relname}; + for my $rel_name (keys %related_stuff) { + my $rel_obj = $related_stuff{$rel_name}; - if (! $self->{_rel_in_storage}{$relname}) { + if (! $self->{_rel_in_storage}{$rel_name}) { next unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row')); - next unless $source->_pk_depends_on( - $relname, { $rel_obj->get_columns } + next unless $rsrc->_pk_depends_on( + $rel_name, { $rel_obj->get_columns } ); # The guard will save us if we blow out of this scope via die $rollback_guard ||= $storage->txn_scope_guard; - MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n"; + MULTICREATE_DEBUG and print STDERR "MC $self pre-reconstructing $rel_name $rel_obj\n"; my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_columns }; my $existing; # if there are no keys - nothing to search for - if (keys %$them and $existing = $self->result_source - ->related_source($relname) + if (keys %$them and $existing = $rsrc->related_source($rel_name) ->resultset ->find($them) ) { @@ -335,11 +382,11 @@ sub insert { $rel_obj->insert; } - $self->{_rel_in_storage}{$relname} = 1; + $self->{_rel_in_storage}{$rel_name} = 1; } - $self->set_from_related($relname, $rel_obj); - delete $related_stuff{$relname}; + $self->set_from_related($rel_name, $rel_obj); + delete $related_stuff{$rel_name}; } # start a transaction here if not started yet and there is more stuff @@ -350,81 +397,74 @@ sub insert { MULTICREATE_DEBUG and do { no warnings 'uninitialized'; - warn "MC $self inserting (".join(', ', $self->get_columns).")\n"; + print STDERR "MC $self inserting (".join(', ', $self->get_columns).")\n"; }; + # perform the insert - the storage will return everything it is asked to + # (autoinc primary columns and any retrieve_on_insert columns) my %current_rowdata = $self->get_columns; - - # perform the insert - the storage may return some stuff for us right there - # my $returned_cols = $storage->insert( - $source, - \%current_rowdata, + $rsrc, + { %current_rowdata }, # what to insert, copy because the storage *will* change it ); for (keys %$returned_cols) { - $self->store_column( - $_, - ( $current_rowdata{$_} = $returned_cols->{$_} ) - ); + $self->store_column($_, $returned_cols->{$_}) + # this ensures we fire store_column only once + # (some asshats like overriding it) + if ( + (!exists $current_rowdata{$_}) + or + (defined $current_rowdata{$_} xor defined $returned_cols->{$_}) + or + ( + defined $current_rowdata{$_} + and + # one of the few spots doing forced-stringification + # needed to work around objects with defined stringification + # but *without* overloaded comparison (ugh!) + "$current_rowdata{$_}" ne "$returned_cols->{$_}" + ) + ); } - # see if any of the pcols still need filling (or re-querying in case of scalarrefs) - my @missing_pri = grep - { ! defined $current_rowdata{$_} or ref $current_rowdata{$_} eq 'SCALAR' } - $self->primary_columns - ; - - if (@missing_pri) { - MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @missing_pri )."\n"; - - $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" ) - unless $storage->can('last_insert_id'); - - my @pri_values = $storage->last_insert_id($self->result_source, @missing_pri); - - $self->throw_exception( "Can't get last insert id" ) - unless (@pri_values == @missing_pri); - - $self->store_column($missing_pri[$_] => $pri_values[$_]) for 0 .. $#missing_pri; - } + delete $self->{_column_data_in_storage}; + $self->in_storage(1); $self->{_dirty_columns} = {}; $self->{related_resultsets} = {}; - foreach my $relname (keys %related_stuff) { - next unless $source->has_relationship ($relname); + foreach my $rel_name (keys %related_stuff) { + next unless $rsrc->has_relationship ($rel_name); - my @cands = ref $related_stuff{$relname} eq 'ARRAY' - ? @{$related_stuff{$relname}} - : $related_stuff{$relname} + my @cands = ref $related_stuff{$rel_name} eq 'ARRAY' + ? @{$related_stuff{$rel_name}} + : $related_stuff{$rel_name} ; if (@cands && blessed $cands[0] && $cands[0]->isa('DBIx::Class::Row') ) { - my $reverse = $source->reverse_relationship_info($relname); + my $reverse = $rsrc->reverse_relationship_info($rel_name); foreach my $obj (@cands) { $obj->set_from_related($_, $self) for keys %$reverse; - if ($self->__their_pk_needs_us($relname)) { - if (exists $self->{_ignore_at_insert}{$relname}) { - MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname"; + if ($self->__their_pk_needs_us($rel_name)) { + if (exists $self->{_ignore_at_insert}{$rel_name}) { + MULTICREATE_DEBUG and print STDERR "MC $self skipping post-insert on $rel_name\n"; } else { - MULTICREATE_DEBUG and warn "MC $self inserting $relname $obj"; + MULTICREATE_DEBUG and print STDERR "MC $self inserting $rel_name $obj\n"; $obj->insert; } } else { - MULTICREATE_DEBUG and warn "MC $self post-inserting $obj"; + MULTICREATE_DEBUG and print STDERR "MC $self post-inserting $obj\n"; $obj->insert(); } } } } - $self->in_storage(1); - delete $self->{_orig_ident}; - delete $self->{_orig_ident_failreason}; delete $self->{_ignore_at_insert}; + $rollback_guard->commit if $rollback_guard; return $self; @@ -432,47 +472,40 @@ sub insert { =head2 in_storage - $row->in_storage; # Get value - $row->in_storage(1); # Set value + $result->in_storage; # Get value + $result->in_storage(1); # Set value =over =item Arguments: none or 1|0 -=item Returns: 1|0 +=item Return Value: 1|0 =back 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. +L or L +are invoked. -Creating a row object using L, or calling -L on one, sets it to false. +Creating a result object using L, or +calling L on one, sets it to false. -=cut - -sub in_storage { - my ($self, $val) = @_; - $self->{_in_storage} = $val if @_ > 1; - return $self->{_in_storage} ? 1 : 0; -} =head2 update - $row->update(\%columns?) + $result->update(\%columns?) =over =item Arguments: none or a hashref -=item Returns: The Row object +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> =back -Throws an exception if the row object is not yet in the database, -according to L. +Throws an exception if the result object is not yet in the database, +according to L. Returns the object itself. This method issues an SQL UPDATE query to commit any changes to the object to the database if required (see L). @@ -491,17 +524,17 @@ to C, e.g. ( { %{ $href } } ) If the values passed or any of the column values set on the object contain scalar references, e.g.: - $row->last_modified(\'NOW()'); + $result->last_modified(\'NOW()')->update(); # OR - $row->update({ last_modified => \'NOW()' }); + $result->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 +L docs). The values in your Result 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. - $row->update()->discard_changes(); + $result->update()->discard_changes(); To determine before calling this method, which column values have changed and will be updated, call L. @@ -516,19 +549,15 @@ this method. sub update { my ($self, $upd) = @_; - my $ident_cond = $self->{_orig_ident} || $self->ident_condition; - $self->set_inflated_columns($upd) if $upd; - my %to_update = $self->get_dirty_columns; - return $self unless keys %to_update; - $self->throw_exception( "Not in database" ) unless $self->in_storage; + my %to_update = $self->get_dirty_columns + or return $self; - $self->throw_exception($self->{_orig_ident_failreason}) - if ! keys %$ident_cond; + $self->throw_exception( "Not in database" ) unless $self->in_storage; - my $rows = $self->result_source->storage->update( - $self->result_source, \%to_update, $ident_cond + my $rows = $self->result_source->schema->storage->update( + $self->result_source, \%to_update, $self->_storage_ident_condition ); if ($rows == 0) { $self->throw_exception( "Can't update ${self}: row not found" ); @@ -537,19 +566,19 @@ sub update { } $self->{_dirty_columns} = {}; $self->{related_resultsets} = {}; - delete $self->{_orig_ident}; + delete $self->{_column_data_in_storage}; return $self; } =head2 delete - $row->delete + $result->delete =over =item Arguments: none -=item Returns: The Row object +=item Return Value: L<$result|DBIx::Class::Manual::ResultClass> =back @@ -573,7 +602,7 @@ main row first> and only then attempts to delete any remaining related rows. If you delete an object within a txn_do() (see L) -and the transaction subsequently fails, the row object will remain marked as +and the transaction subsequently fails, the result 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 @@ -589,43 +618,40 @@ sub delete { if (ref $self) { $self->throw_exception( "Not in database" ) unless $self->in_storage; - my $ident_cond = $self->{_orig_ident} || $self->ident_condition; - $self->throw_exception($self->{_orig_ident_failreason}) - if ! keys %$ident_cond; - - $self->result_source->storage->delete( - $self->result_source, $ident_cond + $self->result_source->schema->storage->delete( + $self->result_source, $self->_storage_ident_condition ); - delete $self->{_orig_ident}; # no longer identifiable - $self->in_storage(undef); + delete $self->{_column_data_in_storage}; + $self->in_storage(0); } else { - $self->throw_exception("Can't do class delete without a ResultSource instance") - unless $self->can('result_source_instance'); + my $rsrc = dbic_internal_try { $self->result_source_instance } + or $self->throw_exception("Can't do class delete without a ResultSource instance"); + my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {}; my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_}; - $self->result_source_instance->resultset->search(@_)->delete; + $rsrc->resultset->search(@_)->delete; } return $self; } =head2 get_column - my $val = $row->get_column($col); + my $val = $result->get_column($col); =over =item Arguments: $columnname -=item Returns: The value of the column +=item Return Value: The value of the column =back Throws an exception if the column name given doesn't exist according -to L. +to L. -Returns a raw column value from the row object, if it has already +Returns a raw column value from the result object, if it has already been fetched from the database or set by an accessor. If an L has been set, it @@ -633,7 +659,7 @@ will be deflated and returned. Note that if you used the C or the C