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