X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FBase.pm;h=b4f75c8a0824df25d0238128aeba03e13d518eeb;hb=83f49b1a6dd37085046213013288504696d5483e;hp=338f0e8a85449808cc5e9954a581cd5dceaa9c29;hpb=12d8a77a713d5ed4f08414e5f34e96d45f60e2d3;p=maypole.git diff --git a/lib/Maypole/Model/Base.pm b/lib/Maypole/Model/Base.pm index 338f0e8..b4f75c8 100644 --- a/lib/Maypole/Model/Base.pm +++ b/lib/Maypole/Model/Base.pm @@ -1,6 +1,6 @@ package Maypole::Model::Base; - use strict; + use Maypole::Constants; use attributes (); @@ -24,7 +24,6 @@ sub FETCH_CODE_ATTRIBUTES { @{ $remember{$_[1]} || [] } } sub process { my ( $class, $r ) = @_; my $method = $r->action; - return if $r->{template}; # Authentication has set this, we're done. $r->{template} = $method; my $obj = $class->fetch_objects($r); @@ -133,6 +132,9 @@ Empty Action. Empty Action. +=item index + +Empty Action, calls list if provided with a table. =back @@ -148,6 +150,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. @@ -189,19 +199,29 @@ 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"; - - 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 add_model_superclass + +Adds model as superclass to model classes (if necessary) + +=cut + +sub add_model_superclass { return; } + =head2 method_attrs Returns the list of attributes defined for a method. Maypole itself only @@ -209,16 +229,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; } @@ -236,3 +255,24 @@ sub related { 1; +=head1 SEE ALSO + +L, L. + +=head1 AUTHOR + +Maypole is currently maintained by Aaron Trevena. + +=head1 AUTHOR EMERITUS + +Simon Cozens, C + +Simon Flack maintained Maypole from 2.05 to 2.09 + +Sebastian Riedel, C maintained Maypole from 1.99_01 to 2.04 + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut