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