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