X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FBase.pm;h=338f0e8a85449808cc5e9954a581cd5dceaa9c29;hb=12d8a77a713d5ed4f08414e5f34e96d45f60e2d3;hp=3375dfd26fba523b126e784c93e32a9779b8cfb6;hpb=05b8c530848b1b7bada1e39ceb8325eb688c35d0;p=maypole.git diff --git a/lib/Maypole/Model/Base.pm b/lib/Maypole/Model/Base.pm index 3375dfd..338f0e8 100644 --- a/lib/Maypole/Model/Base.pm +++ b/lib/Maypole/Model/Base.pm @@ -1,13 +1,25 @@ package Maypole::Model::Base; +use strict; use Maypole::Constants; use attributes (); +# don't know why this is a global - drb our %remember; -sub MODIFY_CODE_ATTRIBUTES { $remember{ $_[1] } = $_[2]; () } +sub MODIFY_CODE_ATTRIBUTES +{ + shift; # class name not used + my ($coderef, @attrs) = @_; + + $remember{$coderef} = \@attrs; + + # previous version took care to return an empty array, not sure why, + # but shall cargo cult it until know better + return; +} -sub FETCH_CODE_ATTRIBUTES { $remember{ $_[1] } } +sub FETCH_CODE_ATTRIBUTES { @{ $remember{$_[1]} || [] } } sub process { my ( $class, $r ) = @_; @@ -17,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} } ); } @@ -169,31 +182,44 @@ sub column_names { } $class->columns; } -=head2 description +=head2 is_public -A description of the class to be passed to the template. +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 description { "A poorly defined class" } +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; +} -=head2 is_public +=head2 method_attrs -should return true if a certain action is supported, or false otherwise. -Defaults to checking if the sub has the C<:Exported> attribute. +Returns the list of attributes defined for a method. Maypole itself only +defines the C attribute. =cut -sub is_public { - my ( $self, $action ) = @_; - my $cv = $self->can($action); - return 0 unless $cv; - my $attrs = join " ", attributes::get($cv); - do { - warn "$action not exported" if Maypole->debug; - return 0; - } unless $attrs =~ /\bExported\b/i; - return 1; +sub method_attrs +{ + my ($class, $method) = @_; + + my $cv = $class->can($method); + + return unless $cv; + + my @attrs = attributes::get($cv); + + return @attrs; } =head2 related