lib/DBIx/Class/Row.pm

   1 package DBIx::Class::Row;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class/;
   7 use Carp::Clan qw/^DBIx::Class/;
   8 use Scalar::Util ();
   9 use Scope::Guard;
  10
  11 __PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
  12
  13 =head1 NAME
  14
  15 DBIx::Class::Row - Basic row methods
  16
  17 =head1 SYNOPSIS
  18
  19 =head1 DESCRIPTION
  20
  21 This class is responsible for defining and doing basic operations on rows
  22 derived from L<DBIx::Class::ResultSource> objects.
  23
  24 Row objects are returned from L<DBIx::Class::ResultSet>s using the
  25 L<DBIx::Class::ResultSet/create>, L<DBIx::Class::ResultSet/find>,
  26 L<DBIx::Class::ResultSet/next> and L<DBIx::Class::ResultSet/all> methods.
  27
  28 =head1 METHODS
  29
  30 =head2 new
  31
  32   my $row = My::Class->new(\%attrs);
  33
  34   my $row = $schema->resultset('MySource')->new(\%colsandvalues);
  35
  36 =over
  37
  38 =item Arguments: \%attrs or \%colsandvalues
  39
  40 =item Returns: A Row object
  41
  42 =back
  43
  44 While you can create a new row object by calling C<new> directly on
  45 this class, you are better off calling it on a
  46 L<DBIx::Class::ResultSet> object.
  47
  48 When calling it directly, you will not get a complete, usable row
  49 object until you pass or set the C<source_handle> attribute, to a
  50 L<DBIx::Class::ResultSource> instance that is attached to a
  51 L<DBIx::Class::Schema> with a valid connection.
  52
  53 C<$attrs> is a hashref of column name, value data. It can also contain
  54 some other attributes such as the C<source_handle>.
  55
  56 Passing an object, or an arrayref of objects as a value will call
  57 L<DBIx::Class::Relationship::Base/set_from_related> for you. When
  58 passed a hashref or an arrayref of hashrefs as the value, these will
  59 be turned into objects via new_related, and treated as if you had
  60 passed objects.
  61
  62 For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
  63
  64 =cut
  65
  66 ## 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().
  67 ## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
  68 ## When doing the later insert, we need to make sure the PKs are set.
  69 ## using _relationship_data in new and funky ways..
  70 ## check Relationship::CascadeActions and Relationship::Accessor for compat
  71 ## tests!
  72
  73 sub __new_related_find_or_new_helper {
  74   my ($self, $relname, $data) = @_;
  75   if ($self->__their_pk_needs_us($relname, $data)) {
  76     return $self->result_source
  77                 ->related_source($relname)
  78                 ->resultset
  79                 ->new_result($data);
  80   }
  81   if ($self->result_source->pk_depends_on($relname, $data)) {
  82     return $self->result_source
  83                 ->related_source($relname)
  84                 ->resultset
  85                 ->find_or_create($data);
  86   }
  87   return $self->find_or_new_related($relname, $data);
  88 }
  89
  90 sub __their_pk_needs_us { # this should maybe be in resultsource.
  91   my ($self, $relname, $data) = @_;
  92   my $source = $self->result_source;
  93   my $reverse = $source->reverse_relationship_info($relname);
  94   my $rel_source = $source->related_source($relname);
  95   my $us = { $self->get_columns };
  96   foreach my $key (keys %$reverse) {
  97     # if their primary key depends on us, then we have to
  98     # just create a result and we'll fill it out afterwards
  99     return 1 if $rel_source->pk_depends_on($key, $us);
 100   }
 101   return 0;
 102 }
 103
 104 sub new {
 105   my ($class, $attrs) = @_;
 106   $class = ref $class if ref $class;
 107
 108   my $new = {
 109       _column_data          => {},
 110   };
 111   bless $new, $class;
 112
 113   if (my $handle = delete $attrs->{-source_handle}) {
 114     $new->_source_handle($handle);
 115   }
 116
 117   my $source;
 118   if ($source = delete $attrs->{-result_source}) {
 119     $new->result_source($source);
 120   }
 121
 122   if ($attrs) {
 123     $new->throw_exception("attrs must be a hashref")
 124       unless ref($attrs) eq 'HASH';
 125
 126     my ($related,$inflated);
 127     ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
 128     $new->{_rel_in_storage} = 1;
 129
 130     foreach my $key (keys %$attrs) {
 131       if (ref $attrs->{$key}) {
 132         ## Can we extract this lot to use with update(_or .. ) ?
 133         confess "Can't do multi-create without result source" unless $source;
 134         my $info = $source->relationship_info($key);
 135         if ($info && $info->{attrs}{accessor}
 136           && $info->{attrs}{accessor} eq 'single')
 137         {
 138           my $rel_obj = delete $attrs->{$key};
 139           if(!Scalar::Util::blessed($rel_obj)) {
 140             $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
 141           }
 142
 143           $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
 144
 145           $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
 146           $related->{$key} = $rel_obj;
 147           next;
 148         } elsif ($info && $info->{attrs}{accessor}
 149             && $info->{attrs}{accessor} eq 'multi'
 150             && ref $attrs->{$key} eq 'ARRAY') {
 151           my $others = delete $attrs->{$key};
 152           foreach my $rel_obj (@$others) {
 153             if(!Scalar::Util::blessed($rel_obj)) {
 154               $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
 155             }
 156
 157             $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
 158             $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
 159           }
 160           $related->{$key} = $others;
 161           next;
 162         } elsif ($info && $info->{attrs}{accessor}
 163           && $info->{attrs}{accessor} eq 'filter')
 164         {
 165           ## 'filter' should disappear and get merged in with 'single' above!
 166           my $rel_obj = delete $attrs->{$key};
 167           if(!Scalar::Util::blessed($rel_obj)) {
 168             $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
 169           }
 170           $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
 171           $inflated->{$key} = $rel_obj;
 172           next;
 173         } elsif ($class->has_column($key)
 174             && $class->column_info($key)->{_inflate_info}) {
 175           $inflated->{$key} = $attrs->{$key};
 176           next;
 177         }
 178       }
 179       $new->throw_exception("No such column $key on $class")
 180         unless $class->has_column($key);
 181       $new->store_column($key => $attrs->{$key});
 182     }
 183
 184     $new->{_relationship_data} = $related if $related;
 185     $new->{_inflated_column} = $inflated if $inflated;
 186   }
 187
 188   return $new;
 189 }
 190
 191 =head2 insert
 192
 193   $row->insert;
 194
 195 =over
 196
 197 =item Arguments: none
 198
 199 =item Returns: The Row object
 200
 201 =back
 202
 203 Inserts an object previously created by L</new> into the database if
 204 it isn't already in there. Returns the object itself. Requires the
 205 object's result source to be set, or the class to have a
 206 result_source_instance method. To insert an entirely new row into
 207 the database, use C<create> (see L<DBIx::Class::ResultSet/create>).
 208
 209 To fetch an uninserted row object, call
 210 L<new|DBIx::Class::ResultSet/new> on a resultset.
 211
 212 This will also insert any uninserted, related objects held inside this
 213 one, see L<DBIx::Class::ResultSet/create> for more details.
 214
 215 =cut
 216
 217 sub insert {
 218   my ($self) = @_;
 219   return $self if $self->in_storage;
 220   my $source = $self->result_source;
 221   $source ||=  $self->result_source($self->result_source_instance)
 222     if $self->can('result_source_instance');
 223   $self->throw_exception("No result_source set on this object; can't insert")
 224     unless $source;
 225
 226   my $rollback_guard;
 227
 228   # Check if we stored uninserted relobjs here in new()
 229   my %related_stuff = (%{$self->{_relationship_data} || {}},
 230                        %{$self->{_inflated_column} || {}});
 231
 232   if(!$self->{_rel_in_storage}) {
 233
 234     # The guard will save us if we blow out of this scope via die
 235     $rollback_guard = $source->storage->txn_scope_guard;
 236
 237     ## Should all be in relationship_data, but we need to get rid of the
 238     ## 'filter' reltype..
 239     ## These are the FK rels, need their IDs for the insert.
 240
 241     my @pri = $self->primary_columns;
 242
 243     REL: foreach my $relname (keys %related_stuff) {
 244
 245       my $rel_obj = $related_stuff{$relname};
 246
 247       next REL unless (Scalar::Util::blessed($rel_obj)
 248                        && $rel_obj->isa('DBIx::Class::Row'));
 249
 250       next REL unless $source->pk_depends_on(
 251                         $relname, { $rel_obj->get_columns }
 252                       );
 253
 254       $rel_obj->insert();
 255       $self->set_from_related($relname, $rel_obj);
 256       delete $related_stuff{$relname};
 257     }
 258   }
 259
 260   my $updated_cols = $source->storage->insert($source, { $self->get_columns });
 261   $self->set_columns($updated_cols);
 262
 263   ## PK::Auto
 264   my @auto_pri = grep {
 265                    !defined $self->get_column($_) ||
 266                    ref($self->get_column($_)) eq 'SCALAR'
 267                  } $self->primary_columns;
 268
 269   if (@auto_pri) {
 270     #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
 271     #  if defined $too_many;
 272
 273     my $storage = $self->result_source->storage;
 274     $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
 275       unless $storage->can('last_insert_id');
 276     my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
 277     $self->throw_exception( "Can't get last insert id" )
 278       unless (@ids == @auto_pri);
 279     $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
 280   }
 281
 282   $self->{_dirty_columns} = {};
 283   $self->{related_resultsets} = {};
 284
 285   if(!$self->{_rel_in_storage}) {
 286     ## Now do the has_many rels, that need $selfs ID.
 287     foreach my $relname (keys %related_stuff) {
 288       my $rel_obj = $related_stuff{$relname};
 289       my @cands;
 290       if (Scalar::Util::blessed($rel_obj)
 291           && $rel_obj->isa('DBIx::Class::Row')) {
 292         @cands = ($rel_obj);
 293       } elsif (ref $rel_obj eq 'ARRAY') {
 294         @cands = @$rel_obj;
 295       }
 296       if (@cands) {
 297         my $reverse = $source->reverse_relationship_info($relname);
 298         foreach my $obj (@cands) {
 299           $obj->set_from_related($_, $self) for keys %$reverse;
 300           my $them = { $obj->get_inflated_columns };
 301           if ($self->__their_pk_needs_us($relname, $them)) {
 302             $obj = $self->find_or_create_related($relname, $them);
 303           } else {
 304             $obj->insert();
 305           }
 306         }
 307       }
 308     }
 309     $rollback_guard->commit;
 310   }
 311
 312   $self->in_storage(1);
 313   undef $self->{_orig_ident};
 314   return $self;
 315 }
 316
 317 =head2 in_storage
 318
 319   $row->in_storage; # Get value
 320   $row->in_storage(1); # Set value
 321
 322 =over
 323
 324 =item Arguments: none or 1|0
 325
 326 =item Returns: 1|0
 327
 328 =back
 329
 330 Indicates whether the object exists as a row in the database or
 331 not. This is set to true when L<DBIx::Class::ResultSet/find>,
 332 L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
 333 are used.
 334
 335 Creating a row object using L<DBIx::Class::ResultSet/new>, or calling
 336 L</delete> on one, sets it to false.
 337
 338 =cut
 339
 340 sub in_storage {
 341   my ($self, $val) = @_;
 342   $self->{_in_storage} = $val if @_ > 1;
 343   return $self->{_in_storage};
 344 }
 345
 346 =head2 update
 347
 348   $row->update(\%columns?)
 349
 350 =over
 351
 352 =item Arguments: none or a hashref
 353
 354 =item Returns: The Row object
 355
 356 =back
 357
 358 Throws an exception if the row object is not yet in the database,
 359 according to L</in_storage>.
 360
 361 This method issues an SQL UPDATE query to commit any changes to the
 362 object to the database if required.
 363
 364 Also takes an optional hashref of C<< column_name => value> >> pairs
 365 to update on the object first. Be aware that the hashref will be
 366 passed to C<set_inflated_columns>, which might edit it in place, so
 367 don't rely on it being the same after a call to C<update>.  If you
 368 need to preserve the hashref, it is sufficient to pass a shallow copy
 369 to C<update>, e.g. ( { %{ $href } } )
 370
 371 If the values passed or any of the column values set on the object
 372 contain scalar references, eg:
 373
 374   $row->last_modified(\'NOW()');
 375   # OR
 376   $row->update({ last_modified => \'NOW()' });
 377
 378 The update will pass the values verbatim into SQL. (See
 379 L<SQL::Abstract> docs).  The values in your Row object will NOT change
 380 as a result of the update call, if you want the object to be updated
 381 with the actual values from the database, call L</discard_changes>
 382 after the update.
 383
 384   $row->update()->discard_changes();
 385
 386 To determine before calling this method, which column values have
 387 changed and will be updated, call L</get_dirty_columns>.
 388
 389 To check if any columns will be updated, call L</is_changed>.
 390
 391 To force a column to be updated, call L</make_column_dirty> before
 392 this method.
 393
 394 =cut
 395
 396 sub update {
 397   my ($self, $upd) = @_;
 398   $self->throw_exception( "Not in database" ) unless $self->in_storage;
 399   my $ident_cond = $self->ident_condition;
 400   $self->throw_exception("Cannot safely update a row in a PK-less table")
 401     if ! keys %$ident_cond;
 402
 403   $self->set_inflated_columns($upd) if $upd;
 404   my %to_update = $self->get_dirty_columns;
 405   return $self unless keys %to_update;
 406   my $rows = $self->result_source->storage->update(
 407                $self->result_source, \%to_update,
 408                $self->{_orig_ident} || $ident_cond
 409              );
 410   if ($rows == 0) {
 411     $self->throw_exception( "Can't update ${self}: row not found" );
 412   } elsif ($rows > 1) {
 413     $self->throw_exception("Can't update ${self}: updated more than one row");
 414   }
 415   $self->{_dirty_columns} = {};
 416   $self->{related_resultsets} = {};
 417   undef $self->{_orig_ident};
 418   return $self;
 419 }
 420
 421 =head2 delete
 422
 423   $row->delete
 424
 425 =over
 426
 427 =item Arguments: none
 428
 429 =item Returns: The Row object
 430
 431 =back
 432
 433 Throws an exception if the object is not in the database according to
 434 L</in_storage>. Runs an SQL DELETE statement using the primary key
 435 values to locate the row.
 436
 437 The object is still perfectly usable, but L</in_storage> will
 438 now return 0 and the object must reinserted using L</insert>
 439 before it can be used to L</update> the row again.
 440
 441 If you delete an object in a class with a C<has_many> relationship, an
 442 attempt is made to delete all the related objects as well. To turn
 443 this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
 444 hashref of the relationship, see L<DBIx::Class::Relationship>. Any
 445 database-level cascade or restrict will take precedence over a
 446 DBIx-Class-based cascading delete.
 447
 448 See also L<DBIx::Class::ResultSet/delete>.
 449
 450 =cut
 451
 452 sub delete {
 453   my $self = shift;
 454   if (ref $self) {
 455     $self->throw_exception( "Not in database" ) unless $self->in_storage;
 456     my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
 457     $self->throw_exception("Cannot safely delete a row in a PK-less table")
 458       if ! keys %$ident_cond;
 459     foreach my $column (keys %$ident_cond) {
 460             $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
 461               unless exists $self->{_column_data}{$column};
 462     }
 463     $self->result_source->storage->delete(
 464       $self->result_source, $ident_cond);
 465     $self->in_storage(undef);
 466   } else {
 467     $self->throw_exception("Can't do class delete without a ResultSource instance")
 468       unless $self->can('result_source_instance');
 469     my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
 470     my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
 471     $self->result_source_instance->resultset->search(@_)->delete;
 472   }
 473   return $self;
 474 }
 475
 476 =head2 get_column
 477
 478   my $val = $row->get_column($col);
 479
 480 =over
 481
 482 =item Arguments: $columnname
 483
 484 =item Returns: The value of the column
 485
 486 =back
 487
 488 Throws an exception if the column name given doesn't exist according
 489 to L</has_column>.
 490
 491 Returns a raw column value from the row object, if it has already
 492 been fetched from the database or set by an accessor.
 493
 494 If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
 495 will be deflated and returned.
 496
 497 To retrieve all loaded column values as a hash, use L</get_columns>.
 498
 499 =cut
 500
 501 sub get_column {
 502   my ($self, $column) = @_;
 503   $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
 504   return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
 505   if (exists $self->{_inflated_column}{$column}) {
 506     return $self->store_column($column,
 507       $self->_deflated_column($column, $self->{_inflated_column}{$column}));
 508   }
 509   $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
 510   return undef;
 511 }
 512
 513 =head2 has_column_loaded
 514
 515   if ( $row->has_column_loaded($col) ) {
 516      print "$col has been loaded from db";
 517   }
 518
 519 =over
 520
 521 =item Arguments: $columnname
 522
 523 =item Returns: 0|1
 524
 525 =back
 526
 527 Returns a true value if the column value has been loaded from the
 528 database (or set locally).
 529
 530 =cut
 531
 532 sub has_column_loaded {
 533   my ($self, $column) = @_;
 534   $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
 535   return 1 if exists $self->{_inflated_column}{$column};
 536   return exists $self->{_column_data}{$column};
 537 }
 538
 539 =head2 get_columns
 540
 541   my %data = $row->get_columns;
 542
 543 =over
 544
 545 =item Arguments: none
 546
 547 =item Returns: A hash of columnname, value pairs.
 548
 549 =back
 550
 551 Returns all loaded column data as a hash, containing raw values. To
 552 get just one value for a particular column, use L</get_column>.
 553
 554 =cut
 555
 556 sub get_columns {
 557   my $self = shift;
 558   if (exists $self->{_inflated_column}) {
 559     foreach my $col (keys %{$self->{_inflated_column}}) {
 560       $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
 561         unless exists $self->{_column_data}{$col};
 562     }
 563   }
 564   return %{$self->{_column_data}};
 565 }
 566
 567 =head2 get_dirty_columns
 568
 569   my %data = $row->get_dirty_columns;
 570
 571 =over
 572
 573 =item Arguments: none
 574
 575 =item Returns: A hash of column, value pairs
 576
 577 =back
 578
 579 Only returns the column, value pairs for those columns that have been
 580 changed on this object since the last L</update> or L</insert> call.
 581
 582 See L</get_columns> to fetch all column/value pairs.
 583
 584 =cut
 585
 586 sub get_dirty_columns {
 587   my $self = shift;
 588   return map { $_ => $self->{_column_data}{$_} }
 589            keys %{$self->{_dirty_columns}};
 590 }
 591
 592 =head2 make_column_dirty
 593
 594   $row->make_column_dirty($col)
 595
 596 =over
 597
 598 =item Arguments: $columnname
 599
 600 =item Returns: undefined
 601
 602 =back
 603
 604 Throws an exception if the column does not exist.
 605
 606 Marks a column as having been changed regardless of whether it has
 607 really changed.
 608
 609 =cut
 610 sub make_column_dirty {
 611   my ($self, $column) = @_;
 612
 613   $self->throw_exception( "No such column '${column}'" )
 614     unless exists $self->{_column_data}{$column} || $self->has_column($column);
 615   $self->{_dirty_columns}{$column} = 1;
 616 }
 617
 618 =head2 get_inflated_columns
 619
 620   my %inflated_data = $obj->get_inflated_columns;
 621
 622 =over
 623
 624 =item Arguments: none
 625
 626 =item Returns: A hash of column, object|value pairs
 627
 628 =back
 629
 630 Returns a hash of all column keys and associated values. Values for any
 631 columns set to use inflation will be inflated and returns as objects.
 632
 633 See L</get_columns> to get the uninflated values.
 634
 635 See L<DBIx::Class::InflateColumn> for how to setup inflation.
 636
 637 =cut
 638
 639 sub get_inflated_columns {
 640   my $self = shift;
 641   return map {
 642     my $accessor = $self->column_info($_)->{'accessor'} || $_;
 643     ($_ => $self->$accessor);
 644   } $self->columns;
 645 }
 646
 647 =head2 set_column
 648
 649   $row->set_column($col => $val);
 650
 651 =over
 652
 653 =item Arguments: $columnname, $value
 654
 655 =item Returns: $value
 656
 657 =back
 658
 659 Sets a raw column value. If the new value is different from the old one,
 660 the column is marked as dirty for when you next call L</update>.
 661
 662 If passed an object or reference as a value, this will happily attempt
 663 store it, and a later L</insert> or L</update> will try and
 664 stringify/numify as appropriate. To set an object to be deflated
 665 instead, see L</set_inflated_columns>.
 666
 667 =cut
 668
 669 sub set_column {
 670   my ($self, $column, $new_value) = @_;
 671
 672   $self->{_orig_ident} ||= $self->ident_condition;
 673   my $old_value = $self->get_column($column);
 674
 675   $self->store_column($column, $new_value);
 676   $self->{_dirty_columns}{$column} = 1
 677     if (defined $old_value xor defined $new_value) || (defined $old_value && $old_value ne $new_value);
 678
 679   # XXX clear out the relation cache for this column
 680   delete $self->{related_resultsets}{$column};
 681
 682   return $new_value;
 683 }
 684
 685 =head2 set_columns
 686
 687   $row->set_columns({ $col => $val, ... });
 688
 689 =over
 690
 691 =item Arguments: \%columndata
 692
 693 =item Returns: The Row object
 694
 695 =back
 696
 697 Sets multiple column, raw value pairs at once.
 698
 699 Works as L</set_column>.
 700
 701 =cut
 702
 703 sub set_columns {
 704   my ($self,$data) = @_;
 705   foreach my $col (keys %$data) {
 706     $self->set_column($col,$data->{$col});
 707   }
 708   return $self;
 709 }
 710
 711 =head2 set_inflated_columns
 712
 713   $row->set_inflated_columns({ $col => $val, $relname => $obj, ... });
 714
 715 =over
 716
 717 =item Arguments: \%columndata
 718
 719 =item Returns: The Row object
 720
 721 =back
 722
 723 Sets more than one column value at once. Any inflated values are
 724 deflated and the raw values stored.
 725
 726 Any related values passed as Row objects, using the relation name as a
 727 key, are reduced to the appropriate foreign key values and stored. If
 728 instead of related row objects, a hashref of column, value data is
 729 passed, will create the related object first then store.
 730
 731 Will even accept arrayrefs of data as a value to a
 732 L<DBIx::Class::Relationship/has_many> key, and create the related
 733 objects if necessary.
 734
 735 Be aware that the input hashref might be edited in place, so dont rely
 736 on it being the same after a call to C<set_inflated_columns>. If you
 737 need to preserve the hashref, it is sufficient to pass a shallow copy
 738 to C<set_inflated_columns>, e.g. ( { %{ $href } } )
 739
 740 See also L<DBIx::Class::Relationship::Base/set_from_related>.
 741
 742 =cut
 743
 744 sub set_inflated_columns {
 745   my ( $self, $upd ) = @_;
 746   foreach my $key (keys %$upd) {
 747     if (ref $upd->{$key}) {
 748       my $info = $self->relationship_info($key);
 749       if ($info && $info->{attrs}{accessor}
 750         && $info->{attrs}{accessor} eq 'single')
 751       {
 752         my $rel = delete $upd->{$key};
 753         $self->set_from_related($key => $rel);
 754         $self->{_relationship_data}{$key} = $rel;
 755       } elsif ($info && $info->{attrs}{accessor}
 756         && $info->{attrs}{accessor} eq 'multi'
 757         && ref $upd->{$key} eq 'ARRAY') {
 758         my $others = delete $upd->{$key};
 759         foreach my $rel_obj (@$others) {
 760           if(!Scalar::Util::blessed($rel_obj)) {
 761             $rel_obj = $self->create_related($key, $rel_obj);
 762           }
 763         }
 764         $self->{_relationship_data}{$key} = $others;
 765 #            $related->{$key} = $others;
 766         next;
 767       }
 768       elsif ($self->has_column($key)
 769         && exists $self->column_info($key)->{_inflate_info})
 770       {
 771         $self->set_inflated_column($key, delete $upd->{$key});
 772       }
 773     }
 774   }
 775   $self->set_columns($upd);
 776 }
 777
 778 =head2 copy
 779
 780   my $copy = $orig->copy({ change => $to, ... });
 781
 782 =over
 783
 784 =item Arguments: \%replacementdata
 785
 786 =item Returns: The Row object copy
 787
 788 =back
 789
 790 Inserts a new row into the database, as a copy of the original
 791 object. If a hashref of replacement data is supplied, these will take
 792 precedence over data in the original.
 793
 794 If the row has related objects in a
 795 L<DBIx::Class::Relationship/has_many> then those objects may be copied
 796 too depending on the L<cascade_copy|DBIx::Class::Relationship>
 797 relationship attribute.
 798
 799 =cut
 800
 801 sub copy {
 802   my ($self, $changes) = @_;
 803   $changes ||= {};
 804   my $col_data = { %{$self->{_column_data}} };
 805   foreach my $col (keys %$col_data) {
 806     delete $col_data->{$col}
 807       if $self->result_source->column_info($col)->{is_auto_increment};
 808   }
 809
 810   my $new = { _column_data => $col_data };
 811   bless $new, ref $self;
 812
 813   $new->result_source($self->result_source);
 814   $new->set_inflated_columns($changes);
 815   $new->insert;
 816
 817   # Its possible we'll have 2 relations to the same Source. We need to make
 818   # sure we don't try to insert the same row twice esle we'll violate unique
 819   # constraints
 820   my $rels_copied = {};
 821
 822   foreach my $rel ($self->result_source->relationships) {
 823     my $rel_info = $self->result_source->relationship_info($rel);
 824
 825     next unless $rel_info->{attrs}{cascade_copy};
 826
 827     my $resolved = $self->result_source->resolve_condition(
 828       $rel_info->{cond}, $rel, $new
 829     );
 830
 831     my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
 832     foreach my $related ($self->search_related($rel)) {
 833       my $id_str = join("\0", $related->id);
 834       next if $copied->{$id_str};
 835       $copied->{$id_str} = 1;
 836       my $rel_copy = $related->copy($resolved);
 837     }
 838
 839   }
 840   return $new;
 841 }
 842
 843 =head2 store_column
 844
 845   $row->store_column($col => $val);
 846
 847 =over
 848
 849 =item Arguments: $columnname, $value
 850
 851 =item Returns: The value set
 852
 853 =back
 854
 855 Set a raw value for a column without marking it as changed. This
 856 method is used internally by L</set_column> which you should probably
 857 be using.
 858
 859 This is the lowest level at which data is set on a row object,
 860 extend this method to catch all data setting methods.
 861
 862 =cut
 863
 864 sub store_column {
 865   my ($self, $column, $value) = @_;
 866   $self->throw_exception( "No such column '${column}'" )
 867     unless exists $self->{_column_data}{$column} || $self->has_column($column);
 868   $self->throw_exception( "set_column called for ${column} without value" )
 869     if @_ < 3;
 870   return $self->{_column_data}{$column} = $value;
 871 }
 872
 873 =head2 inflate_result
 874
 875   Class->inflate_result($result_source, \%me, \%prefetch?)
 876
 877 =over
 878
 879 =item Arguments: $result_source, \%columndata, \%prefetcheddata
 880
 881 =item Returns: A Row object
 882
 883 =back
 884
 885 All L<DBIx::Class::ResultSet> methods that retrieve data from the
 886 database and turn it into row objects call this method.
 887
 888 Extend this method in your Result classes to hook into this process,
 889 for example to rebless the result into a different class.
 890
 891 Reblessing can also be done more easily by setting C<result_class> in
 892 your Result class. See L<DBIx::Class::ResultSource/result_class>.
 893
 894 =cut
 895
 896 sub inflate_result {
 897   my ($class, $source, $me, $prefetch) = @_;
 898
 899   my ($source_handle) = $source;
 900
 901   if ($source->isa('DBIx::Class::ResultSourceHandle')) {
 902       $source = $source_handle->resolve
 903   } else {
 904       $source_handle = $source->handle
 905   }
 906
 907   my $new = {
 908     _source_handle => $source_handle,
 909     _column_data => $me,
 910     _in_storage => 1
 911   };
 912   bless $new, (ref $class || $class);
 913
 914   my $schema;
 915   foreach my $pre (keys %{$prefetch||{}}) {
 916     my $pre_val = $prefetch->{$pre};
 917     my $pre_source = $source->related_source($pre);
 918     $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
 919       unless $pre_source;
 920     if (ref($pre_val->[0]) eq 'ARRAY') { # multi
 921       my @pre_objects;
 922       foreach my $pre_rec (@$pre_val) {
 923         unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
 924            and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
 925           next;
 926         }
 927         push(@pre_objects, $pre_source->result_class->inflate_result(
 928                              $pre_source, @{$pre_rec}));
 929       }
 930       $new->related_resultset($pre)->set_cache(\@pre_objects);
 931     } elsif (defined $pre_val->[0]) {
 932       my $fetched;
 933       unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
 934          and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
 935       {
 936         $fetched = $pre_source->result_class->inflate_result(
 937                       $pre_source, @{$pre_val});
 938       }
 939       $new->related_resultset($pre)->set_cache([ $fetched ]);
 940       my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
 941       $class->throw_exception("No accessor for prefetched $pre")
 942        unless defined $accessor;
 943       if ($accessor eq 'single') {
 944         $new->{_relationship_data}{$pre} = $fetched;
 945       } elsif ($accessor eq 'filter') {
 946         $new->{_inflated_column}{$pre} = $fetched;
 947       } else {
 948        $class->throw_exception("Prefetch not supported with accessor '$accessor'");
 949       }
 950     }
 951   }
 952   return $new;
 953 }
 954
 955 =head2 update_or_insert
 956
 957   $row->update_or_insert
 958
 959 =over
 960
 961 =item Arguments: none
 962
 963 =item Returns: Result of update or insert operation
 964
 965 =back
 966
 967 L</Update>s the object if it's already in the database, according to
 968 L</in_storage>, else L</insert>s it.
 969
 970 =head2 insert_or_update
 971
 972   $obj->insert_or_update
 973
 974 Alias for L</update_or_insert>
 975
 976 =cut
 977
 978 sub insert_or_update { shift->update_or_insert(@_) }
 979
 980 sub update_or_insert {
 981   my $self = shift;
 982   return ($self->in_storage ? $self->update : $self->insert);
 983 }
 984
 985 =head2 is_changed
 986
 987   my @changed_col_names = $row->is_changed();
 988   if ($row->is_changed()) { ... }
 989
 990 =over
 991
 992 =item Arguments: none
 993
 994 =item Returns: 0|1 or @columnnames
 995
 996 =back
 997
 998 In list context returns a list of columns with uncommited changes, or
 999 in scalar context returns a true value if there are uncommitted
1000 changes.
1001
1002 =cut
1003
1004 sub is_changed {
1005   return keys %{shift->{_dirty_columns} || {}};
1006 }
1007
1008 =head2 is_column_changed
1009
1010   if ($row->is_column_changed('col')) { ... }
1011
1012 =over
1013
1014 =item Arguments: $columname
1015
1016 =item Returns: 0|1
1017
1018 =back
1019
1020 Returns a true value if the column has uncommitted changes.
1021
1022 =cut
1023
1024 sub is_column_changed {
1025   my( $self, $col ) = @_;
1026   return exists $self->{_dirty_columns}->{$col};
1027 }
1028
1029 =head2 result_source
1030
1031   my $resultsource = $row->result_source;
1032
1033 =over
1034
1035 =item Arguments: none
1036
1037 =item Returns: a ResultSource instance
1038
1039 =back
1040
1041 Accessor to the L<DBIx::Class::ResultSource> this object was created from.
1042
1043 =cut
1044
1045 sub result_source {
1046     my $self = shift;
1047
1048     if (@_) {
1049         $self->_source_handle($_[0]->handle);
1050     } else {
1051         $self->_source_handle->resolve;
1052     }
1053 }
1054
1055 =head2 register_column
1056
1057   $column_info = { .... };
1058   $class->register_column($column_name, $column_info);
1059
1060 =over
1061
1062 =item Arguments: $columnname, \%columninfo
1063
1064 =item Returns: undefined
1065
1066 =back
1067
1068 Registers a column on the class. If the column_info has an 'accessor'
1069 key, creates an accessor named after the value if defined; if there is
1070 no such key, creates an accessor with the same name as the column
1071
1072 The column_info attributes are described in
1073 L<DBIx::Class::ResultSource/add_columns>
1074
1075 =cut
1076
1077 sub register_column {
1078   my ($class, $col, $info) = @_;
1079   my $acc = $col;
1080   if (exists $info->{accessor}) {
1081     return unless defined $info->{accessor};
1082     $acc = [ $info->{accessor}, $col ];
1083   }
1084   $class->mk_group_accessors('column' => $acc);
1085 }
1086
1087 =head2 get_from_storage
1088
1089   my $copy = $row->get_from_storage($attrs)
1090
1091 =over
1092
1093 =item Arguments: \%attrs
1094
1095 =item Returns: A Row object
1096
1097 =back
1098
1099 Fetches a fresh copy of the Row object from the database and returns it.
1100
1101 If passed the \%attrs argument, will first apply these attributes to
1102 the resultset used to find the row.
1103
1104 This copy can then be used to compare to an existing row object, to
1105 determine if any changes have been made in the database since it was
1106 created.
1107
1108 To just update your Row object with any latest changes from the
1109 database, use L</discard_changes> instead.
1110
1111 The \%attrs argument should be compatible with
1112 L<DBIx::Class::ResultSet/ATTRIBUTES>.
1113
1114 =cut
1115
1116 sub get_from_storage {
1117     my $self = shift @_;
1118     my $attrs = shift @_;
1119     my $resultset = $self->result_source->resultset;
1120
1121     if(defined $attrs) {
1122         $resultset = $resultset->search(undef, $attrs);
1123     }
1124
1125     return $resultset->find($self->{_orig_ident} || $self->ident_condition);
1126 }
1127
1128 =head2 throw_exception
1129
1130 See L<DBIx::Class::Schema/throw_exception>.
1131
1132 =cut
1133
1134 sub throw_exception {
1135   my $self=shift;
1136   if (ref $self && ref $self->result_source && $self->result_source->schema) {
1137     $self->result_source->schema->throw_exception(@_);
1138   } else {
1139     croak(@_);
1140   }
1141 }
1142
1143 =head2 id
1144
1145   my @pk = $row->id;
1146
1147 =over
1148
1149 =item Arguments: none
1150
1151 =item Returns: A list of primary key values
1152
1153 =back
1154
1155 Returns the primary key(s) for a row. Can't be called as a class method.
1156 Actually implemented in L<DBIx::Class::PK>
1157
1158 =head2 discard_changes
1159
1160   $row->discard_changes
1161
1162 =over
1163
1164 =item Arguments: none
1165
1166 =item Returns: nothing (updates object in-place)
1167
1168 =back
1169
1170 Retrieves and sets the row object data from the database, losing any
1171 local changes made.
1172
1173 This method can also be used to refresh from storage, retrieving any
1174 changes made since the row was last read from storage. Actually
1175 implemented in L<DBIx::Class::PK>
1176
1177 =cut
1178
1179 1;
1180
1181 =head1 AUTHORS
1182
1183 Matt S. Trout <mst@shadowcatsystems.co.uk>
1184
1185 =head1 LICENSE
1186
1187 You may distribute this code under the same terms as Perl itself.
1188
1189 =cut