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