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=f9a4c4a59d42d15677e101b61e98a3387f19b73f;hpb=29e5f0267db40420e31c49e5035114447c9ba844;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index f9a4c4a..dcc23b8 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -2,18 +2,22 @@ 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; 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/); @@ -24,6 +28,10 @@ DBIx::Class::ResultSet - Represents a query used for fetching a set of results. =head1 SYNOPSIS my $users_rs = $schema->resultset('User'); + while( $user = $users_rs->next) { + print $user->username; + } + my $registered_users_rs = $schema->resultset('User')->search({ registered => 1 }); my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all(); @@ -52,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 @@ -96,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. @@ -137,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 booleand 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 @@ -194,7 +200,6 @@ sub new { my $self = { _source_handle => $source, cond => $attrs->{where}, - count => undef, pager => undef, attrs => $attrs }; @@ -290,10 +295,15 @@ sub search_rs { $rows = $self->get_cache; } + # reset the selector list + if (List::Util::first { exists $attrs->{$_} } qw{columns select as}) { + delete @{$our_attrs}{qw{select as columns +select +as +columns include_columns}}; + } + my $new_attrs = { %{$our_attrs}, %{$attrs} }; # merge new attrs into inherited - foreach my $key (qw/join prefetch +select +as bind/) { + foreach my $key (qw/join prefetch +select +as +columns include_columns bind/) { next unless exists $attrs->{$key}; $new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key}); } @@ -356,9 +366,9 @@ sub search_rs { } my $rs = (ref $self)->new($self->result_source, $new_attrs); - if ($rows) { - $rs->set_cache($rows); - } + + $rs->set_cache($rows) if ($rows); + return $rs; } @@ -518,7 +528,7 @@ sub find { # in ::Relationship::Base::search_related (the row method), and furthermore # the relationship is of the 'single' type. This means that the condition # provided by the relationship (already attached to $self) is sufficient, - # as there can be only one row in the databse that would satisfy the + # as there can be only one row in the database that would satisfy the # relationship } else { @@ -528,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; @@ -633,7 +643,7 @@ sub search_related { =head2 search_related_rs This method works exactly the same as search_related, except that -it guarantees a restultset, even in list context. +it guarantees a resultset, even in list context. =cut @@ -691,7 +701,7 @@ L returned. =item B -As of 0.08100, this method enforces the assumption that the preceeding +As of 0.08100, this method enforces the assumption that the preceding query returns only one row. If more than one row is returned, you will receive a warning: @@ -940,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]; } @@ -973,19 +984,6 @@ sub _construct_object { sub _collapse_result { my ($self, $as_proto, $row) = @_; - # if the first row that ever came in is totally empty - this means we got - # hit by a smooth^Wempty left-joined resultset. Just noop in that case - # instead of producing a {} - # - my $has_def; - for (@$row) { - if (defined $_) { - $has_def++; - last; - } - } - return undef unless $has_def; - my @copy = @$row; # 'foo' => [ undef, 'foo' ] @@ -1010,7 +1008,7 @@ sub _collapse_result { # without having to contruct the full hash if (keys %collapse) { - my %pri = map { ($_ => 1) } $self->result_source->primary_columns; + my %pri = map { ($_ => 1) } $self->result_source->_pri_cols; foreach my $i (0 .. $#construct_as) { next if defined($construct_as[$i][0]); # only self table if (delete $pri{$construct_as[$i][1]}) { @@ -1141,8 +1139,14 @@ in the original source class will not run. sub result_class { my ($self, $result_class) = @_; if ($result_class) { - $self->ensure_class_loaded($result_class); + unless (ref $result_class) { # don't fire this for an object + $self->ensure_class_loaded($result_class); + } $self->_result_class($result_class); + # THIS LINE WOULD BE A BUG - this accessor specifically exists to + # permit the user to set result class on one result set only; it only + # chains if provided to search() + #$self->{attrs}{result_class} = $result_class if ref $self; } $self->_result_class; } @@ -1238,19 +1242,13 @@ sub _count_rs { $attrs ||= $self->_resolved_attrs; my $tmp_attrs = { %$attrs }; - - # take off any limits, record_filter is cdbi, and no point of ordering a count - delete $tmp_attrs->{$_} for (qw/select as rows offset order_by record_filter/); + # 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'; - # read the comment on top of the actual function to see what this does - $tmp_attrs->{from} = $self->_switch_to_inner_join_if_needed ( - $tmp_attrs->{from}, $tmp_attrs->{alias} - ); - my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count'); return $tmp_rs; @@ -1263,114 +1261,56 @@ sub _count_subq_rs { my ($self, $attrs) = @_; my $rsrc = $self->result_source; - $attrs ||= $self->_resolved_attrs_copy; + $attrs ||= $self->_resolved_attrs; 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/}; - # extra selectors do not go in the subquery and there is no point of ordering it - delete $sub_attrs->{$_} for qw/collapse select _prefetch_select as order_by/; - - # if we 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 - if ( keys %{$attrs->{collapse}} ) { - $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->primary_columns) ] + # 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 + if ( keys %{$attrs->{collapse}} ) { + $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->_pri_cols) ] } - $sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $sub_attrs); - - # read the comment on top of the actual function to see what this does - $sub_attrs->{from} = $self->_switch_to_inner_join_if_needed ( - $sub_attrs->{from}, $sub_attrs->{alias} - ); - - # this is so that ordering can be thrown away in things like Top limit - $sub_attrs->{-for_count_only} = 1; - - my $sub_rs = $rsrc->resultset_class->new ($rsrc, $sub_attrs); - - $attrs->{from} = [{ - -alias => 'count_subq', - -source_handle => $rsrc->handle, - count_subq => $sub_rs->as_query, - }]; - - # the subquery replaces this - delete $attrs->{$_} for qw/where bind collapse group_by having having_bind rows offset/; + # Calculate subquery selector + if (my $g = $sub_attrs->{group_by}) { - return $self->_count_rs ($attrs); -} - - -# The DBIC relationship chaining implementation is pretty simple - every -# new related_relationship is pushed onto the {from} stack, and the {select} -# window simply slides further in. This means that when we count somewhere -# in the middle, we got to make sure that everything in the join chain is an -# actual inner join, otherwise the count will come back with unpredictable -# results (a resultset may be generated with _some_ rows regardless of if -# the relation which the $rs currently selects has rows or not). E.g. -# $artist_rs->cds->count - normally generates: -# SELECT COUNT( * ) FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid -# which actually returns the number of artists * (number of cds || 1) -# -# So what we do here is crawl {from}, determine if the current alias is at -# the top of the stack, and if not - make sure the chain is inner-joined down -# to the root. -# -sub _switch_to_inner_join_if_needed { - my ($self, $from, $alias) = @_; - - # subqueries and other oddness is naturally not supported - return $from if ( - ref $from ne 'ARRAY' - || - @$from <= 1 - || - ref $from->[0] ne 'HASH' - || - ! $from->[0]{-alias} - || - $from->[0]{-alias} eq $alias - ); + my $sql_maker = $rsrc->storage->sql_maker; - my $switch_branch; - JOINSCAN: - for my $j (@{$from}[1 .. $#$from]) { - if ($j->[0]{-alias} eq $alias) { - $switch_branch = $j->[0]{-join_path}; - last JOINSCAN; + # necessary as the group_by may refer to aliased functions + my $sel_index; + for my $sel (@{$attrs->{select}}) { + $sel_index->{$sel->{-as}} = $sel + if (ref $sel eq 'HASH' and $sel->{-as}); } - } - - # something else went wrong - return $from unless $switch_branch; - - # So it looks like we will have to switch some stuff around. - # local() is useless here as we will be leaving the scope - # anyway, and deep cloning is just too fucking expensive - # So replace the inner hashref manually - my @new_from = ($from->[0]); - my $sw_idx = { map { $_ => 1 } @$switch_branch }; - for my $j (@{$from}[1 .. $#$from]) { - my $jalias = $j->[0]{-alias}; + for my $g_part (@$g) { + my $colpiece = $sel_index->{$g_part} || $g_part; - if ($sw_idx->{$jalias}) { - my %attrs = %{$j->[0]}; - delete $attrs{-join_type}; - push @new_from, [ - \%attrs, - @{$j}[ 1 .. $#$j ], - ]; - } - else { - push @new_from, $j; + # 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 { + my @pcols = map { "$attrs->{alias}.$_" } ($rsrc->primary_columns); + $sub_attrs->{select} = @pcols ? \@pcols : [ 1 ]; + } - return \@new_from; + return $rsrc->resultset_class + ->new ($rsrc, $sub_attrs) + ->as_subselect_rs + ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } }) + ->get_column ('count'); } - sub _bool { return 1; } @@ -1494,16 +1434,21 @@ sub _rs_update_delete { my $rsrc = $self->result_source; + # if a condition exists we need to strip all table qualifiers + # if this is not possible we'll force a subquery below + my $cond = $rsrc->schema->storage->_strip_cond_qualifiers ($self->{cond}); + my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/); - my $needs_subq = $self->_has_resolved_attr (qw/row offset/); + my $needs_subq = $needs_group_by_subq || (not defined $cond) || $self->_has_resolved_attr(qw/rows offset/); if ($needs_group_by_subq or $needs_subq) { # 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/; - $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->primary_columns) ]; + + 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) { # make sure no group_by was supplied, or if there is one - make sure it matches @@ -1536,77 +1481,17 @@ sub _rs_update_delete { } my $subrs = (ref $self)->new($rsrc, $attrs); - return $self->result_source->storage->_subq_update_delete($subrs, $op, $values); } else { return $rsrc->storage->$op( $rsrc, $op eq 'update' ? $values : (), - $self->_cond_for_update_delete, + $cond, ); } } - -# _cond_for_update_delete -# -# update/delete require the condition to be modified to handle -# the differing SQL syntax available. This transforms the $self->{cond} -# appropriately, returning the new condition. - -sub _cond_for_update_delete { - my ($self, $full_cond) = @_; - my $cond = {}; - - $full_cond ||= $self->{cond}; - # No-op. No condition, we're updating/deleting everything - return $cond unless ref $full_cond; - - if (ref $full_cond eq 'ARRAY') { - $cond = [ - map { - my %hash; - foreach my $key (keys %{$_}) { - $key =~ /([^.]+)$/; - $hash{$1} = $_->{$key}; - } - \%hash; - } @{$full_cond} - ]; - } - elsif (ref $full_cond eq 'HASH') { - if ((keys %{$full_cond})[0] eq '-and') { - $cond->{-and} = []; - my @cond = @{$full_cond->{-and}}; - for (my $i = 0; $i < @cond; $i++) { - my $entry = $cond[$i]; - my $hash; - if (ref $entry eq 'HASH') { - $hash = $self->_cond_for_update_delete($entry); - } - else { - $entry =~ /([^.]+)$/; - $hash->{$1} = $cond[++$i]; - } - push @{$cond->{-and}}, $hash; - } - } - else { - foreach my $key (keys %{$full_cond}) { - $key =~ /([^.]+)$/; - $cond->{$1} = $full_cond->{$key}; - } - } - } - else { - $self->throw_exception("Can't update/delete on resultset with condition unless hash or array"); - } - - return $cond; -} - - =head2 update =over 4 @@ -1650,9 +1535,10 @@ sub update_all { my ($self, $values) = @_; $self->throw_exception('Values for update_all must be a hash') unless ref $values eq 'HASH'; - foreach my $obj ($self->all) { - $obj->set_columns($values)->update; - } + + my $guard = $self->result_source->schema->txn_scope_guard; + $_->update($values) for $self->all; + $guard->commit; return 1; } @@ -1670,7 +1556,7 @@ Deletes the contents of the resultset from its result source. Note that this will not run DBIC cascade triggers. See L if you need triggers to run. See also L. -Return value will be the amount of rows deleted; exact type of return value +Return value will be the number of rows deleted; exact type of return value is storage-dependent. =cut @@ -1703,7 +1589,9 @@ sub delete_all { $self->throw_exception('delete_all does not accept any arguments') if @_; + my $guard = $self->result_source->schema->txn_scope_guard; $_->delete for $self->all; + $guard->commit; return 1; } @@ -1739,7 +1627,7 @@ Example: Assuming an Artist Class that has many CDs Classes relating: ], }, { artistid => 5, name => 'Angsty-Whiny Girl', cds => [ - { title => 'My parents sold me to a record company' ,year => 2005 }, + { title => 'My parents sold me to a record company', year => 2005 }, { title => 'Why Am I So Ugly?', year => 2006 }, { title => 'I Got Surgery and am now Popular', year => 2007 } ], @@ -1767,7 +1655,7 @@ example: [qw/artistid name/], [100, 'A Formally Unknown Singer'], [101, 'A singer that jumped the shark two albums ago'], - [102, 'An actually cool singer.'], + [102, 'An actually cool singer'], ]); Please note an important effect on your data when choosing between void and @@ -1781,10 +1669,10 @@ values. =cut sub populate { - my $self = shift @_; - my $data = ref $_[0][0] eq 'HASH' - ? $_[0] : ref $_[0][0] eq 'ARRAY' ? $self->_normalize_populate_args($_[0]) : - $self->throw_exception('Populate expects an arrayref of hashes or arrayref of arrayrefs'); + my $self = shift; + + # cruft placed in standalone method + my $data = $self->_normalize_populate_args(@_); if(defined wantarray) { my @created; @@ -1793,10 +1681,19 @@ sub populate { } return wantarray ? @created : \@created; } else { - my ($first, @rest) = @$data; + 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); + for (keys %$first) { + my $ref = ref $first->{$_}; + $self->result_source->has_relationship($_) && ($ref eq 'ARRAY' or $ref eq 'HASH') + ? push @rels, $_ + : push @columns, $_ + ; + } - my @names = grep {!ref $first->{$_}} keys %$first; - my @rels = grep { $self->result_source->has_relationship($_) } keys %$first; my @pks = $self->result_source->primary_columns; ## do the belongs_to relationships @@ -1825,17 +1722,21 @@ sub populate { delete $data->[$index]->{$rel}; $data->[$index] = {%{$data->[$index]}, %$related}; - push @names, keys %$related if $index == 0; + push @columns, keys %$related if $index == 0; } } - ## do bulk insert on current row - my @values = map { [ @$_{@names} ] } @$data; + ## inherit the data locked in the conditions of the resultset + my ($rs_data) = $self->_merge_cond_with_data({}); + delete @{$rs_data}{@columns}; + my @inherit_cols = keys %$rs_data; + my @inherit_data = values %$rs_data; + ## do bulk insert on current row $self->result_source->storage->insert_bulk( $self->result_source, - \@names, - \@values, + [@columns, @inherit_cols], + [ map { [ @$_{@columns}, @inherit_data ] } @$data ], ); ## do the has_many relationships @@ -1844,7 +1745,7 @@ sub populate { foreach my $rel (@rels) { next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY"; - my $parent = $self->find(map {{$_=>$item->{$_}} } @pks) + my $parent = $self->find({map { $_ => $item->{$_} } @pks}) || $self->throw_exception('Cannot find the relating object.'); my $child = $parent->$rel; @@ -1864,26 +1765,27 @@ sub populate { } } -=head2 _normalize_populate_args ($args) - -Private method used by L to normalize its incoming arguments. Factored -out in case you want to subclass and accept new argument structures to the -L method. - -=cut +# populate() argumnets went over several incarnations +# What we ultimately support is AoH sub _normalize_populate_args { - my ($self, $data) = @_; - my @names = @{shift(@$data)}; - my @results_to_create; - foreach my $datum (@$data) { - my %result_to_create; - foreach my $index (0..$#names) { - $result_to_create{$names[$index]} = $$datum[$index]; + my ($self, $arg) = @_; + + if (ref $arg eq 'ARRAY') { + if (ref $arg->[0] eq 'HASH') { + return $arg; + } + elsif (ref $arg->[0] eq 'ARRAY') { + my @ret; + my @colnames = @{$arg->[0]}; + foreach my $values (@{$arg}[1 .. $#$arg]) { + push @ret, { map { $colnames[$_] => $values->[$_] } (0 .. $#colnames) }; + } + return \@ret; } - push @results_to_create, \%result_to_create; } - return \@results_to_create; + + $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs'); } =head2 pager @@ -1904,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}; @@ -1918,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); + - return $self->{pager} = Data::Page->new( - $total_count, +### 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 + + 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 @@ -1972,46 +2034,66 @@ sub new_result { $self->throw_exception( "new_result needs a hash" ) unless (ref $values eq 'HASH'); - my %new; + my ($merged_cond, $cols_from_relations) = $self->_merge_cond_with_data($values); + + my %new = ( + %$merged_cond, + @$cols_from_relations + ? (-cols_from_relations => $cols_from_relations) + : (), + -source_handle => $self->_source_handle, + -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED + ); + + return $self->result_class->new(\%new); +} + +# _merge_cond_with_data +# +# Takes a simple hash of K/V data and returns its copy merged with the +# condition already present on the resultset. Additionally returns an +# arrayref of value/condition names, which were inferred from related +# objects (this is needed for in-memory related objects) +sub _merge_cond_with_data { + my ($self, $data) = @_; + + my (%new_data, @cols_from_relations); + my $alias = $self->{attrs}{alias}; - if ( - defined $self->{cond} - && $self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION - ) { - %new = %{ $self->{attrs}{related_objects} || {} }; # nothing might have been inserted yet - $new{-from_resultset} = [ keys %new ] if keys %new; - } else { + if (! defined $self->{cond}) { + # just massage $data below + } + elsif ($self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) { + %new_data = %{ $self->{attrs}{related_objects} || {} }; # nothing might have been inserted yet + @cols_from_relations = keys %new_data; + } + elsif (ref $self->{cond} ne 'HASH') { $self->throw_exception( - "Can't abstract implicit construct, condition not a hash" - ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH')); - - my $collapsed_cond = ( - $self->{cond} - ? $self->_collapse_cond($self->{cond}) - : {} + "Can't abstract implicit construct, resultset condition not a hash" ); - + } + else { # precendence must be given to passed values over values inherited from # the cond, so the order here is important. - my %implied = %{$self->_remove_alias($collapsed_cond, $alias)}; - while( my($col,$value) = each %implied ){ - if(ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '='){ - $new{$col} = $value->{'='}; + my $collapsed_cond = $self->_collapse_cond($self->{cond}); + my %implied = %{$self->_remove_alias($collapsed_cond, $alias)}; + + while ( my($col, $value) = each %implied ) { + if (ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') { + $new_data{$col} = $value->{'='}; next; } - $new{$col} = $value if $self->_is_deterministic_value($value); + $new_data{$col} = $value if $self->_is_deterministic_value($value); } } - %new = ( - %new, - %{ $self->_remove_alias($values, $alias) }, - -source_handle => $self->_source_handle, - -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED + %new_data = ( + %new_data, + %{ $self->_remove_alias($data, $alias) }, ); - return $self->result_class->new(\%new); + return (\%new_data, \@cols_from_relations); } # _is_deterministic_value @@ -2024,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; } @@ -2136,7 +2218,7 @@ sub _remove_alias { return \%unaliased; } -=head2 as_query (EXPERIMENTAL) +=head2 as_query =over 4 @@ -2150,8 +2232,6 @@ Returns the SQL query and bind vars associated with the invocant. This is generally used as the RHS for a subquery. -B: This feature is still experimental. - =cut sub as_query { @@ -2242,7 +2322,7 @@ To create related objects, pass a hashref of related-object column values B. If the relationship is of type C (L) - pass an arrayref of hashrefs. The process will correctly identify columns holding foreign keys, and will -transparrently populate them from the keys of the corresponding relation. +transparently populate them from the keys of the corresponding relation. This can be applied recursively, and will work correctly for a structure with an arbitrary depth and width, as long as the relationships actually exists and the correct column data has been supplied. @@ -2273,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", @@ -2400,7 +2480,7 @@ For example: producer => $producer, name => 'harry', }, { - key => 'primary, + key => 'primary', }); @@ -2563,6 +2643,40 @@ sub clear_cache { shift->set_cache(undef); } +=head2 is_paged + +=over 4 + +=item Arguments: none + +=item Return Value: true, if the resultset has been paginated + +=back + +=cut + +sub is_paged { + my ($self) = @_; + return !!$self->{attrs}{page}; +} + +=head2 is_ordered + +=over 4 + +=item Arguments: none + +=item Return Value: true, if the resultset has been ordered with C. + +=back + +=cut + +sub is_ordered { + my ($self) = @_; + return scalar $self->result_source->storage->_parse_order_by($self->{attrs}{order_by}); +} + =head2 related_resultset =over 4 @@ -2584,21 +2698,30 @@ sub related_resultset { $self->{related_resultsets} ||= {}; return $self->{related_resultsets}{$rel} ||= do { - my $rel_info = $self->result_source->relationship_info($rel); + my $rsrc = $self->result_source; + my $rel_info = $rsrc->relationship_info($rel); $self->throw_exception( - "search_related: result source '" . $self->result_source->source_name . + "search_related: result source '" . $rsrc->source_name . "' has no such relationship $rel") unless $rel_info; - my ($from,$seen) = $self->_chain_relationship($rel); + my $attrs = $self->_chain_relationship($rel); + + my $join_count = $attrs->{seen_join}{$rel}; + + my $alias = $self->result_source->storage + ->relname_to_table_alias($rel, $join_count); + + # since this is search_related, and we already slid the select window inwards + # (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->_inner_join_to_node ($attrs->{from}, $alias); - my $join_count = $seen->{$rel}; - my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel); #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi - my %attrs = %{$self->{attrs}||{}}; - delete @attrs{qw(result_class alias)}; + delete @{$attrs}{qw(result_class alias)}; my $new_cache; @@ -2609,7 +2732,7 @@ sub related_resultset { } } - my $rel_source = $self->result_source->related_source($rel); + my $rel_source = $rsrc->related_source($rel); my $new = do { @@ -2619,20 +2742,14 @@ sub related_resultset { # to work sanely (e.g. RestrictWithObject wants to be able to add # extra query restrictions, and these may need to be $alias.) - my $attrs = $rel_source->resultset_attributes; - local $attrs->{alias} = $alias; + my $rel_attrs = $rel_source->resultset_attributes; + local $rel_attrs->{alias} = $alias; $rel_source->resultset ->search_rs( undef, { - %attrs, - join => undef, - prefetch => undef, - select => undef, - as => undef, - where => $self->{cond}, - seen_join => $seen, - from => $from, + %$attrs, + where => $attrs->{where}, }); }; $new->set_cache($new_cache) if $new_cache; @@ -2683,6 +2800,78 @@ sub current_source_alias { return ($self->{attrs} || {})->{alias} || 'me'; } +=head2 as_subselect_rs + +=over 4 + +=item Arguments: none + +=item Return Value: $resultset + +=back + +Act as a barrier to SQL symbols. The resultset provided will be made into a +"virtual view" by including it as a subquery within the from clause. From this +point on, any joined tables are inaccessible to ->search on the resultset (as if +it were simply where-filtered without joins). For example: + + my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' }); + + # 'x' now pollutes the query namespace + + # So the following works as expected + my $ok_rs = $rs->search({'x.other' => 1}); + + # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and + # def) we look for one row with contradictory terms and join in another table + # (aliased 'x_2') which we never use + my $broken_rs = $rs->search({'x.name' => 'def'}); + + my $rs2 = $rs->as_subselect_rs; + + # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away + my $not_joined_rs = $rs2->search({'x.other' => 1}); + + # works as expected: finds a 'table' row related to two x rows (abc and def) + my $correctly_joined_rs = $rs2->search({'x.name' => 'def'}); + +Another example of when one might use this would be to select a subset of +columns in a group by clause: + + my $rs = $schema->resultset('Bar')->search(undef, { + group_by => [qw{ id foo_id baz_id }], + })->as_subselect_rs->search(undef, { + columns => [qw{ id foo_id }] + }); + +In the above example normally columns would have to be equal to the group by, +but because we isolated the group by into a subselect the above works. + +=cut + +sub as_subselect_rs { + my $self = shift; + + my $attrs = $self->_resolved_attrs; + + my $fresh_rs = (ref $self)->new ( + $self->result_source + ); + + # these pieces will be locked in the subquery + delete $fresh_rs->{cond}; + delete @{$fresh_rs->{attrs}}{qw/where bind/}; + + return $fresh_rs->search( {}, { + from => [{ + $attrs->{alias} => $self->as_query, + -alias => $attrs->{alias}, + -source_handle => $self->result_source->handle, + }], + alias => $attrs->{alias}, + }); +} + # This code is called by search_related, and makes sure there # is clear separation between the joins before, during, and # after the relationship. This information is needed later @@ -2690,37 +2879,67 @@ sub current_source_alias { # with a relation_chain_depth less than the depth of the # current prefetch is not considered) # -# The increments happen in 1/2s to make it easier to correlate the -# join depth with the join path. An integer means a relationship -# specified via a search_related, whereas a fraction means an added -# join/prefetch via attributes +# The increments happen twice per join. An even number means a +# relationship specified via a search_related, whereas an odd +# number indicates a join/prefetch added via attributes +# +# Also this code will wrap the current resultset (the one we +# chain to) in a subselect IFF it contains limiting attributes sub _chain_relationship { my ($self, $rel) = @_; my $source = $self->result_source; - my $attrs = $self->{attrs}; + my $attrs = { %{$self->{attrs}||{}} }; - my $from = [ @{ - $attrs->{from} - || - [{ - -source_handle => $source->handle, - -alias => $attrs->{alias}, - $attrs->{alias} => $source->from, - }] - }]; + # we need to take the prefetch the attrs into account before we + # ->_resolve_join as otherwise they get lost - captainL + my $join = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} ); - my $seen = { %{$attrs->{seen_join} || {} } }; - my $jpath = ($attrs->{seen_join} && keys %{$attrs->{seen_join}}) - ? $from->[-1][0]{-join_path} - : []; + delete @{$attrs}{qw/join prefetch collapse group_by distinct select as columns +select +as +columns/}; + my $seen = { %{ (delete $attrs->{seen_join}) || {} } }; - # we need to take the prefetch the attrs into account before we - # ->_resolve_join as otherwise they get lost - captainL - my $merged = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} ); + my $from; + my @force_subq_attrs = qw/offset rows group_by having/; + + if ( + ($attrs->{from} && ref $attrs->{from} ne 'ARRAY') + || + $self->_has_resolved_attr (@force_subq_attrs) + ) { + # Nuke the prefetch (if any) before the new $rs attrs + # are resolved (prefetch is useless - we are wrapping + # a subquery anyway). + my $rs_copy = $self->search; + $rs_copy->{attrs}{join} = $self->_merge_attr ( + $rs_copy->{attrs}{join}, + delete $rs_copy->{attrs}{prefetch}, + ); + + $from = [{ + -source_handle => $source->handle, + -alias => $attrs->{alias}, + $attrs->{alias} => $rs_copy->as_query, + }]; + delete @{$attrs}{@force_subq_attrs, qw/where bind/}; + $seen->{-relation_chain_depth} = 0; + } + elsif ($attrs->{from}) { #shallow copy suffices + $from = [ @{$attrs->{from}} ]; + } + else { + $from = [{ + -source_handle => $source->handle, + -alias => $attrs->{alias}, + $attrs->{alias} => $source->from, + }]; + } + + my $jpath = ($seen->{-relation_chain_depth}) + ? $from->[-1][0]{-join_path} + : []; my @requested_joins = $source->_resolve_join( - $merged, + $join, $attrs->{alias}, $seen, $jpath, @@ -2728,7 +2947,7 @@ sub _chain_relationship { push @$from, @requested_joins; - $seen->{-relation_chain_depth} += 0.5; + $seen->{-relation_chain_depth}++; # if $self already had a join/prefetch specified on it, the requested # $rel might very well be already included. What we do in this case @@ -2736,26 +2955,16 @@ sub _chain_relationship { # the join in question so we could tell it *is* the search_related) my $already_joined; - # we consider the last one thus reverse for my $j (reverse @requested_joins) { - if ($rel eq $j->[0]{-join_path}[-1]) { - $j->[0]{-relation_chain_depth} += 0.5; + my ($last_j) = keys %{$j->[0]{-join_path}[-1]}; + if ($rel eq $last_j) { + $j->[0]{-relation_chain_depth}++; $already_joined++; last; } } -# alternative way to scan the entire chain - not backwards compatible -# for my $j (reverse @$from) { -# next unless ref $j eq 'ARRAY'; -# if ($j->[0]{-join_path} && $j->[0]{-join_path}[-1] eq $rel) { -# $j->[0]{-relation_chain_depth} += 0.5; -# $already_joined++; -# last; -# } -# } - unless ($already_joined) { push @$from, $source->_resolve_join( $rel, @@ -2765,9 +2974,9 @@ sub _chain_relationship { ); } - $seen->{-relation_chain_depth} += 0.5; + $seen->{-relation_chain_depth}++; - return ($from,$seen); + return {%$attrs, from => $from, seen_join => $seen}; } # too many times we have to do $attrs = { %{$self->_resolved_attrs} } @@ -2790,44 +2999,46 @@ sub _resolved_attrs { # build columns (as long as select isn't set) into a set of as/select hashes unless ( $attrs->{select} ) { - my @cols = ( ref($attrs->{columns}) eq 'ARRAY' ) - ? @{ delete $attrs->{columns}} - : ( - ( delete $attrs->{columns} ) - || - $source->storage->_order_select_columns( - $source, - [ $source->columns ], - ) - ) - ; + my @cols; + if ( ref $attrs->{columns} eq 'ARRAY' ) { + @cols = @{ delete $attrs->{columns}} + } elsif ( defined $attrs->{columns} ) { + @cols = delete $attrs->{columns} + } else { + @cols = $source->columns + } - @colbits = map { - ( ref($_) eq 'HASH' ) - ? $_ - : { - ( - /^\Q${alias}.\E(.+)$/ - ? "$1" - : "$_" - ) - => - ( - /\./ - ? "$_" - : "${alias}.$_" - ) - } - } @cols; + for (@cols) { + if ( ref $_ eq 'HASH' ) { + push @colbits, $_ + } else { + my $key = /^\Q${alias}.\E(.+)$/ + ? "$1" + : "$_"; + my $value = /\./ + ? "$_" + : "${alias}.$_"; + push @colbits, { $key => $value }; + } + } } # add the additional columns on - foreach ( 'include_columns', '+columns' ) { - push @colbits, map { - ( ref($_) eq 'HASH' ) - ? $_ - : { ( split( /\./, $_ ) )[-1] => ( /\./ ? $_ : "${alias}.$_" ) } - } ( ref($attrs->{$_}) eq 'ARRAY' ) ? @{ delete $attrs->{$_} } : delete $attrs->{$_} if ( $attrs->{$_} ); + foreach (qw{include_columns +columns}) { + if ( $attrs->{$_} ) { + my @list = ( ref($attrs->{$_}) eq 'ARRAY' ) + ? @{ delete $attrs->{$_} } + : delete $attrs->{$_}; + for (@list) { + if ( ref($_) eq 'HASH' ) { + push @colbits, $_ + } else { + my $key = ( split /\./, $_ )[-1]; + my $value = ( /\./ ? $_ : "$alias.$_" ); + push @colbits, { $key => $value }; + } + } + } } # start with initial select items @@ -2836,15 +3047,22 @@ sub _resolved_attrs { ( ref $attrs->{select} eq 'ARRAY' ) ? [ @{ $attrs->{select} } ] : [ $attrs->{select} ]; - $attrs->{as} = ( - $attrs->{as} - ? ( - ref $attrs->{as} eq 'ARRAY' - ? [ @{ $attrs->{as} } ] - : [ $attrs->{as} ] + + if ( $attrs->{as} ) { + $attrs->{as} = + ( + ref $attrs->{as} eq 'ARRAY' + ? [ @{ $attrs->{as} } ] + : [ $attrs->{as} ] ) - : [ map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{ $attrs->{select} } ] - ); + } else { + $attrs->{as} = [ map { + m/^\Q${alias}.\E(.+)$/ + ? $1 + : $_ + } @{ $attrs->{select} } + ] + } } else { @@ -2854,27 +3072,24 @@ sub _resolved_attrs { } # now add colbits to select/as - push( @{ $attrs->{select} }, map { values( %{$_} ) } @colbits ); - push( @{ $attrs->{as} }, map { keys( %{$_} ) } @colbits ); + push @{ $attrs->{select} }, map values %{$_}, @colbits; + push @{ $attrs->{as} }, map keys %{$_}, @colbits; - my $adds; - if ( $adds = delete $attrs->{'+select'} ) { + if ( my $adds = delete $attrs->{'+select'} ) { $adds = [$adds] unless ref $adds eq 'ARRAY'; - push( - @{ $attrs->{select} }, - map { /\./ || ref $_ ? $_ : "${alias}.$_" } @$adds - ); + push @{ $attrs->{select} }, + map { /\./ || ref $_ ? $_ : "$alias.$_" } @$adds; } - if ( $adds = delete $attrs->{'+as'} ) { + if ( my $adds = delete $attrs->{'+as'} ) { $adds = [$adds] unless ref $adds eq 'ARRAY'; - push( @{ $attrs->{as} }, @$adds ); + push @{ $attrs->{as} }, @$adds; } - $attrs->{from} ||= [ { + $attrs->{from} ||= [{ -source_handle => $source->handle, -alias => $self->{attrs}{alias}, $self->{attrs}{alias} => $source->from, - } ]; + }]; if ( $attrs->{join} || $attrs->{prefetch} ) { @@ -2894,7 +3109,7 @@ sub _resolved_attrs { $join, $alias, { %{ $attrs->{seen_join} || {} } }, - ($attrs->{seen_join} && keys %{$attrs->{seen_join}}) + ( $attrs->{seen_join} && keys %{$attrs->{seen_join}}) ? $attrs->{from}[-1][0]{-join_path} : [] , @@ -2921,7 +3136,34 @@ 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' } ... ] + for my $chunk ($storage->_parse_order_by($attrs->{order_by})) { + + # only consider real columns (for functions the user got to do an explicit group_by) + my $colinfo = $rs_column_list->{$chunk} + or next; + + $chunk = "$colinfo->{-source_alias}.$chunk" if $chunk !~ /\./; + push @$group_spec, $chunk unless $group_index{$chunk}++; + } } } @@ -2931,7 +3173,26 @@ sub _resolved_attrs { my $prefetch_ordering = []; - my $join_map = $self->_joinpath_aliases ($attrs->{from}, $attrs->{seen_join}); + # this is a separate structure (we don't look in {from} directly) + # as the resolver needs to shift things off the lists to work + # properly (identical-prefetches on different branches) + my $join_map = {}; + if (ref $attrs->{from} eq 'ARRAY') { + + my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0; + + for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) { + next unless $j->[0]{-alias}; + next unless $j->[0]{-join_path}; + next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth; + + my @jpath = map { keys %$_ } @{$j->[0]{-join_path}}; + + my $p = $join_map; + $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries + push @{$p->{-join_aliases} }, $j->[0]{-alias}; + } + } my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} ); @@ -2950,7 +3211,7 @@ sub _resolved_attrs { # even though it doesn't make much sense, this is what pre 081xx has # been doing if (my $page = delete $attrs->{page}) { - $attrs->{offset} = + $attrs->{offset} = ($attrs->{rows} * ($page - 1)) + ($attrs->{offset} || 0) @@ -2960,33 +3221,6 @@ sub _resolved_attrs { return $self->{_attrs} = $attrs; } -sub _joinpath_aliases { - my ($self, $fromspec, $seen) = @_; - - my $paths = {}; - return $paths unless ref $fromspec eq 'ARRAY'; - - my $cur_depth = $seen->{-relation_chain_depth} || 0; - - if (int ($cur_depth) != $cur_depth) { - $self->throw_exception ("-relation_chain_depth is not an integer, something went horribly wrong ($cur_depth)"); - } - - for my $j (@$fromspec) { - - next if ref $j ne 'ARRAY'; - next if ($j->[0]{-relation_chain_depth} || 0) < $cur_depth; - - my $jpath = $j->[0]{-join_path}; - - my $p = $paths; - $p = $p->{$_} ||= {} for @{$jpath}[$cur_depth .. $#$jpath]; - push @{$p->{-join_aliases} }, $j->[0]{-alias}; - } - - return $paths; -} - sub _rollout_attr { my ($self, $attr) = @_; @@ -3117,12 +3351,13 @@ See L for details. sub throw_exception { my $self=shift; + if (ref $self && $self->_source_handle->schema) { $self->_source_handle->schema->throw_exception(@_) - } else { - croak(@_); } - + else { + DBIx::Class::Exception->throw(@_); + } } # XXX: FIXME: Attributes docs need clearing up @@ -3144,7 +3379,7 @@ These are in no particular order: =back -Which column(s) to order the results by. +Which column(s) to order the results by. [The full list of suitable values is documented in L; the following is a summary of @@ -3182,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 @@ -3231,20 +3475,27 @@ names: select => [ 'name', { count => 'employeeid' }, - { sum => 'salary' } + { max => { length => 'name' }, -as => 'longest_name' } ] }); -When you use function/stored procedure names and do not supply an C -attribute, the column names returned are storage-dependent. E.g. MySQL would -return a column named C in the above example. + # Equivalent SQL + SELECT name, COUNT( employeeid ), MAX( LENGTH( name ) ) AS longest_name FROM employee + +B You will almost always need a corresponding L attribute when you +use L, to instruct DBIx::Class how to store the result of the column. +Also note that the L attribute has nothing to do with the SQL-side 'AS' +identifier aliasing. You can however alias a function, so you can use it in +e.g. an C clause. This is done via the C<-as> B but adds columns to the selection. +L but adds columns to the default selection, instead of specifying +an explicit list. =back @@ -3264,25 +3515,26 @@ Indicates additional column names for those added via L. See L. =back -Indicates column names for object inflation. That is, C -indicates the name that the column can be accessed as via the -C method (or via the object accessor, B). It has nothing to do with the SQL code C, -usually when C for details. $rs = $schema->resultset('Employee')->search(undef, { select => [ 'name', - { count => 'employeeid' } + { count => 'employeeid' }, + { max => { length => 'name' }, -as => 'longest_name' } ], - as => ['name', 'employee_count'], + as => [qw/ + name + employee_count + max_name_length + /], }); - my $employee = $rs->first(); # get the first Employee - If the object against which the search is performed already has an accessor matching a column name specified in C, the value can be retrieved using the accessor as normal: @@ -3297,16 +3549,6 @@ use C instead: You can create your own accessors if required - see L for details. -Please note: This will NOT insert an C into the SQL -statement produced, it is used for internal access only. Thus -attempting to use the accessor in an C clause or similar -will fail miserably. - -To get around this limitation, you can supply literal SQL to your -C