X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FBase.pm;h=26288c29f15cd32d4d00a0dd117ba215cbc1c333;hb=7c1eccbb6e4b547e61e82ece501c824785c25480;hp=d0e9ba81670c357160685195b205736513712b0a;hpb=1d4cf48b6f75c5273fb800ca9442bd423b8c772b;p=maypole.git

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<Exported> 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