lib/Maypole/Model/Base.pm

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