X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=492720cbbc227803a37b31eb3379c2328e11580b;hb=fd323bf1046faa7de5a8c985268d80ec5b703361;hp=4b6ec4588902dea6d4f51fb112f3cc6a41c1c0a9;hpb=2e4ec773b3ab085e8813c15df03d9b4c1f4bf3dc;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 4b6ec45..492720c 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -8,6 +8,8 @@ use DBIx::Class::ResultSourceHandle; use DBIx::Class::Exception; use Carp::Clan qw/^DBIx::Class/; +use Try::Tiny; +use namespace::clean; use base qw/DBIx::Class/; @@ -139,6 +141,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: @@ -167,7 +176,7 @@ the name of the column will be used. This contains the column type. It is automatically filled if you use the L producer, or the -L module. +L module. Currently there is no standard set of values for the data_type. Use whatever your database supports. @@ -250,9 +259,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 +297,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 +369,10 @@ 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 + try { + $info = $self->storage->columns_info_for( $self->from ); for my $realcol ( keys %{$info} ) { $lc_info->{lc $realcol} = $info->{$realcol}; } @@ -364,7 +382,7 @@ sub column_info { %{ $info->{$col} || $lc_info->{lc $col} || {} } }; } - } + }; } return $self->_columns->{$column}; } @@ -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,12 +522,15 @@ 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', - ref $self, + "Operation requires a primary key to be declared on '%s' via set_primary_key", + $self->source_name, )); return @pcols; } @@ -878,7 +900,7 @@ clause contents. my $schema = $source->schema(); -Returns the L object that this result source +Returns the L object that this result source belongs to. =head2 storage @@ -1003,7 +1025,7 @@ sub add_relationship { return $self; - # XXX disabled. doesn't work properly currently. skip in tests. +# XXX disabled. doesn't work properly currently. skip in tests. my $f_source = $self->schema->source($f_source_name); unless ($f_source) { @@ -1016,13 +1038,14 @@ 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 - delete $rels{$rel}; # + 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; } @@ -1226,7 +1249,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'; @@ -1256,7 +1279,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, @@ -1424,7 +1447,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); @@ -1449,14 +1472,14 @@ 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} ? ($rel_info->{attrs}{order_by}) : ())); @@ -1485,7 +1508,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}); } @@ -1507,14 +1530,14 @@ 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}); } =head2 handle -Obtain a new handle to this source. Returns an instance of a +Obtain a new handle to this source. Returns an instance of a L. =cut