use Carp::Clan qw/^DBIx::Class/;
use DBIx::Class::Exception;
use Data::Page;
-use Storable;
use DBIx::Class::ResultSetColumn;
use DBIx::Class::ResultSourceHandle;
use Hash::Merge ();
'bool' => "_bool",
fallback => 1;
-__PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/);
+__PACKAGE__->mk_group_accessors('simple' => qw/_result_class result_source/);
=head1 NAME
return $class->new_result(@_) if ref $class;
my ($source, $attrs) = @_;
- $source = $source->handle
- unless $source->isa('DBIx::Class::ResultSourceHandle');
+ $source = $source->resolve
+ if $source->isa('DBIx::Class::ResultSourceHandle');
$attrs = { %{$attrs||{}} };
if ($attrs->{page}) {
# Creation of {} and bless separated to mitigate RH perl bug
# see https://bugzilla.redhat.com/show_bug.cgi?id=196836
my $self = {
- _source_handle => $source,
+ result_source => $source,
cond => $attrs->{where},
pager => undef,
- attrs => $attrs
+ attrs => $attrs,
};
bless $self, $class;
$self->result_class(
- $attrs->{result_class} || $source->resolve->result_class
+ $attrs->{result_class} || $source->result_class
);
return $self;
# if balanced - treat as a columns entry
$attrs->{"${pref}columns"} = $self->_merge_attr(
$attrs->{"${pref}columns"},
- { map { $as->[$_] => $sel->[$_] } ( 0 .. $#$as ) }
+ [ map { +{ $as->[$_] => $sel->[$_] } } ( 0 .. $#$as ) ]
);
}
else {
push(@created, $self->create($item));
}
return wantarray ? @created : \@created;
- } else {
+ }
+ else {
my $first = $data->[0];
# if a column is a registered relationship, and is a non-blessed hash/array, consider
# it relationship data
my (@rels, @columns);
+ my $rsrc = $self->result_source;
+ my $rels = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships };
for (keys %$first) {
my $ref = ref $first->{$_};
- $self->result_source->has_relationship($_) && ($ref eq 'ARRAY' or $ref eq 'HASH')
+ $rels->{$_} && ($ref eq 'ARRAY' or $ref eq 'HASH')
? push @rels, $_
: push @columns, $_
;
}
- my @pks = $self->result_source->primary_columns;
+ my @pks = $rsrc->primary_columns;
## do the belongs_to relationships
foreach my $index (0..$#$data) {
foreach my $rel (@rels) {
next unless ref $data->[$index]->{$rel} eq "HASH";
my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
- my ($reverse) = keys %{$self->result_source->reverse_relationship_info($rel)};
+ my ($reverse_relname, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)};
my $related = $result->result_source->_resolve_condition(
- $result->result_source->relationship_info($reverse)->{cond},
+ $reverse_relinfo->{cond},
$self,
$result,
);
my @inherit_data = values %$rs_data;
## do bulk insert on current row
- $self->result_source->storage->insert_bulk(
- $self->result_source,
+ $rsrc->storage->insert_bulk(
+ $rsrc,
[@columns, @inherit_cols],
[ map { [ @$_{@columns}, @inherit_data ] } @$data ],
);
## do the has_many relationships
foreach my $item (@$data) {
+ my $main_row;
+
foreach my $rel (@rels) {
next unless ref $item->{$rel} eq "ARRAY" && @{ $item->{$rel} };
- my $parent = $self->find({map { $_ => $item->{$_} } @pks})
- || $self->throw_exception('Cannot find the relating object.');
+ $main_row ||= $self->new_result({map { $_ => $item->{$_} } @pks});
- my $child = $parent->$rel;
+ my $child = $main_row->$rel;
my $related = $child->result_source->_resolve_condition(
- $parent->result_source->relationship_info($rel)->{cond},
+ $rels->{$rel}{cond},
$child,
- $parent,
+ $main_row,
);
my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
@$cols_from_relations
? (-cols_from_relations => $cols_from_relations)
: (),
- -source_handle => $self->_source_handle,
-result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
);
# disassemble columns
my (@sel, @as);
- for my $c (@{
- ref $attrs->{columns} eq 'ARRAY' ? $attrs->{columns} : [ $attrs->{columns} || () ]
- }) {
- if (ref $c eq 'HASH') {
- for my $as (keys %$c) {
- push @sel, $c->{$as};
- push @as, $as;
+ if (my $cols = delete $attrs->{columns}) {
+ for my $c (ref $cols eq 'ARRAY' ? @$cols : $cols) {
+ if (ref $c eq 'HASH') {
+ for my $as (keys %$c) {
+ push @sel, $c->{$as};
+ push @as, $as;
+ }
+ }
+ else {
+ push @sel, $c;
+ push @as, $c;
}
- }
- else {
- push @sel, $c;
- push @as, $c;
}
}
}
}
-sub result_source {
- my $self = shift;
-
- if (@_) {
- $self->_source_handle($_[0]->handle);
- } else {
- $self->_source_handle->resolve;
- }
-}
-
-
sub STORABLE_freeze {
my ($self, $cloning) = @_;
my $to_serialize = { %$self };
sub throw_exception {
my $self=shift;
- if (ref $self && $self->_source_handle->schema) {
- $self->_source_handle->schema->throw_exception(@_)
+ if (ref $self and my $rsrc = $self->result_source) {
+ $rsrc->throw_exception(@_)
}
else {
DBIx::Class::Exception->throw(@_);