use Class::DBI::Pager;
use Lingua::EN::Inflect::Number qw(to_PL);
-
+use attributes ();
###############################################################################
# Helper methods
}
}
-=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)
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;
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
}
}
+=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;
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