Redo badly named constant folding arg introduced in 8d73fcd4
[dbsrgits/DBIx-Class-Historic.git] / 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
8 use Scalar::Util 'blessed';
9 use List::Util 'first';
10 use Try::Tiny;
11 use DBIx::Class::Carp;
12 use SQL::Abstract qw( is_literal_value is_plain_value );
13
14 ###
15 ### Internal method
16 ### Do not use
17 ###
18 BEGIN {
19   *MULTICREATE_DEBUG =
20     $ENV{DBIC_MULTICREATE_DEBUG}
21       ? sub () { 1 }
22       : sub () { 0 };
23 }
24
25 use namespace::clean;
26
27 __PACKAGE__->mk_group_accessors ( simple => [ in_storage => '_in_storage' ] );
28
29 =head1 NAME
30
31 DBIx::Class::Row - Basic row methods
32
33 =head1 SYNOPSIS
34
35 =head1 DESCRIPTION
36
37 This class is responsible for defining and doing basic operations on rows
38 derived from L<DBIx::Class::ResultSource> objects.
39
40 Result objects are returned from L<DBIx::Class::ResultSet>s using the
41 L<create|DBIx::Class::ResultSet/create>, L<find|DBIx::Class::ResultSet/find>,
42 L<next|DBIx::Class::ResultSet/next> and L<all|DBIx::Class::ResultSet/all> methods,
43 as well as invocations of 'single' (
44 L<belongs_to|DBIx::Class::Relationship/belongs_to>,
45 L<has_one|DBIx::Class::Relationship/has_one> or
46 L<might_have|DBIx::Class::Relationship/might_have>)
47 relationship accessors of L<Result|DBIx::Class::Manual::ResultClass> objects.
48
49 =head1 NOTE
50
51 All "Row objects" derived from a Schema-attached L<DBIx::Class::ResultSet>
52 object (such as a typical C<< L<search|DBIx::Class::ResultSet/search>->
53 L<next|DBIx::Class::ResultSet/next> >> call) are actually Result
54 instances, based on your application's
55 L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
56
57 L<DBIx::Class::Row> implements most of the row-based communication with the
58 underlying storage, but a Result class B<should not inherit from it directly>.
59 Usually, Result classes inherit from L<DBIx::Class::Core>, which in turn
60 combines the methods from several classes, one of them being
61 L<DBIx::Class::Row>.  Therefore, while many of the methods available to a
62 L<DBIx::Class::Core>-derived Result class are described in the following
63 documentation, it does not detail all of the methods available to Result
64 objects.  Refer to L<DBIx::Class::Manual::ResultClass> for more info.
65
66 =head1 METHODS
67
68 =head2 new
69
70   my $result = My::Class->new(\%attrs);
71
72   my $result = $schema->resultset('MySource')->new(\%colsandvalues);
73
74 =over
75
76 =item Arguments: \%attrs or \%colsandvalues
77
78 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
79
80 =back
81
82 While you can create a new result object by calling C<new> directly on
83 this class, you are better off calling it on a
84 L<DBIx::Class::ResultSet> object.
85
86 When calling it directly, you will not get a complete, usable row
87 object until you pass or set the C<result_source> attribute, to a
88 L<DBIx::Class::ResultSource> instance that is attached to a
89 L<DBIx::Class::Schema> with a valid connection.
90
91 C<$attrs> is a hashref of column name, value data. It can also contain
92 some other attributes such as the C<result_source>.
93
94 Passing an object, or an arrayref of objects as a value will call
95 L<DBIx::Class::Relationship::Base/set_from_related> for you. When
96 passed a hashref or an arrayref of hashrefs as the value, these will
97 be turned into objects via new_related, and treated as if you had
98 passed objects.
99
100 For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
101
102 Please note that if a value is not passed to new, no value will be sent
103 in the SQL INSERT call, and the column will therefore assume whatever
104 default value was specified in your database. While DBIC will retrieve the
105 value of autoincrement columns, it will never make an explicit database
106 trip to retrieve default values assigned by the RDBMS. You can explicitly
107 request that all values be fetched back from the database by calling
108 L</discard_changes>, or you can supply an explicit C<undef> to columns
109 with NULL as the default, and save yourself a SELECT.
110
111  CAVEAT:
112
113  The behavior described above will backfire if you use a foreign key column
114  with a database-defined default. If you call the relationship accessor on
115  an object that doesn't have a set value for the FK column, DBIC will throw
116  an exception, as it has no way of knowing the PK of the related object (if
117  there is one).
118
119 =cut
120
121 ## 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().
122 ## This only works because DBIC doesn't yet care to check whether the new_related objects have been passed all their mandatory columns
123 ## When doing the later insert, we need to make sure the PKs are set.
124 ## using _relationship_data in new and funky ways..
125 ## check Relationship::CascadeActions and Relationship::Accessor for compat
126 ## tests!
127
128 sub __new_related_find_or_new_helper {
129   my ($self, $rel_name, $values) = @_;
130
131   my $rsrc = $self->result_source;
132
133   # create a mock-object so all new/set_column component overrides will run:
134   my $rel_rs = $rsrc->related_source($rel_name)->resultset;
135   my $new_rel_obj = $rel_rs->new_result($values);
136   my $proc_data = { $new_rel_obj->get_columns };
137
138   if ($self->__their_pk_needs_us($rel_name)) {
139     MULTICREATE_DEBUG and print STDERR "MC $self constructing $rel_name via new_result\n";
140     return $new_rel_obj;
141   }
142   elsif ($rsrc->_pk_depends_on($rel_name, $proc_data )) {
143     if (! keys %$proc_data) {
144       # there is nothing to search for - blind create
145       MULTICREATE_DEBUG and print STDERR "MC $self constructing default-insert $rel_name\n";
146     }
147     else {
148       MULTICREATE_DEBUG and print STDERR "MC $self constructing $rel_name via find_or_new\n";
149       # this is not *really* find or new, as we don't want to double-new the
150       # data (thus potentially double encoding or whatever)
151       my $exists = $rel_rs->find ($proc_data);
152       return $exists if $exists;
153     }
154     return $new_rel_obj;
155   }
156   else {
157     my $us = $rsrc->source_name;
158     $self->throw_exception (
159       "Unable to determine relationship '$rel_name' direction from '$us', "
160     . "possibly due to a missing reverse-relationship on '$rel_name' to '$us'."
161     );
162   }
163 }
164
165 sub __their_pk_needs_us { # this should maybe be in resultsource.
166   my ($self, $rel_name) = @_;
167   my $rsrc = $self->result_source;
168   my $reverse = $rsrc->reverse_relationship_info($rel_name);
169   my $rel_source = $rsrc->related_source($rel_name);
170   my $us = { $self->get_columns };
171   foreach my $key (keys %$reverse) {
172     # if their primary key depends on us, then we have to
173     # just create a result and we'll fill it out afterwards
174     return 1 if $rel_source->_pk_depends_on($key, $us);
175   }
176   return 0;
177 }
178
179 sub new {
180   my ($class, $attrs) = @_;
181   $class = ref $class if ref $class;
182
183   my $new = bless { _column_data => {}, _in_storage => 0 }, $class;
184
185   if ($attrs) {
186     $new->throw_exception("attrs must be a hashref")
187       unless ref($attrs) eq 'HASH';
188
189     my $rsrc = delete $attrs->{-result_source};
190     if ( my $h = delete $attrs->{-source_handle} ) {
191       $rsrc ||= $h->resolve;
192     }
193
194     $new->result_source($rsrc) if $rsrc;
195
196     if (my $col_from_rel = delete $attrs->{-cols_from_relations}) {
197       @{$new->{_ignore_at_insert}={}}{@$col_from_rel} = ();
198     }
199
200     my ($related,$inflated);
201
202     foreach my $key (keys %$attrs) {
203       if (ref $attrs->{$key} and ! is_literal_value($attrs->{$key}) ) {
204         ## Can we extract this lot to use with update(_or .. ) ?
205         $new->throw_exception("Can't do multi-create without result source")
206           unless $rsrc;
207         my $info = $rsrc->relationship_info($key);
208         my $acc_type = $info->{attrs}{accessor} || '';
209         if ($acc_type eq 'single') {
210           my $rel_obj = delete $attrs->{$key};
211           if(!blessed $rel_obj) {
212             $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
213           }
214
215           if ($rel_obj->in_storage) {
216             $new->{_rel_in_storage}{$key} = 1;
217             $new->set_from_related($key, $rel_obj);
218           } else {
219             MULTICREATE_DEBUG and print STDERR "MC $new uninserted $key $rel_obj\n";
220           }
221
222           $related->{$key} = $rel_obj;
223           next;
224         }
225         elsif ($acc_type eq 'multi' && ref $attrs->{$key} eq 'ARRAY' ) {
226           my $others = delete $attrs->{$key};
227           my $total = @$others;
228           my @objects;
229           foreach my $idx (0 .. $#$others) {
230             my $rel_obj = $others->[$idx];
231             if(!blessed $rel_obj) {
232               $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
233             }
234
235             if ($rel_obj->in_storage) {
236               $rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong');
237             } else {
238               MULTICREATE_DEBUG and
239                 print STDERR "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
240             }
241             push(@objects, $rel_obj);
242           }
243           $related->{$key} = \@objects;
244           next;
245         }
246         elsif ($acc_type eq 'filter') {
247           ## 'filter' should disappear and get merged in with 'single' above!
248           my $rel_obj = delete $attrs->{$key};
249           if(!blessed $rel_obj) {
250             $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
251           }
252           if ($rel_obj->in_storage) {
253             $new->{_rel_in_storage}{$key} = 1;
254           }
255           else {
256             MULTICREATE_DEBUG and print STDERR "MC $new uninserted $key $rel_obj\n";
257           }
258           $inflated->{$key} = $rel_obj;
259           next;
260         }
261         elsif (
262           $rsrc->has_column($key)
263             and
264           $rsrc->column_info($key)->{_inflate_info}
265         ) {
266           $inflated->{$key} = $attrs->{$key};
267           next;
268         }
269       }
270       $new->store_column($key => $attrs->{$key});
271     }
272
273     $new->{_relationship_data} = $related if $related;
274     $new->{_inflated_column} = $inflated if $inflated;
275   }
276
277   return $new;
278 }
279
280 =head2 $column_accessor
281
282   # Each pair does the same thing
283
284   # (un-inflated, regular column)
285   my $val = $result->get_column('first_name');
286   my $val = $result->first_name;
287
288   $result->set_column('first_name' => $val);
289   $result->first_name($val);
290
291   # (inflated column via DBIx::Class::InflateColumn::DateTime)
292   my $val = $result->get_inflated_column('last_modified');
293   my $val = $result->last_modified;
294
295   $result->set_inflated_column('last_modified' => $val);
296   $result->last_modified($val);
297
298 =over
299
300 =item Arguments: $value?
301
302 =item Return Value: $value
303
304 =back
305
306 A column accessor method is created for each column, which is used for
307 getting/setting the value for that column.
308
309 The actual method name is based on the
310 L<accessor|DBIx::Class::ResultSource/accessor> name given during the
311 L<Result Class|DBIx::Class::Manual::ResultClass> L<column definition
312 |DBIx::Class::ResultSource/add_columns>. Like L</set_column>, this
313 will not store the data in the database until L</insert> or L</update>
314 is called on the row.
315
316 =head2 insert
317
318   $result->insert;
319
320 =over
321
322 =item Arguments: none
323
324 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
325
326 =back
327
328 Inserts an object previously created by L</new> into the database if
329 it isn't already in there. Returns the object itself. To insert an
330 entirely new row into the database, use L<DBIx::Class::ResultSet/create>.
331
332 To fetch an uninserted result object, call
333 L<new_result|DBIx::Class::ResultSet/new_result> on a resultset.
334
335 This will also insert any uninserted, related objects held inside this
336 one, see L<DBIx::Class::ResultSet/create> for more details.
337
338 =cut
339
340 sub insert {
341   my ($self) = @_;
342   return $self if $self->in_storage;
343   my $rsrc = $self->result_source;
344   $self->throw_exception("No result_source set on this object; can't insert")
345     unless $rsrc;
346
347   my $storage = $rsrc->storage;
348
349   my $rollback_guard;
350
351   # Check if we stored uninserted relobjs here in new()
352   my %related_stuff = (%{$self->{_relationship_data} || {}},
353                        %{$self->{_inflated_column} || {}});
354
355   # insert what needs to be inserted before us
356   my %pre_insert;
357   for my $rel_name (keys %related_stuff) {
358     my $rel_obj = $related_stuff{$rel_name};
359
360     if (! $self->{_rel_in_storage}{$rel_name}) {
361       next unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row'));
362
363       next unless $rsrc->_pk_depends_on(
364                     $rel_name, { $rel_obj->get_columns }
365                   );
366
367       # The guard will save us if we blow out of this scope via die
368       $rollback_guard ||= $storage->txn_scope_guard;
369
370       MULTICREATE_DEBUG and print STDERR "MC $self pre-reconstructing $rel_name $rel_obj\n";
371
372       my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_columns };
373       my $existing;
374
375       # if there are no keys - nothing to search for
376       if (keys %$them and $existing = $self->result_source
377                                            ->related_source($rel_name)
378                                            ->resultset
379                                            ->find($them)
380       ) {
381         %{$rel_obj} = %{$existing};
382       }
383       else {
384         $rel_obj->insert;
385       }
386
387       $self->{_rel_in_storage}{$rel_name} = 1;
388     }
389
390     $self->set_from_related($rel_name, $rel_obj);
391     delete $related_stuff{$rel_name};
392   }
393
394   # start a transaction here if not started yet and there is more stuff
395   # to insert after us
396   if (keys %related_stuff) {
397     $rollback_guard ||= $storage->txn_scope_guard
398   }
399
400   MULTICREATE_DEBUG and do {
401     no warnings 'uninitialized';
402     print STDERR "MC $self inserting (".join(', ', $self->get_columns).")\n";
403   };
404
405   # perform the insert - the storage will return everything it is asked to
406   # (autoinc primary columns and any retrieve_on_insert columns)
407   my %current_rowdata = $self->get_columns;
408   my $returned_cols = $storage->insert(
409     $rsrc,
410     { %current_rowdata }, # what to insert, copy because the storage *will* change it
411   );
412
413   for (keys %$returned_cols) {
414     $self->store_column($_, $returned_cols->{$_})
415       # this ensures we fire store_column only once
416       # (some asshats like overriding it)
417       if (
418         (!exists $current_rowdata{$_})
419           or
420         (defined $current_rowdata{$_} xor defined $returned_cols->{$_})
421           or
422         (defined $current_rowdata{$_} and $current_rowdata{$_} ne $returned_cols->{$_})
423       );
424   }
425
426   delete $self->{_column_data_in_storage};
427   $self->in_storage(1);
428
429   $self->{_dirty_columns} = {};
430   $self->{related_resultsets} = {};
431
432   foreach my $rel_name (keys %related_stuff) {
433     next unless $rsrc->has_relationship ($rel_name);
434
435     my @cands = ref $related_stuff{$rel_name} eq 'ARRAY'
436       ? @{$related_stuff{$rel_name}}
437       : $related_stuff{$rel_name}
438     ;
439
440     if (@cands && blessed $cands[0] && $cands[0]->isa('DBIx::Class::Row')
441     ) {
442       my $reverse = $rsrc->reverse_relationship_info($rel_name);
443       foreach my $obj (@cands) {
444         $obj->set_from_related($_, $self) for keys %$reverse;
445         if ($self->__their_pk_needs_us($rel_name)) {
446           if (exists $self->{_ignore_at_insert}{$rel_name}) {
447             MULTICREATE_DEBUG and print STDERR "MC $self skipping post-insert on $rel_name\n";
448           }
449           else {
450             MULTICREATE_DEBUG and print STDERR "MC $self inserting $rel_name $obj\n";
451             $obj->insert;
452           }
453         } else {
454           MULTICREATE_DEBUG and print STDERR "MC $self post-inserting $obj\n";
455           $obj->insert();
456         }
457       }
458     }
459   }
460
461   delete $self->{_ignore_at_insert};
462
463   $rollback_guard->commit if $rollback_guard;
464
465   return $self;
466 }
467
468 =head2 in_storage
469
470   $result->in_storage; # Get value
471   $result->in_storage(1); # Set value
472
473 =over
474
475 =item Arguments: none or 1|0
476
477 =item Return Value: 1|0
478
479 =back
480
481 Indicates whether the object exists as a row in the database or
482 not. This is set to true when L<DBIx::Class::ResultSet/find>,
483 L<DBIx::Class::ResultSet/create> or L<DBIx::Class::Row/insert>
484 are invoked.
485
486 Creating a result object using L<DBIx::Class::ResultSet/new_result>, or
487 calling L</delete> on one, sets it to false.
488
489
490 =head2 update
491
492   $result->update(\%columns?)
493
494 =over
495
496 =item Arguments: none or a hashref
497
498 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
499
500 =back
501
502 Throws an exception if the result object is not yet in the database,
503 according to L</in_storage>. Returns the object itself.
504
505 This method issues an SQL UPDATE query to commit any changes to the
506 object to the database if required (see L</get_dirty_columns>).
507 It throws an exception if a proper WHERE clause uniquely identifying
508 the database row can not be constructed (see
509 L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
510 for more details).
511
512 Also takes an optional hashref of C<< column_name => value >> pairs
513 to update on the object first. Be aware that the hashref will be
514 passed to C<set_inflated_columns>, which might edit it in place, so
515 don't rely on it being the same after a call to C<update>.  If you
516 need to preserve the hashref, it is sufficient to pass a shallow copy
517 to C<update>, e.g. ( { %{ $href } } )
518
519 If the values passed or any of the column values set on the object
520 contain scalar references, e.g.:
521
522   $result->last_modified(\'NOW()')->update();
523   # OR
524   $result->update({ last_modified => \'NOW()' });
525
526 The update will pass the values verbatim into SQL. (See
527 L<SQL::Abstract> docs).  The values in your Result object will NOT change
528 as a result of the update call, if you want the object to be updated
529 with the actual values from the database, call L</discard_changes>
530 after the update.
531
532   $result->update()->discard_changes();
533
534 To determine before calling this method, which column values have
535 changed and will be updated, call L</get_dirty_columns>.
536
537 To check if any columns will be updated, call L</is_changed>.
538
539 To force a column to be updated, call L</make_column_dirty> before
540 this method.
541
542 =cut
543
544 sub update {
545   my ($self, $upd) = @_;
546
547   $self->set_inflated_columns($upd) if $upd;
548
549   my %to_update = $self->get_dirty_columns
550     or return $self;
551
552   $self->throw_exception( "Not in database" ) unless $self->in_storage;
553
554   my $rows = $self->result_source->storage->update(
555     $self->result_source, \%to_update, $self->_storage_ident_condition
556   );
557   if ($rows == 0) {
558     $self->throw_exception( "Can't update ${self}: row not found" );
559   } elsif ($rows > 1) {
560     $self->throw_exception("Can't update ${self}: updated more than one row");
561   }
562   $self->{_dirty_columns} = {};
563   $self->{related_resultsets} = {};
564   delete $self->{_column_data_in_storage};
565   return $self;
566 }
567
568 =head2 delete
569
570   $result->delete
571
572 =over
573
574 =item Arguments: none
575
576 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
577
578 =back
579
580 Throws an exception if the object is not in the database according to
581 L</in_storage>. Also throws an exception if a proper WHERE clause
582 uniquely identifying the database row can not be constructed (see
583 L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
584 for more details).
585
586 The object is still perfectly usable, but L</in_storage> will
587 now return 0 and the object must be reinserted using L</insert>
588 before it can be used to L</update> the row again.
589
590 If you delete an object in a class with a C<has_many> relationship, an
591 attempt is made to delete all the related objects as well. To turn
592 this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
593 hashref of the relationship, see L<DBIx::Class::Relationship>. Any
594 database-level cascade or restrict will take precedence over a
595 DBIx-Class-based cascading delete, since DBIx-Class B<deletes the
596 main row first> and only then attempts to delete any remaining related
597 rows.
598
599 If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
600 and the transaction subsequently fails, the result object will remain marked as
601 not being in storage. If you know for a fact that the object is still in
602 storage (i.e. by inspecting the cause of the transaction's failure), you can
603 use C<< $obj->in_storage(1) >> to restore consistency between the object and
604 the database. This would allow a subsequent C<< $obj->delete >> to work
605 as expected.
606
607 See also L<DBIx::Class::ResultSet/delete>.
608
609 =cut
610
611 sub delete {
612   my $self = shift;
613   if (ref $self) {
614     $self->throw_exception( "Not in database" ) unless $self->in_storage;
615
616     $self->result_source->storage->delete(
617       $self->result_source, $self->_storage_ident_condition
618     );
619
620     delete $self->{_column_data_in_storage};
621     $self->in_storage(0);
622   }
623   else {
624     my $rsrc = try { $self->result_source_instance }
625       or $self->throw_exception("Can't do class delete without a ResultSource instance");
626
627     my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
628     my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
629     $rsrc->resultset->search(@_)->delete;
630   }
631   return $self;
632 }
633
634 =head2 get_column
635
636   my $val = $result->get_column($col);
637
638 =over
639
640 =item Arguments: $columnname
641
642 =item Return Value: The value of the column
643
644 =back
645
646 Throws an exception if the column name given doesn't exist according
647 to L<has_column|DBIx::Class::ResultSource/has_column>.
648
649 Returns a raw column value from the result object, if it has already
650 been fetched from the database or set by an accessor.
651
652 If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
653 will be deflated and returned.
654
655 Note that if you used the C<columns> or the C<select/as>
656 L<search attributes|DBIx::Class::ResultSet/ATTRIBUTES> on the resultset from
657 which C<$result> was derived, and B<did not include> C<$columnname> in the list,
658 this method will return C<undef> even if the database contains some value.
659
660 To retrieve all loaded column values as a hash, use L</get_columns>.
661
662 =cut
663
664 sub get_column {
665   my ($self, $column) = @_;
666   $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
667
668   return $self->{_column_data}{$column}
669     if exists $self->{_column_data}{$column};
670
671   if (exists $self->{_inflated_column}{$column}) {
672     # deflate+return cycle
673     return $self->store_column($column, $self->_deflated_column(
674       $column, $self->{_inflated_column}{$column}
675     ));
676   }
677
678   $self->throw_exception( "No such column '${column}' on " . ref $self )
679     unless $self->result_source->has_column($column);
680
681   return undef;
682 }
683
684 =head2 has_column_loaded
685
686   if ( $result->has_column_loaded($col) ) {
687      print "$col has been loaded from db";
688   }
689
690 =over
691
692 =item Arguments: $columnname
693
694 =item Return Value: 0|1
695
696 =back
697
698 Returns a true value if the column value has been loaded from the
699 database (or set locally).
700
701 =cut
702
703 sub has_column_loaded {
704   my ($self, $column) = @_;
705   $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
706
707   return (
708     exists $self->{_inflated_column}{$column}
709       or
710     exists $self->{_column_data}{$column}
711   ) ? 1 : 0;
712 }
713
714 =head2 get_columns
715
716   my %data = $result->get_columns;
717
718 =over
719
720 =item Arguments: none
721
722 =item Return Value: A hash of columnname, value pairs.
723
724 =back
725
726 Returns all loaded column data as a hash, containing raw values. To
727 get just one value for a particular column, use L</get_column>.
728
729 See L</get_inflated_columns> to get the inflated values.
730
731 =cut
732
733 sub get_columns {
734   my $self = shift;
735   if (exists $self->{_inflated_column}) {
736     # deflate cycle for each inflation, including filter rels
737     foreach my $col (keys %{$self->{_inflated_column}}) {
738       unless (exists $self->{_column_data}{$col}) {
739
740         # if cached related_resultset is present assume this was a prefetch
741         carp_unique(
742           "Returning primary keys of prefetched 'filter' rels as part of get_columns() is deprecated and will "
743         . 'eventually be removed entirely (set DBIC_COLUMNS_INCLUDE_FILTER_RELS to disable this warning)'
744         ) if (
745           ! $ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS}
746             and
747           defined $self->{related_resultsets}{$col}
748             and
749           defined $self->{related_resultsets}{$col}->get_cache
750         );
751
752         $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}));
753       }
754     }
755   }
756   return %{$self->{_column_data}};
757 }
758
759 =head2 get_dirty_columns
760
761   my %data = $result->get_dirty_columns;
762
763 =over
764
765 =item Arguments: none
766
767 =item Return Value: A hash of column, value pairs
768
769 =back
770
771 Only returns the column, value pairs for those columns that have been
772 changed on this object since the last L</update> or L</insert> call.
773
774 See L</get_columns> to fetch all column/value pairs.
775
776 =cut
777
778 sub get_dirty_columns {
779   my $self = shift;
780   return map { $_ => $self->{_column_data}{$_} }
781            keys %{$self->{_dirty_columns}};
782 }
783
784 =head2 make_column_dirty
785
786   $result->make_column_dirty($col)
787
788 =over
789
790 =item Arguments: $columnname
791
792 =item Return Value: not defined
793
794 =back
795
796 Throws an exception if the column does not exist.
797
798 Marks a column as having been changed regardless of whether it has
799 really changed.
800
801 =cut
802
803 sub make_column_dirty {
804   my ($self, $column) = @_;
805
806   $self->throw_exception( "No such column '${column}' on " . ref $self )
807     unless exists $self->{_column_data}{$column} || $self->result_source->has_column($column);
808
809   # the entire clean/dirty code relies on exists, not on true/false
810   return 1 if exists $self->{_dirty_columns}{$column};
811
812   $self->{_dirty_columns}{$column} = 1;
813
814   # if we are just now making the column dirty, and if there is an inflated
815   # value, force it over the deflated one
816   if (exists $self->{_inflated_column}{$column}) {
817     $self->store_column($column,
818       $self->_deflated_column(
819         $column, $self->{_inflated_column}{$column}
820       )
821     );
822   }
823 }
824
825 =head2 get_inflated_columns
826
827   my %inflated_data = $obj->get_inflated_columns;
828
829 =over
830
831 =item Arguments: none
832
833 =item Return Value: A hash of column, object|value pairs
834
835 =back
836
837 Returns a hash of all column keys and associated values. Values for any
838 columns set to use inflation will be inflated and returns as objects.
839
840 See L</get_columns> to get the uninflated values.
841
842 See L<DBIx::Class::InflateColumn> for how to setup inflation.
843
844 =cut
845
846 sub get_inflated_columns {
847   my $self = shift;
848
849   my $loaded_colinfo = $self->result_source->columns_info;
850   $self->has_column_loaded($_) or delete $loaded_colinfo->{$_}
851     for keys %$loaded_colinfo;
852
853   my %cols_to_return = ( %{$self->{_column_data}}, %$loaded_colinfo );
854
855   unless ($ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS}) {
856     for (keys %$loaded_colinfo) {
857       # if cached related_resultset is present assume this was a prefetch
858       if (
859         $loaded_colinfo->{$_}{_inflate_info}
860           and
861         defined $self->{related_resultsets}{$_}
862           and
863         defined $self->{related_resultsets}{$_}->get_cache
864       ) {
865         carp_unique(
866           "Returning prefetched 'filter' rels as part of get_inflated_columns() is deprecated and will "
867         . 'eventually be removed entirely (set DBIC_COLUMNS_INCLUDE_FILTER_RELS to disable this warning)'
868         );
869         last;
870       }
871     }
872   }
873
874   map { $_ => (
875   (
876     ! exists $loaded_colinfo->{$_}
877       or
878     (
879       exists $loaded_colinfo->{$_}{accessor}
880         and
881       ! defined $loaded_colinfo->{$_}{accessor}
882     )
883   ) ? $self->get_column($_)
884     : $self->${ \(
885       defined $loaded_colinfo->{$_}{accessor}
886         ? $loaded_colinfo->{$_}{accessor}
887         : $_
888       )}
889   )} keys %cols_to_return;
890 }
891
892 sub _is_column_numeric {
893     my ($self, $column) = @_;
894
895     return undef unless $self->result_source->has_column($column);
896
897     my $colinfo = $self->result_source->column_info ($column);
898
899     # cache for speed (the object may *not* have a resultsource instance)
900     if (
901       ! defined $colinfo->{is_numeric}
902         and
903       my $storage = try { $self->result_source->schema->storage }
904     ) {
905       $colinfo->{is_numeric} =
906         $storage->is_datatype_numeric ($colinfo->{data_type})
907           ? 1
908           : 0
909         ;
910     }
911
912     return $colinfo->{is_numeric};
913 }
914
915 =head2 set_column
916
917   $result->set_column($col => $val);
918
919 =over
920
921 =item Arguments: $columnname, $value
922
923 =item Return Value: $value
924
925 =back
926
927 Sets a raw column value. If the new value is different from the old one,
928 the column is marked as dirty for when you next call L</update>.
929
930 If passed an object or reference as a value, this method will happily
931 attempt to store it, and a later L</insert> or L</update> will try and
932 stringify/numify as appropriate. To set an object to be deflated
933 instead, see L</set_inflated_columns>, or better yet, use L</$column_accessor>.
934
935 =cut
936
937 sub set_column {
938   my ($self, $column, $new_value) = @_;
939
940   my $had_value = $self->has_column_loaded($column);
941   my $old_value = $self->get_column($column);
942
943   $new_value = $self->store_column($column, $new_value);
944
945   my $dirty =
946     $self->{_dirty_columns}{$column}
947       ||
948     ( $self->in_storage # no point tracking dirtyness on uninserted data
949       ? ! $self->_eq_column_values ($column, $old_value, $new_value)
950       : 1
951     )
952   ;
953
954   if ($dirty) {
955     # FIXME sadly the update code just checks for keys, not for their value
956     $self->{_dirty_columns}{$column} = 1;
957
958     # Clear out the relation/inflation cache related to this column
959     #
960     # FIXME - this is a quick *largely incorrect* hack, pending a more
961     # serious rework during the merge of single and filter rels
962     my $rel_names = $self->result_source->{_relationships};
963     for my $rel_name (keys %$rel_names) {
964
965       my $acc = $rel_names->{$rel_name}{attrs}{accessor} || '';
966
967       if ( $acc eq 'single' and $rel_names->{$rel_name}{attrs}{fk_columns}{$column} ) {
968         delete $self->{related_resultsets}{$rel_name};
969         delete $self->{_relationship_data}{$rel_name};
970         #delete $self->{_inflated_column}{$rel_name};
971       }
972       elsif ( $acc eq 'filter' and $rel_name eq $column) {
973         delete $self->{related_resultsets}{$rel_name};
974         #delete $self->{_relationship_data}{$rel_name};
975         delete $self->{_inflated_column}{$rel_name};
976       }
977     }
978
979     if (
980       # value change from something (even if NULL)
981       $had_value
982         and
983       # no storage - no storage-value
984       $self->in_storage
985         and
986       # no value already stored (multiple changes before commit to storage)
987       ! exists $self->{_column_data_in_storage}{$column}
988         and
989       $self->_track_storage_value($column)
990     ) {
991       $self->{_column_data_in_storage}{$column} = $old_value;
992     }
993   }
994
995   return $new_value;
996 }
997
998 sub _eq_column_values {
999   my ($self, $col, $old, $new) = @_;
1000
1001   if (defined $old xor defined $new) {
1002     return 0;
1003   }
1004   elsif (not defined $old) {  # both undef
1005     return 1;
1006   }
1007   elsif (
1008     is_literal_value $old
1009       or
1010     is_literal_value $new
1011   ) {
1012     return 0;
1013   }
1014   elsif ($old eq $new) {
1015     return 1;
1016   }
1017   elsif ($self->_is_column_numeric($col)) {  # do a numeric comparison if datatype allows it
1018     return $old == $new;
1019   }
1020   else {
1021     return 0;
1022   }
1023 }
1024
1025 # returns a boolean indicating if the passed column should have its original
1026 # value tracked between column changes and commitment to storage
1027 sub _track_storage_value {
1028   my ($self, $col) = @_;
1029   return defined first { $col eq $_ } ($self->result_source->primary_columns);
1030 }
1031
1032 =head2 set_columns
1033
1034   $result->set_columns({ $col => $val, ... });
1035
1036 =over
1037
1038 =item Arguments: \%columndata
1039
1040 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1041
1042 =back
1043
1044 Sets multiple column, raw value pairs at once.
1045
1046 Works as L</set_column>.
1047
1048 =cut
1049
1050 sub set_columns {
1051   my ($self, $values) = @_;
1052   $self->set_column( $_, $values->{$_} ) for keys %$values;
1053   return $self;
1054 }
1055
1056 =head2 set_inflated_columns
1057
1058   $result->set_inflated_columns({ $col => $val, $rel_name => $obj, ... });
1059
1060 =over
1061
1062 =item Arguments: \%columndata
1063
1064 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1065
1066 =back
1067
1068 Sets more than one column value at once. Any inflated values are
1069 deflated and the raw values stored.
1070
1071 Any related values passed as Result objects, using the relation name as a
1072 key, are reduced to the appropriate foreign key values and stored. If
1073 instead of related result objects, a hashref of column, value data is
1074 passed, will create the related object first then store.
1075
1076 Will even accept arrayrefs of data as a value to a
1077 L<DBIx::Class::Relationship/has_many> key, and create the related
1078 objects if necessary.
1079
1080 Be aware that the input hashref might be edited in place, so don't rely
1081 on it being the same after a call to C<set_inflated_columns>. If you
1082 need to preserve the hashref, it is sufficient to pass a shallow copy
1083 to C<set_inflated_columns>, e.g. ( { %{ $href } } )
1084
1085 See also L<DBIx::Class::Relationship::Base/set_from_related>.
1086
1087 =cut
1088
1089 sub set_inflated_columns {
1090   my ( $self, $upd ) = @_;
1091   my $rsrc;
1092   foreach my $key (keys %$upd) {
1093     if (ref $upd->{$key}) {
1094       $rsrc ||= $self->result_source;
1095       my $info = $rsrc->relationship_info($key);
1096       my $acc_type = $info->{attrs}{accessor} || '';
1097
1098       if ($acc_type eq 'single') {
1099         my $rel_obj = delete $upd->{$key};
1100         $self->set_from_related($key => $rel_obj);
1101         $self->{_relationship_data}{$key} = $rel_obj;
1102       }
1103       elsif ($acc_type eq 'multi') {
1104         $self->throw_exception(
1105           "Recursive update is not supported over relationships of type '$acc_type' ($key)"
1106         );
1107       }
1108       elsif (
1109         $rsrc->has_column($key)
1110           and
1111         exists $rsrc->column_info($key)->{_inflate_info}
1112       ) {
1113         $self->set_inflated_column($key, delete $upd->{$key});
1114       }
1115     }
1116   }
1117   $self->set_columns($upd);
1118 }
1119
1120 =head2 copy
1121
1122   my $copy = $orig->copy({ change => $to, ... });
1123
1124 =over
1125
1126 =item Arguments: \%replacementdata
1127
1128 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass> copy
1129
1130 =back
1131
1132 Inserts a new row into the database, as a copy of the original
1133 object. If a hashref of replacement data is supplied, these will take
1134 precedence over data in the original. Also any columns which have
1135 the L<column info attribute|DBIx::Class::ResultSource/add_columns>
1136 C<< is_auto_increment => 1 >> are explicitly removed before the copy,
1137 so that the database can insert its own autoincremented values into
1138 the new object.
1139
1140 Relationships will be followed by the copy procedure B<only> if the
1141 relationship specifies a true value for its
1142 L<cascade_copy|DBIx::Class::Relationship::Base> attribute. C<cascade_copy>
1143 is set by default on C<has_many> relationships and unset on all others.
1144
1145 =cut
1146
1147 sub copy {
1148   my ($self, $changes) = @_;
1149   $changes ||= {};
1150   my $col_data = { $self->get_columns };
1151
1152   my $rsrc = $self->result_source;
1153
1154   my $colinfo = $rsrc->columns_info;
1155   foreach my $col (keys %$col_data) {
1156     delete $col_data->{$col}
1157       if ( ! $colinfo->{$col} or $colinfo->{$col}{is_auto_increment} );
1158   }
1159
1160   my $new = { _column_data => $col_data };
1161   bless $new, ref $self;
1162
1163   $new->result_source($rsrc);
1164   $new->set_inflated_columns($changes);
1165   $new->insert;
1166
1167   # Its possible we'll have 2 relations to the same Source. We need to make
1168   # sure we don't try to insert the same row twice else we'll violate unique
1169   # constraints
1170   my $rel_names_copied = {};
1171
1172   foreach my $rel_name ($rsrc->relationships) {
1173     my $rel_info = $rsrc->relationship_info($rel_name);
1174
1175     next unless $rel_info->{attrs}{cascade_copy};
1176
1177     my $foreign_vals;
1178     my $copied = $rel_names_copied->{ $rel_info->{source} } ||= {};
1179
1180     $copied->{$_->ID}++ or $_->copy(
1181
1182       $foreign_vals ||= $rsrc->_resolve_relationship_condition(
1183         infer_values_based_on => {},
1184         rel_name => $rel_name,
1185         self_result_object => $new,
1186
1187         self_alias => "\xFE", # irrelevant
1188         foreign_alias => "\xFF", # irrelevant,
1189       )->{inferred_values}
1190
1191     ) for $self->search_related($rel_name)->all;
1192   }
1193   return $new;
1194 }
1195
1196 =head2 store_column
1197
1198   $result->store_column($col => $val);
1199
1200 =over
1201
1202 =item Arguments: $columnname, $value
1203
1204 =item Return Value: The value sent to storage
1205
1206 =back
1207
1208 Set a raw value for a column without marking it as changed. This
1209 method is used internally by L</set_column> which you should probably
1210 be using.
1211
1212 This is the lowest level at which data is set on a result object,
1213 extend this method to catch all data setting methods.
1214
1215 =cut
1216
1217 sub store_column {
1218   my ($self, $column, $value) = @_;
1219   $self->throw_exception( "No such column '${column}' on " . ref $self )
1220     unless exists $self->{_column_data}{$column} || $self->result_source->has_column($column);
1221   $self->throw_exception( "set_column called for ${column} without value" )
1222     if @_ < 3;
1223
1224   # stringify all refs explicitly, guards against overloaded objects
1225   # with defined stringification AND fallback => 0 (ugh!)
1226   $self->{_column_data}{$column} = ( length ref $value and is_plain_value( $value ) )
1227     ? "$value"
1228     : $value
1229   ;
1230 }
1231
1232 =head2 inflate_result
1233
1234   Class->inflate_result($result_source, \%me, \%prefetch?)
1235
1236 =over
1237
1238 =item Arguments: L<$result_source|DBIx::Class::ResultSource>, \%columndata, \%prefetcheddata
1239
1240 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1241
1242 =back
1243
1244 All L<DBIx::Class::ResultSet> methods that retrieve data from the
1245 database and turn it into result objects call this method.
1246
1247 Extend this method in your Result classes to hook into this process,
1248 for example to rebless the result into a different class.
1249
1250 Reblessing can also be done more easily by setting C<result_class> in
1251 your Result class. See L<DBIx::Class::ResultSource/result_class>.
1252
1253 Different types of results can also be created from a particular
1254 L<DBIx::Class::ResultSet>, see L<DBIx::Class::ResultSet/result_class>.
1255
1256 =cut
1257
1258 sub inflate_result {
1259   my ($class, $rsrc, $me, $prefetch) = @_;
1260
1261   my $new = bless
1262     { _column_data => $me, _result_source => $rsrc },
1263     ref $class || $class
1264   ;
1265
1266   if ($prefetch) {
1267     for my $rel_name ( keys %$prefetch ) {
1268
1269       my $relinfo = $rsrc->relationship_info($rel_name) or do {
1270         my $err = sprintf
1271           "Inflation into non-existent relationship '%s' of '%s' requested",
1272           $rel_name,
1273           $rsrc->source_name,
1274         ;
1275         if (my ($colname) = sort { length($a) <=> length ($b) } keys %{$prefetch->{$rel_name}[0] || {}} ) {
1276           $err .= sprintf ", check the inflation specification (columns/as) ending in '...%s.%s'",
1277           $rel_name,
1278           $colname,
1279         }
1280
1281         $rsrc->throw_exception($err);
1282       };
1283
1284       $class->throw_exception("No accessor type declared for prefetched relationship '$rel_name'")
1285         unless $relinfo->{attrs}{accessor};
1286
1287       my $rel_rs = $new->related_resultset($rel_name);
1288
1289       my @rel_objects;
1290       if (
1291         @{ $prefetch->{$rel_name} || [] }
1292           and
1293         ref($prefetch->{$rel_name}) ne $DBIx::Class::ResultSource::RowParser::Util::null_branch_class
1294       ) {
1295
1296         if (ref $prefetch->{$rel_name}[0] eq 'ARRAY') {
1297           my $rel_rsrc = $rel_rs->result_source;
1298           my $rel_class = $rel_rs->result_class;
1299           my $rel_inflator = $rel_class->can('inflate_result');
1300           @rel_objects = map
1301             { $rel_class->$rel_inflator ( $rel_rsrc, @$_ ) }
1302             @{$prefetch->{$rel_name}}
1303           ;
1304         }
1305         else {
1306           @rel_objects = $rel_rs->result_class->inflate_result(
1307             $rel_rs->result_source, @{$prefetch->{$rel_name}}
1308           );
1309         }
1310       }
1311
1312       if ($relinfo->{attrs}{accessor} eq 'single') {
1313         $new->{_relationship_data}{$rel_name} = $rel_objects[0];
1314       }
1315       elsif ($relinfo->{attrs}{accessor} eq 'filter') {
1316         $new->{_inflated_column}{$rel_name} = $rel_objects[0];
1317       }
1318
1319       $rel_rs->set_cache(\@rel_objects);
1320     }
1321   }
1322
1323   $new->in_storage (1);
1324   return $new;
1325 }
1326
1327 =head2 update_or_insert
1328
1329   $result->update_or_insert
1330
1331 =over
1332
1333 =item Arguments: none
1334
1335 =item Return Value: Result of update or insert operation
1336
1337 =back
1338
1339 L</update>s the object if it's already in the database, according to
1340 L</in_storage>, else L</insert>s it.
1341
1342 =head2 insert_or_update
1343
1344   $obj->insert_or_update
1345
1346 Alias for L</update_or_insert>
1347
1348 =cut
1349
1350 sub insert_or_update { shift->update_or_insert(@_) }
1351
1352 sub update_or_insert {
1353   my $self = shift;
1354   return ($self->in_storage ? $self->update : $self->insert);
1355 }
1356
1357 =head2 is_changed
1358
1359   my @changed_col_names = $result->is_changed();
1360   if ($result->is_changed()) { ... }
1361
1362 =over
1363
1364 =item Arguments: none
1365
1366 =item Return Value: 0|1 or @columnnames
1367
1368 =back
1369
1370 In list context returns a list of columns with uncommited changes, or
1371 in scalar context returns a true value if there are uncommitted
1372 changes.
1373
1374 =cut
1375
1376 sub is_changed {
1377   return keys %{shift->{_dirty_columns} || {}};
1378 }
1379
1380 =head2 is_column_changed
1381
1382   if ($result->is_column_changed('col')) { ... }
1383
1384 =over
1385
1386 =item Arguments: $columname
1387
1388 =item Return Value: 0|1
1389
1390 =back
1391
1392 Returns a true value if the column has uncommitted changes.
1393
1394 =cut
1395
1396 sub is_column_changed {
1397   my( $self, $col ) = @_;
1398   return exists $self->{_dirty_columns}->{$col};
1399 }
1400
1401 =head2 result_source
1402
1403   my $resultsource = $result->result_source;
1404
1405 =over
1406
1407 =item Arguments: L<$result_source?|DBIx::Class::ResultSource>
1408
1409 =item Return Value: L<$result_source|DBIx::Class::ResultSource>
1410
1411 =back
1412
1413 Accessor to the L<DBIx::Class::ResultSource> this object was created from.
1414
1415 =cut
1416
1417 sub result_source {
1418   $_[0]->throw_exception( 'result_source can be called on instances only' )
1419     unless ref $_[0];
1420
1421   @_ > 1
1422     ? $_[0]->{_result_source} = $_[1]
1423
1424     # note this is a || not a ||=, the difference is important
1425     : $_[0]->{_result_source} || do {
1426         $_[0]->can('result_source_instance')
1427           ? $_[0]->result_source_instance
1428           : $_[0]->throw_exception(
1429             "No result source instance registered for @{[ ref $_[0] ]}, did you forget to call @{[ ref $_[0] ]}->table(...) ?"
1430           )
1431       }
1432   ;
1433 }
1434
1435 =head2 register_column
1436
1437   $column_info = { .... };
1438   $class->register_column($column_name, $column_info);
1439
1440 =over
1441
1442 =item Arguments: $columnname, \%columninfo
1443
1444 =item Return Value: not defined
1445
1446 =back
1447
1448 Registers a column on the class. If the column_info has an 'accessor'
1449 key, creates an accessor named after the value if defined; if there is
1450 no such key, creates an accessor with the same name as the column
1451
1452 The column_info attributes are described in
1453 L<DBIx::Class::ResultSource/add_columns>
1454
1455 =cut
1456
1457 sub register_column {
1458   my ($class, $col, $info) = @_;
1459   my $acc = $col;
1460   if (exists $info->{accessor}) {
1461     return unless defined $info->{accessor};
1462     $acc = [ $info->{accessor}, $col ];
1463   }
1464   $class->mk_group_accessors('column' => $acc);
1465 }
1466
1467 =head2 get_from_storage
1468
1469   my $copy = $result->get_from_storage($attrs)
1470
1471 =over
1472
1473 =item Arguments: \%attrs
1474
1475 =item Return Value: A Result object
1476
1477 =back
1478
1479 Fetches a fresh copy of the Result object from the database and returns it.
1480 Throws an exception if a proper WHERE clause identifying the database row
1481 can not be constructed (i.e. if the original object does not contain its
1482 entire
1483  L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
1484 ). If passed the \%attrs argument, will first apply these attributes to
1485 the resultset used to find the row.
1486
1487 This copy can then be used to compare to an existing result object, to
1488 determine if any changes have been made in the database since it was
1489 created.
1490
1491 To just update your Result object with any latest changes from the
1492 database, use L</discard_changes> instead.
1493
1494 The \%attrs argument should be compatible with
1495 L<DBIx::Class::ResultSet/ATTRIBUTES>.
1496
1497 =cut
1498
1499 sub get_from_storage {
1500     my $self = shift @_;
1501     my $attrs = shift @_;
1502     my $resultset = $self->result_source->resultset;
1503
1504     if(defined $attrs) {
1505       $resultset = $resultset->search(undef, $attrs);
1506     }
1507
1508     return $resultset->find($self->_storage_ident_condition);
1509 }
1510
1511 =head2 discard_changes
1512
1513   $result->discard_changes
1514
1515 =over
1516
1517 =item Arguments: none or $attrs
1518
1519 =item Return Value: self (updates object in-place)
1520
1521 =back
1522
1523 Re-selects the row from the database, losing any changes that had
1524 been made. Throws an exception if a proper C<WHERE> clause identifying
1525 the database row can not be constructed (i.e. if the original object
1526 does not contain its entire
1527 L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>).
1528
1529 This method can also be used to refresh from storage, retrieving any
1530 changes made since the row was last read from storage.
1531
1532 $attrs, if supplied, is expected to be a hashref of attributes suitable for passing as the
1533 second argument to C<< $resultset->search($cond, $attrs) >>;
1534
1535 Note: If you are using L<DBIx::Class::Storage::DBI::Replicated> as your
1536 storage, a default of
1537 L<< C<< { force_pool => 'master' } >>
1538 |DBIx::Class::Storage::DBI::Replicated/SYNOPSIS >>  is automatically set for
1539 you. Prior to C<< DBIx::Class 0.08109 >> (before 2010) one would have been
1540 required to explicitly wrap the entire operation in a transaction to guarantee
1541 that up-to-date results are read from the master database.
1542
1543 =cut
1544
1545 sub discard_changes {
1546   my ($self, $attrs) = @_;
1547   return unless $self->in_storage; # Don't reload if we aren't real!
1548
1549   # add a replication default to read from the master only
1550   $attrs = { force_pool => 'master', %{$attrs||{}} };
1551
1552   if( my $current_storage = $self->get_from_storage($attrs)) {
1553
1554     # Set $self to the current.
1555     %$self = %$current_storage;
1556
1557     # Avoid a possible infinite loop with
1558     # sub DESTROY { $_[0]->discard_changes }
1559     bless $current_storage, 'Do::Not::Exist';
1560
1561     return $self;
1562   }
1563   else {
1564     $self->in_storage(0);
1565     return $self;
1566   }
1567 }
1568
1569 =head2 throw_exception
1570
1571 See L<DBIx::Class::Schema/throw_exception>.
1572
1573 =cut
1574
1575 sub throw_exception {
1576   my $self=shift;
1577
1578   if (ref $self && ref (my $rsrc = try { $self->result_source_instance } ) ) {
1579     $rsrc->throw_exception(@_)
1580   }
1581   else {
1582     DBIx::Class::Exception->throw(@_);
1583   }
1584 }
1585
1586 =head2 id
1587
1588   my @pk = $result->id;
1589
1590 =over
1591
1592 =item Arguments: none
1593
1594 =item Returns: A list of primary key values
1595
1596 =back
1597
1598 Returns the primary key(s) for a row. Can't be called as a class method.
1599 Actually implemented in L<DBIx::Class::PK>
1600
1601 =head1 FURTHER QUESTIONS?
1602
1603 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
1604
1605 =head1 COPYRIGHT AND LICENSE
1606
1607 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
1608 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
1609 redistribute it and/or modify it under the same terms as the
1610 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
1611
1612 =cut
1613
1614 1;