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.
53 $class->init unless $class->init_done;
54 my $r = bless { config => $class->config }, $class;
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 $status = $r->is_applicable;
68 $status = $r->call_authenticate;
69 if ($r->debug and $status != OK and $status != DECLINED) {
70 $r->view_object->error($r,
71 "Got unexpected status $status from calling authentication");
73 return $status unless $status == OK;
74 $r->additional_data();
76 $r->model_class->process($r);
78 # Otherwise, it's just a plain template.
79 $r->call_authenticate; # No harm in it
80 delete $r->{model_class};
81 $r->{path} =~ s{/}{}; # De-absolutify
82 $r->template($r->{path});
84 if (!$r->{output}) { # You might want to do it yourself
85 return $r->view_object->process($r);
91 my $config = $self->config;
92 $config->{ok_tables} = {map {$_ => 1} @{$config->{display_tables}}};
93 warn "We don't have that table ($self->{table})"
94 if $self->debug and not $config->{ok_tables}{$self->{table}};
95 return DECLINED() unless exists $config->{ok_tables}{$self->{table}};
97 # Does the action method exist?
98 my $cv = $self->model_class->can($self->{action});
99 warn "We don't have that action ($self->{action})"
100 if $self->debug and not $cv;
101 return DECLINED() unless $cv;
104 $self->{method_attribs} = join " ", attributes::get($cv);
105 do { warn "$self->{action} not exported" if $self->debug;
107 } unless $self->{method_attribs} =~ /\bExported\b/i;
111 sub call_authenticate {
113 return $self->model_class->authenticate($self) if
114 $self->model_class->can("authenticate");
115 return $self->authenticate($self); # Interface consistency is a Good Thing
118 sub additional_data {}
120 sub authenticate { return OK }
124 $self->{path} ||= "frontpage";
125 my @pi = split /\//, $self->{path};
126 shift @pi while @pi and !$pi[0];
127 $self->{table} = shift @pi;
128 $self->{action} = shift @pi;
129 $self->{args} = \@pi;
134 Maypole - MVC web application framework
142 A large number of web programming tasks follow the same sort of pattern:
143 we have some data in a datasource, typically a relational database. We
144 have a bunch of templates provided by web designers. We have a number of
145 things we want to be able to do with the database - create, add, edit,
146 delete records, view records, run searches, and so on. We have a web
147 server which provides input from the user about what to do. Something in
148 the middle takes the input, grabs the relevant rows from the database,
149 performs the action, constructs a page, and spits it out.
151 Maypole aims to be the most generic and extensible "something in the
152 middle" - an MVC-based web application framework.
154 An example would help explain this best. You need to add a product
155 catalogue to a company's web site. Users need to list the products in
156 various categories, view a page on each product with its photo and
157 pricing information and so on, and there needs to be a back-end where
158 sales staff can add new lines, change prices, and delete out of date
159 records. So, you set up the database, provide some default templates
160 for the designers to customize, and then write an Apache handler like
163 package ProductDatabase;
164 use base 'Apache::MVC';
165 __PACKAGE__->set_database("dbi:mysql:products");
166 ProductDatabase->config->{uri_base} = "http://your.site/catalogue/";
167 ProductDatabase::Product->has_a("category" => ProductDatabase::Category);
171 my ($self, $request) = @_;
172 return OK if $request->{ar}->get_remote_host() eq "sales.yourcorp.com";
173 return OK if $request->{action} =~ /^(view|list)$/;
178 You then put the following in your Apache config:
180 <Location /catalogue>
181 SetHandler perl-script
182 PerlHandler ProductDatabase
185 And copy the templates found in F<templates/factory> into the
186 F<catalogue/factory> directory off the web root. When the designers get
187 back to you with custom templates, they are to go in
188 F<catalogue/custom>. If you need to do override templates on a
189 database-table-by-table basis, put the new template in
190 F<catalogue/I<table>>.
192 This will automatically give you C<add>, C<edit>, C<list>, C<view> and
193 C<delete> commands; for instance, a product list, go to
195 http://your.site/catalogue/product/list
197 For a full example, see the included "beer database" application.
201 There's some documentation for the workflow in L<Maypole::Workflow>,
202 but the basic idea is that a URL part like C<product/list> gets
203 translated into a call to C<ProductDatabase::Product-E<gt>list>. This
204 propagates the request with a set of objects from the database, and then
205 calls the C<list> template; first, a C<product/list> template if it
206 exists, then the C<custom/list> and finally C<factory/list>.
208 If there's another action you want the system to do, you need to either
209 subclass the model class, and configure your class slightly differently:
211 package ProductDatabase::Model;
212 use base 'Maypole::Model::CDBI';
214 sub supersearch :Exported {
215 my ($self, $request) = @_;
216 # Do stuff, get a bunch of objects back
217 $r->objects(\@objects);
218 $r->template("template_name");
221 Then your top-level application package should change the model class:
222 (Before calling C<setup>)
224 ProductDatabase->config->{model} = "ProductDatabase::Model";
226 (The C<:Exported> attribute means that the method can be called via the
227 URL C</I<table>/supersearch/...>.)
229 Alternatively, you can put the method directly into the specific model
232 sub ProductDatabase::Product::supersearch :Exported { ... }
234 By default, the view class uses Template Toolkit as the template
235 processor, and the model class uses C<Class::DBI>; it may help you to be
236 familiar with these modules before going much further with this,
237 although I expect there to be other subclasses for other templating
238 systems and database abstraction layers as time goes on. The article at
239 C<http://www.perl.com/pub/a/2003/07/15/nocode.html> is a great
240 introduction to the process we're trying to automate.
244 You should probably not use Maypole directly. Maypole is an abstract
245 class which does not specify how to communicate with the outside world.
246 The most popular subclass of Maypole is L<Apache::MVC>, which interfaces
247 the Maypole framework to Apache mod_perl; another important one is
250 If you are implementing Maypole subclasses, you need to provide at least
251 the C<parse_location> and C<send_output> methods. You may also want to
252 provide C<get_request> and C<get_template_root>. See the
253 L<Maypole::Workflow> documentation for what these are expected to do.
257 sub get_template_root { "." }
259 sub parse_location { die "Do not use Maypole directly; use Apache::MVC or similar" }
260 sub send_output{ die "Do not use Maypole directly; use Apache::MVC or similar" }
264 There's more documentation, examples, and a wiki at the Maypole web site:
266 http://maypole.simon-cozens.org/
268 L<Apache::MVC>, L<CGI::Maypole>.
272 Simon Cozens, C<simon@cpan.org>
276 You may distribute this code under the same terms as Perl itself.