X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=dcc23b82b515be83d97337b518dfc3e4f7866b5f;hb=652452208e616becca6cfd0f16956339410da6d0;hp=a27f8a2fb18f4e52f71f2df5c6a3522f99d6ce15;hpb=7ad315356c82a425365b88b6146617485897a4a0;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index a27f8a2..dcc23b8 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -2,10 +2,7 @@ package DBIx::Class::ResultSet; use strict; use warnings; -use overload - '0+' => "count", - 'bool' => "_bool", - fallback => 1; +use base qw/DBIx::Class/; use Carp::Clan qw/^DBIx::Class/; use DBIx::Class::Exception; use Data::Page; @@ -13,8 +10,14 @@ use Storable; use DBIx::Class::ResultSetColumn; use DBIx::Class::ResultSourceHandle; use List::Util (); -use Scalar::Util (); -use base qw/DBIx::Class/; +use Scalar::Util qw/blessed weaken/; +use Try::Tiny; +use namespace::clean; + +use overload + '0+' => "count", + 'bool' => "_bool", + fallback => 1; __PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/); @@ -197,7 +200,6 @@ sub new { my $self = { _source_handle => $source, cond => $attrs->{where}, - count => undef, pager => undef, attrs => $attrs }; @@ -948,6 +950,7 @@ sub next { return $cache->[$self->{all_cache_position}++]; } if ($self->{attrs}{cache}) { + delete $self->{pager}; $self->{all_cache_position} = 1; return ($self->all)[0]; } @@ -1238,14 +1241,12 @@ sub _count_rs { my $rsrc = $self->result_source; $attrs ||= $self->_resolved_attrs; - # only take pieces we need for a simple count - my $tmp_attrs = { map - { $_ => $attrs->{$_} } - qw/ alias from where bind join / - }; + my $tmp_attrs = { %$attrs }; + # take off any limits, record_filter is cdbi, and no point of ordering nor locking a count + delete @{$tmp_attrs}{qw/rows offset order_by record_filter for/}; # overwrite the selector (supplied by the storage) - $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs); + $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $attrs); $tmp_attrs->{as} = 'count'; my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count'); @@ -1262,10 +1263,9 @@ sub _count_subq_rs { my $rsrc = $self->result_source; $attrs ||= $self->_resolved_attrs; - my $sub_attrs = { map - { $_ => $attrs->{$_} } - qw/ alias from where bind join group_by having rows offset / - }; + my $sub_attrs = { %$attrs }; + # extra selectors do not go in the subquery and there is no point of ordering it, nor locking it + delete @{$sub_attrs}{qw/collapse select _prefetch_select as order_by for/}; # if we multi-prefetch we group_by primary keys only as this is what we would # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless @@ -1276,6 +1276,8 @@ sub _count_subq_rs { # Calculate subquery selector if (my $g = $sub_attrs->{group_by}) { + my $sql_maker = $rsrc->storage->sql_maker; + # necessary as the group_by may refer to aliased functions my $sel_index; for my $sel (@{$attrs->{select}}) { @@ -1284,7 +1286,17 @@ sub _count_subq_rs { } for my $g_part (@$g) { - push @{$sub_attrs->{select}}, $sel_index->{$g_part} || $g_part; + my $colpiece = $sel_index->{$g_part} || $g_part; + + # disqualify join-based group_by's. Arcane but possible query + # also horrible horrible hack to alias a column (not a func.) + # (probably need to introduce SQLA syntax) + if ($colpiece =~ /\./ && $colpiece !~ /^$attrs->{alias}\./) { + my $as = $colpiece; + $as =~ s/\./__/; + $colpiece = \ sprintf ('%s AS %s', map { $sql_maker->_quote ($_) } ($colpiece, $as) ); + } + push @{$sub_attrs->{select}}, $colpiece; } } else { @@ -1296,7 +1308,7 @@ sub _count_subq_rs { ->new ($rsrc, $sub_attrs) ->as_subselect_rs ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } }) - -> get_column ('count'); + ->get_column ('count'); } sub _bool { @@ -1434,7 +1446,8 @@ sub _rs_update_delete { # make a new $rs selecting only the PKs (that's all we really need) my $attrs = $self->_resolved_attrs_copy; - delete $attrs->{$_} for qw/collapse select as/; + + delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_select as/; $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->_pri_cols) ]; if ($needs_group_by_subq) { @@ -1468,7 +1481,6 @@ sub _rs_update_delete { } my $subrs = (ref $self)->new($rsrc, $attrs); - return $self->result_source->storage->_subq_update_delete($subrs, $op, $values); } else { @@ -1794,11 +1806,115 @@ C on the L object. =cut +# make a wizard good for both a scalar and a hashref +my $mk_lazy_count_wizard = sub { + require Variable::Magic; + + my $stash = { total_rs => shift }; + my $slot = shift; # only used by the hashref magic + + my $magic = Variable::Magic::wizard ( + data => sub { $stash }, + + (!$slot) + ? ( + # the scalar magic + get => sub { + # set value lazily, and dispell for good + ${$_[0]} = $_[1]{total_rs}->count; + Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref}); + return 1; + }, + set => sub { + # an explicit set implies dispell as well + # the unless() is to work around "fun and giggles" below + Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref}) + unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager'; + return 1; + }, + ) + : ( + # the uvar magic + fetch => sub { + if ($_[2] eq $slot and !$_[1]{inactive}) { + my $cnt = $_[1]{total_rs}->count; + $_[0]->{$slot} = $cnt; + + # attempting to dispell in a fetch handle (works in store), seems + # to invariable segfault on 5.10, 5.12, 5.13 :( + # so use an inactivator instead + #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref}); + $_[1]{inactive}++; + } + return 1; + }, + store => sub { + if (! $_[1]{inactive} and $_[2] eq $slot) { + #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref}); + $_[1]{inactive}++ + unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager'; + } + return 1; + }, + ), + ); + + $stash->{magic_selfref} = $magic; + weaken ($stash->{magic_selfref}); # this fails on 5.8.1 + + return $magic; +}; + +# the tie class for 5.8.1 +{ + package DBIx::Class::__DBIC_LAZY_RS_COUNT__; + use base qw/Tie::Hash/; + + sub FIRSTKEY { my $dummy = scalar keys %{$_[0]{data}}; each %{$_[0]{data}} } + sub NEXTKEY { each %{$_[0]{data}} } + sub EXISTS { exists $_[0]{data}{$_[1]} } + sub DELETE { delete $_[0]{data}{$_[1]} } + sub CLEAR { %{$_[0]{data}} = () } + sub SCALAR { scalar %{$_[0]{data}} } + + sub TIEHASH { + $_[1]{data} = {%{$_[1]{selfref}}}; + %{$_[1]{selfref}} = (); + Scalar::Util::weaken ($_[1]{selfref}); + return bless ($_[1], $_[0]); + }; + + sub FETCH { + if ($_[1] eq $_[0]{slot}) { + my $cnt = $_[0]{data}{$_[1]} = $_[0]{total_rs}->count; + untie %{$_[0]{selfref}}; + %{$_[0]{selfref}} = %{$_[0]{data}}; + return $cnt; + } + else { + $_[0]{data}{$_[1]}; + } + } + + sub STORE { + $_[0]{data}{$_[1]} = $_[2]; + if ($_[1] eq $_[0]{slot}) { + untie %{$_[0]{selfref}}; + %{$_[0]{selfref}} = %{$_[0]{data}}; + } + $_[2]; + } +} + sub pager { my ($self) = @_; return $self->{pager} if $self->{pager}; + if ($self->get_cache) { + $self->throw_exception ('Pagers on cached resultsets are not supported'); + } + my $attrs = $self->{attrs}; $self->throw_exception("Can't create pager for non-paged rs") unless $self->{attrs}{page}; @@ -1808,13 +1924,69 @@ sub pager { # with a subselect) to get the real total count my $count_attrs = { %$attrs }; delete $count_attrs->{$_} for qw/rows offset page pager/; - my $total_count = (ref $self)->new($self->result_source, $count_attrs)->count; + my $total_rs = (ref $self)->new($self->result_source, $count_attrs); + + +### the following may seem awkward and dirty, but it's a thought-experiment +### necessary for future development of DBIx::DS. Do *NOT* change this code +### before talking to ribasushi/mst - return $self->{pager} = Data::Page->new( - $total_count, + my $pager = Data::Page->new( + 0, #start with an empty set $attrs->{rows}, - $self->{attrs}{page} + $self->{attrs}{page}, ); + + my $data_slot = 'total_entries'; + + # Since we are interested in a cached value (once it's set - it's set), every + # technique will detach from the magic-host once the time comes to fire the + # ->count (or in the segfaulting case of >= 5.10 it will deactivate itself) + + if ($] < 5.008003) { + # 5.8.1 throws 'Modification of a read-only value attempted' when one tries + # to weakref the magic container :( + # tested on 5.8.1 + tie (%$pager, 'DBIx::Class::__DBIC_LAZY_RS_COUNT__', + { slot => $data_slot, total_rs => $total_rs, selfref => $pager } + ); + } + elsif ($] < 5.010) { + # We can use magic on the hash value slot. It's interesting that the magic is + # attached to the hash-slot, and does *not* stop working once I do the dummy + # assignments after the cast() + # tested on 5.8.3 and 5.8.9 + my $magic = $mk_lazy_count_wizard->($total_rs); + Variable::Magic::cast ( $pager->{$data_slot}, $magic ); + + # this is for fun and giggles + $pager->{$data_slot} = -1; + $pager->{$data_slot} = 0; + + # this does not work for scalars, but works with + # uvar magic below + #my %vals = %$pager; + #%$pager = (); + #%{$pager} = %vals; + } + else { + # And the uvar magic + # works on 5.10.1, 5.12.1 and 5.13.4 in its current form, + # however see the wizard maker for more notes + my $magic = $mk_lazy_count_wizard->($total_rs, $data_slot); + Variable::Magic::cast ( %$pager, $magic ); + + # still works + $pager->{$data_slot} = -1; + $pager->{$data_slot} = 0; + + # this now works + my %vals = %$pager; + %$pager = (); + %{$pager} = %vals; + } + + return $self->{pager} = $pager; } =head2 page @@ -1934,7 +2106,7 @@ sub _is_deterministic_value { my $value = shift; my $ref_type = ref $value; return 1 if $ref_type eq '' || $ref_type eq 'SCALAR'; - return 1 if Scalar::Util::blessed($value); + return 1 if blessed $value; return 0; } @@ -2181,7 +2353,7 @@ or C resultset. Note Arrayref. ); Example of creating a new row and also creating a row in a related -Cresultset. Note Hashref. +C resultset. Note Hashref. $cd_rs->create({ title=>"Music for Silly Walks", @@ -2545,7 +2717,7 @@ sub related_resultset { # (the select/as attrs were deleted in the beginning), we need to flip all # left joins to inner, so we get the expected results # read the comment on top of the actual function to see what this does - $attrs->{from} = $rsrc->schema->storage->_straight_join_to_node ($attrs->{from}, $alias); + $attrs->{from} = $rsrc->schema->storage->_inner_join_to_node ($attrs->{from}, $alias); #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi @@ -2964,21 +3136,33 @@ sub _resolved_attrs { carp ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)"); } else { - $attrs->{group_by} = [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ]; + my $storage = $self->result_source->schema->storage; + my $rs_column_list = $storage->_resolve_column_info ($attrs->{from}); + my $group_spec = $attrs->{group_by} = []; + my %group_index; + + for (@{$attrs->{select}}) { + if (! ref($_) or ref ($_) ne 'HASH' ) { + push @$group_spec, $_; + $group_index{$_}++; + if ($rs_column_list->{$_} and $_ !~ /\./ ) { + # add a fully qualified version as well + $group_index{"$rs_column_list->{$_}{-source_alias}.$_"}++; + } + } + } # add any order_by parts that are not already present in the group_by # we need to be careful not to add any named functions/aggregates # i.e. select => [ ... { count => 'foo', -as 'foocount' } ... ] - my %already_grouped = map { $_ => 1 } (@{$attrs->{group_by}}); - - my $storage = $self->result_source->schema->storage; + for my $chunk ($storage->_parse_order_by($attrs->{order_by})) { - my $rs_column_list = $storage->_resolve_column_info ($attrs->{from}); + # only consider real columns (for functions the user got to do an explicit group_by) + my $colinfo = $rs_column_list->{$chunk} + or next; - for my $chunk ($storage->_parse_order_by($attrs->{order_by})) { - if ($rs_column_list->{$chunk} && not $already_grouped{$chunk}++) { - push @{$attrs->{group_by}}, $chunk; - } + $chunk = "$colinfo->{-source_alias}.$chunk" if $chunk !~ /\./; + push @$group_spec, $chunk unless $group_index{$chunk}++; } } } @@ -3233,6 +3417,15 @@ it and sets C as normal. (You may also use the C attribute, as in earlier versions of DBIC.) +Essentially C does the same as L and L. + + columns => [ 'foo', { bar => 'baz' } ] + +is the same as + + select => [qw/foo baz/], + as => [qw/foo bar/] + =head2 +columns =over 4