lib/Maypole/Model/Base.pm

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