lib/Maypole/Model/Base.pm

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