From: David Baird Date: Thu, 6 Oct 2005 08:32:08 +0000 (+0000) Subject: Added doc stubs for Aaron's new methods. X-Git-Tag: 2.11~128 X-Git-Url: https://git.decadent.org.uk/gitweb/?p=maypole.git;a=commitdiff_plain;h=7c1eccbb6e4b547e61e82ece501c824785c25480 Added doc stubs for Aaron's new methods. Added capability to store multiple attributes to Mp-Model-Base. Split method_attrs method out of is_public in Mp-Model-Base. git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@390 48953598-375a-da11-a14b-00016c27c3ee --- diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm index 4653112..827d5d2 100644 --- a/lib/Apache/MVC.pm +++ b/lib/Apache/MVC.pm @@ -188,12 +188,16 @@ functionality. See L for these: =item get_template_root +=item get_protocol + =item parse_args =item parse_location =item send_output +=item redirect_request + =back =head1 AUTHOR diff --git a/lib/CGI/Maypole.pm b/lib/CGI/Maypole.pm index bb6de3f..a4835b8 100644 --- a/lib/CGI/Maypole.pm +++ b/lib/CGI/Maypole.pm @@ -164,12 +164,17 @@ functionality. See L for these: =item get_template_root +=item get_protocol + =item parse_args =item parse_location =item send_output +=item redirect_request + + =back =head1 DEPENDANCIES diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 2535340..89eae6b 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -532,6 +532,7 @@ You should only need to define this method if you are writing a new Maypole backend. It should return something that looks like an Apache or CGI request object, it defaults to blank. +=head3 default_table_view =head3 is_applicable diff --git a/lib/Maypole/Model/Base.pm b/lib/Maypole/Model/Base.pm index d0e9ba8..26288c2 100644 --- a/lib/Maypole/Model/Base.pm +++ b/lib/Maypole/Model/Base.pm @@ -6,9 +6,19 @@ use attributes (); 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 ) = @_; @@ -177,16 +187,37 @@ Defaults to checking if the sub has the C<:Exported> 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 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; +} + +=head2 method_attrs + +Returns the list of attributes defined for a method. Maypole itself only +defines the C attribute. + +=cut + +sub method_attrs +{ + my ($class, $method) = @_; + + my $cv = $class->can($method); + + return unless $cv; + + my @attrs = attributes::get($cv); + + return @attrs; } =head2 related