2 use base qw(Class::Accessor Class::Data::Inheritable);
4 use UNIVERSAL::require;
8 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
9 __PACKAGE__->mk_accessors(
10 qw( ar params query objects model_class
11 args action template )
13 __PACKAGE__->config( {} );
14 __PACKAGE__->init_done(0);
15 use Maypole::Constants;
20 my $calling_class = shift;
21 $calling_class = ref $calling_class if ref $calling_class;
26 *{ $calling_class . "::handler" } =
27 sub { Maypole::handler( $calling_class, @_ ) };
29 my $config = $calling_class->config;
30 $config->{model} ||= "Maypole::Model::CDBI";
31 $config->{model}->require;
32 die "Couldn't load the model class $config->{model}: $@" if $@;
33 $config->{model}->setup_database( $config, $calling_class, @_ );
34 for my $subclass ( @{ $config->{classes} } ) {
36 unshift @{ $subclass . "::ISA" }, $config->{model};
37 $config->{model}->adopt($subclass)
38 if $config->{model}->can("adopt");
44 my $config = $class->config;
45 $config->{view} ||= "Maypole::View::TT";
46 $config->{view}->require;
47 die "Couldn't load the view class $config->{view}: $@" if $@;
48 $config->{display_tables} ||= [ @{ $class->config->{tables} } ];
49 $class->view_object( $class->config->{view}->new );
56 # See Maypole::Workflow before trying to understand this.
57 my ( $class, $req ) = @_;
58 $class->init unless $class->init_done;
59 my $r = bless { config => $class->config }, $class;
60 $r->get_request($req);
62 my $status = $r->handler_guts();
63 return $status unless $status == OK;
70 $r->model_class( $r->config->{model}->class_of( $r, $r->{table} ) );
71 my $applicable = $r->is_applicable;
72 unless ( $applicable == OK ) {
74 # It's just a plain template
75 delete $r->{model_class};
76 $r->{path} =~ s{/$}{}; # De-absolutify
77 $r->template( $r->{path} );
80 # We authenticate every request, needed for proper session management
82 eval { $status = $r->call_authenticate };
83 if ( my $error = $@ ) {
84 $status = $r->call_exception($error);
85 if ( $status != OK ) {
86 warn "caught model error: $error";
87 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
90 if ( $r->debug and $status != OK and $status != DECLINED ) {
91 $r->view_object->error( $r,
92 "Got unexpected status $status from calling authentication" );
94 return $status unless $status == OK;
96 # We run additional_data for every request
98 if ( $applicable == OK ) {
99 eval { $r->model_class->process($r) };
100 if ( my $error = $@ ) {
101 $status = $r->call_exception($error);
102 if ( $status != OK ) {
103 warn "caught model error: $error";
104 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
108 if ( !$r->{output} ) { # You might want to do it yourself
109 return $r->view_object->process($r);
116 my $config = $self->config;
117 $config->{ok_tables} ||= $config->{display_tables};
118 $config->{ok_tables} = { map { $_ => 1 } @{ $config->{ok_tables} } }
119 if ref $config->{ok_tables} eq "ARRAY";
120 warn "We don't have that table ($self->{table})"
122 and not $config->{ok_tables}{ $self->{table} };
123 return DECLINED() unless exists $config->{ok_tables}{ $self->{table} };
125 # Does the action method exist?
126 my $cv = $self->model_class->can( $self->{action} );
127 warn "We don't have that action ($self->{action})"
128 if $self->debug and not $cv;
129 return DECLINED() unless $cv;
132 $self->{method_attribs} = join " ", attributes::get($cv);
134 warn "$self->{action} not exported" if $self->debug;
136 } unless $self->{method_attribs} =~ /\bExported\b/i;
140 sub call_authenticate {
143 # Check if we have a model class
144 if ( $self->{model_class} ) {
145 return $self->model_class->authenticate($self)
146 if $self->model_class->can("authenticate");
148 return $self->authenticate($self); # Interface consistency is a Good Thing
155 # Check if we have a model class
156 if ( $self->{model_class}
157 && $self->model_class->can('exception') )
159 my $status = $self->model_class->exception( $self, $error );
160 return $status if $status == OK;
162 return $self->exception($error);
165 sub additional_data { }
167 sub authenticate { return OK }
169 sub exception { return ERROR }
173 $self->{path} ||= "frontpage";
174 my @pi = split /\//, $self->{path};
175 shift @pi while @pi and !$pi[0];
176 $self->{table} = shift @pi;
177 $self->{action} = shift @pi;
178 $self->{args} = \@pi;
183 Maypole - MVC web application framework
191 A large number of web programming tasks follow the same sort of pattern:
192 we have some data in a datasource, typically a relational database. We
193 have a bunch of templates provided by web designers. We have a number of
194 things we want to be able to do with the database - create, add, edit,
195 delete records, view records, run searches, and so on. We have a web
196 server which provides input from the user about what to do. Something in
197 the middle takes the input, grabs the relevant rows from the database,
198 performs the action, constructs a page, and spits it out.
200 Maypole aims to be the most generic and extensible "something in the
201 middle" - an MVC-based web application framework.
203 An example would help explain this best. You need to add a product
204 catalogue to a company's web site. Users need to list the products in
205 various categories, view a page on each product with its photo and
206 pricing information and so on, and there needs to be a back-end where
207 sales staff can add new lines, change prices, and delete out of date
208 records. So, you set up the database, provide some default templates
209 for the designers to customize, and then write an Apache handler like
212 package ProductDatabase;
213 use base 'Apache::MVC';
214 __PACKAGE__->set_database("dbi:mysql:products");
215 ProductDatabase->config->{uri_base} = "http://your.site/catalogue/";
216 ProductDatabase::Product->has_a("category" => ProductDatabase::Category);
220 my ($self, $request) = @_;
221 return OK if $request->{ar}->get_remote_host() eq "sales.yourcorp.com";
222 return OK if $request->{action} =~ /^(view|list)$/;
227 You then put the following in your Apache config:
229 <Location /catalogue>
230 SetHandler perl-script
231 PerlHandler ProductDatabase
234 And copy the templates found in F<templates/factory> into the
235 F<catalogue/factory> directory off the web root. When the designers get
236 back to you with custom templates, they are to go in
237 F<catalogue/custom>. If you need to do override templates on a
238 database-table-by-table basis, put the new template in
239 F<catalogue/I<table>>.
241 This will automatically give you C<add>, C<edit>, C<list>, C<view> and
242 C<delete> commands; for instance, a product list, go to
244 http://your.site/catalogue/product/list
246 For a full example, see the included "beer database" application.
250 There's some documentation for the workflow in L<Maypole::Workflow>,
251 but the basic idea is that a URL part like C<product/list> gets
252 translated into a call to C<ProductDatabase::Product-E<gt>list>. This
253 propagates the request with a set of objects from the database, and then
254 calls the C<list> template; first, a C<product/list> template if it
255 exists, then the C<custom/list> and finally C<factory/list>.
257 If there's another action you want the system to do, you need to either
258 subclass the model class, and configure your class slightly differently:
260 package ProductDatabase::Model;
261 use base 'Maypole::Model::CDBI';
263 sub supersearch :Exported {
264 my ($self, $request) = @_;
265 # Do stuff, get a bunch of objects back
266 $r->objects(\@objects);
267 $r->template("template_name");
270 Then your top-level application package should change the model class:
271 (Before calling C<setup>)
273 ProductDatabase->config->{model} = "ProductDatabase::Model";
275 (The C<:Exported> attribute means that the method can be called via the
276 URL C</I<table>/supersearch/...>.)
278 Alternatively, you can put the method directly into the specific model
281 sub ProductDatabase::Product::supersearch :Exported { ... }
283 By default, the view class uses Template Toolkit as the template
284 processor, and the model class uses C<Class::DBI>; it may help you to be
285 familiar with these modules before going much further with this,
286 although I expect there to be other subclasses for other templating
287 systems and database abstraction layers as time goes on. The article at
288 C<http://www.perl.com/pub/a/2003/07/15/nocode.html> is a great
289 introduction to the process we're trying to automate.
293 You should probably not use Maypole directly. Maypole is an abstract
294 class which does not specify how to communicate with the outside world.
295 The most popular subclass of Maypole is L<Apache::MVC>, which interfaces
296 the Maypole framework to Apache mod_perl; another important one is
299 If you are implementing Maypole subclasses, you need to provide at least
300 the C<parse_location> and C<send_output> methods. You may also want to
301 provide C<get_request> and C<get_template_root>. See the
302 L<Maypole::Workflow> documentation for what these are expected to do.
306 sub get_template_root { "." }
310 die "Do not use Maypole directly; use Apache::MVC or similar";
314 die "Do not use Maypole directly; use Apache::MVC or similar";
319 There's more documentation, examples, and a wiki at the Maypole web site:
321 http://maypole.simon-cozens.org/
323 L<Apache::MVC>, L<CGI::Maypole>.
327 Sebastian Riedel, c<sri@oook.de>
331 Simon Cozens, C<simon@cpan.org>
335 Jesse Scheidlower, Jody Belka, Markus Ramberg, Mickael Joanne, Simon Flack and all the others who've helped.
339 You may distribute this code under the same terms as Perl itself.