+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)
+
+=cut
+
+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);
+ return 1 if $attrs =~ /\bClass\b/i;
+ return 1 if $method =~ /^list$/; # default class actions
+ return 0;
+}
+
+=head2 is_object
+
+Tell if action is a object method (See Maypole::Plugin::Menu)
+
+=cut
+
+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);
+ 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
+
+This method returns a list of has-many accessors. A brewery has many
+beers, so C<BeerDB::Brewery> needs to return C<beers>.
+
+=cut
+
+sub related {
+ my ( $self, $r ) = @_;
+ return keys %{ $self->meta_info('has_many') || {} };
+}
+
+
+=head2 related_class
+
+Given an accessor name as a method, this function returns the class this accessor returns.
+
+=cut
+
+sub related_class {
+ my ( $self, $r, $accessor ) = @_;
+ my $meta = $self->meta_info;
+ my @rels = keys %$meta;
+ my $related;
+ foreach (@rels) {
+ $related = $meta->{$_}{$accessor};
+ last if $related;
+ }
+ return unless $related;
+
+ my $mapping = $related->{args}->{mapping};
+ if ( $mapping and @$mapping ) {
+ return $related->{foreign_class}->meta_info('has_a')->{$$mapping[0]}->{foreign_class};
+ }
+ else {
+ return $related->{foreign_class};
+ }
+ }
+
+=head2 isa_class
+
+Returns class of a column inherited by is_a, assumes something can be more than one thing (have * is_a rels)
+
+=cut
+
+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;
+ return $isaclass if ($isaclass->find_column($col));
+ }
+ return 0; # col not in a is_a class