X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=ebe2ff1af6cc9bd1fed162d2a11e7b42bb8a20a4;hb=455a33cbbf34ec2e40402dbd5cd88c1f92ebac17;hp=9d22175412310a6a22c4ce73218e36d1bc0d7285;hpb=b82c8a28bb4cb7d704496b8ce3966565d255d5b3;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 9d22175..ebe2ff1 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -139,6 +139,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 +257,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 +295,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; } @@ -465,10 +480,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 +519,16 @@ sub primary_columns { return @{shift->_primaries||[]}; } +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 @@ -1188,12 +1214,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) = @_; @@ -1222,7 +1242,7 @@ 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'; @@ -1252,7 +1272,7 @@ sub _resolve_join { ); 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, @@ -1377,77 +1397,6 @@ 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 @@ -1491,7 +1440,7 @@ 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); @@ -1552,7 +1501,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}); } @@ -1574,7 +1523,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}); } @@ -1642,7 +1591,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.