X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=78f43032aaa38b401da5e7450cc268530936fa76;hp=4e06ed6c34f9512626b8ce5d220dc00686221795;hb=da00dd3222e065b93820304fd992f461f96c50c2;hpb=f50497ab497520c6f79154cdff283921c4d2cb9e diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 4e06ed6..78f4303 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/); @@ -57,7 +60,12 @@ represents. The query that the ResultSet represents is B executed against the database when these methods are called: -L L L L L L +L, L, L, L, L, L. + +If a resultset is used in a numeric context it returns the L. +However, if it is used in a boolean context it is B true. So if +you want to check if a resultset has any results, you must use C. =head1 EXAMPLES @@ -101,7 +109,7 @@ attributes with the same keys need resolving. L, L, L, L attributes are merged into the existing ones from the original resultset. -The L, L attribute, and any search conditions are +The L and L attributes, and any search conditions, are merged with an SQL C to the existing condition from the original resultset. @@ -142,13 +150,6 @@ Which is the same as: See: L, L, L, L, L. -=head1 OVERLOADING - -If a resultset is used in a numeric context it returns the L. -However, if it is used in a boolean context it is always true. So if -you want to check if a resultset has any results use C. -C will always be true. - =head1 METHODS =head2 new @@ -199,7 +200,6 @@ sub new { my $self = { _source_handle => $source, cond => $attrs->{where}, - count => undef, pager => undef, attrs => $attrs }; @@ -538,8 +538,8 @@ sub find { : $self->_add_alias($input_query, $alias); } - # Run the query - my $rs = $self->search ($query, $attrs); + # Run the query, passing the result_class since it should propagate for find + my $rs = $self->search ($query, {result_class => $self->result_class, %$attrs}); if (keys %{$rs->_resolved_attrs->{collapse}}) { my $row = $rs->next; carp "Query returned more than one row" if $rs->next; @@ -682,15 +682,15 @@ sub cursor { =item Arguments: $cond? -=item Return Value: $row_object? +=item Return Value: $row_object | undef =back my $cd = $schema->resultset('CD')->single({ year => 2001 }); Inflates the first result without creating a cursor if the resultset has -any records in it; if not returns nothing. Used by L as a lean version of -L. +any records in it; if not returns C. Used by L as a lean version +of L. While this method can take an optional search condition (just like L) being a fast-code-path it does not recognize search attributes. If you need to @@ -913,7 +913,7 @@ sub slice { $attrs->{offset} = $self->{attrs}{offset} || 0; $attrs->{offset} += $min; $attrs->{rows} = ($max ? ($max - $min + 1) : 1); - return $self->search(undef(), $attrs); + return $self->search(undef, $attrs); #my $slice = (ref $self)->new($self->result_source, $attrs); #return (wantarray ? $slice->all : $slice); } @@ -924,7 +924,7 @@ sub slice { =item Arguments: none -=item Return Value: $result? +=item Return Value: $result | undef =back @@ -950,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]; } @@ -1240,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'); @@ -1264,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 @@ -1278,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}}) { @@ -1286,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 { @@ -1298,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 { @@ -1399,12 +1409,12 @@ sub reset { =item Arguments: none -=item Return Value: $object? +=item Return Value: $object | undef =back -Resets the resultset and returns an object for the first result (if the -resultset returns anything). +Resets the resultset and returns an object for the first result (or C +if the resultset is empty). =cut @@ -1436,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) { @@ -1470,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 { @@ -1796,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}; @@ -1810,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 @@ -1936,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; } @@ -2183,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", @@ -2413,7 +2583,7 @@ sub update_or_new { =item Arguments: none -=item Return Value: \@cache_objects? +=item Return Value: \@cache_objects | undef =back @@ -2461,7 +2631,7 @@ sub set_cache { =item Arguments: none -=item Return Value: [] +=item Return Value: undef =back @@ -2504,7 +2674,7 @@ sub is_paged { sub is_ordered { my ($self) = @_; - return scalar $self->result_source->storage->_parse_order_by($self->{attrs}{order_by}); + return scalar $self->result_source->storage->_extract_order_columns($self->{attrs}{order_by}); } =head2 related_resultset @@ -2547,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 @@ -2966,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}}); + for my $chunk ($storage->_extract_order_columns($attrs->{order_by})) { - my $storage = $self->result_source->schema->storage; + # only consider real columns (for functions the user got to do an explicit group_by) + my $colinfo = $rs_column_list->{$chunk} + or next; - my $rs_column_list = $storage->_resolve_column_info ($attrs->{from}); - - 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}++; } } } @@ -3235,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