7ee9ca85e82d6006e8d6373c617b5537ed41ad4a
[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 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 =head1 METHODS
25
26 =head2 new
27
28   my $obj = My::Class->new($attrs);
29
30 Creates a new row object from column => value mappings passed as a hash ref
31
32 Passing an object, or an arrayref of objects as a value will call
33 L<DBIx::Class::Relationship::Base/set_from_related> for you. When
34 passed a hashref or an arrayref of hashrefs as the value, these will
35 be turned into objects via new_related, and treated as if you had
36 passed objects.
37
38 For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
39
40 =cut
41
42 ## 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().
43 ## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
44 ## When doing the later insert, we need to make sure the PKs are set.
45 ## using _relationship_data in new and funky ways..
46 ## check Relationship::CascadeActions and Relationship::Accessor for compat
47 ## tests!
48
49 sub new {
50   my ($class, $attrs) = @_;
51   $class = ref $class if ref $class;
52
53   my $new = { _column_data => {} };
54   bless $new, $class;
55
56   if (my $handle = delete $attrs->{-source_handle}) {
57     $new->_source_handle($handle);
58   }
59   if (my $source = delete $attrs->{-result_source}) {
60     $new->result_source($source);
61   }
62
63   if ($attrs) {
64     $new->throw_exception("attrs must be a hashref")
65       unless ref($attrs) eq 'HASH';
66     
67     my ($related,$inflated);
68     ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
69     $new->{_rel_in_storage} = 1;
70
71     foreach my $key (keys %$attrs) {
72       if (ref $attrs->{$key}) {
73         ## Can we extract this lot to use with update(_or .. ) ?
74         my $info = $class->relationship_info($key);
75         if ($info && $info->{attrs}{accessor}
76           && $info->{attrs}{accessor} eq 'single')
77         {
78           my $rel_obj = delete $attrs->{$key};
79           if(!Scalar::Util::blessed($rel_obj)) {
80             $rel_obj = $new->find_or_new_related($key, $rel_obj);
81           }
82
83           $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
84
85           $new->set_from_related($key, $rel_obj);        
86           $related->{$key} = $rel_obj;
87           next;
88         } elsif ($info && $info->{attrs}{accessor}
89             && $info->{attrs}{accessor} eq 'multi'
90             && ref $attrs->{$key} eq 'ARRAY') {
91           my $others = delete $attrs->{$key};
92           foreach my $rel_obj (@$others) {
93             if(!Scalar::Util::blessed($rel_obj)) {
94               $rel_obj = $new->new_related($key, $rel_obj);
95               $new->{_rel_in_storage} = 0;
96             }
97
98             $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
99           }
100           $related->{$key} = $others;
101           next;
102         } elsif ($info && $info->{attrs}{accessor}
103           && $info->{attrs}{accessor} eq 'filter')
104         {
105           ## 'filter' should disappear and get merged in with 'single' above!
106           my $rel_obj = delete $attrs->{$key};
107           if(!Scalar::Util::blessed($rel_obj)) {
108             $rel_obj = $new->find_or_new_related($key, $rel_obj);
109             $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
110           }
111           $inflated->{$key} = $rel_obj;
112           next;
113         } elsif ($class->has_column($key)
114             && $class->column_info($key)->{_inflate_info}) {
115           $inflated->{$key} = $attrs->{$key};
116           next;
117         }
118       }
119       $new->throw_exception("No such column $key on $class")
120         unless $class->has_column($key);
121       $new->store_column($key => $attrs->{$key});          
122     }
123
124     $new->{_relationship_data} = $related if $related;
125     $new->{_inflated_column} = $inflated if $inflated;
126   }
127
128   return $new;
129 }
130
131 =head2 insert
132
133   $obj->insert;
134
135 Inserts an object into the database if it isn't already in
136 there. Returns the object itself. Requires the object's result source to
137 be set, or the class to have a result_source_instance method. To insert
138 an entirely new object into the database, use C<create> (see
139 L<DBIx::Class::ResultSet/create>).
140
141 This will also insert any uninserted, related objects held inside this
142 one, see L<DBIx::Class::ResultSet/create> for more details.
143
144 =cut
145
146 sub insert {
147   my ($self) = @_;
148   return $self if $self->in_storage;
149   my $source = $self->result_source;
150   $source ||=  $self->result_source($self->result_source_instance)
151     if $self->can('result_source_instance');
152   $self->throw_exception("No result_source set on this object; can't insert")
153     unless $source;
154
155   my $rollback_guard;
156
157   # Check if we stored uninserted relobjs here in new()
158   my %related_stuff = (%{$self->{_relationship_data} || {}}, 
159                        %{$self->{_inflated_column} || {}});
160
161   if(!$self->{_rel_in_storage}) {
162     $source->storage->txn_begin;
163
164     # The guard will save us if we blow out of this scope via die
165
166     $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback });
167
168     ## Should all be in relationship_data, but we need to get rid of the
169     ## 'filter' reltype..
170     ## These are the FK rels, need their IDs for the insert.
171
172     my @pri = $self->primary_columns;
173
174     REL: foreach my $relname (keys %related_stuff) {
175
176       my $rel_obj = $related_stuff{$relname};
177
178       next REL unless (Scalar::Util::blessed($rel_obj)
179                        && $rel_obj->isa('DBIx::Class::Row'));
180
181       my $cond = $source->relationship_info($relname)->{cond};
182
183       next REL unless ref($cond) eq 'HASH';
184
185       # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
186
187       my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
188
189       # assume anything that references our PK probably is dependent on us
190       # rather than vice versa, unless the far side is (a) defined or (b)
191       # auto-increment
192
193       foreach my $p (@pri) {
194         if (exists $keyhash->{$p}) {
195           unless (defined($rel_obj->get_column($keyhash->{$p}))
196                   || $rel_obj->column_info($keyhash->{$p})
197                              ->{is_auto_increment}) {
198             next REL;
199           }
200         }
201       }
202
203       $rel_obj->insert();
204       $self->set_from_related($relname, $rel_obj);
205       delete $related_stuff{$relname};
206     }
207   }
208
209   $source->storage->insert($source, { $self->get_columns });
210
211   ## PK::Auto
212   my @auto_pri = grep {
213                    !defined $self->get_column($_) || 
214                    ref($self->get_column($_)) eq 'SCALAR'
215                  } $self->primary_columns;
216
217   if (@auto_pri) {
218     #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
219     #  if defined $too_many;
220
221     my $storage = $self->result_source->storage;
222     $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
223       unless $storage->can('last_insert_id');
224     my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
225     $self->throw_exception( "Can't get last insert id" )
226       unless (@ids == @auto_pri);
227     $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
228   }
229
230   if(!$self->{_rel_in_storage}) {
231     ## Now do the has_many rels, that need $selfs ID.
232     foreach my $relname (keys %related_stuff) {
233       my $rel_obj = $related_stuff{$relname};
234       my @cands;
235       if (Scalar::Util::blessed($rel_obj)
236           && $rel_obj->isa('DBIx::Class::Row')) {
237         @cands = ($rel_obj);
238       } elsif (ref $rel_obj eq 'ARRAY') {
239         @cands = @$rel_obj;
240       }
241       if (@cands) {
242         my $reverse = $source->reverse_relationship_info($relname);
243         foreach my $obj (@cands) {
244           $obj->set_from_related($_, $self) for keys %$reverse;
245           $obj->insert() unless ($obj->in_storage || $obj->result_source->resultset->search({$obj->get_columns})->count);
246         }
247       }
248     }
249     $source->storage->txn_commit;
250     $rollback_guard->dismiss;
251   }
252
253   $self->in_storage(1);
254   $self->{_dirty_columns} = {};
255   $self->{related_resultsets} = {};
256   undef $self->{_orig_ident};
257   return $self;
258 }
259
260 =head2 in_storage
261
262   $obj->in_storage; # Get value
263   $obj->in_storage(1); # Set value
264
265 Indicates whether the object exists as a row in the database or not
266
267 =cut
268
269 sub in_storage {
270   my ($self, $val) = @_;
271   $self->{_in_storage} = $val if @_ > 1;
272   return $self->{_in_storage};
273 }
274
275 =head2 update
276
277   $obj->update \%columns?;
278
279 Must be run on an object that is already in the database; issues an SQL
280 UPDATE query to commit any changes to the object to the database if
281 required.
282
283 Also takes an options hashref of C<< column_name => value> pairs >> to update
284 first. But be awawre that the hashref will be passed to
285 C<set_inflated_columns>, which might edit it in place, so dont rely on it being
286 the same after a call to C<update>.  If you need to preserve the hashref, it is
287 sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
288
289 =cut
290
291 sub update {
292   my ($self, $upd) = @_;
293   $self->throw_exception( "Not in database" ) unless $self->in_storage;
294   my $ident_cond = $self->ident_condition;
295   $self->throw_exception("Cannot safely update a row in a PK-less table")
296     if ! keys %$ident_cond;
297
298   $self->set_inflated_columns($upd) if $upd;
299   my %to_update = $self->get_dirty_columns;
300   return $self unless keys %to_update;
301   my $rows = $self->result_source->storage->update(
302                $self->result_source, \%to_update,
303                $self->{_orig_ident} || $ident_cond
304              );
305   if ($rows == 0) {
306     $self->throw_exception( "Can't update ${self}: row not found" );
307   } elsif ($rows > 1) {
308     $self->throw_exception("Can't update ${self}: updated more than one row");
309   }
310   $self->{_dirty_columns} = {};
311   $self->{related_resultsets} = {};
312   undef $self->{_orig_ident};
313   return $self;
314 }
315
316 =head2 delete
317
318   $obj->delete
319
320 Deletes the object from the database. The object is still perfectly
321 usable, but C<< ->in_storage() >> will now return 0 and the object must
322 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
323 on it. If you delete an object in a class with a C<has_many>
324 relationship, all the related objects will be deleted as well. To turn
325 this behavior off, pass C<< cascade_delete => 0 >> in the C<$attr>
326 hashref. Any database-level cascade or restrict will take precedence
327 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
328
329 =cut
330
331 sub delete {
332   my $self = shift;
333   if (ref $self) {
334     $self->throw_exception( "Not in database" ) unless $self->in_storage;
335     my $ident_cond = $self->ident_condition;
336     $self->throw_exception("Cannot safely delete a row in a PK-less table")
337       if ! keys %$ident_cond;
338     foreach my $column (keys %$ident_cond) {
339             $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
340               unless exists $self->{_column_data}{$column};
341     }
342     $self->result_source->storage->delete(
343       $self->result_source, $ident_cond);
344     $self->in_storage(undef);
345   } else {
346     $self->throw_exception("Can't do class delete without a ResultSource instance")
347       unless $self->can('result_source_instance');
348     my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
349     my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
350     $self->result_source_instance->resultset->search(@_)->delete;
351   }
352   return $self;
353 }
354
355 =head2 get_column
356
357   my $val = $obj->get_column($col);
358
359 Gets a column value from a row object. Does not do any queries; the column 
360 must have already been fetched from the database and stored in the object. If 
361 there is an inflated value stored that has not yet been deflated, it is deflated
362 when the method is invoked.
363
364 =cut
365
366 sub get_column {
367   my ($self, $column) = @_;
368   $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
369   return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
370   if (exists $self->{_inflated_column}{$column}) {
371     return $self->store_column($column,
372       $self->_deflated_column($column, $self->{_inflated_column}{$column}));   
373   }
374   $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
375   return undef;
376 }
377
378 =head2 has_column_loaded
379
380   if ( $obj->has_column_loaded($col) ) {
381      print "$col has been loaded from db";
382   }
383
384 Returns a true value if the column value has been loaded from the
385 database (or set locally).
386
387 =cut
388
389 sub has_column_loaded {
390   my ($self, $column) = @_;
391   $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
392   return 1 if exists $self->{_inflated_column}{$column};
393   return exists $self->{_column_data}{$column};
394 }
395
396 =head2 get_columns
397
398   my %data = $obj->get_columns;
399
400 Does C<get_column>, for all column values at once.
401
402 =cut
403
404 sub get_columns {
405   my $self = shift;
406   if (exists $self->{_inflated_column}) {
407     foreach my $col (keys %{$self->{_inflated_column}}) {
408       $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
409         unless exists $self->{_column_data}{$col};
410     }
411   }
412   return %{$self->{_column_data}};
413 }
414
415 =head2 get_dirty_columns
416
417   my %data = $obj->get_dirty_columns;
418
419 Identical to get_columns but only returns those that have been changed.
420
421 =cut
422
423 sub get_dirty_columns {
424   my $self = shift;
425   return map { $_ => $self->{_column_data}{$_} }
426            keys %{$self->{_dirty_columns}};
427 }
428
429 =head2 get_inflated_columns
430
431   my $inflated_data = $obj->get_inflated_columns;
432
433 Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
434
435 =cut
436
437 sub get_inflated_columns {
438   my $self = shift;
439   return map {
440     my $accessor = $self->column_info($_)->{'accessor'} || $_;
441     ($_ => $self->$accessor);
442   } $self->columns;
443 }
444
445 =head2 set_column
446
447   $obj->set_column($col => $val);
448
449 Sets a column value. If the new value is different from the old one,
450 the column is marked as dirty for when you next call $obj->update.
451
452 =cut
453
454 sub set_column {
455   my $self = shift;
456   my ($column) = @_;
457   $self->{_orig_ident} ||= $self->ident_condition;
458   my $old = $self->get_column($column);
459   my $ret = $self->store_column(@_);
460   $self->{_dirty_columns}{$column} = 1
461     if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
462   return $ret;
463 }
464
465 =head2 set_columns
466
467   my $copy = $orig->set_columns({ $col => $val, ... });
468
469 Sets more than one column value at once.
470
471 =cut
472
473 sub set_columns {
474   my ($self,$data) = @_;
475   foreach my $col (keys %$data) {
476     $self->set_column($col,$data->{$col});
477   }
478   return $self;
479 }
480
481 =head2 set_inflated_columns
482
483   my $copy = $orig->set_inflated_columns({ $col => $val, $rel => $obj, ... });
484
485 Sets more than one column value at once, taking care to respect inflations and
486 relationships if relevant. Be aware that this hashref might be edited in place,
487 so dont rely on it being the same after a call to C<set_inflated_columns>. If
488 you need to preserve the hashref, it is sufficient to pass a shallow copy to
489 C<set_inflated_columns>, e.g. ( { %{ $href } } )
490
491 =cut
492
493 sub set_inflated_columns {
494   my ( $self, $upd ) = @_;
495   foreach my $key (keys %$upd) {
496     if (ref $upd->{$key}) {
497       my $info = $self->relationship_info($key);
498       if ($info && $info->{attrs}{accessor}
499         && $info->{attrs}{accessor} eq 'single')
500       {
501         my $rel = delete $upd->{$key};
502         $self->set_from_related($key => $rel);
503         $self->{_relationship_data}{$key} = $rel;          
504       } elsif ($info && $info->{attrs}{accessor}
505         && $info->{attrs}{accessor} eq 'multi'
506         && ref $upd->{$key} eq 'ARRAY') {
507         my $others = delete $upd->{$key};
508         foreach my $rel_obj (@$others) {
509           if(!Scalar::Util::blessed($rel_obj)) {
510             $rel_obj = $self->create_related($key, $rel_obj);
511           }
512         }
513         $self->{_relationship_data}{$key} = $others; 
514 #            $related->{$key} = $others;
515         next;
516       }
517       elsif ($self->has_column($key)
518         && exists $self->column_info($key)->{_inflate_info})
519       {
520         $self->set_inflated_column($key, delete $upd->{$key});          
521       }
522     }
523   }
524   $self->set_columns($upd);    
525 }
526
527 =head2 copy
528
529   my $copy = $orig->copy({ change => $to, ... });
530
531 Inserts a new row with the specified changes.
532
533 =cut
534
535 sub copy {
536   my ($self, $changes) = @_;
537   $changes ||= {};
538   my $col_data = { %{$self->{_column_data}} };
539   foreach my $col (keys %$col_data) {
540     delete $col_data->{$col}
541       if $self->result_source->column_info($col)->{is_auto_increment};
542   }
543
544   my $new = { _column_data => $col_data };
545   bless $new, ref $self;
546
547   $new->result_source($self->result_source);
548   $new->set_inflated_columns($changes);
549   $new->insert;
550
551   # Its possible we'll have 2 relations to the same Source. We need to make 
552   # sure we don't try to insert the same row twice esle we'll violate unique
553   # constraints
554   my $rels_copied = {};
555
556   foreach my $rel ($self->result_source->relationships) {
557     my $rel_info = $self->result_source->relationship_info($rel);
558
559     next unless $rel_info->{attrs}{cascade_copy};
560   
561     my $resolved = $self->result_source->resolve_condition(
562       $rel_info->{cond}, $rel, $new
563     );
564
565     my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
566     foreach my $related ($self->search_related($rel)) {
567       my $id_str = join("\0", $related->id);
568       next if $copied->{$id_str};
569       $copied->{$id_str} = 1;
570       my $rel_copy = $related->copy($resolved);
571     }
572  
573   }
574   return $new;
575 }
576
577 =head2 store_column
578
579   $obj->store_column($col => $val);
580
581 Sets a column value without marking it as dirty.
582
583 =cut
584
585 sub store_column {
586   my ($self, $column, $value) = @_;
587   $self->throw_exception( "No such column '${column}'" )
588     unless exists $self->{_column_data}{$column} || $self->has_column($column);
589   $self->throw_exception( "set_column called for ${column} without value" )
590     if @_ < 3;
591   return $self->{_column_data}{$column} = $value;
592 }
593
594 =head2 inflate_result
595
596   Class->inflate_result($result_source, \%me, \%prefetch?)
597
598 Called by ResultSet to inflate a result from storage
599
600 =cut
601
602 sub inflate_result {
603   my ($class, $source, $me, $prefetch) = @_;
604
605   my ($source_handle) = $source;
606
607   if ($source->isa('DBIx::Class::ResultSourceHandle')) {
608       $source = $source_handle->resolve
609   } else {
610       $source_handle = $source->handle
611   }
612
613   my $new = {
614     _source_handle => $source_handle,
615     _column_data => $me,
616     _in_storage => 1
617   };
618   bless $new, (ref $class || $class);
619
620   my $schema;
621   foreach my $pre (keys %{$prefetch||{}}) {
622     my $pre_val = $prefetch->{$pre};
623     my $pre_source = $source->related_source($pre);
624     $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
625       unless $pre_source;
626     if (ref($pre_val->[0]) eq 'ARRAY') { # multi
627       my @pre_objects;
628       foreach my $pre_rec (@$pre_val) {
629         unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
630            and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
631           next;
632         }
633         push(@pre_objects, $pre_source->result_class->inflate_result(
634                              $pre_source, @{$pre_rec}));
635       }
636       $new->related_resultset($pre)->set_cache(\@pre_objects);
637     } elsif (defined $pre_val->[0]) {
638       my $fetched;
639       unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
640          and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
641       {
642         $fetched = $pre_source->result_class->inflate_result(
643                       $pre_source, @{$pre_val});
644       }
645       $new->related_resultset($pre)->set_cache([ $fetched ]);
646       my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
647       $class->throw_exception("No accessor for prefetched $pre")
648        unless defined $accessor;
649       if ($accessor eq 'single') {
650         $new->{_relationship_data}{$pre} = $fetched;
651       } elsif ($accessor eq 'filter') {
652         $new->{_inflated_column}{$pre} = $fetched;
653       } else {
654        $class->throw_exception("Prefetch not supported with accessor '$accessor'");
655       }
656     }
657   }
658   return $new;
659 }
660
661 =head2 update_or_insert
662
663   $obj->update_or_insert
664
665 Updates the object if it's already in the db, else inserts it.
666
667 =head2 insert_or_update
668
669   $obj->insert_or_update
670
671 Alias for L</update_or_insert>
672
673 =cut
674
675 *insert_or_update = \&update_or_insert;
676 sub update_or_insert {
677   my $self = shift;
678   return ($self->in_storage ? $self->update : $self->insert);
679 }
680
681 =head2 is_changed
682
683   my @changed_col_names = $obj->is_changed();
684   if ($obj->is_changed()) { ... }
685
686 In array context returns a list of columns with uncommited changes, or
687 in scalar context returns a true value if there are uncommitted
688 changes.
689
690 =cut
691
692 sub is_changed {
693   return keys %{shift->{_dirty_columns} || {}};
694 }
695
696 =head2 is_column_changed
697
698   if ($obj->is_column_changed('col')) { ... }
699
700 Returns a true value if the column has uncommitted changes.
701
702 =cut
703
704 sub is_column_changed {
705   my( $self, $col ) = @_;
706   return exists $self->{_dirty_columns}->{$col};
707 }
708
709 =head2 result_source
710
711   my $resultsource = $object->result_source;
712
713 Accessor to the ResultSource this object was created from
714
715 =cut
716
717 sub result_source {
718     my $self = shift;
719
720     if (@_) {
721         $self->_source_handle($_[0]->handle);
722     } else {
723         $self->_source_handle->resolve;
724     }
725 }
726
727 =head2 register_column
728
729   $column_info = { .... };
730   $class->register_column($column_name, $column_info);
731
732 Registers a column on the class. If the column_info has an 'accessor'
733 key, creates an accessor named after the value if defined; if there is
734 no such key, creates an accessor with the same name as the column
735
736 The column_info attributes are described in
737 L<DBIx::Class::ResultSource/add_columns>
738
739 =cut
740
741 sub register_column {
742   my ($class, $col, $info) = @_;
743   my $acc = $col;
744   if (exists $info->{accessor}) {
745     return unless defined $info->{accessor};
746     $acc = [ $info->{accessor}, $col ];
747   }
748   $class->mk_group_accessors('column' => $acc);
749 }
750
751
752 =head2 throw_exception
753
754 See Schema's throw_exception.
755
756 =cut
757
758 sub throw_exception {
759   my $self=shift;
760   if (ref $self && ref $self->result_source && $self->result_source->schema) {
761     $self->result_source->schema->throw_exception(@_);
762   } else {
763     croak(@_);
764   }
765 }
766
767 =head2 id
768
769 Returns the primary key(s) for a row. Can't be called as a class method.
770 Actually implemented in L<DBIx::Class::Pk>
771
772 =head2 discard_changes
773
774 Re-selects the row from the database, losing any changes that had
775 been made.
776
777 This method can also be used to refresh from storage, retrieving any
778 changes made since the row was last read from storage. Actually
779 implemented in L<DBIx::Class::Pk>
780
781 =cut
782
783 1;
784
785 =head1 AUTHORS
786
787 Matt S. Trout <mst@shadowcatsystems.co.uk>
788
789 =head1 LICENSE
790
791 You may distribute this code under the same terms as Perl itself.
792
793 =cut