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