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