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=789aeda641224c975273eec476eb37275287c2c5;hpb=aea52c85cb46edd8f8fea4fe01f169fcba814c33;p=dbsrgits%2FDBIx-Class-Historic.git

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 789aeda..28f931f 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -4,14 +4,16 @@ use strict;
 use warnings;
 
 use DBIx::Class::ResultSet;
+use Carp::Clan qw/^DBIx::Class/;
 
-use Carp qw/croak/;
+use Storable;
 
 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 
 
@@ -33,13 +35,32 @@ sub new {
   $class = ref $class if ref $class;
   my $new = bless({ %{$attrs || {}} }, $class);
   $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
-  $new->{_ordered_columns} ||= [];
-  $new->{_columns} ||= {};
-  $new->{_relationships} ||= {};
+  $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 )
@@ -62,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)) { ... }                                           
@@ -107,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{
@@ -135,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)
@@ -152,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);
@@ -184,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($_);
   }
 
@@ -254,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:                    
                                                                                 
@@ -276,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 };
@@ -309,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;
 }
@@ -353,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
@@ -381,30 +392,107 @@ 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 :(");
   }
 }
 
+=head2 resolve_prefetch (hashref/arrayref/scalar)
+ 
+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
+
+sub resolve_prefetch {
+  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, $seen ) } @$pre;
+  }
+  elsif( ref $pre eq 'HASH' ) {
+    my @ret =
+    map {
+      $self->resolve_prefetch($_, $alias, $seen),
+      $self->related_source($_)->resolve_prefetch(
+                                   $pre->{$_}, "${alias}.$_", $seen)
+        } keys %$pre;
+    #die Dumper \@ret;
+    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.'.' : '');
+    return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
+      $self->related_source($pre)->columns;
+    #warn $alias, Dumper (\@ret);
+    #return @ret;
+  }
+}
 
 =head2 related_source($relname)
 
@@ -415,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