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 query 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 $self->{path} ||= "frontpage";
105 my @pi = split /\//, $self->{path};
106 shift @pi while @pi and !$pi[0];
107 $self->{table} = shift @pi;
108 $self->{action} = shift @pi;
109 $self->{args} = \@pi;
111 $self->{params} = { $self->{ar}->content };
112 $self->{query} = { $self->{ar}->args };
117 my $config = $self->config;
118 $config->{ok_tables} = {map {$_ => 1} @{$config->{display_tables}}};
119 warn "We don't have that table ($self->{table})"
120 unless $config->{ok_tables}{$self->{table}};
121 return DECLINED() unless exists $config->{ok_tables}{$self->{table}};
123 # Does the action method exist?
124 my $cv = $self->model_class->can($self->{action});
125 warn "We don't have that action ($self->{action})" unless $cv;
126 return DECLINED() unless $cv;
129 $self->{method_attribs} = join " ", attributes::get($cv);
130 do { warn "$self->{action} not exported";
132 } unless $self->{method_attribs} =~ /\bExported\b/i;
136 sub call_authenticate {
138 return $self->model_class->authenticate($self) if
139 $self->model_class->can("authenticate");
140 return $self->authenticate();
143 sub additional_data {}
145 sub authenticate { return OK }
151 Apache::MVC - Web front end to a data source
156 use base 'Apache::MVC';
157 sub handler { Apache::MVC::handler("BeerDB", @_) }
158 BeerDB->set_database("dbi:mysql:beerdb");
159 BeerDB->config->{uri_base} = "http://your.site/";
160 BeerDB->config->{display_tables} = [qw[beer brewery pub style]];
161 # Now set up your database:
162 # has-a relationships
169 A large number of web programming tasks follow the same sort of pattern:
170 we have some data in a datasource, typically a relational database. We
171 have a bunch of templates provided by web designers. We have a number of
172 things we want to be able to do with the database - create, add, edit,
173 delete records, view records, run searches, and so on. We have a web
174 server which provides input from the user about what to do. Something in
175 the middle takes the input, grabs the relevant rows from the database,
176 performs the action, constructs a page, and spits it out.
178 This module aims to be the most generic and extensible "something in the
181 An example would help explain this best. You need to add a product
182 catalogue to a company's web site. Users need to list the products in
183 various categories, view a page on each product with its photo and
184 pricing information and so on, and there needs to be a back-end where
185 sales staff can add new lines, change prices, and delete out of date
186 records. So, you set up the database, provide some default templates
187 for the designers to customize, and then write an Apache handler like
190 package ProductDatabase;
191 use base 'Apache::MVC';
192 __PACKAGE__->set_database("dbi:mysql:products");
193 BeerDB->config->{uri_base} = "http://your.site/catalogue/";
194 ProductDatabase::Product->has_a("category" => ProductDatabase::Category);
198 my ($self, $request) = @_;
199 return OK if $request->{ar}->get_remote_host() eq "sales.yourcorp.com";
200 return OK if $request->{action} =~ /^(view|list)$/;
205 You then put the following in your Apache config:
207 <Location /catalogue>
208 SetHandler perl-script
209 PerlHandler ProductDatabase
212 And copy the templates found in F<templates/factory> into the
213 F<catalogue/factory> directory off the web root. When the designers get
214 back to you with custom templates, they are to go in
215 F<catalogue/custom>. If you need to do override templates on a
216 database-table-by-table basis, put the new template in
217 F<catalogue/I<table>>.
219 This will automatically give you C<add>, C<edit>, C<list>, C<view> and
220 C<delete> commands; for instance, a product list, go to
222 http://your.site/catalogue/product/list
224 For a full example, see the included "beer database" application.
228 There's some documentation for the workflow in L<Apache::MVC::Workflow>,
229 but the basic idea is that a URL part like C<product/list> gets
230 translated into a call to C<ProductDatabase::Product-E<gt>list>. This
231 propagates the request with a set of objects from the database, and then
232 calls the C<list> template; first, a C<product/list> template if it
233 exists, then the C<custom/list> and finally C<factory/list>.
235 If there's another action you want the system to do, you need to either
236 subclass the model class, and configure your class slightly differently:
238 package ProductDatabase::Model;
239 use base 'Apache::MVC::Model::CDBI';
241 sub supersearch :Exported {
242 my ($self, $request) = @_;
243 # Do stuff, get a bunch of objects back
244 $r->objects(\@objects);
245 $r->template("template_name");
248 ProductDatabase->config->{model_class} = "ProductDatabase::Model";
250 (The C<:Exported> attribute means that the method can be called via the
251 URL C</I<table>/supersearch/...>.)
253 Alternatively, you can put the method directly into the specific model
256 sub ProductDatabase::Product::supersearch :Exported { ... }
258 By default, the view class uses Template Toolkit as the template
259 processor, and the model class uses C<Class::DBI>; it may help you to be
260 familiar with these modules before going much further with this,
261 although I expect there to be other subclasses for other templating
262 systems and database abstraction layers as time goes on. The article at
263 C<http://www.perl.com/pub/a/2003/07/15/nocode.html> is a great
264 introduction to the process we're trying to automate.
268 Simon Cozens, C<simon@cpan.org>
272 You may distribute this code under the same terms as Perl itself.