Added ->relationships and ->relationship_info from castaway

diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index 3231ebf..ef56fb6 100644 (file)
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -123,6 +123,12 @@ Marcus Ramberg <mramberg@cpan.org>
 
 Paul Makepeace
 
+CL Kao
+
+Jess Robinson
+
+Marcus Ramberg
+
 =head1 LICENSE
 
 You may distribute this code under the same terms as Perl itself.

diff --git a/lib/DBIx/Class/CDBICompat/ImaDBI.pm b/lib/DBIx/Class/CDBICompat/ImaDBI.pm
index aff3713..2226ea7 100644 (file)
--- a/lib/DBIx/Class/CDBICompat/ImaDBI.pm
+++ b/lib/DBIx/Class/CDBICompat/ImaDBI.pm
@@ -32,12 +32,14 @@ __PACKAGE__->mk_classdata('_transform_sql_handlers' =>
         my ($from, $to) = split(/ /, $data);
         my ($from_class, $to_class) = @{$self->{_classes}}{$from, $to};
         my ($rel_obj) = grep { $_->{class} && $_->{class} eq $to_class }
-                          values %{ $from_class->_relationships };
+                          map { $from_class->relationship_info($_) }
+                            $from_class->relationships;
         unless ($rel_obj) {
           ($from, $to) = ($to, $from);
           ($from_class, $to_class) = ($to_class, $from_class);
           ($rel_obj) = grep { $_->{class} && $_->{class} eq $to_class }
-                         values %{ $from_class->_relationships };
+                          map { $from_class->relationship_info($_) }
+                            $from_class->relationships;
         }
         $self->throw( "No relationship to JOIN from ${from_class} to ${to_class}" )
           unless $rel_obj;

diff --git a/lib/DBIx/Class/Relationship.pm b/lib/DBIx/Class/Relationship.pm
index 3a68ee2..71c0004 100644 (file)
--- a/lib/DBIx/Class/Relationship.pm
+++ b/lib/DBIx/Class/Relationship.pm
@@ -15,6 +15,21 @@ __PACKAGE__->load_own_components(qw/
 
 __PACKAGE__->mk_classdata('_relationships', { } );
 
+sub relationships
+{
+    my $self = shift;
+
+    return keys %{$self->_relationships};
+}
+
+sub relationship_info
+{
+    my $self = shift;
+    my ($rel) = @_;
+
+    return $self->_relationships->{$rel};
+}
+
 =head1 NAME 
 
 DBIx::Class::Relationship - Inter-table relationships

diff --git a/lib/DBIx/Class/Relationship/Accessor.pm b/lib/DBIx/Class/Relationship/Accessor.pm
index f641351..ca902b3 100644 (file)
--- a/lib/DBIx/Class/Relationship/Accessor.pm
+++ b/lib/DBIx/Class/Relationship/Accessor.pm
@@ -6,7 +6,7 @@ use warnings;
 sub add_relationship {
   my ($class, $rel, @rest) = @_;
   my $ret = $class->next::method($rel => @rest);
-  my $rel_obj = $class->_relationships->{$rel};
+  my $rel_obj = $class->relationship_info($rel);
   if (my $acc_type = $rel_obj->{attrs}{accessor}) {
     $class->add_relationship_accessor($rel => $acc_type);
   }
@@ -33,7 +33,7 @@ sub add_relationship_accessor {
   } elsif ($acc_type eq 'filter') {
     $class->throw("No such column $rel to filter")
        unless $class->has_column($rel);
-    my $f_class = $class->_relationships->{$rel}{class};
+    my $f_class = $class->relationship_info($rel)->{class};
     $class->inflate_column($rel,
       { inflate => sub {
           my ($val, $self) = @_;

diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index f0e40e9..ce7555b 100644 (file)
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -102,12 +102,12 @@ sub _resolve_join {
     return map { $class->_resolve_join($_, $alias) } @$join;
   } elsif (ref $join eq 'HASH') {
     return map { $class->_resolve_join($_, $alias),
-                 $class->_relationships->{$_}{class}->_resolve_join($join->{$_}, $_) }
+                 $class->relationship_info($_)->{class}->_resolve_join($join->{$_}, $_) }
            keys %$join;
   } elsif (ref $join) {
     $class->throw("No idea how to resolve join reftype ".ref $join);
   } else {
-    my $rel_obj = $class->_relationships->{$join};
+    my $rel_obj = $class->relationship_info($join);
     $class->throw("No such relationship ${join}") unless $rel_obj;
     my $j_class = $rel_obj->{class};
     my %join = (_action => 'join',
@@ -207,7 +207,7 @@ sub search_related {
   if (@_ > 1 && ref $_[$#_] eq 'HASH') {
     $attrs = { %{ pop(@_) } };
   }
-  my $rel_obj = $self->_relationships->{$rel};
+  my $rel_obj = $self->relationship_info($rel);
   $self->throw( "No such relationship ${rel}" ) unless $rel_obj;
   $attrs = { %{$rel_obj->{attrs} || {}}, %{$attrs || {}} };
 
@@ -290,7 +290,7 @@ sub find_or_create_related {
 
 sub set_from_related {
   my ($self, $rel, $f_obj) = @_;
-  my $rel_obj = $self->_relationships->{$rel};
+  my $rel_obj = $self->relationship_info($rel);
   $self->throw( "No such relationship ${rel}" ) unless $rel_obj;
   my $cond = $rel_obj->{cond};
   $self->throw( "set_from_related can only handle a hash condition; the "

diff --git a/lib/DBIx/Class/Relationship/CascadeActions.pm b/lib/DBIx/Class/Relationship/CascadeActions.pm
index 0da3993..e1d1341 100644 (file)
--- a/lib/DBIx/Class/Relationship/CascadeActions.pm
+++ b/lib/DBIx/Class/Relationship/CascadeActions.pm
@@ -9,7 +9,7 @@ sub delete {
 
   my $ret = $self->next::method(@rest);
 
-  my %rels = %{ $self->_relationships };
+  my %rels = map { $_ => $self->relationship_info($_) } $self->relationships;
   my @cascade = grep { $rels{$_}{attrs}{cascade_delete} } keys %rels;
   foreach my $rel (@cascade) {
     $self->search_related($rel)->delete;
@@ -24,7 +24,7 @@ sub update {
 
   my $ret = $self->next::method(@rest);
 
-  my %rels = %{ $self->_relationships };
+  my %rels = map { $_ => $self->relationship_info($_) } $self->relationships;
   my @cascade = grep { $rels{$_}{attrs}{cascade_update} } keys %rels;
   foreach my $rel (@cascade) {
     $_->update for $self->$rel;

diff --git a/lib/DBIx/Class/Relationship/ProxyMethods.pm b/lib/DBIx/Class/Relationship/ProxyMethods.pm
index 0524288..7ac439b 100644 (file)
--- a/lib/DBIx/Class/Relationship/ProxyMethods.pm
+++ b/lib/DBIx/Class/Relationship/ProxyMethods.pm
@@ -8,7 +8,7 @@ use base qw/DBIx::Class/;
 sub add_relationship {
   my ($class, $rel, @rest) = @_;
   my $ret = $class->next::method($rel => @rest);
-  if (my $proxy_list = $class->_relationships->{$rel}->{attrs}{proxy}) {
+  if (my $proxy_list = $class->relationship_info($rel)->{attrs}{proxy}) {
     $class->proxy_to_related($rel,
               (ref $proxy_list ? @$proxy_list : $proxy_list));
   }

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 0c74273..3d514cc 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -67,7 +67,7 @@ sub new {
       unless $seen{$pre};
     my @pre = 
       map { "$pre.$_" }
-      $source->result_class->_relationships->{$pre}->{class}->columns;
+      $source->result_class->relationship_info($pre)->{class}->columns;
     push(@{$attrs->{select}}, @pre);
     push(@{$attrs->{as}}, @pre);
   }
@@ -177,7 +177,7 @@ sub find {
 
 sub search_related {
   my ($self, $rel, @rest) = @_;
-  my $rel_obj = $self->{source}->result_class->_relationships->{$rel};
+  my $rel_obj = $self->{source}->result_class->relationship_info($rel);
   $self->{source}->result_class->throw(
     "No such relationship ${rel} in search_related")
       unless $rel_obj;

diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index b33a3e9..b0df7df 100644 (file)
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -251,7 +251,8 @@ sub inflate_result {
                     ref $class || $class);
   my $schema;
   PRE: foreach my $pre (keys %{$prefetch||{}}) {
-    my $rel_obj = $class->_relationships->{$pre};
+    my $rel_obj = $class->relationship_info($pre);
+    die "Can't prefetch non-eistant relationship ${pre}" unless $rel_obj;
     $schema ||= $new->result_source->schema;
     my $pre_class = $schema->class($rel_obj->{class});
     my $fetched = $pre_class->inflate_result(@{$prefetch->{$pre}});