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