X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=2287bef26f223a0a546e5b3b10693414ac0498ec;hb=35ec03666abd9d13ef8d40444e25295f3a4441cc;hp=a72f54d2527bef5c0fb0d5fb22351a3c2c507596;hpb=880c075bf6651976e9799a6a2b35c0fcc94f232a;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index a72f54d..2287bef 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -29,6 +29,8 @@ DBIx::Class::ResultSource - Result source object A ResultSource is a component of a schema from which results can be directly retrieved, most usually a table (see L) +Basic view support also exists, see L<. + =head1 METHODS =pod @@ -72,7 +74,7 @@ the hashref as the column_info for that column. Repeated calls of this method will add more columns, not replace them. The column names given will be created as accessor methods on your -L objects, you can change the name of the accessor +L objects. You can change the name of the accessor by supplying an L in the column_info hash. The contents of the column_info are not set in stone. The following @@ -111,9 +113,21 @@ NULL values. This is currently only used by L. Set this to a true value for a column whose value is somehow automatically set. This is used to determine which columns to empty -when cloning objects using C. It is also used by +when cloning objects using L. It is also used by L. +=item is_numeric + +Set this to a true or false value (not C) to explicitly specify +if this column contains numeric data. This controls how set_column +decides whether to consider a column dirty after an update: if +C is true a numeric comparison C<< != >> will take place +instead of the usual C + +If not specified the storage class will attempt to figure this out on +first access to the column, based on the column C. The +result will be cached in this attribute. + =item is_foreign_key Set this to a true value for a column that contains a key from a @@ -123,8 +137,12 @@ L. =item default_value Set this to the default value which will be inserted into a column -by the database. Can contain either a value or a function. This is -currently only used by L. +by the database. Can contain either a value or a function (use a +reference to a scalar e.g. C<\'now()'> if you want a function). This +is currently only used by L. + +See the note on L for more information about possible +issues related to db-side default values. =item sequence @@ -136,7 +154,7 @@ automatically. =item auto_nextval Set this to a true value for a column whose value is retrieved -automatically from an oracle sequence. If you do not use an oracle +automatically from an oracle sequence. If you do not use an Oracle trigger to get the nextval, you have to set sequence as well. =item extra @@ -647,7 +665,7 @@ but is cached from then on unless resultset_class changes. $source->resultset_class('My::ResultSet::Class'); -Set the class of the resultset, this is useful if you want to create your +Set the class of the resultset. This is useful if you want to create your own resultset methods. Create your own class derived from L, and set it here. If called with no arguments, this method returns the name of the existing resultset class, if one @@ -835,7 +853,7 @@ relationship. =back Throws an exception if the condition is improperly supplied, or cannot -be resolved using L. +be resolved. =cut @@ -875,7 +893,7 @@ sub add_relationship { } return unless $f_source; # Can't test rel without f_source - eval { $self->resolve_join($rel, 'me') }; + eval { $self->_resolve_join($rel, 'me') }; if ($@) { # If the resolve failed, back out and re-throw the error delete $rels{$rel}; # @@ -1009,29 +1027,22 @@ sub reverse_relationship_info { my @other_cond = keys(%$othercond); my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond; my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond; - next if (!$self->compare_relationship_keys(\@refkeys, \@other_keys) || - !$self->compare_relationship_keys(\@other_refkeys, \@keys)); + next if (!$self->_compare_relationship_keys(\@refkeys, \@other_keys) || + !$self->_compare_relationship_keys(\@other_refkeys, \@keys)); $ret->{$otherrel} = $otherrel_info; } } return $ret; } -=head2 compare_relationship_keys - -=over 4 - -=item Arguments: \@keys1, \@keys2 - -=item Return value: 1/0 (true/false) - -=back - -Returns true if both sets of keynames are the same, false otherwise. - -=cut - sub compare_relationship_keys { + carp 'compare_relationship_keys is a private method, stop calling it'; + my $self = shift; + $self->_compare_relationship_keys (@_); +} + +# Returns true if both sets of keynames are the same, false otherwise. +sub _compare_relationship_keys { my ($self, $keys1, $keys2) = @_; # Make sure every keys1 is in keys2 @@ -1064,44 +1075,54 @@ sub compare_relationship_keys { return $found; } -=head2 resolve_join - -=over 4 - -=item Arguments: $relation +sub resolve_join { + carp 'resolve_join is a private method, stop calling it'; + my $self = shift; + $self->_resolve_join (@_); +} -=item Return value: Join condition arrayref +# Returns the {from} structure used to express JOIN conditions +sub _resolve_join { + my ($self, $join, $alias, $seen, $force_left, $jpath) = @_; -=back + # we need a supplied one, because we do in-place modifications, no returns + $self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join') + unless $seen; -Returns the join structure required for the related result source. + $force_left ||= { force => 0 }; -=cut + # This isn't quite right, we should actually dive into $seen and reconstruct + # the entire path (the reference entry point would be the join conditional + # with depth == current_depth - 1. At this point however nothing depends on + # having the entire path, transcending related_resultset, so just leave it + # as is, hairy enough already. + $jpath ||= []; -sub resolve_join { - my ($self, $join, $alias, $seen, $force_left) = @_; - $seen ||= {}; - $force_left ||= { force => 0 }; if (ref $join eq 'ARRAY') { - return map { $self->resolve_join($_, $alias, $seen) } @$join; + return + map { + local $force_left->{force} = $force_left->{force}; + $self->_resolve_join($_, $alias, $seen, $force_left, [@$jpath]); + } @$join; } elsif (ref $join eq 'HASH') { return map { - my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_); - local $force_left->{force}; + my $as = ($seen->{$_} ? join ('_', $_, $seen->{$_} + 1) : $_); # the actual seen value will be incremented below + local $force_left->{force} = $force_left->{force}; ( - $self->resolve_join($_, $alias, $seen, $force_left), - $self->related_source($_)->resolve_join( - $join->{$_}, $as, $seen, $force_left + $self->_resolve_join($_, $alias, $seen, $force_left, [@$jpath]), + $self->related_source($_)->_resolve_join( + $join->{$_}, $as, $seen, $force_left, [@$jpath, $_] ) ); } keys %$join; } elsif (ref $join) { $self->throw_exception("No idea how to resolve join reftype ".ref $join); } else { + my $count = ++$seen->{$join}; - #use Data::Dumper; warn Dumper($seen); my $as = ($count > 1 ? "${join}_${count}" : $join); + my $rel_info = $self->relationship_info($join); $self->throw_exception("No such relationship ${join}") unless $rel_info; my $type; @@ -1111,29 +1132,29 @@ sub resolve_join { $type = $rel_info->{attrs}{join_type} || ''; $force_left->{force} = 1 if lc($type) eq 'left'; } - return [ { $as => $self->related_source($join)->from, - -join_type => $type }, - $self->resolve_condition($rel_info->{cond}, $as, $alias) ]; + + my $rel_src = $self->related_source($join); + return [ { $as => $rel_src->from, + -source_handle => $rel_src->handle, + -join_type => $type, + -join_path => [@$jpath, $join], + -alias => $as, + -relation_chain_depth => $seen->{-relation_chain_depth} || 0, + }, + $self->_resolve_condition($rel_info->{cond}, $as, $alias) ]; } } -=head2 pk_depends_on - -=over 4 - -=item Arguments: $relname, $rel_data - -=item Return value: 1/0 (true/false) - -=back - -Determines whether a relation is dependent on an object from this source -having already been inserted. Takes the name of the relationship and a -hashref of columns of the related object. - -=cut - sub pk_depends_on { + carp 'pk_depends_on is a private method, stop calling it'; + my $self = shift; + $self->_pk_depends_on (@_); +} + +# Determines whether a relation is dependent on an object from this source +# having already been inserted. Takes the name of the relationship and a +# hashref of columns of the related object. +sub _pk_depends_on { my ($self, $relname, $rel_data) = @_; my $cond = $self->relationship_info($relname)->{cond}; @@ -1162,23 +1183,18 @@ sub pk_depends_on { return 1; } -=head2 resolve_condition - -=over 4 - -=item Arguments: $cond, $as, $alias|$object - -=back - -Resolves the passed condition to a concrete query fragment. If given an alias, -returns a join condition; if given an object, inverts that object to produce -a related conditional from that object. - -=cut +sub resolve_condition { + carp 'resolve_condition is a private method, stop calling it'; + my $self = shift; + $self->_resolve_condition (@_); +} +# Resolves the passed condition to a concrete query fragment. If given an alias, +# returns a join condition; if given an object, inverts that object to produce +# a related conditional from that object. our $UNRESOLVABLE_CONDITION = \'1 = 0'; -sub resolve_condition { +sub _resolve_condition { my ($self, $cond, $as, $for) = @_; #warn %$cond; if (ref $cond eq 'HASH') { @@ -1194,7 +1210,11 @@ sub resolve_condition { #warn "$self $k $for $v"; unless ($for->has_column_loaded($v)) { if ($for->in_storage) { - $self->throw_exception("Column ${v} not loaded on ${for} trying to resolve relationship"); + $self->throw_exception( + "Column ${v} not loaded or not passed to new() prior to insert()" + ." on ${for} trying to resolve relationship (maybe you forgot " + ."to call ->discard_changes to get defaults from the db)" + ); } return $UNRESOLVABLE_CONDITION; } @@ -1215,66 +1235,18 @@ sub resolve_condition { } return \%ret; } elsif (ref $cond eq 'ARRAY') { - return [ map { $self->resolve_condition($_, $as, $for) } @$cond ]; + return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ]; } else { die("Can't handle this yet :("); } } -=head2 resolve_prefetch - -=over 4 - -=item Arguments: hashref/arrayref/scalar - -=back - -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. Examples: - - my $source = $schema->resultset('Tag')->source; - @columns = $source->resolve_prefetch( { cd => 'artist' } ); - - # @columns = - #( - # 'cd.cdid', - # 'cd.artist', - # 'cd.title', - # 'cd.year', - # 'cd.artist.artistid', - # 'cd.artist.name' - #) - - @columns = $source->resolve_prefetch( qw[/ cd /] ); - - # @columns = - #( - # 'cd.cdid', - # 'cd.artist', - # 'cd.title', - # 'cd.year' - #) - - $source = $schema->resultset('CD')->source; - @columns = $source->resolve_prefetch( qw[/ artist producer /] ); - - # @columns = - #( - # 'artist.artistid', - # 'artist.name', - # 'producer.producerid', - # 'producer.name' - #) - -=cut - +# Legacy code, needs to go entirely away (fully replaced by _resolve_prefetch) sub resolve_prefetch { + carp 'resolve_prefetch is a private method, stop calling it'; + my ($self, $pre, $alias, $seen, $order, $collapse) = @_; $seen ||= {}; - #$alias ||= $self->name; - #warn $alias, Dumper $pre; if( ref $pre eq 'ARRAY' ) { return map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) } @@ -1287,7 +1259,6 @@ sub resolve_prefetch { $self->related_source($_)->resolve_prefetch( $pre->{$_}, "${alias}.$_", $seen, $order, $collapse) } keys %$pre; - #die Dumper \@ret; return @ret; } elsif( ref $pre ) { @@ -1318,8 +1289,92 @@ sub resolve_prefetch { ? "at the same level (${as_prefix}) " : "at top level " ) - . 'will currently disrupt both the functionality of $rs->count(), ' - . 'and the amount of objects retrievable via $rs->next(). ' + . '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->primary_columns ]; + # action at a distance. prepending the '.' allows simpler code + # in ResultSet->_collapse_result + my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); } + keys %{$rel_info->{cond}}; + my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY' + ? @{$rel_info->{attrs}{order_by}} + : (defined $rel_info->{attrs}{order_by} + ? ($rel_info->{attrs}{order_by}) + : ())); + push(@$order, map { "${as}.$_" } (@key, @ord)); + } + + return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] } + $rel_source->columns; + } +} + +# 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. Needs an alias_map generated by +# $rs->_joinpath_aliases + +sub _resolve_prefetch { + my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_; + $pref_path ||= []; + + if( 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->name . " has no such relationship '$pre'" ) + unless $rel_info; + my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : ''); + my $rel_source = $self->related_source($pre); + + if (exists $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.' ); } @@ -1340,8 +1395,6 @@ sub resolve_prefetch { return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] } $rel_source->columns; - #warn $alias, Dumper (\@ret); - #return @ret; } }