use strict;
use warnings;
-use base qw/DBIx::Class/;
+
+use base 'DBIx::Class';
+use mro 'c3';
+
use DBIx::Class::Carp;
use DBIx::Class::ResultSetColumn;
use DBIx::Class::ResultClass::HashRefInflator;
-use Scalar::Util qw/blessed weaken reftype/;
+use Scalar::Util qw( blessed reftype );
use DBIx::Class::_Util qw(
dbic_internal_try dump_value
fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION
);
use Try::Tiny;
-# not importing first() as it will clash with our own method
-use List::Util ();
-
BEGIN {
# De-duplication in _merge_attr() is disabled, but left in for reference
# (the merger is used for other things that ought not to be de-duped)
# see if we can keep the cache (no $rs changes)
my $cache;
my %safe = (alias => 1, cache => 1);
- if ( ! List::Util::first { !$safe{$_} } keys %$call_attrs and (
+ if ( ! grep { !$safe{$_} } keys %$call_attrs and (
! defined $call_cond
or
ref $call_cond eq 'HASH' && ! keys %$call_cond
my @selector_attrs = qw/select as columns cols +select +as +columns include_columns/;
# reset the current selector list if new selectors are supplied
- if (List::Util::first { exists $call_attrs->{$_} } qw/columns cols select as/) {
- delete @{$old_attrs}{(@selector_attrs, '_dark_selector')};
- }
+ delete @{$old_attrs}{(@selector_attrs, '_dark_selector')}
+ if grep { exists $call_attrs->{$_} } qw(columns cols select as);
# Normalize the new selector list (operates on the passed-in attr structure)
# Need to do it on every chain instead of only once on _resolved_attrs, in
if (defined $constraint_name) {
$final_cond = $self->_qualify_cond_columns (
- $self->result_source->_minimal_valueset_satisfying_constraint(
+ $rsrc->_minimal_valueset_satisfying_constraint(
constraint_name => $constraint_name,
values => ($self->_merge_with_rscond($call_cond))[0],
carp_on_nulls => 1,
dbic_internal_try {
push @unique_queries, $self->_qualify_cond_columns(
- $self->result_source->_minimal_valueset_satisfying_constraint(
+ $rsrc->_minimal_valueset_satisfying_constraint(
constraint_name => $c_name,
values => ($self->_merge_with_rscond($call_cond))[0],
- columns_info => ($ci ||= $self->result_source->columns_info),
+ columns_info => ($ci ||= $rsrc->columns_info),
),
$alias
);
=cut
sub search_related {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
return shift->related_resultset(shift)->search(@_);
}
=cut
sub search_related_rs {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
return shift->related_resultset(shift)->search_rs(@_);
}
return $self->{cursor} ||= do {
my $attrs = $self->_resolved_attrs;
- $self->result_source->storage->select(
+ $self->result_source->schema->storage->select(
$attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
);
};
}
}
- my $data = [ $self->result_source->storage->select_single(
+ my $data = [ $self->result_source->schema->storage->select_single(
$attrs->{from}, $attrs->{select},
$attrs->{where}, $attrs
)];
=cut
sub get_column {
- my ($self, $column) = @_;
- my $new = DBIx::Class::ResultSetColumn->new($self, $column);
- return $new;
+ DBIx::Class::ResultSetColumn->new(@_);
}
=head2 search_like
: '@$rows = map { $inflator_cref->($res_class, $rsrc, { %s } ) } @$rows'
),
( join (', ', map { "\$infmap->[$_] => \$_->[$_]" } 0..$#$infmap ) )
- );
+ ) . '; 1' or die;
}
}
else {
: 'classic_nonpruning'
;
- # $args and $attrs to _mk_row_parser are separated to delineate what is
- # core collapser stuff and what is dbic $rs specific
- $self->{_row_parser}{$parser_type}{cref} = $rsrc->_mk_row_parser({
- eval => 1,
- inflate_map => $infmap,
- collapse => $attrs->{collapse},
- premultiplied => $attrs->{_main_source_premultiplied},
- hri_style => $self->{_result_inflator}{is_hri},
- prune_null_branches => $self->{_result_inflator}{is_hri} || $self->{_result_inflator}{is_core_row},
- }, $attrs) unless $self->{_row_parser}{$parser_type}{cref};
+ unless( $self->{_row_parser}{$parser_type}{cref} ) {
+
+ # $args and $attrs to _mk_row_parser are separated to delineate what is
+ # core collapser stuff and what is dbic $rs specific
+ $self->{_row_parser}{$parser_type}{src} = $rsrc->_mk_row_parser({
+ inflate_map => $infmap,
+ collapse => $attrs->{collapse},
+ premultiplied => $attrs->{_main_source_premultiplied},
+ hri_style => $self->{_result_inflator}{is_hri},
+ prune_null_branches => $self->{_result_inflator}{is_hri} || $self->{_result_inflator}{is_core_row},
+ }, $attrs);
+
+ $self->{_row_parser}{$parser_type}{cref} = do {
+ package # hide form PAUSE
+ DBIx::Class::__GENERATED_ROW_PARSER__;
+ eval $self->{_row_parser}{$parser_type}{src};
+ } || die $@;
+ }
+
+ # this needs to close over the *current* cursor, hence why it is not cached above
my $next_cref = ($did_fetch_all or ! $attrs->{collapse})
? undef
: sub {
# overwrite the selector (supplied by the storage)
$rsrc->resultset_class->new($rsrc, {
%$tmp_attrs,
- select => $rsrc->storage->_count_select ($rsrc, $attrs),
+ select => $rsrc->schema->storage->_count_select ($rsrc, $attrs),
as => 'count',
})->get_column ('count');
}
# Calculate subquery selector
if (my $g = $sub_attrs->{group_by}) {
- my $sql_maker = $rsrc->storage->sql_maker;
+ my $sql_maker = $rsrc->schema->storage->sql_maker;
# necessary as the group_by may refer to aliased functions
my $sel_index;
return $rsrc->resultset_class
->new ($rsrc, $sub_attrs)
->as_subselect_rs
- ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } })
+ ->search ({}, { columns => { count => $rsrc->schema->storage->_count_select ($rsrc, $attrs) } })
->get_column ('count');
}
=cut
-sub count_literal { shift->search_literal(@_)->count; }
+sub count_literal {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+ shift->search_literal(@_)->count
+}
=head2 all
=cut
sub first {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
return $_[0]->reset->next;
}
$storage->_prune_unused_joins ($attrs);
# any non-pruneable non-local restricting joins imply subq
- $needs_subq = defined List::Util::first { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} };
+ $needs_subq = grep { $_ ne $attrs->{alias} } keys %{ $join_classifications->{restricting} || {} };
}
# check if the head is composite (by now all joins are thrown out unless $needs_subq)
# a condition containing 'me' or other table prefixes will not work
# at all. Tell SQLMaker to dequalify idents via a gross hack.
$cond = do {
- my $sqla = $rsrc->storage->sql_maker;
+ my $sqla = $rsrc->schema->storage->sql_maker;
local $sqla->{_dequalify_idents} = 1;
\[ $sqla->_recurse_where($self->{cond}) ];
};
# FIXME - no cref handling
# At this point assume either hashes or arrays
+ my $rsrc = $self->result_source;
+
if(defined wantarray) {
my (@results, $guard);
# column names only, nothing to do
return if @$data == 1;
- $guard = $self->result_source->schema->storage->txn_scope_guard
+ $guard = $rsrc->schema->storage->txn_scope_guard
if @$data > 2;
@results = map
}
else {
- $guard = $self->result_source->schema->storage->txn_scope_guard
+ $guard = $rsrc->schema->storage->txn_scope_guard
if @$data > 1;
@results = map { $self->new_result($_)->insert } @$data;
# this means we have to walk the data structure twice
# whether we want this or not
# jnap, I hate you ;)
- my $rsrc = $self->result_source;
my $rel_info = { map { $_ => $rsrc->relationship_info($_) } $rsrc->relationships };
my ($colinfo, $colnames, $slices_with_rels);
### main source data
# FIXME - need to switch entirely to a coderef-based thing,
# so that large sets aren't copied several times... I think
- $rsrc->storage->_insert_bulk(
+ $rsrc->schema->storage->_insert_bulk(
$rsrc,
[ @$colnames, sort keys %$rs_data ],
[ map {
sub new_result {
my ($self, $values) = @_;
- $self->throw_exception( "new_result takes only one argument - a hashref of values" )
- if @_ > 2;
-
- $self->throw_exception( "Result object instantiation requires a hashref as argument" )
- unless (ref $values eq 'HASH');
+ $self->throw_exception( "Result object instantiation requires a single hashref argument" )
+ if @_ > 2 or ref $values ne 'HASH';
my ($merged_cond, $cols_from_relations) = $self->_merge_with_rscond($values);
my $attrs = { %{ $self->_resolved_attrs } };
- my $aq = $self->result_source->storage->_select_args_to_query (
+ my $aq = $self->result_source->schema->storage->_select_args_to_query (
$attrs->{from}, $attrs->{select}, $attrs->{where}, $attrs
);
sub is_ordered {
my ($self) = @_;
- return scalar $self->result_source->storage->_extract_order_criteria($self->{attrs}{order_by});
+ return scalar $self->result_source->schema->storage->_extract_order_criteria($self->{attrs}{order_by});
}
=head2 related_resultset
# default selection list
$attrs->{columns} = [ $source->columns ]
- unless List::Util::first { exists $attrs->{$_} } qw/columns cols select as/;
+ unless grep { exists $attrs->{$_} } qw/columns cols select as/;
# merge selectors together
for (qw/columns select as/) {
if (
! $attrs->{_main_source_premultiplied}
and
- ! List::Util::first { ! $_->[0]{-is_single} } @fromlist
+ ! grep { ! $_->[0]{-is_single} } @fromlist
) {
$attrs->{collapse} = 0;
}
else {
$attrs->{_grouped_by_distinct} = 1;
# distinct affects only the main selection part, not what prefetch may add below
- ($attrs->{group_by}, my $new_order) = $source->storage->_group_over_selection($attrs);
+ ($attrs->{group_by}, my $new_order) = $source->schema->storage->_group_over_selection($attrs);
# FIXME possibly ignore a rewritten order_by (may turn out to be an issue)
# The thinking is: if we are collapsing the subquerying prefetch engine will
},
ARRAY => sub {
return $_[1] if !defined $_[0];
- return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
+ return $_[1] if __HM_DEDUP and grep { $_ eq $_[0] } @{$_[1]};
return [$_[0], @{$_[1]}]
},
HASH => sub {
ARRAY => {
SCALAR => sub {
return $_[0] if !defined $_[1];
- return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
+ return $_[0] if __HM_DEDUP and grep { $_ eq $_[1] } @{$_[0]};
return [@{$_[0]}, $_[1]]
},
ARRAY => sub {
HASH => sub {
return [ $_[1] ] if ! @{$_[0]};
return $_[0] if !keys %{$_[1]};
- return $_[0] if __HM_DEDUP and List::Util::first { $_ eq $_[1] } @{$_[0]};
+ return $_[0] if __HM_DEDUP and grep { $_ eq $_[1] } @{$_[0]};
return [ @{$_[0]}, $_[1] ];
},
},
return [] if !keys %{$_[0]} and !@{$_[1]};
return [ $_[0] ] if !@{$_[1]};
return $_[1] if !keys %{$_[0]};
- return $_[1] if __HM_DEDUP and List::Util::first { $_ eq $_[0] } @{$_[1]};
+ return $_[1] if __HM_DEDUP and grep { $_ eq $_[0] } @{$_[1]};
return [ $_[0], @{$_[1]} ];
},
HASH => sub {