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 ( qw( ar params query objects model_class
10 args action template ));
11 __PACKAGE__->config({});
12 __PACKAGE__->init_done(0);
13 use Maypole::Constants;
18 my $calling_class = shift;
19 $calling_class = ref $calling_class if ref $calling_class;
23 *{$calling_class."::handler"} = sub { Maypole::handler($calling_class, @_) };
25 my $config = $calling_class->config;
26 $config->{model} ||= "Maypole::Model::CDBI";
27 $config->{model}->require;
28 die "Couldn't load the model class $config->{model}: $@" if $@;
29 $config->{model}->setup_database($config, $calling_class, @_);
30 for my $subclass (@{$config->{classes}}) {
32 unshift @{$subclass."::ISA"}, $config->{model};
33 $config->{model}->adopt($subclass)
34 if $config->{model}->can("adopt");
40 my $config = $class->config;
41 $config->{view} ||= "Maypole::View::TT";
42 $config->{view}->require;
43 die "Couldn't load the view class $config->{view}: $@" if $@;
44 $config->{display_tables} ||= [ @{$class->config->{tables}} ];
45 $class->view_object($class->config->{view}->new);
51 # See Maypole::Workflow before trying to understand this.
52 my ( $class, $req ) = @_;
53 $class->init unless $class->init_done;
54 my $r = bless { config => $class->config }, $class;
55 $r->get_request($req);
57 my $status = $r->handler_guts();
58 return $status unless $status == OK;
65 $r->model_class($r->config->{model}->class_of($r, $r->{table}));
66 my $applicable = $r->is_applicable;
67 unless ($applicable == OK) {
68 # It's just a plain template
69 delete $r->{model_class};
70 $r->{path} =~ s{/$}{}; # De-absolutify
71 $r->template($r->{path});
73 # We authenticate every request, needed for proper session management
74 my $status = $r->call_authenticate;
75 if ($r->debug and $status != OK and $status != DECLINED) {
76 $r->view_object->error($r,
77 "Got unexpected status $status from calling authentication");
79 return $status unless $status == OK;
80 # We run additional_data for every request
82 if ($applicable == OK) {
83 $r->model_class->process($r);
85 if (!$r->{output}) { # You might want to do it yourself
86 return $r->view_object->process($r);
92 my $config = $self->config;
93 $config->{ok_tables} ||= $config->{display_tables};
94 $config->{ok_tables} = {map {$_=>1} @{$config->{ok_tables}}}
95 if ref $config->{ok_tables} eq "ARRAY";
96 warn "We don't have that table ($self->{table})"
97 if $self->debug and not $config->{ok_tables}{$self->{table}};
98 return DECLINED() unless exists $config->{ok_tables}{$self->{table}};
100 # Does the action method exist?
101 my $cv = $self->model_class->can($self->{action});
102 warn "We don't have that action ($self->{action})"
103 if $self->debug and not $cv;
104 return DECLINED() unless $cv;
107 $self->{method_attribs} = join " ", attributes::get($cv);
108 do { warn "$self->{action} not exported" if $self->debug;
110 } unless $self->{method_attribs} =~ /\bExported\b/i;
114 sub call_authenticate {
116 # Check if we have a model class
117 if ($self->{model_class}) {
118 return $self->model_class->authenticate($self) if
119 $self->model_class->can("authenticate");
121 return $self->authenticate($self); # Interface consistency is a Good Thing
124 sub additional_data {}
126 sub authenticate { return OK }
130 $self->{path} ||= "frontpage";
131 my @pi = split /\//, $self->{path};
132 shift @pi while @pi and !$pi[0];
133 $self->{table} = shift @pi;
134 $self->{action} = shift @pi;
135 $self->{args} = \@pi;
140 Maypole - MVC web application framework
148 A large number of web programming tasks follow the same sort of pattern:
149 we have some data in a datasource, typically a relational database. We
150 have a bunch of templates provided by web designers. We have a number of
151 things we want to be able to do with the database - create, add, edit,
152 delete records, view records, run searches, and so on. We have a web
153 server which provides input from the user about what to do. Something in
154 the middle takes the input, grabs the relevant rows from the database,
155 performs the action, constructs a page, and spits it out.
157 Maypole aims to be the most generic and extensible "something in the
158 middle" - an MVC-based web application framework.
160 An example would help explain this best. You need to add a product
161 catalogue to a company's web site. Users need to list the products in
162 various categories, view a page on each product with its photo and
163 pricing information and so on, and there needs to be a back-end where
164 sales staff can add new lines, change prices, and delete out of date
165 records. So, you set up the database, provide some default templates
166 for the designers to customize, and then write an Apache handler like
169 package ProductDatabase;
170 use base 'Apache::MVC';
171 __PACKAGE__->set_database("dbi:mysql:products");
172 ProductDatabase->config->{uri_base} = "http://your.site/catalogue/";
173 ProductDatabase::Product->has_a("category" => ProductDatabase::Category);
177 my ($self, $request) = @_;
178 return OK if $request->{ar}->get_remote_host() eq "sales.yourcorp.com";
179 return OK if $request->{action} =~ /^(view|list)$/;
184 You then put the following in your Apache config:
186 <Location /catalogue>
187 SetHandler perl-script
188 PerlHandler ProductDatabase
191 And copy the templates found in F<templates/factory> into the
192 F<catalogue/factory> directory off the web root. When the designers get
193 back to you with custom templates, they are to go in
194 F<catalogue/custom>. If you need to do override templates on a
195 database-table-by-table basis, put the new template in
196 F<catalogue/I<table>>.
198 This will automatically give you C<add>, C<edit>, C<list>, C<view> and
199 C<delete> commands; for instance, a product list, go to
201 http://your.site/catalogue/product/list
203 For a full example, see the included "beer database" application.
207 There's some documentation for the workflow in L<Maypole::Workflow>,
208 but the basic idea is that a URL part like C<product/list> gets
209 translated into a call to C<ProductDatabase::Product-E<gt>list>. This
210 propagates the request with a set of objects from the database, and then
211 calls the C<list> template; first, a C<product/list> template if it
212 exists, then the C<custom/list> and finally C<factory/list>.
214 If there's another action you want the system to do, you need to either
215 subclass the model class, and configure your class slightly differently:
217 package ProductDatabase::Model;
218 use base 'Maypole::Model::CDBI';
220 sub supersearch :Exported {
221 my ($self, $request) = @_;
222 # Do stuff, get a bunch of objects back
223 $r->objects(\@objects);
224 $r->template("template_name");
227 Then your top-level application package should change the model class:
228 (Before calling C<setup>)
230 ProductDatabase->config->{model} = "ProductDatabase::Model";
232 (The C<:Exported> attribute means that the method can be called via the
233 URL C</I<table>/supersearch/...>.)
235 Alternatively, you can put the method directly into the specific model
238 sub ProductDatabase::Product::supersearch :Exported { ... }
240 By default, the view class uses Template Toolkit as the template
241 processor, and the model class uses C<Class::DBI>; it may help you to be
242 familiar with these modules before going much further with this,
243 although I expect there to be other subclasses for other templating
244 systems and database abstraction layers as time goes on. The article at
245 C<http://www.perl.com/pub/a/2003/07/15/nocode.html> is a great
246 introduction to the process we're trying to automate.
250 You should probably not use Maypole directly. Maypole is an abstract
251 class which does not specify how to communicate with the outside world.
252 The most popular subclass of Maypole is L<Apache::MVC>, which interfaces
253 the Maypole framework to Apache mod_perl; another important one is
256 If you are implementing Maypole subclasses, you need to provide at least
257 the C<parse_location> and C<send_output> methods. You may also want to
258 provide C<get_request> and C<get_template_root>. See the
259 L<Maypole::Workflow> documentation for what these are expected to do.
263 sub get_template_root { "." }
265 sub parse_location { die "Do not use Maypole directly; use Apache::MVC or similar" }
266 sub send_output{ die "Do not use Maypole directly; use Apache::MVC or similar" }
270 There's more documentation, examples, and a wiki at the Maypole web site:
272 http://maypole.simon-cozens.org/
274 L<Apache::MVC>, L<CGI::Maypole>.
278 Sebastian Riedel, c<sri@oook.de>
282 Simon Cozens, C<simon@cpan.org>
286 Jesse Scheidlower, Jody Belka, Markus Ramberg, Mickael Joanne, Simon Flack and all the others who've helped.
290 You may distribute this code under the same terms as Perl itself.