X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=171218bd72c5633980ebaf3fdec1615f4a03c4e1;hb=ed7ab0f4ce1a9118ea6285ee562ef003085a6b64;hp=4dc8e31ba5131747fcd4e06a8fc1385625aaf8c6;hpb=971beb942408fe56c2b5afcea159d9ab4db14a27;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 4dc8e31..171218b 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -8,6 +8,7 @@ use DBIx::Class::ResultSourceHandle; use DBIx::Class::Exception; use Carp::Clan qw/^DBIx::Class/; +use Try::Tiny; use base qw/DBIx::Class/; @@ -139,6 +140,13 @@ The column names given will be created as accessor methods on your L objects. You can change the name of the accessor by supplying an L in the column_info hash. +If a column name beginning with a plus sign ('+col1') is provided, the +attributes provided will be merged with any existing attributes for the +column, with the new attributes taking precedence in the case that an +attribute already exists. Using this without a hashref +(C<< $source->add_columns(qw/+col1 +col2/) >>) is legal, but useless -- +it does the same thing it would do without the plus. + The contents of the column_info are not set in stone. The following keys are currently recognised/used by DBIx::Class: @@ -250,9 +258,9 @@ sequence, if you do not use a trigger to get the nextval, you have to set the L value as well. Also set this for MSSQL columns with the 'uniqueidentifier' -L whose values you want to automatically -generate using C, unless they are a primary key in which case this will -be done anyway. +L whose values you want to +automatically generate using C, unless they are a primary key in which +case this will be done anyway. =item extra @@ -288,9 +296,17 @@ sub add_columns { my @added; my $columns = $self->_columns; while (my $col = shift @cols) { + my $column_info = {}; + if ($col =~ s/^\+//) { + $column_info = $self->column_info($col); + } + # If next entry is { ... } use that for the column info, if not # use an empty hashref - my $column_info = ref $cols[0] ? shift(@cols) : {}; + if (ref $cols[0]) { + my $new_info = shift(@cols); + %$column_info = (%$column_info, %$new_info); + } push(@added, $col) unless exists $columns->{$col}; $columns->{$col} = $column_info; } @@ -352,9 +368,11 @@ sub column_info { $self->{_columns_info_loaded}++; my $info = {}; my $lc_info = {}; - # eval for the case of storage without table - eval { $info = $self->storage->columns_info_for( $self->from ) }; - unless ($@) { + # try for the case of storage without table + my $caught; + try { $info = $self->storage->columns_info_for( $self->from ) } + catch { $caught = 1 }; + unless ($caught) { for my $realcol ( keys %{$info} ) { $lc_info->{lc $realcol} = $info->{$realcol}; } @@ -465,10 +483,11 @@ called after L. Additionally, defines a L named C. -The primary key columns are used by L to -retrieve automatically created values from the database. They are also -used as default joining columns when specifying relationships, see -L. +Note: you normally do want to define a primary key on your sources +B. +See +L +for more info. =cut @@ -503,6 +522,19 @@ sub primary_columns { return @{shift->_primaries||[]}; } +# a helper method that will automatically die with a descriptive message if +# no pk is defined on the source in question. For internal use to save +# on if @pks... boilerplate +sub _pri_cols { + my $self = shift; + my @pcols = $self->primary_columns + or $self->throw_exception (sprintf( + "Operation requires a primary key to be declared on '%s' via set_primary_key", + $self->source_name, + )); + return @pcols; +} + =head2 add_unique_constraint =over 4 @@ -1006,13 +1038,13 @@ sub add_relationship { } return unless $f_source; # Can't test rel without f_source - eval { $self->_resolve_join($rel, 'me', {}, []) }; - - if ($@) { # If the resolve failed, back out and re-throw the error + try { $self->_resolve_join($rel, 'me', {}, []) } + catch { + # If the resolve failed, back out and re-throw the error delete $rels{$rel}; # $self->_relationships(\%rels); - $self->throw_exception("Error creating relationship $rel: $@"); - } + $self->throw_exception("Error creating relationship $rel: $_"); + }; 1; } @@ -1188,12 +1220,6 @@ sub _compare_relationship_keys { return $found; } -sub resolve_join { - carp 'resolve_join is a private method, stop calling it'; - my $self = shift; - $self->_resolve_join (@_); -} - # Returns the {from} structure used to express JOIN conditions sub _resolve_join { my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_; @@ -1205,7 +1231,7 @@ sub _resolve_join { $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join') unless ref $jpath eq 'ARRAY'; - $jpath = [@$jpath]; + $jpath = [@$jpath]; # copy if (not defined $join) { return (); @@ -1222,18 +1248,20 @@ sub _resolve_join { for my $rel (keys %$join) { my $rel_info = $self->relationship_info($rel) - or $self->throw_exception("No such relationship ${rel}"); + or $self->throw_exception("No such relationship '$rel' on " . $self->source_name); my $force_left = $parent_force_left; $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left'; # the actual seen value will be incremented by the recursion - my $as = ($seen->{$rel} ? join ('_', $rel, $seen->{$rel} + 1) : $rel); + my $as = $self->storage->relname_to_table_alias( + $rel, ($seen->{$rel} && $seen->{$rel} + 1) + ); push @ret, ( $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left), $self->related_source($rel)->_resolve_join( - $join->{$rel}, $as, $seen, [@$jpath, $rel], $force_left + $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left ) ); } @@ -1245,10 +1273,12 @@ sub _resolve_join { } else { my $count = ++$seen->{$join}; - my $as = ($count > 1 ? "${join}_${count}" : $join); + my $as = $self->storage->relname_to_table_alias( + $join, ($count > 1 && $count) + ); my $rel_info = $self->relationship_info($join) - or $self->throw_exception("No such relationship ${join}"); + or $self->throw_exception("No such relationship $join on " . $self->source_name); my $rel_src = $self->related_source($join); return [ { $as => $rel_src->from, @@ -1257,7 +1287,12 @@ sub _resolve_join { ? 'left' : $rel_info->{attrs}{join_type} , - -join_path => [@$jpath, $join], + -join_path => [@$jpath, { $join => $as } ], + -is_single => ( + $rel_info->{attrs}{accessor} + && + List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/) + ), -alias => $as, -relation_chain_depth => $seen->{-relation_chain_depth} || 0, }, @@ -1334,13 +1369,13 @@ sub _resolve_condition { unless ($for->has_column_loaded($v)) { if ($for->in_storage) { $self->throw_exception(sprintf - "Unable to resolve relationship '%s' from '%s': column '%s' of object %s " - . 'not loaded from storage (or not passed to new() prior to insert()). ' - . 'Maybe you forgot to call ->discard_changes to get defaults from the db.', + "Unable to resolve relationship '%s' from object %s: column '%s' not " + . 'loaded from storage (or not passed to new() prior to insert()). You ' + . 'probably need to call ->discard_changes to get the server-side defaults ' + . 'from the database.', $as, - $for->result_source->source_name, - $v, $for, + $v, ); } return $UNRESOLVABLE_CONDITION; @@ -1368,83 +1403,11 @@ sub _resolve_condition { } } -# 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 ||= {}; - if( ref $pre eq 'ARRAY' ) { - return - map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) } - @$pre; - } - elsif( ref $pre eq 'HASH' ) { - my @ret = - map { - $self->resolve_prefetch($_, $alias, $seen, $order, $collapse), - $self->related_source($_)->resolve_prefetch( - $pre->{$_}, "${alias}.$_", $seen, $order, $collapse) - } keys %$pre; - return @ret; - } - elsif( ref $pre ) { - $self->throw_exception( - "don't know how to resolve prefetch reftype ".ref($pre)); - } - else { - my $count = ++$seen->{$pre}; - my $as = ($count > 1 ? "${pre}_${count}" : $pre); - 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.' - ); - } - #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 +# in the supplied relationships. sub _resolve_prefetch { my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_; @@ -1483,13 +1446,12 @@ sub _resolve_prefetch { my $as = shift @{$p->{-join_aliases}}; my $rel_info = $self->relationship_info( $pre ); - $self->throw_exception( $self->name . " has no such relationship '$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 (exists $rel_info->{attrs}{accessor} - && $rel_info->{attrs}{accessor} eq 'multi') { + 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'; @@ -1509,14 +1471,15 @@ sub _resolve_prefetch { } #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); } # values %{$rel_info->{cond}}; - $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ]; + $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}}; my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY' ? @{$rel_info->{attrs}{order_by}} - : (defined $rel_info->{attrs}{order_by} + + : (defined $rel_info->{attrs}{order_by} ? ($rel_info->{attrs}{order_by}) : ())); push(@$order, map { "${as}.$_" } (@key, @ord)); @@ -1544,7 +1507,7 @@ Returns the result source object for the given relationship. sub related_source { my ($self, $rel) = @_; if( !$self->has_relationship( $rel ) ) { - $self->throw_exception("No such relationship '$rel'"); + $self->throw_exception("No such relationship '$rel' on " . $self->source_name); } return $self->schema->source($self->relationship_info($rel)->{source}); } @@ -1566,7 +1529,7 @@ Returns the class name for objects in the given relationship. sub related_class { my ($self, $rel) = @_; if( !$self->has_relationship( $rel ) ) { - $self->throw_exception("No such relationship '$rel'"); + $self->throw_exception("No such relationship '$rel' on " . $self->source_name); } return $self->schema->class($self->relationship_info($rel)->{source}); } @@ -1579,7 +1542,7 @@ L. =cut sub handle { - return new DBIx::Class::ResultSourceHandle({ + return DBIx::Class::ResultSourceHandle->new({ schema => $_[0]->schema, source_moniker => $_[0]->source_name }); @@ -1634,7 +1597,7 @@ Creates a new ResultSource object. Not normally called directly by end users. __PACKAGE__->column_info_from_storage(1); Enables the on-demand automatic loading of the above column -metadata from storage as neccesary. This is *deprecated*, and +metadata from storage as necessary. This is *deprecated*, and should not be used. It will be removed before 1.0.