lib/Maypole/Model/Base.pm

   1 package Maypole::Model::Base;
   2
   3 use strict;
   4 use Maypole::Constants;
   5 use attributes ();
   6
   7 # don't know why this is a global - drb
   8 our %remember;
   9
  10 sub MODIFY_CODE_ATTRIBUTES
  11 {
  12     shift; # class name not used
  13     my ($coderef, @attrs) = @_;
  14
  15     $remember{$coderef} = \@attrs;
  16
  17     # previous version took care to return an empty array, not sure why,
  18     # but shall cargo cult it until know better
  19     return;
  20 }
  21
  22 sub FETCH_CODE_ATTRIBUTES { @{ $remember{$_[1]} || [] } }
  23
  24 sub process {
  25     my ( $class, $r ) = @_;
  26     my $method = $r->action;
  27     return if $r->{template};    # Authentication has set this, we're done.
  28
  29     $r->{template} = $method;
  30     my $obj = $class->fetch_objects($r);
  31     $r->objects([$obj]) if $obj;
  32
  33     $class->$method( $r, $obj, @{ $r->{args} } );
  34 }
  35
  36 sub list_columns {
  37     shift->display_columns;
  38 }
  39
  40 sub display_columns {
  41     sort shift->columns;
  42 }
  43
  44 =head1 NAME
  45
  46 Maypole::Model::Base - Base class for model classes
  47
  48 =head1 DESCRIPTION
  49
  50 This is the base class for Maypole data models. This is an abstract class
  51 that defines the interface, and can't be used directly.
  52
  53 =head2 process
  54
  55 This is the engine of this module. Given the request object, it populates
  56 all the relevant variables and calls the requested action.
  57
  58 Anyone subclassing this for a different database abstraction mechanism
  59 needs to provide the following methods:
  60
  61 =head2 setup_database
  62
  63     $model->setup_database($config, $namespace, @data)
  64
  65 Uses the user-defined data in C<@data> to specify a database- for
  66 example, by passing in a DSN. The model class should open the database,
  67 and create a class for each table in the database. These classes will
  68 then be C<adopt>ed. It should also populate C<< $config->tables >> and
  69 C<< $config->classes >> with the names of the classes and tables
  70 respectively. The classes should be placed under the specified
  71 namespace. For instance, C<beer> should be mapped to the class
  72 C<BeerDB::Beer>.
  73
  74 =head2 class_of
  75
  76     $model->class_of($r, $table)
  77
  78 This maps between a table name and its associated class.
  79
  80 =head2 fetch_objects
  81
  82 This class method is passed a request object and is expected to return an
  83 object of the appropriate table class from information stored in the request
  84 object.
  85
  86 =head2 adopt
  87
  88 This class method is passed the name of a model class that represensts a table
  89 and allows the master model class to do any set-up required.
  90
  91 =head2 columns
  92
  93 This is a list of all the columns in a table. You may also override
  94 see also C<display_columns>
  95
  96 =head2 table
  97
  98 This is the name of the table.
  99
 100 =cut
 101
 102 sub class_of       { die "This is an abstract method" }
 103 sub setup_database { die "This is an abstract method" }
 104 sub fetch_objects { die "This is an abstract method" }
 105
 106 =head2 Actions
 107
 108 =over
 109
 110 =item do_edit
 111
 112 If there is an object in C<$r-E<gt>objects>, then it should be edited
 113 with the parameters in C<$r-E<gt>params>; otherwise, a new object should
 114 be created with those parameters, and put back into C<$r-E<gt>objects>.
 115 The template should be changed to C<view>, or C<edit> if there were any
 116 errors. A hash of errors will be passed to the template.
 117
 118 =cut
 119
 120 sub do_edit { die "This is an abstract method" }
 121
 122 =item list
 123
 124 The C<list> method should fill C<$r-E<gt>objects> with all of the
 125 objects in the class. You may want to page this using C<Data::Page> or
 126 similar.
 127
 128 =item edit
 129
 130 Empty Action.
 131
 132 =item view
 133
 134 Empty Action.
 135
 136
 137 =back
 138
 139 =cut
 140
 141 sub list : Exported {
 142     die "This is an abstract method";
 143 }
 144
 145 sub view : Exported {
 146 }
 147
 148 sub edit : Exported {
 149 }
 150
 151 =pod
 152
 153 Also, see the exported commands in C<Maypole::Model::CDBI>.
 154
 155 =head1 Other overrides
 156
 157 Additionally, individual derived model classes may want to override the
 158 following methods:
 159
 160 =head2 display_columns
 161
 162 Returns a list of columns to display in the model. By default returns
 163 all columns in alphabetical order. Override this in base classes to
 164 change ordering, or elect not to show columns.
 165
 166 =head2 list_columns
 167
 168 Same as display_columns, only for listings. Defaults to display_columns
 169
 170 =head2 column_names
 171
 172 Return a hash mapping column names with human-readable equivalents.
 173
 174 =cut
 175
 176 sub column_names {
 177     my $class = shift;
 178     map {
 179         my $col = $_;
 180         $col =~ s/_+(\w)?/ \U$1/g;
 181         $_ => ucfirst $col
 182     } $class->columns;
 183 }
 184
 185 =head2 is_public
 186
 187 should return true if a certain action is supported, or false otherwise.
 188 Defaults to checking if the sub has the C<:Exported> attribute.
 189
 190 =cut
 191
 192 sub is_public {
 193     my ( $self, $action, $attrs ) = @_;
 194     my $cv = $self->can($action);
 195     warn "is_public failed . action is $action. self is $self" and return 0 unless $cv;
 196
 197     my %attrs = (ref $attrs) ?  %$attrs : map {$_ => 1} $self->method_attrs($action,$cv) ;
 198
 199     do {
 200         warn "is_public failed. $action not exported. attributes are : ", %attrs;
 201         return 0;
 202     } unless $attrs{Exported};
 203     return 1;
 204 }
 205
 206
 207
 208 =head2 method_attrs
 209
 210 Returns the list of attributes defined for a method. Maypole itself only
 211 defines the C<Exported> attribute.
 212
 213 =cut
 214
 215 sub method_attrs {
 216     my ($class, $method, $cv) = @_;
 217
 218     $cv ||= $class->can($method);
 219
 220     return unless $cv;
 221
 222     my @attrs = attributes::get($cv);
 223
 224     return @attrs;
 225 }
 226
 227 =head2 related
 228
 229 This can go either in the master model class or in the individual
 230 classes, and returns a list of has-many accessors. A brewery has many
 231 beers, so C<BeerDB::Brewery> needs to return C<beers>.
 232
 233 =cut
 234
 235 sub related {
 236 }
 237
 238 1;
 239
 240