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