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