X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=1e11805bd71c76e21395b93517fb85c4d13a40d7;hb=937114227af35f69796b19606cd87083b2a9ae68;hp=5b350bdc09855a77d3430614deb7f46a4d5f0abb;hpb=50261284a5486d1974adb202eb84e5ed782d3665;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 5b350bd..1e11805 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -7,8 +7,8 @@ use base qw/DBIx::Class/;
 
 use DBIx::Class::Exception;
 use Scalar::Util 'blessed';
+use List::Util 'first';
 use Try::Tiny;
-use namespace::clean;
 
 ###
 ### Internal method
@@ -21,7 +21,7 @@ BEGIN {
       : sub () { 0 };
 }
 
-__PACKAGE__->mk_group_accessors('simple' => [result_source => '_result_source']);
+use namespace::clean;
 
 =head1 NAME
 
@@ -43,6 +43,23 @@ L<has_one|DBIx::Class::Relationship/has_one> or
 L<might_have|DBIx::Class::Relationship/might_have>)
 relationship accessors of L<DBIx::Class::Row> objects.
 
+=head1 NOTE
+
+All "Row objects" derived from a Schema-attached L<DBIx::Class::ResultSet>
+object (such as a typical C<< L<search|DBIx::Class::ResultSet/search
+>->L<next|DBIx::Class::ResultSet/next> >> call) are actually Result
+instances, based on your application's
+L<Result class|DBIx::Class::Manual::Glossary/Result_class>.
+
+L<DBIx::Class::Row> implements most of the row-based communication with the
+underlying storage, but a Result class B<should not inherit from it directly>.
+Usually, Result classes inherit from L<DBIx::Class::Core>, which in turn
+combines the methods from several classes, one of them being
+L<DBIx::Class::Row>.  Therefore, while many of the methods available to a
+L<DBIx::Class::Core>-derived Result class are described in the following
+documentation, it does not detail all of the methods available to Result
+objects.  Refer to L<DBIx::Class::Core> for more info.
+
 =head1 METHODS
 
 =head2 new
@@ -55,7 +72,7 @@ relationship accessors of L<DBIx::Class::Row> objects.
 
 =item Arguments: \%attrs or \%colsandvalues
 
-=item Returns: A Row object
+=item Returns: A DBIx::Class::Row object
 
 =back
 
@@ -162,21 +179,21 @@ sub new {
 
   my $new = bless { _column_data => {} }, $class;
 
-  my $source =
-    delete $attrs->{-result_source}
-      or
-    ( $attrs->{-source_handle} and (delete $attrs->{-source_handle})->resolve )
-  ;
-  $new->result_source($source) if $source;
-
-  if (my $related = delete $attrs->{-cols_from_relations}) {
-    @{$new->{_ignore_at_insert}={}}{@$related} = ();
-  }
-
   if ($attrs) {
     $new->throw_exception("attrs must be a hashref")
       unless ref($attrs) eq 'HASH';
 
+    my $source = delete $attrs->{-result_source};
+    if ( my $h = delete $attrs->{-source_handle} ) {
+      $source ||= $h->resolve;
+    }
+
+    $new->result_source($source) if $source;
+
+    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) {
@@ -255,6 +272,39 @@ sub new {
   return $new;
 }
 
+=head2 $column_accessor
+
+  # Each pair does the same thing
+
+  # (un-inflated, regular column)
+  my $val = $row->get_column('first_name');
+  my $val = $row->first_name;
+
+  $row->set_column('first_name' => $val);
+  $row->first_name($val);
+
+  # (inflated column via DBIx::Class::InflateColumn::DateTime)
+  my $val = $row->get_inflated_column('last_modified');
+  my $val = $row->last_modified;
+
+  $row->set_inflated_column('last_modified' => $val);
+  $row->last_modified($val);
+
+=over
+
+=item Arguments: $value?
+
+=item Returns: $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<accessor|DBIx::Class::ResultSource/accessor>
+name given in the table definition.  Like L</set_column>, this will
+not store the data until L</insert> or L</update> is called on the row.
+
 =head2 insert
 
   $row->insert;
@@ -268,10 +318,8 @@ sub new {
 =back
 
 Inserts an object previously created by L</new> 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<create> (see L<DBIx::Class::ResultSet/create>).
+it isn't already in there. Returns the object itself. To insert an
+entirely new row into the database, use L<DBIx::Class::ResultSet/create>.
 
 To fetch an uninserted row object, call
 L<new|DBIx::Class::ResultSet/new> on a resultset.
@@ -285,8 +333,6 @@ 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');
   $self->throw_exception("No result_source set on this object; can't insert")
     unless $source;
 
@@ -348,41 +394,29 @@ sub insert {
     warn "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,
+    { %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 $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} = {};
@@ -416,10 +450,8 @@ sub 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;
@@ -486,7 +518,7 @@ to C<update>, 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()');
+  $row->last_modified(\'NOW()')->update();
   # OR
   $row->update({ last_modified => \'NOW()' });
 
@@ -516,14 +548,10 @@ sub update {
   my %to_update = $self->get_dirty_columns
     or return $self;
 
-  my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
   $self->throw_exception( "Not in database" ) unless $self->in_storage;
 
-  $self->throw_exception($self->{_orig_ident_failreason})
-    if ! keys %$ident_cond;
-
   my $rows = $self->result_source->storage->update(
-    $self->result_source, \%to_update, $ident_cond
+    $self->result_source, \%to_update, $self->_storage_ident_condition
   );
   if ($rows == 0) {
     $self->throw_exception( "Can't update ${self}: row not found" );
@@ -532,7 +560,7 @@ sub update {
   }
   $self->{_dirty_columns} = {};
   $self->{related_resultsets} = {};
-  delete $self->{_orig_ident};
+  delete $self->{_column_data_in_storage};
   return $self;
 }
 
@@ -584,23 +612,20 @@ 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, $self->_storage_ident_condition
     );
 
-    delete $self->{_orig_ident};  # no longer identifiable
+    delete $self->{_column_data_in_storage};
     $self->in_storage(undef);
   }
   else {
-    $self->throw_exception("Can't do class delete without a ResultSource instance")
-      unless $self->can('result_source_instance');
+    my $rsrc = 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;
 }
@@ -618,7 +643,7 @@ sub delete {
 =back
 
 Throws an exception if the column name given doesn't exist according
-to L</has_column>.
+to L<has_column|DBIx::Class::ResultSource/has_column>.
 
 Returns a raw column value from the row object, if it has already
 been fetched from the database or set by an accessor.
@@ -849,32 +874,23 @@ the column is marked as dirty for when you next call L</update>.
 If passed an object or reference as a value, this method will happily
 attempt to store it, and a later L</insert> or L</update> will try and
 stringify/numify as appropriate. To set an object to be deflated
-instead, see L</set_inflated_columns>.
+instead, see L</set_inflated_columns>, or better yet, use L</$column_accessor>.
 
 =cut
 
 sub set_column {
   my ($self, $column, $new_value) = @_;
 
-  # if we can't get an ident condition on first try - mark the object as unidentifiable
-  # (by using an empty hashref) and store the error for further diag
-  unless ($self->{_orig_ident}) {
-    try {
-      $self->{_orig_ident} = $self->ident_condition
-    }
-    catch {
-      $self->{_orig_ident_failreason} = $_;
-      $self->{_orig_ident} = {};
-    };
-  }
+  my $had_value = $self->has_column_loaded($column);
+  my ($old_value, $in_storage) = ($self->get_column($column), $self->in_storage)
+    if $had_value;
 
-  my $old_value = $self->get_column($column);
   $new_value = $self->store_column($column, $new_value);
 
   my $dirty =
     $self->{_dirty_columns}{$column}
       ||
-    $self->in_storage # no point tracking dirtyness on uninserted data
+    $in_storage # no point tracking dirtyness on uninserted data
       ? ! $self->_eq_column_values ($column, $old_value, $new_value)
       : 1
   ;
@@ -903,6 +919,21 @@ sub set_column {
         delete $self->{_inflated_column}{$rel};
       }
     }
+
+    if (
+      # value change from something (even if NULL)
+      $had_value
+        and
+      # no storage - no storage-value
+      $in_storage
+        and
+      # no value already stored (multiple changes before commit to storage)
+      ! exists $self->{_column_data_in_storage}{$column}
+        and
+      $self->_track_storage_value($column)
+    ) {
+      $self->{_column_data_in_storage}{$column} = $old_value;
+    }
   }
 
   return $new_value;
@@ -928,6 +959,13 @@ sub _eq_column_values {
   }
 }
 
+# returns a boolean indicating if the passed column should have its original
+# value tracked between column changes and commitment to storage
+sub _track_storage_value {
+  my ($self, $col) = @_;
+  return defined first { $col eq $_ } ($self->primary_columns);
+}
+
 =head2 set_columns
 
   $row->set_columns({ $col => $val, ... });
@@ -1067,7 +1105,7 @@ sub copy {
     next unless $rel_info->{attrs}{cascade_copy};
 
     my $resolved = $self->result_source->_resolve_condition(
-      $rel_info->{cond}, $rel, $new
+      $rel_info->{cond}, $rel, $new, $rel
     );
 
     my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
@@ -1151,23 +1189,38 @@ sub inflate_result {
 
   foreach my $pre (keys %{$prefetch||{}}) {
 
-    my $pre_source = $source->related_source($pre)
-      or $class->throw_exception("Can't prefetch non-existent relationship ${pre}");
-
-    my $accessor = $source->relationship_info($pre)->{attrs}{accessor}
-      or $class->throw_exception("No accessor for prefetched $pre");
-
-    my @pre_vals;
+    my (@pre_vals, $is_multi);
     if (ref $prefetch->{$pre}[0] eq 'ARRAY') {
+      $is_multi = 1;
       @pre_vals = @{$prefetch->{$pre}};
     }
-    elsif ($accessor eq 'multi') {
-      $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor 'multi'");
-    }
     else {
       @pre_vals = $prefetch->{$pre};
     }
 
+    my $pre_source = try {
+      $source->related_source($pre)
+    }
+    catch {
+      $class->throw_exception(sprintf
+
+        "Can't inflate manual prefetch into non-existent relationship '%s' from '%s', "
+      . "check the inflation specification (columns/as) ending in '%s.%s'.",
+
+        $pre,
+        $source->source_name,
+        $pre,
+        (keys %{$pre_vals[0][0]})[0] || 'something.something...',
+      );
+    };
+
+    my $accessor = $source->relationship_info($pre)->{attrs}{accessor}
+      or $class->throw_exception("No accessor type declared for prefetched $pre");
+
+    if (! $is_multi and $accessor eq 'multi') {
+      $class->throw_exception("Manual prefetch (via select/columns) not supported with accessor 'multi'");
+    }
+
     my @pre_objects;
     for my $me_pref (@pre_vals) {
 
@@ -1290,6 +1343,27 @@ sub is_column_changed {
 
 Accessor to the L<DBIx::Class::ResultSource> this object was created from.
 
+=cut
+
+sub result_source {
+  $_[0]->throw_exception( 'result_source can be called on instances only' )
+    unless ref $_[0];
+
+  @_ > 1
+    ? $_[0]->{_result_source} = $_[1]
+
+    # note this is a || not a ||=, the difference is important
+    : $_[0]->{_result_source} || do {
+        my $class = ref $_[0];
+        $_[0]->can('result_source_instance')
+          ? $_[0]->result_source_instance
+          : $_[0]->throw_exception(
+            "No result source instance registered for $class, did you forget to call $class->table(...) ?"
+          )
+      }
+  ;
+}
+
 =head2 register_column
 
   $column_info = { .... };
@@ -1363,15 +1437,10 @@ sub get_from_storage {
       $resultset = $resultset->search(undef, $attrs);
     }
 
-    my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
-
-    $self->throw_exception($self->{_orig_ident_failreason})
-      if ! keys %$ident_cond;
-
-    return $resultset->find($ident_cond);
+    return $resultset->find($self->_storage_ident_condition);
 }
 
-=head2 discard_changes ($attrs?)
+=head2 discard_changes
 
   $row->discard_changes
 
@@ -1428,7 +1497,6 @@ sub discard_changes {
   }
 }
 
-
 =head2 throw_exception
 
 See L<DBIx::Class::Schema/throw_exception>.
@@ -1438,8 +1506,8 @@ See L<DBIx::Class::Schema/throw_exception>.
 sub throw_exception {
   my $self=shift;
 
-  if (ref $self && ref $self->result_source && $self->result_source->schema) {
-    $self->result_source->schema->throw_exception(@_)
+  if (ref $self && ref $self->result_source ) {
+    $self->result_source->throw_exception(@_)
   }
   else {
     DBIx::Class::Exception->throw(@_);
@@ -1461,11 +1529,9 @@ sub throw_exception {
 Returns the primary key(s) for a row. Can't be called as a class method.
 Actually implemented in L<DBIx::Class::PK>
 
-1;
-
-=head1 AUTHORS
+=head1 AUTHOR AND CONTRIBUTORS
 
-Matt S. Trout <mst@shadowcatsystems.co.uk>
+See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
 
 =head1 LICENSE