lib/Maypole/Model/Base.pm

   1 package Maypole::Model::Base;
   2 use strict;
   3
   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
  28     $r->{template} = $method;
  29     my $obj = $class->fetch_objects($r);
  30     $r->objects([$obj]) if $obj;
  31
  32     $class->$method( $r, $obj, @{ $r->{args} } );
  33 }
  34
  35 sub list_columns {
  36     shift->display_columns;
  37 }
  38
  39 sub display_columns {
  40     sort shift->columns;
  41 }
  42
  43 =head1 NAME
  44
  45 Maypole::Model::Base - Base class for model classes
  46
  47 =head1 DESCRIPTION
  48
  49 This is the base class for Maypole data models. This is an abstract class
  50 that defines the interface, and can't be used directly.
  51
  52 =head2 process
  53
  54 This is the engine of this module. Given the request object, it populates
  55 all the relevant variables and calls the requested action.
  56
  57 Anyone subclassing this for a different database abstraction mechanism
  58 needs to provide the following methods:
  59
  60 =head2 setup_database
  61
  62     $model->setup_database($config, $namespace, @data)
  63
  64 Uses the user-defined data in C<@data> to specify a database- for
  65 example, by passing in a DSN. The model class should open the database,
  66 and create a class for each table in the database. These classes will
  67 then be C<adopt>ed. It should also populate C<< $config->tables >> and
  68 C<< $config->classes >> with the names of the classes and tables
  69 respectively. The classes should be placed under the specified
  70 namespace. For instance, C<beer> should be mapped to the class
  71 C<BeerDB::Beer>.
  72
  73 =head2 class_of
  74
  75     $model->class_of($r, $table)
  76
  77 This maps between a table name and its associated class.
  78
  79 =head2 fetch_objects
  80
  81 This class method is passed a request object and is expected to return an
  82 object of the appropriate table class from information stored in the request
  83 object.
  84
  85 =head2 adopt
  86
  87 This class method is passed the name of a model class that represensts a table
  88 and allows the master model class to do any set-up required.
  89
  90 =head2 columns
  91
  92 This is a list of all the columns in a table. You may also override
  93 see also C<display_columns>
  94
  95 =head2 table
  96
  97 This is the name of the table.
  98
  99 =cut
 100
 101 sub class_of       { die "This is an abstract method" }
 102 sub setup_database { die "This is an abstract method" }
 103 sub fetch_objects { die "This is an abstract method" }
 104
 105 =head2 Actions
 106
 107 =over
 108
 109 =item do_edit
 110
 111 If there is an object in C<$r-E<gt>objects>, then it should be edited
 112 with the parameters in C<$r-E<gt>params>; otherwise, a new object should
 113 be created with those parameters, and put back into C<$r-E<gt>objects>.
 114 The template should be changed to C<view>, or C<edit> if there were any
 115 errors. A hash of errors will be passed to the template.
 116
 117 =cut
 118
 119 sub do_edit { die "This is an abstract method" }
 120
 121 =item list
 122
 123 The C<list> method should fill C<$r-E<gt>objects> with all of the
 124 objects in the class. You may want to page this using C<Data::Page> or
 125 similar.
 126
 127 =item edit
 128
 129 Empty Action.
 130
 131 =item view
 132
 133 Empty Action.
 134
 135 =item index
 136
 137 Empty Action, calls list if provided with a table.
 138
 139 =back
 140
 141 =cut
 142
 143 sub list : Exported {
 144     die "This is an abstract method";
 145 }
 146
 147 sub view : Exported {
 148 }
 149
 150 sub edit : Exported {
 151 }
 152
 153 sub index : Exported {
 154     my ( $self, $r ) = @_;
 155     if ($r->table) {
 156         $r->template("list");
 157         return $self->list($r);
 158     }
 159 }
 160
 161 =pod
 162
 163 Also, see the exported commands in C<Maypole::Model::CDBI>.
 164
 165 =head1 Other overrides
 166
 167 Additionally, individual derived model classes may want to override the
 168 following methods:
 169
 170 =head2 display_columns
 171
 172 Returns a list of columns to display in the model. By default returns
 173 all columns in alphabetical order. Override this in base classes to
 174 change ordering, or elect not to show columns.
 175
 176 =head2 list_columns
 177
 178 Same as display_columns, only for listings. Defaults to display_columns
 179
 180 =head2 column_names
 181
 182 Return a hash mapping column names with human-readable equivalents.
 183
 184 =cut
 185
 186 sub column_names {
 187     my $class = shift;
 188     map {
 189         my $col = $_;
 190         $col =~ s/_+(\w)?/ \U$1/g;
 191         $_ => ucfirst $col
 192     } $class->columns;
 193 }
 194
 195 =head2 is_public
 196
 197 should return true if a certain action is supported, or false otherwise.
 198 Defaults to checking if the sub has the C<:Exported> attribute.
 199
 200 =cut
 201
 202 sub is_public {
 203     my ( $self, $action, $attrs ) = @_;
 204     my $cv = $self->can($action);
 205     warn "is_public failed . action is $action. self is $self" and return 0 unless $cv;
 206
 207     my %attrs = (ref $attrs) ?  %$attrs : map {$_ => 1} $self->method_attrs($action,$cv) ;
 208
 209     do {
 210         warn "is_public failed. $action not exported. attributes are : ", %attrs;
 211         return 0;
 212     } unless $attrs{Exported};
 213     return 1;
 214 }
 215
 216
 217 =head2 add_model_superclass
 218
 219 Adds model as superclass to model classes (if necessary)
 220
 221 =cut
 222
 223 sub add_model_superclass { return; }
 224
 225 =head2 method_attrs
 226
 227 Returns the list of attributes defined for a method. Maypole itself only
 228 defines the C<Exported> attribute.
 229
 230 =cut
 231
 232 sub method_attrs {
 233     my ($class, $method, $cv) = @_;
 234
 235     $cv ||= $class->can($method);
 236
 237     return unless $cv;
 238
 239     my @attrs = attributes::get($cv);
 240
 241     return @attrs;
 242 }
 243
 244 =head2 related
 245
 246 This can go either in the master model class or in the individual
 247 classes, and returns a list of has-many accessors. A brewery has many
 248 beers, so C<BeerDB::Brewery> needs to return C<beers>.
 249
 250 =cut
 251
 252 sub related {
 253 }
 254
 255 1;
 256
 257
 258 =head1 SEE ALSO
 259
 260 L<Maypole>, L<Maypole::Model::CDBI>.
 261
 262 =head1 AUTHOR
 263
 264 Maypole is currently maintained by Aaron Trevena.
 265
 266 =head1 AUTHOR EMERITUS
 267
 268 Simon Cozens, C<simon#cpan.org>
 269
 270 Simon Flack maintained Maypole from 2.05 to 2.09
 271
 272 Sebastian Riedel, C<sri#oook.de> maintained Maypole from 1.99_01 to 2.04
 273
 274 =head1 LICENSE
 275
 276 You may distribute this code under the same terms as Perl itself.
 277
 278 =cut