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