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, @_) };
26 $calling_class->config($config);
27 $config->{model} ||= "Maypole::Model::CDBI";
28 $config->{model}->require;
29 die "Couldn't load the model class $config->{model}: $@" if $@;
30 $config->{model}->setup_database($config, $calling_class, @_);
31 for my $subclass (@{$config->{classes}}) {
33 unshift @{$subclass."::ISA"}, $config->{model};
34 $config->{model}->adopt($subclass)
35 if $config->{model}->can("adopt");
41 my $config = $class->config;
42 $config->{view} ||= "Maypole::View::TT";
43 $config->{view}->require;
44 die "Couldn't load the view class $config->{view}: $@" if $@;
45 $config->{display_tables} ||= [ @{$class->config->{tables}} ];
46 $class->view_object($class->config->{view}->new);
52 # See Maypole::Workflow before trying to understand this.
54 $class->init unless $class->init_done;
55 my $r = bless { config => $class->config }, $class;
58 my $status = $r->handler_guts();
59 return $status unless $status == OK;
60 $r->{content_type} ||= "text/html";
67 $r->model_class($r->config->{model}->class_of($r, $r->{table}));
68 my $status = $r->is_applicable;
70 $status = $r->call_authenticate;
71 if ($r->debug and $status != OK and $status != DECLINED) {
72 $r->view_object->error($r,
73 "Got unexpected status $status from calling authentication");
75 return $status unless $status == OK;
76 $r->additional_data();
78 $r->model_class->process($r);
80 # Otherwise, it's just a plain template.
81 delete $r->{model_class};
82 $r->{path} =~ s{/}{}; # De-absolutify
83 $r->template($r->{path});
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 return $self->model_class->authenticate($self) if
117 $self->model_class->can("authenticate");
118 return $self->authenticate($self); # Interface consistency is a Good Thing
121 sub additional_data {}
123 sub authenticate { return OK }
127 $self->{path} ||= "frontpage";
128 my @pi = split /\//, $self->{path};
129 shift @pi while @pi and !$pi[0];
130 $self->{table} = shift @pi;
131 $self->{action} = shift @pi;
132 $self->{args} = \@pi;
137 Maypole - MVC web application framework
145 A large number of web programming tasks follow the same sort of pattern:
146 we have some data in a datasource, typically a relational database. We
147 have a bunch of templates provided by web designers. We have a number of
148 things we want to be able to do with the database - create, add, edit,
149 delete records, view records, run searches, and so on. We have a web
150 server which provides input from the user about what to do. Something in
151 the middle takes the input, grabs the relevant rows from the database,
152 performs the action, constructs a page, and spits it out.
154 Maypole aims to be the most generic and extensible "something in the
155 middle" - an MVC-based web application framework.
157 An example would help explain this best. You need to add a product
158 catalogue to a company's web site. Users need to list the products in
159 various categories, view a page on each product with its photo and
160 pricing information and so on, and there needs to be a back-end where
161 sales staff can add new lines, change prices, and delete out of date
162 records. So, you set up the database, provide some default templates
163 for the designers to customize, and then write an Apache handler like
166 package ProductDatabase;
167 use base 'Apache::MVC';
168 __PACKAGE__->set_database("dbi:mysql:products");
169 ProductDatabase->config->{uri_base} = "http://your.site/catalogue/";
170 ProductDatabase::Product->has_a("category" => ProductDatabase::Category);
174 my ($self, $request) = @_;
175 return OK if $request->{ar}->get_remote_host() eq "sales.yourcorp.com";
176 return OK if $request->{action} =~ /^(view|list)$/;
181 You then put the following in your Apache config:
183 <Location /catalogue>
184 SetHandler perl-script
185 PerlHandler ProductDatabase
188 And copy the templates found in F<templates/factory> into the
189 F<catalogue/factory> directory off the web root. When the designers get
190 back to you with custom templates, they are to go in
191 F<catalogue/custom>. If you need to do override templates on a
192 database-table-by-table basis, put the new template in
193 F<catalogue/I<table>>.
195 This will automatically give you C<add>, C<edit>, C<list>, C<view> and
196 C<delete> commands; for instance, a product list, go to
198 http://your.site/catalogue/product/list
200 For a full example, see the included "beer database" application.
204 There's some documentation for the workflow in L<Maypole::Workflow>,
205 but the basic idea is that a URL part like C<product/list> gets
206 translated into a call to C<ProductDatabase::Product-E<gt>list>. This
207 propagates the request with a set of objects from the database, and then
208 calls the C<list> template; first, a C<product/list> template if it
209 exists, then the C<custom/list> and finally C<factory/list>.
211 If there's another action you want the system to do, you need to either
212 subclass the model class, and configure your class slightly differently:
214 package ProductDatabase::Model;
215 use base 'Maypole::Model::CDBI';
217 sub supersearch :Exported {
218 my ($self, $request) = @_;
219 # Do stuff, get a bunch of objects back
220 $r->objects(\@objects);
221 $r->template("template_name");
224 Then your top-level application package should change the model class:
225 (Before calling C<setup>)
227 ProductDatabase->config->{model} = "ProductDatabase::Model";
229 (The C<:Exported> attribute means that the method can be called via the
230 URL C</I<table>/supersearch/...>.)
232 Alternatively, you can put the method directly into the specific model
235 sub ProductDatabase::Product::supersearch :Exported { ... }
237 By default, the view class uses Template Toolkit as the template
238 processor, and the model class uses C<Class::DBI>; it may help you to be
239 familiar with these modules before going much further with this,
240 although I expect there to be other subclasses for other templating
241 systems and database abstraction layers as time goes on. The article at
242 C<http://www.perl.com/pub/a/2003/07/15/nocode.html> is a great
243 introduction to the process we're trying to automate.
247 You should probably not use Maypole directly. Maypole is an abstract
248 class which does not specify how to communicate with the outside world.
249 The most popular subclass of Maypole is L<Apache::MVC>, which interfaces
250 the Maypole framework to Apache mod_perl; another important one is
253 If you are implementing Maypole subclasses, you need to provide at least
254 the C<parse_location> and C<send_output> methods. You may also want to
255 provide C<get_request> and C<get_template_root>. See the
256 L<Maypole::Workflow> documentation for what these are expected to do.
260 sub get_template_root { "." }
262 sub parse_location { die "Do not use Maypole directly; use Apache::MVC or similar" }
263 sub send_output{ die "Do not use Maypole directly; use Apache::MVC or similar" }
267 There's more documentation, examples, and a wiki at the Maypole web site:
269 http://maypole.simon-cozens.org/
271 L<Apache::MVC>, L<CGI::Maypole>.
275 Simon Cozens, C<simon@cpan.org>
279 You may distribute this code under the same terms as Perl itself.