use warnings;
use base qw/DBIx::Class/;
-use Carp::Clan qw/^DBIx::Class/;
+
+use DBIx::Class::Exception;
use Scalar::Util ();
-use Scope::Guard;
###
### Internal method
$new->result_source($source);
}
- if (my $related = delete $attrs->{-from_resultset}) {
+ if (my $related = delete $attrs->{-cols_from_relations}) {
@{$new->{_ignore_at_insert}={}}{@$related} = ();
}
foreach my $key (keys %$attrs) {
if (ref $attrs->{$key}) {
## Can we extract this lot to use with update(_or .. ) ?
- confess "Can't do multi-create without result source" unless $source;
+ $new->throw_exception("Can't do multi-create without result source")
+ unless $source;
my $info = $source->relationship_info($key);
- if ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'single')
- {
+ my $acc_type = $info->{attrs}{accessor} || '';
+ if ($acc_type eq 'single') {
my $rel_obj = delete $attrs->{$key};
if(!Scalar::Util::blessed($rel_obj)) {
$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
$related->{$key} = $rel_obj;
next;
- } elsif ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'multi'
- && ref $attrs->{$key} eq 'ARRAY') {
+ }
+ elsif ($acc_type eq 'multi' && ref $attrs->{$key} eq 'ARRAY' ) {
my $others = delete $attrs->{$key};
my $total = @$others;
my @objects;
}
$related->{$key} = \@objects;
next;
- } elsif ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'filter')
- {
+ }
+ elsif ($acc_type eq 'filter') {
## 'filter' should disappear and get merged in with 'single' above!
my $rel_obj = delete $attrs->{$key};
if(!Scalar::Util::blessed($rel_obj)) {
sub in_storage {
my ($self, $val) = @_;
$self->{_in_storage} = $val if @_ > 1;
- return $self->{_in_storage};
+ return $self->{_in_storage} ? 1 : 0;
}
=head2 update
this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
hashref of the relationship, see L<DBIx::Class::Relationship>. Any
database-level cascade or restrict will take precedence over a
-DBIx-Class-based cascading delete.
+DBIx-Class-based cascading delete, since DBIx-Class B<deletes the
+main row first> and only then attempts to delete any remaining related
+rows.
If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
and the transaction subsequently fails, the row object will remain marked as
sub get_inflated_columns {
my $self = shift;
- return map {
- my $accessor = $self->column_info($_)->{'accessor'} || $_;
- ($_ => $self->$accessor);
- } grep $self->has_column_loaded($_), $self->columns;
+
+ my %loaded_colinfo = (map
+ { $_ => $self->column_info($_) }
+ (grep { $self->has_column_loaded($_) } $self->columns)
+ );
+
+ my %inflated;
+ for my $col (keys %loaded_colinfo) {
+ my $acc = $loaded_colinfo{$col}{accessor};
+ if (defined $acc) {
+ $inflated{$col} = $self->$acc;
+ }
+ else {
+ $inflated{$col} = $self->$col;
+ }
+ }
+
+ # return all loaded columns with the inflations overlayed on top
+ return ($self->get_columns, %inflated);
+}
+
+sub _is_column_numeric {
+ my ($self, $column) = @_;
+ my $colinfo = $self->column_info ($column);
+
+ # cache for speed (the object may *not* have a resultsource instance)
+ if (not defined $colinfo->{is_numeric} && $self->_source_handle) {
+ $colinfo->{is_numeric} =
+ $self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type})
+ ? 1
+ : 0
+ ;
+ }
+
+ return $colinfo->{is_numeric};
}
=head2 set_column
$self->{_orig_ident} ||= $self->ident_condition;
my $old_value = $self->get_column($column);
- $self->store_column($column, $new_value);
+ $new_value = $self->store_column($column, $new_value);
my $dirty;
if (!$self->in_storage) { # no point tracking dirtyness on uninserted data
$dirty = 0;
}
else { # do a numeric comparison if datatype allows it
- my $colinfo = $self->column_info ($column);
-
- # cache for speed (the object may *not* have a resultsource instance)
- if (not defined $colinfo->{is_numeric} && $self->_source_handle) {
- $colinfo->{is_numeric} =
- $self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type})
- ? 1
- : 0
- ;
- }
-
- if ($colinfo->{is_numeric}) {
+ if ($self->_is_column_numeric($column)) {
$dirty = $old_value != $new_value;
}
else {
foreach my $key (keys %$upd) {
if (ref $upd->{$key}) {
my $info = $self->relationship_info($key);
- if ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'single')
- {
+ my $acc_type = $info->{attrs}{accessor} || '';
+ if ($acc_type eq 'single') {
my $rel = delete $upd->{$key};
$self->set_from_related($key => $rel);
$self->{_relationship_data}{$key} = $rel;
- } elsif ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'multi') {
- $self->throw_exception(
- "Recursive update is not supported over relationships of type multi ($key)"
- );
}
- elsif ($self->has_column($key)
- && exists $self->column_info($key)->{_inflate_info})
- {
+ elsif ($acc_type eq 'multi') {
+ $self->throw_exception(
+ "Recursive update is not supported over relationships of type '$acc_type' ($key)"
+ );
+ }
+ elsif ($self->has_column($key) && exists $self->column_info($key)->{_inflate_info}) {
$self->set_inflated_column($key, delete $upd->{$key});
}
}
$fetched = $pre_source->result_class->inflate_result(
$pre_source, @{$pre_val});
}
- my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
- $class->throw_exception("No accessor for prefetched $pre")
- unless defined $accessor;
- if ($accessor eq 'single') {
+ my $acc_type = $source->relationship_info($pre)->{attrs}{accessor}
+ or $class->throw_exception("No accessor type for prefetched $pre");
+
+ if ($acc_type eq 'single') {
$new->{_relationship_data}{$pre} = $fetched;
- } elsif ($accessor eq 'filter') {
+ }
+ elsif ($acc_type eq 'filter') {
$new->{_inflated_column}{$pre} = $fetched;
- } else {
- $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor '$accessor'");
+ }
+ else {
+ $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor type '$acc_type'");
}
$new->related_resultset($pre)->set_cache([ $fetched ]);
}
sub throw_exception {
my $self=shift;
+
if (ref $self && ref $self->result_source && $self->result_source->schema) {
- $self->result_source->schema->throw_exception(@_);
- } else {
- croak(@_);
+ $self->result_source->schema->throw_exception(@_)
+ }
+ else {
+ DBIx::Class::Exception->throw(@_);
}
}
projects / dbsrgits/DBIx-Class.git / blobdiff