X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FBase.pm;h=d5d325c6dfaaf374414ac728ec9f894e9b2de1a3;hb=83769a6653a8736141d035a8a963c6cc99970a17;hp=26288c29f15cd32d4d00a0dd117ba215cbc1c333;hpb=7c1eccbb6e4b547e61e82ece501c824785c25480;p=maypole.git diff --git a/lib/Maypole/Model/Base.pm b/lib/Maypole/Model/Base.pm index 26288c2..d5d325c 100644 --- a/lib/Maypole/Model/Base.pm +++ b/lib/Maypole/Model/Base.pm @@ -4,6 +4,7 @@ use strict; use Maypole::Constants; use attributes (); +# don't know why this is a global - drb our %remember; sub MODIFY_CODE_ATTRIBUTES @@ -28,6 +29,7 @@ sub process { $r->{template} = $method; my $obj = $class->fetch_objects($r); $r->objects([$obj]) if $obj; + $class->$method( $r, $obj, @{ $r->{args} } ); } @@ -131,6 +133,9 @@ Empty Action. Empty Action. +=item index + +Empty Action, calls list if provided with a table. =back @@ -146,6 +151,14 @@ sub view : Exported { sub edit : Exported { } +sub index : Exported { + my ( $self, $r ) = @_; + if ($r->table) { + $r->template("list"); + return $self->list($r); + } +} + =pod Also, see the exported commands in C. @@ -187,19 +200,22 @@ Defaults to checking if the sub has the C<:Exported> attribute. =cut -sub is_public -{ - my ($self, $action) = @_; - - my %attrs = map {$_ => 1} $self->method_attrs($action); - - return 1 if $attrs{Exported}; - - warn "$action not exported" if Maypole->debug; - - return 0; +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; + + my %attrs = (ref $attrs) ? %$attrs : map {$_ => 1} $self->method_attrs($action,$cv) ; + + do { + warn "is_public failed. $action not exported. attributes are : ", %attrs; + return 0; + } unless $attrs{Exported}; + return 1; } + + =head2 method_attrs Returns the list of attributes defined for a method. Maypole itself only @@ -207,16 +223,15 @@ defines the C attribute. =cut -sub method_attrs -{ - my ($class, $method) = @_; +sub method_attrs { + my ($class, $method, $cv) = @_; - my $cv = $class->can($method); + $cv ||= $class->can($method); return unless $cv; my @attrs = attributes::get($cv); - + return @attrs; }