Fixed mime type setting, fixed errors in revision 445, folded in Maypole::Component...

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

diff --git a/lib/Maypole/Model/Base.pm b/lib/Maypole/Model/Base.pm
index ea1632a8cce0436c7d4c669604d788cc72bbea3b..de33ac98c991137b24712b86d947553629d2f01e 100644 (file)
--- a/lib/Maypole/Model/Base.pm
+++ b/lib/Maypole/Model/Base.pm
@@ -1,13 +1,25 @@
 package Maypole::Model::Base;
 
 package Maypole::Model::Base;
 

+use strict;

 use Maypole::Constants;
 use attributes ();
 
 use Maypole::Constants;
 use attributes ();
 

+# don't know why this is a global - drb

 our %remember;
 
 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,12 +27,9 @@ 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] );
-    if ($obj) {
-        $r->objects( [$obj] );
-        shift @{ $r->{args} };
-    }
+    my $obj = $class->fetch_objects($r);
+    $r->objects([$obj]) if $obj;
+    

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


@@ -39,12 +48,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:


@@ -56,8 +65,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>.


@@ -68,14 +77,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
 


@@ -90,8 +101,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
 


@@ -107,16 +119,15 @@ errors. A hash of errors will be passed to the template.
 
 sub do_edit { die "This is an abstract method" }
 
 
 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
 


@@ -127,7 +138,6 @@ Empty Action.
 
 =cut
 
 
 =cut
 

-

 sub list : Exported {
     die "This is an abstract method";
 }
 sub list : Exported {
     die "This is an abstract method";
 }


@@ -149,7 +159,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.
 


@@ -172,33 +182,48 @@ sub column_names {
     } $class->columns;
 }
 
     } $class->columns;
 }
 

-=head2 description
-
-A description of the class to be passed to the template.
-
-=cut
-
-sub description { "A poorly defined class" }
-

 =head2 is_public
 
 should return true if a certain action is supported, or false otherwise. 
 =head2 is_public
 
 should return true if a certain action is supported, or false otherwise. 

-Defaults to checking if the sub has the :Exported attribute.
+Defaults to checking if the sub has the C<:Exported> attribute.

 
 =cut
 
 sub is_public {
 
 =cut
 
 sub is_public {

-    my ( $self, $action ) = @_;
+    my ( $self, $action, $attrs ) = @_;

     my $cv = $self->can($action);
     my $cv = $self->can($action);

-    return 0 unless $cv;
-    my $attrs = join " ", attributes::get($cv);
+    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 {
     do {

-        warn "$action not exported" if Maypole->debug;
-        return 0;
-    } unless $attrs =~ /\bExported\b/i;
+       warn "is_public failed. $action not exported. attributes are : ", %attrs;
+       return 0;
+    } unless $attrs{Exported};

     return 1;
 }
 
     return 1;
 }
 

+
+
+=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, $cv) = @_;
+    
+    $cv ||= $class->can($method);
+    
+    return unless $cv;
+    
+    my @attrs = attributes::get($cv);
+
+    return @attrs;
+}
+

 =head2 related
 
 This can go either in the master model class or in the individual
 =head2 related
 
 This can go either in the master model class or in the individual


@@ -211,3 +236,5 @@ sub related {
 }
 
 1;
 }
 
 1;

+
+