2 use base qw(Class::Accessor::FAST Class::Data::Inheritable);
4 use UNIVERSAL::require;
9 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
10 __PACKAGE__->mk_accessors(
11 qw( ar params query objects model_class
12 args action template )
14 __PACKAGE__->config( Maypole::Config->new() );
15 __PACKAGE__->init_done(0);
16 use Maypole::Constants;
21 my $calling_class = shift;
22 $calling_class = ref $calling_class if ref $calling_class;
27 *{ $calling_class . "::handler" } =
28 sub { Maypole::handler( $calling_class, @_ ) };
30 my $config = $calling_class->config;
31 $config->model || $config->model("Maypole::Model::CDBI");
32 $config->model->require;
33 die "Couldn't load the model class $config->model: $@" if $@;
34 $config->model->setup_database( $config, $calling_class, @_ );
35 for my $subclass ( @{ $config->classes } ) {
37 unshift @{ $subclass . "::ISA" }, $config->model;
38 $config->model->adopt($subclass)
39 if $config->model->can("adopt");
45 my $config = $class->config;
46 $config->view || $config->view("Maypole::View::TT");
47 $config->view->require;
48 die "Couldn't load the view class ".$config->view.": $@" if $@;
49 $config->display_tables || $config->display_tables([ $class->config->tables ]);
50 $class->view_object( $class->config->view->new );
57 # See Maypole::Workflow before trying to understand this.
58 my ( $class, $req ) = @_;
59 $class->init unless $class->init_done;
60 my $r = bless { config => $class->config }, $class;
61 $r->get_request($req);
63 my $status = $r->handler_guts();
64 return $status unless $status == OK;
71 $r->model_class( $r->config->model->class_of( $r, $r->{table} ) );
72 my $applicable = $r->is_applicable;
73 unless ( $applicable == OK ) {
75 # It's just a plain template
76 delete $r->{model_class};
77 $r->{path} =~ s{/$}{}; # De-absolutify
78 $r->template( $r->{path} );
81 # We authenticate every request, needed for proper session management
83 eval { $status = $r->call_authenticate };
84 if ( my $error = $@ ) {
85 $status = $r->call_exception($error);
86 if ( $status != OK ) {
87 warn "caught authenticate error: $error";
88 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
91 if ( $r->debug and $status != OK and $status != DECLINED ) {
92 $r->view_object->error( $r,
93 "Got unexpected status $status from calling authentication" );
95 return $status unless $status == OK;
97 # We run additional_data for every request
99 if ( $applicable == OK ) {
100 eval { $r->model_class->process($r) };
101 if ( my $error = $@ ) {
102 $status = $r->call_exception($error);
103 if ( $status != OK ) {
104 warn "caught model error: $error";
105 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
109 if ( !$r->{output} ) { # You might want to do it yourself
110 eval { $status = $r->view_object->process($r) };
111 if ( my $error = $@ ) {
112 $status = $r->call_exception($error);
113 if ( $status != OK ) {
114 warn "caught view error: $error";
115 return $r->debug ? $r->view_object->error( $r, $error ) : ERROR;
125 my $config = $self->config;
126 $config->ok_tables || $config->ok_tables($config->display_tables);
127 $config->ok_tables ({ map { $_ => 1 } @{ $config->ok_tables } })
128 if ref $config->ok_tables eq "ARRAY";
129 warn "We don't have that table ($self->{table})"
131 and not $config->ok_tables->{ $self->{table} };
132 return DECLINED() unless exists $config->ok_tables->{ $self->{table} };
134 # Does the action method exist?
135 my $cv = $self->model_class->can( $self->{action} );
136 warn "We don't have that action ($self->{action})"
137 if $self->debug and not $cv;
138 return DECLINED() unless $cv;
141 $self->{method_attribs} = join " ", attributes::get($cv);
143 warn "$self->{action} not exported" if $self->debug;
145 } unless $self->{method_attribs} =~ /\bExported\b/i;
149 sub call_authenticate {
152 # Check if we have a model class
153 if ( $self->{model_class} ) {
154 return $self->model_class->authenticate($self)
155 if $self->model_class->can("authenticate");
157 return $self->authenticate($self); # Interface consistency is a Good Thing
164 # Check if we have a model class
165 if ( $self->{model_class}
166 && $self->model_class->can('exception') )
168 my $status = $self->model_class->exception( $self, $error );
169 return $status if $status == OK;
171 return $self->exception($error);
174 sub additional_data { }
176 sub authenticate { return OK }
178 sub exception { return ERROR }
182 $self->{path} ||= "frontpage";
183 my @pi = split /\//, $self->{path};
184 shift @pi while @pi and !$pi[0];
185 $self->{table} = shift @pi;
186 $self->{action} = shift @pi;
187 $self->{args} = \@pi;
192 Maypole - MVC web application framework
200 A large number of web programming tasks follow the same sort of pattern:
201 we have some data in a datasource, typically a relational database. We
202 have a bunch of templates provided by web designers. We have a number of
203 things we want to be able to do with the database - create, add, edit,
204 delete records, view records, run searches, and so on. We have a web
205 server which provides input from the user about what to do. Something in
206 the middle takes the input, grabs the relevant rows from the database,
207 performs the action, constructs a page, and spits it out.
209 Maypole aims to be the most generic and extensible "something in the
210 middle" - an MVC-based web application framework.
212 An example would help explain this best. You need to add a product
213 catalogue to a company's web site. Users need to list the products in
214 various categories, view a page on each product with its photo and
215 pricing information and so on, and there needs to be a back-end where
216 sales staff can add new lines, change prices, and delete out of date
217 records. So, you set up the database, provide some default templates
218 for the designers to customize, and then write an Apache handler like
221 package ProductDatabase;
222 use base 'Maypole::Application';
223 __PACKAGE__->set_database("dbi:mysql:products");
224 ProductDatabase->config->uri_base = "http://your.site/catalogue/";
225 ProductDatabase::Product->has_a("category" => ProductDatabase::Category);
229 my ($self, $request) = @_;
230 return OK if $request->{ar}->get_remote_host() eq "sales.yourcorp.com";
231 return OK if $request->{action} =~ /^(view|list)$/;
236 You then put the following in your Apache config:
238 <Location /catalogue>
239 SetHandler perl-script
240 PerlHandler ProductDatabase
243 And copy the templates found in F<templates/factory> into the
244 F<catalogue/factory> directory off the web root. When the designers get
245 back to you with custom templates, they are to go in
246 F<catalogue/custom>. If you need to do override templates on a
247 database-table-by-table basis, put the new template in
248 F<catalogue/I<table>>.
250 This will automatically give you C<add>, C<edit>, C<list>, C<view> and
251 C<delete> commands; for instance, a product list, go to
253 http://your.site/catalogue/product/list
255 For a full example, see the included "beer database" application.
259 There's some documentation for the workflow in L<Maypole::Workflow>,
260 but the basic idea is that a URL part like C<product/list> gets
261 translated into a call to C<ProductDatabase::Product-E<gt>list>. This
262 propagates the request with a set of objects from the database, and then
263 calls the C<list> template; first, a C<product/list> template if it
264 exists, then the C<custom/list> and finally C<factory/list>.
266 If there's another action you want the system to do, you need to either
267 subclass the model class, and configure your class slightly differently:
269 package ProductDatabase::Model;
270 use base 'Maypole::Model::CDBI';
272 sub supersearch :Exported {
273 my ($self, $request) = @_;
274 # Do stuff, get a bunch of objects back
275 $r->objects(\@objects);
276 $r->template("template_name");
279 Then your top-level application package should change the model class:
280 (Before calling C<setup>)
282 ProductDatabase->config->model("ProductDatabase::Model");
284 (The C<:Exported> attribute means that the method can be called via the
285 URL C</I<table>/supersearch/...>.)
287 Alternatively, you can put the method directly into the specific model
290 sub ProductDatabase::Product::supersearch :Exported { ... }
292 By default, the view class uses Template Toolkit as the template
293 processor, and the model class uses C<Class::DBI>; it may help you to be
294 familiar with these modules before going much further with this,
295 although I expect there to be other subclasses for other templating
296 systems and database abstraction layers as time goes on. The article at
297 C<http://www.perl.com/pub/a/2003/07/15/nocode.html> is a great
298 introduction to the process we're trying to automate.
302 You should probably not use Maypole directly. Maypole is an abstract
303 class which does not specify how to communicate with the outside world.
304 The most popular subclass of Maypole is L<Apache::MVC>, which interfaces
305 the Maypole framework to Apache mod_perl; another important one is
306 L<CGI::Maypole>. However, if you just don't care, use Maypole::Application,
307 and it will choose the right one for you.
309 If you are implementing Maypole subclasses, you need to provide at least
310 the C<parse_location> and C<send_output> methods. You may also want to
311 provide C<get_request> and C<get_template_root>. See the
312 L<Maypole::Workflow> documentation for what these are expected to do.
316 sub get_template_root { "." }
320 die "Do not use Maypole directly; use Apache::MVC or similar";
324 die "Do not use Maypole directly; use Apache::MVC or similar";
329 There's more documentation, examples, and a wiki at the Maypole web site:
331 http://maypole.simon-cozens.org/
333 L<Maypole::Application>,L<Apache::MVC>, L<CGI::Maypole>.
337 Sebastian Riedel, c<sri@oook.de>
341 Simon Cozens, C<simon@cpan.org>
345 Jesse Scheidlower, Jody Belka, Marcus Ramberg, Mickael Joanne, Simon Flack,
346 Veljko Vidovic and all the others who've helped.
350 You may distribute this code under the same terms as Perl itself.