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

diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm
index dd9af06..4423b69 100644
--- a/lib/Maypole/Model/CDBI.pm
+++ b/lib/Maypole/Model/CDBI.pm
@@ -29,7 +29,7 @@ use Class::DBI::Plugin::RetrieveAll;
 use Class::DBI::Pager;
 
 use Lingua::EN::Inflect::Number qw(to_PL);
-
+use attributes ();
 
 ###############################################################################
 # Helper methods
@@ -301,29 +301,6 @@ sub adopt {
     }
 }
 
-=head2 is_public
-
-Should return true if a certain action is supported, or false otherwise.
-Defaults to checking if the sub has the C<:Exported> attribute.
-
-=cut
-
-sub is_public {
-    my ( $self, $action, $attrs ) = @_;
-	my $cv = $self->can($action);
-	warn "is_public failed . action is $action. self is $self" and return 0 unless $cv;
-	unless ($attrs) { 
-	  my @attrs = attributes::get($cv) || ();
-	  $attrs = join " ", @attrs;
-	}
-	do {
-	  warn "is_public failed .$action not exported" if Maypole->debug;
-	  return 0;
-	} unless $attrs =~ /\bExported\b/i;
-	return 1;
-}
-
-
 =head2 is_class
 
 Tell if action is a class method (See Maypole::Plugin::Menu)
@@ -333,7 +310,7 @@ Tell if action is a class method (See Maypole::Plugin::Menu)
 sub is_class {
 	my ( $self, $method, $attrs ) = @_;
 	die "Usage: method must be passed as first arg" unless $method;
-	$attrs = $self->method_attrs($method) unless ($attrs);
+	$attrs = join(' ',$self->method_attrs($method)) unless ($attrs);
 	return 1 if $attrs  =~ /\bClass\b/i;
 	return 1 if $method =~ /^list$/;  # default class actions
 	return 0;
@@ -348,20 +325,12 @@ Tell if action is a object method (See Maypole::Plugin::Menu)
 sub is_object {
 	my ( $self, $method, $attrs ) = @_;
 	die "Usage: method must be passed as first arg" unless $method;
-	$attrs = $self->method_attrs($method) unless ($attrs);
+	$attrs = join(' ',$self->method_attrs($method)) unless ($attrs);
 	return 1 if $attrs  =~ /\bObject\b/i;
 	return 1 if $method =~ /(^view$|^edit$|^delete$)/;  # default object actions
 	return 0;
 }
 
-# Get string of joined attributes for matching
-sub method_attrs {
-	my ($class, $method) = @_;
-	my $cv = $class->can($method);
-	return 0 unless $cv;
-	my @attrs = attributes::get($cv) || ();
-	return  join " ", @attrs;
-}
 
 =head2 related
 
@@ -402,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; 
@@ -426,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