2 use base qw(Class::Accessor Class::Data::Inheritable);
4 use Class::DBI::Loader;
5 use UNIVERSAL::require;
6 use Apache::Constants ":common";
10 __PACKAGE__->mk_classdata($_) for qw( _config init_done view_object );
11 __PACKAGE__->mk_accessors ( qw( config ar params objects model_class
12 args action template ));
13 __PACKAGE__->config({});
14 __PACKAGE__->init_done(0);
19 if ($real ne "Apache::MVC") {
21 *{$real."::handler"} = sub { Apache::MVC::handler($real, @_) };
25 # This is really dirty.
28 if (ref $self) { return $self->_config_accessor(@_) }
29 return $self->_config(@_);
33 my ($calling_class, $dsn) = @_;
34 $calling_class = ref $calling_class if ref $calling_class;
35 my $config = $calling_class->config;
36 $config->{model} ||= "Apache::MVC::Model::CDBI";
37 $config->{model}->require;
38 $config->{dsn} = $dsn;
39 $config->{loader} = Class::DBI::Loader->new(
40 namespace => $calling_class,
43 $config->{classes} = [ $config->{loader}->classes ];
44 for my $subclass (@{$config->{classes}}) {
46 unshift @{$subclass."::ISA"}, $config->{model};
47 $config->{model}->adopt($subclass)
48 if $config->{model}->can("adopt");
54 my $config = $class->config;
55 $config->{view} ||= "Apache::MVC::View::TT";
56 $config->{view}->require;
57 $config->{display_tables} ||= [ $class->config->{loader}->tables ];
58 $class->view_object($class->config->{view}->new);
64 my ($self, $table) = @_;
65 return $self->config->{loader}->_table2class($table);
69 # See Apache::MVC::Workflow before trying to understand this.
71 $class->init unless $class->init_done;
72 my $r = bless { config => $class->config }, $class;
76 $r->model_class($r->class_of($r->{table}));
77 my $status = $r->is_applicable;
79 $status = $r->call_authenticate;
80 return $status unless $status == OK;
81 $r->additional_data();
83 $r->model_class->process($r);
85 # Otherwise, it's just a plain template.
86 delete $r->{model_class};
87 $r->{path} =~ s{/}{}; # De-absolutify
88 $r->template($r->{path});
90 return $r->view_object->process($r);
95 require Apache; require Apache::Request;
96 $self->{ar} = Apache::Request->new(Apache->request);
101 $self->{path} = $self->{ar}->uri;
102 my $loc = $self->{ar}->location;
103 $self->{path} =~ s/^$loc//; # I shouldn't need to do this?
104 my @pi = split /\//, $self->{path};
105 shift @pi while @pi and !$pi[0];
106 $self->{table} = shift @pi;
107 $self->{action} = shift @pi;
108 $self->{args} = \@pi;
110 $self->{params} = { $self->{ar}->content };
115 my $config = $self->config;
116 $config->{ok_tables} = {map {$_ => 1} @{$config->{display_tables}}};
117 warn "We don't have that table ($self->{table})"
118 unless $config->{ok_tables}{$self->{table}};
119 return DECLINED() unless exists $config->{ok_tables}{$self->{table}};
121 # Does the action method exist?
122 my $cv = $self->model_class->can($self->{action});
123 warn "We don't have that action ($self->{action})" unless $cv;
124 return DECLINED() unless $cv;
127 $self->{method_attribs} = join " ", attributes::get($cv);
128 do { warn "$self->{action} not exported";
130 } unless $self->{method_attribs} =~ /\bExported\b/i;
134 sub call_authenticate {
136 return $self->model_class->authenticate($self) if
137 $self->model_class->can("authenticate");
138 return $self->authenticate();
141 sub additional_data {}
143 sub authenticate { return OK }
149 Apache::MVC - Web front end to a data source
154 use base 'Apache::MVC';
155 sub handler { Apache::MVC::handler("BeerDB", @_) }
156 BeerDB->set_database("dbi:mysql:beerdb");
157 BeerDB->config->{uri_base} = "http://your.site/";
158 BeerDB->config->{display_tables} = [qw[beer brewery pub style]];
159 # Now set up your database:
160 # has-a relationships
167 A large number of web programming tasks follow the same sort of pattern:
168 we have some data in a datasource, typically a relational database. We
169 have a bunch of templates provided by web designers. We have a number of
170 things we want to be able to do with the database - create, add, edit,
171 delete records, view records, run searches, and so on. We have a web
172 server which provides input from the user about what to do. Something in
173 the middle takes the input, grabs the relevant rows from the database,
174 performs the action, constructs a page, and spits it out.
176 This module aims to be the most generic and extensible "something in the
179 An example would help explain this best. You need to add a product
180 catalogue to a company's web site. Users need to list the products in
181 various categories, view a page on each product with its photo and
182 pricing information and so on, and there needs to be a back-end where
183 sales staff can add new lines, change prices, and delete out of date
184 records. So, you set up the database, provide some default templates
185 for the designers to customize, and then write an Apache handler like
188 package ProductDatabase;
189 use base 'Apache::MVC';
190 __PACKAGE__->set_database("dbi:mysql:products");
191 BeerDB->config->{uri_base} = "http://your.site/catalogue/";
192 ProductDatabase::Product->has_a("category" => ProductDatabase::Category);
196 my ($self, $request) = @_;
197 return OK if $request->{ar}->get_remote_host() eq "sales.yourcorp.com";
198 return OK if $request->{action} =~ /^(view|list)$/;
203 You then put the following in your Apache config:
205 <Location /catalogue>
206 SetHandler perl-script
207 PerlHandler ProductDatabase
210 And copy the templates found in F<templates/factory> into the
211 F<catalogue/factory> directory off the web root. When the designers get
212 back to you with custom templates, they are to go in
213 F<catalogue/custom>. If you need to do override templates on a
214 database-table-by-table basis, put the new template in
215 F<catalogue/I<table>>.
217 This will automatically give you C<add>, C<edit>, C<list>, C<view> and
218 C<delete> commands; for instance, a product list, go to
220 http://your.site/catalogue/product/list
222 For a full example, see the included "beer database" application.
226 There's some documentation for the workflow in L<Apache::MVC::Workflow>,
227 but the basic idea is that a URL part like C<product/list> gets
228 translated into a call to C<ProductDatabase::Product-E<gt>list>. This
229 propagates the request with a set of objects from the database, and then
230 calls the C<list> template; first, a C<product/list> template if it
231 exists, then the C<custom/list> and finally C<factory/list>.
233 If there's another action you want the system to do, you need to either
234 subclass the model class, and configure your class slightly differently:
236 package ProductDatabase::Model;
237 use base 'Apache::MVC::Model::CDBI';
239 sub supersearch :Exported {
240 my ($self, $request) = @_;
241 # Do stuff, get a bunch of objects back
242 $r->objects(\@objects);
243 $r->template("template_name");
246 ProductDatabase->config->{model_class} = "ProductDatabase::Model";
248 (The C<:Exported> attribute means that the method can be called via the
249 URL C</I<table>/supersearch/...>.)
251 Alternatively, you can put the method directly into the specific model
254 sub ProductDatabase::Product::supersearch :Exported { ... }
256 By default, the view class uses Template Toolkit as the template
257 processor, and the model class uses C<Class::DBI>; it may help you to be
258 familiar with these modules before going much further with this,
259 although I expect there to be other subclasses for other templating
260 systems and database abstraction layers as time goes on. The article at
261 C<http://www.perl.com/pub/a/2003/07/15/nocode.html> is a great
262 introduction to the process we're trying to automate.
266 Simon Cozens, C<simon@cpan.org>
270 You may distribute this code under the same terms as Perl itself.