X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=28f931f9ffc1a95a587642a07e96777ccc6974e2;hb=f8d97a01cf029a4c59196b89a2472b86de7cf91f;hp=b4dbfd36aca3c18a9e8f5f4ff24f08685f23eb80;hpb=b3e8ac9b6c2b4b611b3f34f4024f64f352d8e9fa;p=dbsrgits%2FDBIx-Class-Historic.git

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index b4dbfd3..28f931f 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -4,8 +4,7 @@ use strict;
 use warnings;
 
 use DBIx::Class::ResultSet;
-
-use Carp qw/croak/;
+use Carp::Clan qw/^DBIx::Class/;
 
 use Storable;
 
@@ -13,7 +12,8 @@ use base qw/DBIx::Class/;
 __PACKAGE__->load_components(qw/AccessorGroup/);
 
 __PACKAGE__->mk_group_accessors('simple' =>
-  qw/_ordered_columns _columns _primaries _unique_constraints name resultset_class result_class schema from _relationships/);
+  qw/_ordered_columns _columns _primaries _unique_constraints name resultset_attributes schema from _relationships/);
+__PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class result_class/);
 
 =head1 NAME 
 
@@ -35,13 +35,32 @@ sub new {
   $class = ref $class if ref $class;
   my $new = bless({ %{$attrs || {}} }, $class);
   $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
+  $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
   $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
   $new->{_columns} = { %{$new->{_columns}||{}} };
   $new->{_relationships} = { %{$new->{_relationships}||{}} };
   $new->{name} ||= "!!NAME NOT SET!!";
+  $new->{_columns_info_loaded} ||= 0;
   return $new;
 }
 
+=head2 add_columns
+
+  $table->add_columns(qw/col1 col2 col3/);
+
+  $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
+
+Adds columns to the result source. If supplied key => hashref pairs uses
+the hashref as the column_info for that column.
+
+=head2 add_column
+
+  $table->add_column('col' => \%info?);
+
+Convenience alias to add_columns
+
+=cut
+
 sub add_columns {
   my ($self, @cols) = @_;
   $self->_ordered_columns( \@cols )
@@ -64,28 +83,6 @@ sub add_columns {
 
 *add_column = \&add_columns;
 
-=head2 add_columns
-
-  $table->add_columns(qw/col1 col2 col3/);
-
-  $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
-
-Adds columns to the result source. If supplied key => hashref pairs uses
-the hashref as the column_info for that column.
-
-=head2 add_column
-
-  $table->add_column('col' => \%info?);
-
-Convenience alias to add_columns
-
-=cut
-
-sub resultset {
-  my $self = shift;
-  return $self->resultset_class->new($self);
-}
-
 =head2 has_column
 
   if ($obj->has_column($col)) { ... }                                           
@@ -109,9 +106,13 @@ Returns the column metadata hashref for a column.
 
 sub column_info {
   my ($self, $column) = @_;
-  croak "No such column $column" unless exists $self->_columns->{$column};
-  if ( (! $self->_columns->{$column}->{data_type})
+  $self->throw_exception("No such column $column") 
+    unless exists $self->_columns->{$column};
+  #warn $self->{_columns_info_loaded}, "\n";
+  if ( ! $self->_columns->{$column}->{data_type} 
+       && ! $self->{_columns_info_loaded} 
        && $self->schema && $self->storage() ){
+      $self->{_columns_info_loaded}++;
       my $info;
 ############ eval for the case of storage without table 
       eval{
@@ -137,8 +138,9 @@ Returns all column names in the order they were declared to add_columns
 =cut
 
 sub columns {
-  croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
-  return @{shift->{_ordered_columns}||[]};
+  my $self=shift;
+  $self->throw_exception("columns() is a read-only accessor, did you mean add_columns()?") if (@_ > 1);
+  return @{$self->{_ordered_columns}||[]};
 }
 
 =head2 set_primary_key(@cols)
@@ -154,7 +156,7 @@ sub set_primary_key {
   my ($self, @cols) = @_;
   # check if primary key columns are valid columns
   for (@cols) {
-    $self->throw("No such column $_ on table ".$self->name)
+    $self->throw_exception("No such column $_ on table ".$self->name)
       unless $self->has_column($_);
   }
   $self->_primaries(\@cols);
@@ -186,7 +188,7 @@ sub add_unique_constraint {
   my ($self, $name, $cols) = @_;
 
   for (@$cols) {
-    $self->throw("No such column $_ on table ".$self->name)
+    $self->throw_exception("No such column $_ on table ".$self->name)
       unless $self->has_column($_);
   }
 
@@ -256,7 +258,7 @@ command immediately before C<JOIN>.
 An arrayref containing a list of accessors in the foreign class to proxy in     
 the main class. If, for example, you do the following:                          
                                                                                 
-  __PACKAGE__->might_have(bar => 'Bar', undef, { proxy => qw[/ margle /] });    
+  __PACKAGE__->might_have(bar => 'Bar', undef, { proxy => [ qw/margle/ ] });    
                                                                                 
 Then, assuming Bar has an accessor named margle, you can do:                    
                                                                                 
@@ -278,7 +280,7 @@ created, which calls C<create_related> for the relationship.
 
 sub add_relationship {
   my ($self, $rel, $f_source_name, $cond, $attrs) = @_;
-  croak "Can't create relationship without join condition" unless $cond;
+  $self->throw_exception("Can't create relationship without join condition") unless $cond;
   $attrs ||= {};
 
   my %rels = %{ $self->_relationships };
@@ -311,7 +313,7 @@ sub add_relationship {
   if ($@) { # If the resolve failed, back out and re-throw the error
     delete $rels{$rel}; # 
     $self->_relationships(\%rels);
-    croak "Error creating relationship $rel: $@";
+    $self->throw_exception("Error creating relationship $rel: $@");
   }
   1;
 }
@@ -355,26 +357,33 @@ Returns the join structure required for the related result source
 =cut
 
 sub resolve_join {
-  my ($self, $join, $alias) = @_;
+  my ($self, $join, $alias, $seen) = @_;
+  $seen ||= {};
   if (ref $join eq 'ARRAY') {
-    return map { $self->resolve_join($_, $alias) } @$join;
+    return map { $self->resolve_join($_, $alias, $seen) } @$join;
   } elsif (ref $join eq 'HASH') {
-    return map { $self->resolve_join($_, $alias),
-                 $self->related_source($_)->resolve_join($join->{$_}, $_) }
-           keys %$join;
+    return
+      map {
+        my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
+        ($self->resolve_join($_, $alias, $seen),
+          $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
+      } keys %$join;
   } elsif (ref $join) {
-    croak ("No idea how to resolve join reftype ".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);
-    croak("No such relationship ${join}") unless $rel_info;
+    $self->throw_exception("No such relationship ${join}") unless $rel_info;
     my $type = $rel_info->{attrs}{join_type} || '';
-    return [ { $join => $self->related_source($join)->from,
+    return [ { $as => $self->related_source($join)->from,
                -join_type => $type },
-             $self->resolve_condition($rel_info->{cond}, $join, $alias) ];
+             $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
   }
 }
 
-=head2 resolve_condition($cond, $rel, $alias|$object)
+=head2 resolve_condition($cond, $as, $alias|$object)
 
 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
@@ -383,25 +392,25 @@ a related conditional from that object.
 =cut
 
 sub resolve_condition {
-  my ($self, $cond, $rel, $for) = @_;
+  my ($self, $cond, $as, $for) = @_;
   #warn %$cond;
   if (ref $cond eq 'HASH') {
     my %ret;
     while (my ($k, $v) = each %{$cond}) {
       # XXX should probably check these are valid columns
-      $k =~ s/^foreign\.// || croak "Invalid rel cond key ${k}";
-      $v =~ s/^self\.// || croak "Invalid rel cond val ${v}";
+      $k =~ s/^foreign\.// || $self->throw_exception("Invalid rel cond key ${k}");
+      $v =~ s/^self\.// || $self->throw_exception("Invalid rel cond val ${v}");
       if (ref $for) { # Object
         #warn "$self $k $for $v";
         $ret{$k} = $for->get_column($v);
         #warn %ret;
       } else {
-        $ret{"${rel}.${k}"} = "${for}.${v}";
+        $ret{"${as}.${k}"} = "${for}.${v}";
       }
     }
     return \%ret;
   } elsif (ref $cond eq 'ARRAY') {
-    return [ map { $self->resolve_condition($_, $rel, $for) } @$cond ];
+    return [ map { $self->resolve_condition($_, $as, $for) } @$cond ];
   } else {
    die("Can't handle this yet :(");
   }
@@ -414,7 +423,7 @@ 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;
+  my $source = $schema->resultset('Tag')->source;
   @columns = $source->resolve_prefetch( { cd => 'artist' } );
 
   # @columns =
@@ -451,33 +460,37 @@ in the supplied relationships. Examples:
 =cut
 
 sub resolve_prefetch {
-  my( $self, $pre, $alias ) = @_;
+  my ($self, $pre, $alias, $seen) = @_;
+  $seen ||= {};
   use Data::Dumper;
   #$alias ||= $self->name;
   #warn $alias, Dumper $pre;
   if( ref $pre eq 'ARRAY' ) {
-    return map { $self->resolve_prefetch( $_, $alias ) } @$pre;
+    return map { $self->resolve_prefetch( $_, $alias, $seen ) } @$pre;
   }
   elsif( ref $pre eq 'HASH' ) {
     my @ret =
     map {
-      $self->resolve_prefetch($_, $alias),
-      $self->related_source($_)->resolve_prefetch( $pre->{$_}, $_ )
-    }
-    keys %$pre;
+      $self->resolve_prefetch($_, $alias, $seen),
+      $self->related_source($_)->resolve_prefetch(
+                                   $pre->{$_}, "${alias}.$_", $seen)
+        } keys %$pre;
     #die Dumper \@ret;
     return @ret;
   }
   elsif( ref $pre ) {
-    croak( "don't know how to resolve prefetch reftype " . 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 );
-    croak( $self->name . " has no such relationship '$pre'" ) unless $rel_info;
-    my $prefix = $alias && $alias ne 'me' ? "$alias.$pre" : $pre;
-    my @ret = map { "$prefix.$_" } $self->related_source($pre)->columns;
+    $self->throw_exception( $self->name . " has no such relationship '$pre'" ) unless $rel_info;
+    my $as_prefix = ($alias =~ /^.*?\.(.*)$/ ? $1.'.' : '');
+    return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
+      $self->related_source($pre)->columns;
     #warn $alias, Dumper (\@ret);
-    return @ret;
+    #return @ret;
   }
 }
 
@@ -490,12 +503,47 @@ Returns the result source for the given relationship
 sub related_source {
   my ($self, $rel) = @_;
   if( !$self->has_relationship( $rel ) ) {
-    croak "No such relationship '$rel'";
+    $self->throw_exception("No such relationship '$rel'");
   }
   return $self->schema->source($self->relationship_info($rel)->{source});
 }
 
-1;
+=head2 resultset
+
+Returns a resultset for the given source created by calling
+
+$self->resultset_class->new($self, $self->resultset_attributes)
+
+=head2 resultset_class
+
+Simple accessor.
+
+=head2 resultset_attributes
+
+Simple accessor.
+
+=cut
+
+sub resultset {
+  my $self = shift;
+  return $self->resultset_class->new($self, $self->{resultset_attributes});
+}
+
+=head2 throw_exception
+
+See schema's throw_exception
+
+=cut
+
+sub throw_exception {
+  my $self = shift;
+  if (defined $self->schema) { 
+    $self->schema->throw_exception(@_);
+  } else {
+    croak(@_);
+  }
+}
+
 
 =head1 AUTHORS