Skip to content

Commit

Permalink
Merge the last bits of indirect callchain optimization
Browse files Browse the repository at this point in the history 
This set of commits (again - merge for easier bisect) is exclusively dealing
with various wantarray()-aware methods, most notably ::ResultSet::search()

Wide smoke of downstream adds only 3 extra dists to the list of "passes tests
but warns about indirect-sugar overrides" as shown in 12e7015. In the cases
below all overrides are that of search() - a rather legitimate problem to be
warning about

  Catalyst::Controller::DBIC::API
  DBIx::Class::Helpers
  DBIx::Class::ResultSet::AccessorsEverywhere

No other known breakage as of this commit
  • Loading branch information
@ribasushi
ribasushi committed Sep 30, 2016
2 parents 9ab0364 + 367eaf5 commit dc7d899
Show file tree
Hide file tree
Showing 15 changed files with 314 additions and 223 deletions.
2 changes: 2 additions & 0 deletions Changes
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,8 @@ Revision history for DBIx::Class
an underlying search_rs(), as by design these arguments would be
used only on the first call to ->related_resultset(), and ignored
afterwards. Instead an exception (detailing the fix) is thrown.
- Change func_rs() and as_subselect_rs() to properly ignore list
context (i.e. wantarray). Both were implemented broken from day 1 :/
- Increased checking for the correctness of the is_nullable attribute
within the prefetch result parser may highlight previously unknown
mismatches between your codebase and data source
Expand Down
9 changes: 6 additions & 3 deletions lib/DBIx/Class/Admin.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -480,7 +480,8 @@ sub update {
$where ||= $self->where();
$set ||= $self->set();
my $resultset = $self->schema->resultset($rs);
$resultset = $resultset->search( ($where||{}) );
$resultset = $resultset->search_rs( $where )
if $where;

my $count = $resultset->count();
print "This action will modify $count ".ref($resultset)." records.\n" if (!$self->quiet);
Expand Down Expand Up @@ -511,7 +512,8 @@ sub delete {
$where ||= $self->where();
$attrs ||= $self->attrs();
my $resultset = $self->schema->resultset($rs);
$resultset = $resultset->search( ($where||{}), ($attrs||()) );
$resultset = $resultset->search_rs( ($where||{}), ($attrs||()) )
if $where or $attrs;

my $count = $resultset->count();
print "This action will delete $count ".ref($resultset)." records.\n" if (!$self->quiet);
Expand Down Expand Up @@ -542,7 +544,8 @@ sub select {
$where ||= $self->where();
$attrs ||= $self->attrs();
my $resultset = $self->schema->resultset($rs);
$resultset = $resultset->search( ($where||{}), ($attrs||()) );
$resultset = $resultset->search_rs( ($where||{}), ($attrs||()) )
if $where or $attrs;

my @data;
my @columns = $resultset->result_source->columns();
Expand Down
5 changes: 2 additions & 3 deletions lib/DBIx/Class/CDBICompat/LazyLoading.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,9 +8,8 @@ use base 'DBIx::Class';

sub resultset_instance {
my $self = shift;
my $rs = $self->next::method(@_);
$rs = $rs->search(undef, { columns => [ $self->columns('Essential') ] });
return $rs;
$self->next::method(@_)
->search_rs(undef, { columns => [ $self->columns('Essential') ] });
}


Expand Down
147 changes: 110 additions & 37 deletions lib/DBIx/Class/Ordered.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,9 @@ use strict;
use warnings;
use base qw( DBIx::Class );

use DBIx::Class::_Util qw( bag_eq fail_on_internal_call );
use namespace::clean;

=head1 NAME
DBIx::Class::Ordered - Modify the position of objects in an ordered list.
Expand Down Expand Up @@ -143,13 +146,28 @@ __PACKAGE__->mk_classaccessor( 'null_position_value' => 0 );
Returns an B<ordered> resultset of all other objects in the same
group excluding the one you called it on.
Underneath calls L<DBIx::Class::ResultSet/search>, and therefore returns
objects by implicitly invoking L<C<< ->all() >>|DBIx::Class::ResultSet/all>
in list context.
The ordering is a backwards-compatibility artifact - if you need
a resultset with no ordering applied use C<_siblings>
=cut

sub siblings {
my $self = shift;
return $self->_siblings->search ({}, { order_by => $self->position_column } );
#my $self = shift;

DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
and
wantarray
and
! eval { fail_on_internal_call; 1 }
and
die "ILLEGAL LIST CONTEXT INVOCATION: $@";

# *MUST* be context sensitive due to legacy (DO NOT call search_rs)
$_[0]->_siblings->search ({}, { order_by => $_[0]->position_column } );
}

=head2 previous_siblings
Expand All @@ -160,15 +178,29 @@ sub siblings {
Returns a resultset of all objects in the same group
positioned before the object on which this method was called.
Underneath calls L<DBIx::Class::ResultSet/search>, and therefore returns
objects by implicitly invoking L<C<< ->all() >>|DBIx::Class::ResultSet/all>
in list context.
=cut
sub previous_siblings {
my $self = shift;
my $position_column = $self->position_column;
my $position = $self->get_column ($position_column);
return ( defined $position

DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
and
wantarray
and
! eval { fail_on_internal_call; 1 }
and
die "ILLEGAL LIST CONTEXT INVOCATION: $@";

# *MUST* be context sensitive due to legacy (DO NOT call search_rs)
defined( $position )
? $self->_siblings->search ({ $position_column => { '<', $position } })
: $self->_siblings
);
;
}

=head2 next_siblings
Expand All @@ -179,15 +211,29 @@ sub previous_siblings {
Returns a resultset of all objects in the same group
positioned after the object on which this method was called.
Underneath calls L<DBIx::Class::ResultSet/search>, and therefore returns
objects by implicitly invoking L<C<< ->all() >>|DBIx::Class::ResultSet/all>
in list context.
=cut
sub next_siblings {
my $self = shift;
my $position_column = $self->position_column;
my $position = $self->get_column ($position_column);
return ( defined $position

DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
and
wantarray
and
! eval { fail_on_internal_call; 1 }
and
die "ILLEGAL LIST CONTEXT INVOCATION: $@";

# *MUST* be context sensitive due to legacy (DO NOT call search_rs)
defined( $position )
? $self->_siblings->search ({ $position_column => { '>', $position } })
: $self->_siblings
);
;
}

=head2 previous_sibling
Expand All @@ -203,12 +249,12 @@ sub previous_sibling {
my $self = shift;
my $position_column = $self->position_column;

my $psib = $self->previous_siblings->search(
my $psib = $self->previous_siblings->search_rs(
{},
{ rows => 1, order_by => { '-desc' => $position_column } },
)->single;

return defined $psib ? $psib : 0;
return defined( $psib ) ? $psib : 0;
}

=head2 first_sibling
Expand All @@ -224,12 +270,12 @@ sub first_sibling {
my $self = shift;
my $position_column = $self->position_column;

my $fsib = $self->previous_siblings->search(
my $fsib = $self->previous_siblings->search_rs(
{},
{ rows => 1, order_by => { '-asc' => $position_column } },
)->single;

return defined $fsib ? $fsib : 0;
return defined( $fsib ) ? $fsib : 0;
}

=head2 next_sibling
Expand All @@ -244,12 +290,12 @@ if the current object is the last one.
sub next_sibling {
my $self = shift;
my $position_column = $self->position_column;
my $nsib = $self->next_siblings->search(
my $nsib = $self->next_siblings->search_rs(
{},
{ rows => 1, order_by => { '-asc' => $position_column } },
)->single;

return defined $nsib ? $nsib : 0;
return defined( $nsib ) ? $nsib : 0;
}

=head2 last_sibling
Expand All @@ -264,26 +310,25 @@ sibling.
sub last_sibling {
my $self = shift;
my $position_column = $self->position_column;
my $lsib = $self->next_siblings->search(
my $lsib = $self->next_siblings->search_rs(
{},
{ rows => 1, order_by => { '-desc' => $position_column } },
)->single;

return defined $lsib ? $lsib : 0;
return defined( $lsib ) ? $lsib : 0;
}

# an optimized method to get the last sibling position value without inflating a result object
sub _last_sibling_posval {
my $self = shift;
my $position_column = $self->position_column;

my $cursor = $self->next_siblings->search(
my $cursor = $self->next_siblings->search_rs(
{},
{ rows => 1, order_by => { '-desc' => $position_column }, select => $position_column },
)->cursor;

my ($pos) = $cursor->next;
return $pos;
($cursor->next)[0];
}

=head2 move_previous
Expand Down Expand Up @@ -378,7 +423,7 @@ sub move_to {
$self->store_column(
$position_column,
( $rsrc->resultset
->search($self->_storage_ident_condition, { rows => 1, columns => $position_column })
->search_rs($self->_storage_ident_condition, { rows => 1, columns => $position_column })
->cursor
->next
)[0] || $self->throw_exception(
Expand Down Expand Up @@ -730,7 +775,7 @@ sub _shift_siblings {
$ord = 'desc';
}

my $shift_rs = $self->_group_rs-> search ({ $position_column => { -between => \@between } });
my $shift_rs = $self->_group_rs-> search_rs ({ $position_column => { -between => \@between } });

# some databases (sqlite, pg, perhaps others) are dumb and can not do a
# blanket increment/decrement without violating a unique constraint.
Expand All @@ -746,7 +791,7 @@ sub _shift_siblings {
) {
my $clean_rs = $rsrc->resultset;

for ( $shift_rs->search (
for ( $shift_rs->search_rs (
{}, { order_by => { "-$ord", $position_column }, select => [$position_column, @pcols] }
)->cursor->all ) {
my $pos = shift @$_;
Expand All @@ -762,8 +807,18 @@ sub _shift_siblings {
# This method returns a resultset containing all members of the row
# group (including the row itself).
sub _group_rs {
my $self = shift;
return $self->result_source->resultset->search({$self->_grouping_clause()});
#my $self = shift;

DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
and
wantarray
and
! eval { fail_on_internal_call; 1 }
and
die "ILLEGAL LIST CONTEXT INVOCATION: $@";

# *MUST* be context sensitive due to legacy (DO NOT call search_rs)
$_[0]->result_source->resultset->search({ $_[0]->_grouping_clause() });
}

# Returns an unordered resultset of all objects in the same group
Expand All @@ -772,7 +827,17 @@ sub _siblings {
my $self = shift;
my $position_column = $self->position_column;
my $pos;
return defined ($pos = $self->get_column($position_column))

DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
and
wantarray
and
! eval { fail_on_internal_call; 1 }
and
die "ILLEGAL LIST CONTEXT INVOCATION: $@";

# *MUST* be context sensitive due to legacy (DO NOT call search_rs)
defined( $pos = $self->get_column($position_column) )
? $self->_group_rs->search(
{ $position_column => { '!=' => $pos } },
)
Expand Down Expand Up @@ -815,17 +880,26 @@ sub _is_in_group {
my ($self, $other) = @_;
my $current = {$self->_grouping_clause};

no warnings qw/uninitialized/;

return 0 if (
join ("\x00", sort keys %$current)
ne
join ("\x00", sort keys %$other)
);
for my $key (keys %$current) {
return 0 if $current->{$key} ne $other->{$key};
}
return 1;
(
bag_eq(
[ keys %$current ],
[ keys %$other ],
)
and
! grep {
(
defined( $current->{$_} )
xor
defined( $other->{$_} )
)
or
(
defined $current->{$_}
and
$current->{$_} ne $other->{$_}
)
} keys %$other
) ? 1 : 0;
}

# This is a short-circuited method, that is used internally by this
Expand All @@ -841,9 +915,8 @@ sub _is_in_group {
# you are doing use this method which bypasses any hooks introduced by
# this module.
sub _ordered_internal_update {
my $self = shift;
local $self->result_source->schema->{_ORDERED_INTERNAL_UPDATE} = 1;
return $self->update (@_);
local $_[0]->result_source->schema->{_ORDERED_INTERNAL_UPDATE} = 1;
shift->update (@_);
}

1;
Expand Down
19 changes: 13 additions & 6 deletions lib/DBIx/Class/PK.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,9 @@ use warnings;

use base qw/DBIx::Class::Row/;

use DBIx::Class::_Util 'fail_on_internal_call';
use namespace::clean;

=head1 NAME
DBIx::Class::PK - Primary Key class
Expand All @@ -27,12 +30,16 @@ a class method.
=cut

sub id {
my ($self) = @_;
$self->throw_exception( "Can't call id() as a class method" )
unless ref $self;
my @id_vals = $self->_ident_values;
return (wantarray ? @id_vals : $id_vals[0]);
sub id :DBIC_method_is_indirect_sugar {
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;

$_[0]->throw_exception( "Can't call id() as a class method" )
unless ref $_[0];

wantarray
? $_[0]->_ident_values
: ($_[0]->_ident_values)[0] # FIXME - horrible horrible legacy crap
;
}

sub _ident_values {
Expand Down
1 change: 0 additions & 1 deletion lib/DBIx/Class/Relationship/Accessor.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -160,7 +160,6 @@ EOC

quote_sub "${class}::${rel}", sprintf( <<'EOC', perlstring $rel ), @qsub_args;
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call;
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = DBIx::Class::_Util::fail_on_internal_wantarray;
shift->related_resultset(%s)->search( @_ )
EOC

Expand Down
Loading

0 comments on commit dc7d899

Please sign in to comment.