X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=c94476da2ac3aeab6b53e8a44a5bd5f16803e31b;hb=46a05fd450f4848c6dc5f1302001571a79f4728e;hp=7bb8c832c29cb3ed67505f6932887834a40842bf;hpb=d489cbe96de8888268f9a3bbaa8927dbee410b00;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 7bb8c83..c94476d 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -12,8 +12,6 @@ use Storable; use DBIx::Class::ResultSetColumn; use base qw/DBIx::Class/; -use Data::Dumper; $Data::Dumper::Indent = 1; - __PACKAGE__->load_components(qw/AccessorGroup/); __PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/); @@ -97,14 +95,24 @@ sub new { $attrs->{alias} ||= 'me'; - bless { + # XXXX + # Use a named hash here and bless afterwards to avoid a huge performance hit + # in perl 5.8.8-5+ FC5 and later, and possibly other distributions. + # + # See https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=196836 for more + # information. + my $self = { result_source => $source, result_class => $attrs->{result_class} || $source->result_class, cond => $attrs->{where}, count => undef, pager => undef, attrs => $attrs - }, $class; + }; + + bless $self, $class; + + return $self; } =head2 search @@ -131,6 +139,8 @@ call it as C. columns => [qw/name artistid/], }); +For a list of attributes that can be passed to C, see L. For more examples of using this function, see L. + =cut sub search { @@ -466,10 +476,11 @@ sub single { } } - unless ($self->_is_unique_query($attrs->{where})) { - carp "Query not guaranteed to return a single row" - . "; please declare your unique constraints or use search instead"; - } +# XXX: Disabled since it doesn't infer uniqueness in all cases +# unless ($self->_is_unique_query($attrs->{where})) { +# carp "Query not guaranteed to return a single row" +# . "; please declare your unique constraints or use search instead"; +# } my @data = $self->result_source->storage->select_single( $attrs->{from}, $attrs->{select}, @@ -768,6 +779,20 @@ sub _collapse_result { An accessor for the primary ResultSource object from which this ResultSet is derived. +=head2 result_class + +=over 4 + +=item Arguments: $result_class? + +=item Return Value: $result_class + +=back + +An accessor for the class to use when creating row objects. Defaults to +C<< result_source->result_class >> - which in most cases is the name of the +L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class. + =cut @@ -1419,38 +1444,43 @@ sub related_resultset { "' has no such relationship $rel") unless $rel_obj; - my ($from,$seen) = $self->search(undef, { join => $rel })->_resolve_from; + my ($from,$seen) = $self->_resolve_from($rel); - my $join_count = $self->{attrs}{seen_join}{$rel}; - my $alias = $join_count ? join('_', $rel, $join_count+1) : $rel; + my $join_count = $seen->{$rel}; + my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel); $self->result_source->schema->resultset($rel_obj->{class})->search_rs( undef, { + %{$self->{attrs}||{}}, + join => undef, + prefetch => undef, select => undef, as => undef, alias => $alias, where => $self->{cond}, seen_join => $seen, - _parent_from => $from, + from => $from, }); }; } sub _resolve_from { - my ($self) = @_; + my ($self, $extra_join) = @_; my $source = $self->result_source; my $attrs = $self->{attrs}; - my $from = $attrs->{_parent_from} + my $from = $attrs->{from} || [ { $attrs->{alias} => $source->from } ]; my $seen = { %{$attrs->{seen_join}||{}} }; - if ($attrs->{join}) { - push(@{$from}, - $source->resolve_join($attrs->{join}, $attrs->{alias}, $seen) - ); - } + my $join = ($attrs->{join} + ? [ $attrs->{join}, $extra_join ] + : $extra_join); + $from = [ + @$from, + ($join ? $source->resolve_join($join, $attrs->{alias}, $seen) : ()), + ]; return ($from,$seen); } @@ -1469,13 +1499,21 @@ sub _resolved_attrs { } elsif (!$attrs->{select}) { $attrs->{columns} = [ $source->columns ]; } - - $attrs->{select} ||= [ - map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}} - ]; - $attrs->{as} ||= [ - map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}} - ]; + + $attrs->{select} = + ($attrs->{select} + ? (ref $attrs->{select} eq 'ARRAY' + ? [ @{$attrs->{select}} ] + : [ $attrs->{select} ]) + : [ map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}} ] + ); + $attrs->{as} = + ($attrs->{as} + ? (ref $attrs->{as} eq 'ARRAY' + ? [ @{$attrs->{as}} ] + : [ $attrs->{as} ]) + : [ map { m/^\Q${alias}.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}} ] + ); my $adds; if ($adds = delete $attrs->{include_columns}) { @@ -1485,15 +1523,15 @@ sub _resolved_attrs { } if ($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 (my $adds = delete $attrs->{'+as'}) { $adds = [$adds] unless ref $adds eq 'ARRAY'; push(@{$attrs->{as}}, @$adds); } - $attrs->{from} ||= delete $attrs->{_parent_from} - || [ { 'me' => $source->from } ]; + $attrs->{from} ||= [ { 'me' => $source->from } ]; if (exists $attrs->{join} || exists $attrs->{prefetch}) { my $join = delete $attrs->{join} || {}; @@ -1504,25 +1542,31 @@ sub _resolved_attrs { ); } - push(@{$attrs->{from}}, - $source->resolve_join($join, $alias, { %{$attrs->{seen_join}||{}} }) - ); + $attrs->{from} = # have to copy here to avoid corrupting the original + [ + @{$attrs->{from}}, + $source->resolve_join($join, $alias, { %{$attrs->{seen_join}||{}} }) + ]; } $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct}; if ($attrs->{order_by}) { - $attrs->{order_by} = [ $attrs->{order_by} ] unless ref $attrs->{order_by}; + $attrs->{order_by} = (ref($attrs->{order_by}) eq 'ARRAY' + ? [ @{$attrs->{order_by}} ] + : [ $attrs->{order_by} ]); } else { - $attrs->{order_by} ||= []; + $attrs->{order_by} = []; } my $collapse = $attrs->{collapse} || {}; if (my $prefetch = delete $attrs->{prefetch}) { + $prefetch = $self->_merge_attr({}, $prefetch); my @pre_order; + my $seen = $attrs->{seen_join} || {}; foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) { # bring joins back to level of current class my @prefetch = $source->resolve_prefetch( - $p, $alias, { %{$attrs->{seen_join}||{}} }, \@pre_order, $collapse + $p, $alias, $seen, \@pre_order, $collapse ); push(@{$attrs->{select}}, map { $_->[0] } @prefetch); push(@{$attrs->{as}}, map { $_->[1] } @prefetch); @@ -1536,7 +1580,8 @@ sub _resolved_attrs { sub _merge_attr { my ($self, $a, $b) = @_; - return $b unless $a; + return $b unless defined($a); + return $a unless defined($b); if (ref $b eq 'HASH' && ref $a eq 'HASH') { foreach my $key (keys %{$b}) { @@ -1720,9 +1765,15 @@ 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 misrably. +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