X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI.pm;h=4423b69b63e2b5b2fad74158312b1d86e87da65b;hb=28823167d12d4cd1419cc6a58900c0fc5819e1af;hp=a5c65f65166c417f1171ee051e97768713ee188e;hpb=2e10fe80846e7911976d686cbc87a9b7d78da559;p=maypole.git

diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm
index a5c65f6..4423b69 100644
--- a/lib/Maypole/Model/CDBI.pm
+++ b/lib/Maypole/Model/CDBI.pm
@@ -371,17 +371,36 @@ sub related_class {
      }
  }
 
+=head2 related_meta
+
+  $class->related_meta($col);
+
+Given a column  associated with a relationship it will return the relatation
+ship type and the meta info for the relationship on the column.
+
+=cut
+
+sub related_meta {
+    my ($self,$r, $accssr) = @_;
+    $self->_croak("You forgot to put the place holder for 'r' or forgot the accssr parameter") unless $accssr;
+    my $class_meta = $self->meta_info;
+    if (my ($rel_type) = grep { defined $class_meta->{$_}->{$accssr} }
+        keys %$class_meta)
+    { return  $rel_type, $class_meta->{$rel_type}->{$accssr} };
+}
+
+
 =head2 isa_class
 
-Returns class of a column inherited by is_a, assumes something can be more than one thing (have * is_a rels)
+Returns class of a column inherited by is_a.
 
 =cut
 
+# Maybe put this in IsA?
 sub isa_class {
   my ($class, $col) = @_;
   $class->_croak( "Need a column for isa_class." ) unless $col;
   my $isaclass;
-  # class col is first found in is returned 
   my $isa = $class->meta_info("is_a") || {}; 
   foreach ( keys %$isa ) {
     $isaclass = $isa->{$_}->foreign_class; 
@@ -395,7 +414,8 @@ sub isa_class {
 Returns hash ref of classes for accessors.
 
 This is an attempt at a more efficient method than calling "related_class()"
-a bunch of times when you need it for many relations. 
+a bunch of times when you need it for many relations.
+It may be good to call at startup and store in a global config. 
 
 =cut