X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=d33a74d58e65657e96a128014dc37c93fcf5235b;hb=b7ddb46dbf77846e735fc491e04b0db4337fe5c0;hp=fe82facd4d18b878979f333115ff19be3a0a38b0;hpb=6bf7e59400fd71ec3d3e27155b354ee2369e49c4;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index fe82fac..d33a74d 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -3,18 +3,18 @@ package DBIx::Class::ResultSource; use strict; use warnings; +use base qw/DBIx::Class::ResultSource::RowParser DBIx::Class/; + use DBIx::Class::ResultSet; use DBIx::Class::ResultSourceHandle; -use DBIx::Class::Exception; use DBIx::Class::Carp; use Devel::GlobalDestruction; use Try::Tiny; use List::Util 'first'; use Scalar::Util qw/blessed weaken isweak/; -use namespace::clean; -use base qw/DBIx::Class/; +use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/ source_name name source_info @@ -1367,8 +1367,8 @@ name. The keys/values are as specified for L_relationships->{$rel}; + #my ($self, $rel) = @_; + return shift->_relationships->{+shift}; } =head2 has_relationship @@ -1386,8 +1386,8 @@ Returns true if the source has a relationship of this name, false otherwise. =cut sub has_relationship { - my ($self, $rel) = @_; - return exists $self->_relationships->{$rel}; + #my ($self, $rel) = @_; + return exists shift->_relationships->{+shift}; } =head2 reverse_relationship_info @@ -1595,12 +1595,12 @@ sub _resolve_join { , -join_path => [@$jpath, { $join => $as } ], -is_single => ( - $rel_info->{attrs}{accessor} - && + (! $rel_info->{attrs}{accessor}) + or first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/) ), -alias => $as, - -relation_chain_depth => $seen->{-relation_chain_depth} || 0, + -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1, }, scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join) ]; @@ -1797,113 +1797,6 @@ sub _resolve_condition { } } -# Accepts one or more relationships for the current source and returns an -# array of column names for each of those relationships. Column names are -# prefixed relative to the current source, in accordance with where they appear -# in the supplied relationships. -sub _resolve_prefetch { - my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_; - $pref_path ||= []; - - if (not defined $pre or not length $pre) { - return (); - } - elsif( ref $pre eq 'ARRAY' ) { - return - map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) } - @$pre; - } - elsif( ref $pre eq 'HASH' ) { - my @ret = - map { - $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ), - $self->related_source($_)->_resolve_prefetch( - $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] ) - } keys %$pre; - return @ret; - } - elsif( ref $pre ) { - $self->throw_exception( - "don't know how to resolve prefetch reftype ".ref($pre)); - } - else { - my $p = $alias_map; - $p = $p->{$_} for (@$pref_path, $pre); - - $self->throw_exception ( - "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: " - . join (' -> ', @$pref_path, $pre) - ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} ); - - my $as = shift @{$p->{-join_aliases}}; - - my $rel_info = $self->relationship_info( $pre ); - $self->throw_exception( $self->source_name . " has no such relationship '$pre'" ) - unless $rel_info; - my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : ''); - my $rel_source = $self->related_source($pre); - - if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') { - $self->throw_exception( - "Can't prefetch has_many ${pre} (join cond too complex)") - unless ref($rel_info->{cond}) eq 'HASH'; - my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}" - - if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots } - keys %{$collapse}) { - my ($last) = ($fail =~ /([^\.]+)$/); - carp ( - "Prefetching multiple has_many rels ${last} and ${pre} " - .(length($as_prefix) - ? "at the same level (${as_prefix}) " - : "at top level " - ) - . 'will explode the number of row objects retrievable via ->next or ->all. ' - . 'Use at your own risk.' - ); - } - - #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); } - # values %{$rel_info->{cond}}; - $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ]; - # action at a distance. prepending the '.' allows simpler code - # in ResultSet->_collapse_result - my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); } - keys %{$rel_info->{cond}}; - push @$order, map { "${as}.$_" } @key; - - if (my $rel_order = $rel_info->{attrs}{order_by}) { - # this is kludgy and incomplete, I am well aware - # but the parent method is going away entirely anyway - # so sod it - my $sql_maker = $self->storage->sql_maker; - my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars; - my $sep = $sql_maker->name_sep; - - # install our own quoter, so we can catch unqualified stuff - local $sql_maker->{quote_char} = ["\x00", "\xFF"]; - - my $quoted_prefix = "\x00${as}\xFF"; - - for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) { - my @bind; - ($chunk, @bind) = @$chunk if ref $chunk; - - $chunk = "${quoted_prefix}${sep}${chunk}" - unless $chunk =~ /\Q$sep/; - - $chunk =~ s/\x00/$orig_ql/g; - $chunk =~ s/\xFF/$orig_qr/g; - push @$order, \[$chunk, @bind]; - } - } - } - - return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] } - $rel_source->columns; - } -} - =head2 related_source =over 4