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