Added doc stubs for Aaron's new methods.

[maypole.git] / lib / Maypole / Model / Base.pm

diff --git a/lib/Maypole/Model/Base.pm b/lib/Maypole/Model/Base.pm
index 0d534a542559e0ec5448c29ffe805bb729317a05..26288c29f15cd32d4d00a0dd117ba215cbc1c333 100644 (file)
--- a/lib/Maypole/Model/Base.pm
+++ b/lib/Maypole/Model/Base.pm
@@ -1,13 +1,24 @@
 package Maypole::Model::Base;
 
 package Maypole::Model::Base;
 

+use strict;

 use Maypole::Constants;
 use attributes ();
 
 our %remember;
 
 use Maypole::Constants;
 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 ) = @_;
 
 sub process {
     my ( $class, $r ) = @_;


@@ -15,9 +26,8 @@ sub process {
     return if $r->{template};    # Authentication has set this, we're done.
 
     $r->{template} = $method;
     return if $r->{template};    # Authentication has set this, we're done.
 
     $r->{template} = $method;

-    $r->objects( [] );
-    my $obj = $class->retrieve( $r->{args}->[0] );
-    $r->objects( [$obj] ) if $obj;
+    my $obj = $class->fetch_objects($r);
+    $r->objects([$obj]) if $obj;

     $class->$method( $r, $obj, @{ $r->{args} } );
 }
 
     $class->$method( $r, $obj, @{ $r->{args} } );
 }
 


@@ -36,12 +46,12 @@ Maypole::Model::Base - Base class for model classes
 =head1 DESCRIPTION
 
 This is the base class for Maypole data models. This is an abstract class
 =head1 DESCRIPTION
 
 This is the base class for Maypole data models. This is an abstract class

-meant to define the interface, and can't be used directly.
+that defines the interface, and can't be used directly.

 
 =head2 process
 
 
 =head2 process
 

-This is the engine of this module. It populates all the relevant variables
-and calls the requested action.
+This is the engine of this module. Given the request object, it populates
+all the relevant variables and calls the requested action.

 
 Anyone subclassing this for a different database abstraction mechanism
 needs to provide the following methods:
 
 Anyone subclassing this for a different database abstraction mechanism
 needs to provide the following methods:


@@ -53,8 +63,8 @@ needs to provide the following methods:
 Uses the user-defined data in C<@data> to specify a database- for
 example, by passing in a DSN. The model class should open the database,
 and create a class for each table in the database. These classes will
 Uses the user-defined data in C<@data> to specify a database- for
 example, by passing in a DSN. The model class should open the database,
 and create a class for each table in the database. These classes will

-then be C<adopt>ed. It should also populate C<< $config->{tables} >> and
-C<< $config->{classes} >> with the names of the classes and tables
+then be C<adopt>ed. It should also populate C<< $config->tables >> and
+C<< $config->classes >> with the names of the classes and tables

 respectively. The classes should be placed under the specified
 namespace. For instance, C<beer> should be mapped to the class
 C<BeerDB::Beer>.
 respectively. The classes should be placed under the specified
 namespace. For instance, C<beer> should be mapped to the class
 C<BeerDB::Beer>.


@@ -65,14 +75,16 @@ C<BeerDB::Beer>.
 
 This maps between a table name and its associated class.
 
 
 This maps between a table name and its associated class.
 

-=head2 retrieve
+=head2 fetch_objects

 
 

-This turns an ID into an object of the appropriate class.
+This class method is passed a request object and is expected to return an
+object of the appropriate table class from information stored in the request
+object.

 
 =head2 adopt
 
 
 =head2 adopt
 

-This is called on an model class representing a table and allows the
-master model class to do any set-up required. 
+This class method is passed the name of a model class that represensts a table
+and allows the master model class to do any set-up required.

 
 =head2 columns
 
 
 =head2 columns
 


@@ -87,8 +99,9 @@ This is the name of the table.
 
 sub class_of       { die "This is an abstract method" }
 sub setup_database { die "This is an abstract method" }
 
 sub class_of       { die "This is an abstract method" }
 sub setup_database { die "This is an abstract method" }

+sub fetch_objects { die "This is an abstract method" }

 
 

-=head2 Commands
+=head2 Actions

 
 =over
 
 
 =over
 


@@ -106,13 +119,13 @@ sub do_edit { die "This is an abstract method" }
 
 =item list
 
 
 =item list
 

-The C<list> method should fill C<< $r-> objects >> with all of the
+The C<list> method should fill C<$r-E<gt>objects> with all of the

 objects in the class. You may want to page this using C<Data::Page> or
 similar.
 
 =item edit
 
 objects in the class. You may want to page this using C<Data::Page> or
 similar.
 
 =item edit
 

-Empty Action
+Empty Action.

 
 =item view
 
 
 =item view
 


@@ -144,7 +157,7 @@ following methods:
 
 =head2 display_columns
 
 
 =head2 display_columns
 

-Returns a list of columns to display in the model. by default returns
+Returns a list of columns to display in the model. By default returns

 all columns in alphabetical order. Override this in base classes to
 change ordering, or elect not to show columns.
 
 all columns in alphabetical order. Override this in base classes to
 change ordering, or elect not to show columns.
 


@@ -167,31 +180,44 @@ sub column_names {
     } $class->columns;
 }
 
     } $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
 
 
 =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" if Maypole->debug;
+    
+    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 :Exported attribute.
+Returns the list of attributes defined for a method. Maypole itself only
+defines the C<Exported> attribute. 

 
 =cut
 
 
 =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
 }
 
 =head2 related


@@ -206,3 +232,5 @@ sub related {
 }
 
 1;
 }
 
 1;

+
+