NAME => 'Apache::MVC',
VERSION_FROM => 'lib/Apache/MVC.pm', # finds $VERSION
PREREQ_PM => {
- DBD::SQLite => 0, # For testing
Class::DBI::Loader => 0,
Class::DBI::AbstractSearch => 0,
Class::DBI::Pager => 0,
if (!-e "t/beerdb.db") {
print "Making SQLite DB\n";
- require DBD::SQLite;
+ require DBD::SQLite
+ or die "No, wait, we don't have SQLite installed. Never mind\n";
require DBI;
my $dbh = DBI->connect("dbi:SQLite:dbname=t/beerdb.db");
$r->get_request();
$r->parse_location();
- warn "Parsed location\n";
$r->model_class($r->class_of($r->{table}));
my $status = $r->is_applicable;
if ($status == OK) {
$r->model_class->process($r);
} else {
- warn "Plain template $r->{path}";
# Otherwise, it's just a plain template.
delete $r->{model_class};
$r->{path} =~ s{/}{}; # De-absolutify
$r->template($r->{path});
- warn $r->template;
}
return $r->view_object->process($r);
}
$self->{path} = $self->{ar}->uri;
my $loc = $self->{ar}->location;
$self->{path} =~ s/^$loc//; # I shouldn't need to do this?
- warn "Path is $self->{path}";
my @pi = split /\//, $self->{path};
shift @pi while @pi and !$pi[0];
$self->{table} = shift @pi;
1;
-=haed1 DESCRIPTION
+=head1 DESCRIPTION
A large number of web programming tasks follow the same sort of pattern:
we have some data in a datasource, typically a relational database. We
for the designers to customize, and then write an Apache handler like
this:
- package MyCorp::ProductDatabase;
+ package ProductDatabase;
use base 'Apache::MVC';
__PACKAGE__->set_database("dbi:mysql:products");
+ BeerDB->config->{uri_base} = "http://your.site/catalogue/";
+ ProductDatabase::Product->has_a("category" => ProductDatabase::Category);
+ # ...
+ sub authenticate {
+ my ($self, $request) = @_;
+ return OK if $request->{ar}->get_remote_host() eq "sales.yourcorp.com";
+ return OK if $request->{action} =~ /^(view|list)$/;
+ return DECLINED;
+ }
+ 1;
+
+You then put the following in your Apache config:
+
+ <Location /catalogue>
+ SetHandler perl-script
+ PerlHandler ProductDatabase
+ </Location>
+
+And copy the templates found in F<templates/factory> into the
+F<catalogue/factory> directory off the web root. When the designers get
+back to you with custom templates, they are to go in
+F<catalogue/custom>. If you need to do override templates on a
+database-table-by-table basis, put the new template in
+F<catalogue/I<table>>.
+
+This will automatically give you C<add>, C<edit>, C<list>, C<view> and
+C<delete> commands; for instance, a product list, go to
+
+ http://your.site/catalogue/product/list
+
+For a full example, see the included "beer database" application.
+
+=head1 HOW IT WORKS
+
+There's some documentation for the workflow in L<Apache::MVC::Workflow>,
+but the basic idea is that a URL part like C<product/list> gets
+translated into a call to C<ProductDatabase::Product-E<gt>list>. This
+propagates the request with a set of objects from the database, and then
+calls the C<list> template; first, a C<product/list> template if it
+exists, then the C<custom/list> and finally C<factory/list>.
+
+If there's another action you want the system to do, you need to either
+subclass the model class, and configure your class slightly differently:
+
+ package ProductDatabase::Model;
+ use base 'Apache::MVC::Model::CDBI';
+
+ sub supersearch :Exported {
+ my ($self, $request) = @_;
+ # Do stuff, get a bunch of objects back
+ $r->objects(\@objects);
+ $r->template("template_name");
+ }
+
+ ProductDatabase->config->{model_class} = "ProductDatabase::Model";
+
+(The C<:Exported> attribute means that the method can be called via the
+URL C</I<table>/supersearch/...>.)
+
+Alternatively, you can put the method directly into the specific model
+class for the table:
+
+ sub ProductDatabase::Product::supersearch :Exported { ... }
+
+By default, the view class uses Template Toolkit as the template
+processor, and the model class uses C<Class::DBI>; it may help you to be
+familiar with these modules before going much further with this,
+although I expect there to be other subclasses for other templating
+systems and database abstraction layers as time goes on. The article at
+C<http://www.perl.com/pub/a/2003/07/15/nocode.html> is a great
+introduction to the process we're trying to automate.
+
+=head1 AUTHOR
+
+Simon Cozens, C<simon@cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
package Apache::MVC::Model::Base;
our %remember;
-sub MODIFY_CODE_ATTRIBUTES {
- $remember{$_[1]} = $_[2]; ()
-}
-
-sub FETCH_CODE_ATTRIBUTES { $remember{$_[1]}
-}
+sub MODIFY_CODE_ATTRIBUTES { $remember{$_[1]} = $_[2]; () }
+sub FETCH_CODE_ATTRIBUTES { $remember{$_[1]} }
sub view :Exported { }
sub edit :Exported { }
-sub do_edit { die "This is an abstract method" }
-sub get_objects { die "This is an abstract method" }
-
sub list :Exported {
my ($self, $r) = @_;
$r->objects([ $self->retrieve_all ]);
sub process {
my ($class, $r) = @_;
$r->template( my $method = $r->action );
- $r->objects([ $class->get_objects($r) ]);
- $class->$method($r)
+ $r->objects([ $class->retrieve(shift @{$r->{args}}) ]);
+ $class->$method($r);
}
+
+=head1 NAME
+
+Apache::MVC::Model::Base - Base class for model classes
+
+=head1 DESCRIPTION
+
+Anyone subclassing this for a different database abstraction mechanism
+needs to provide the following methods:
+
+=head2 do_edit
+
+If there is an object in C<$r-E<gt>objects>, then it should be edited
+with the parameters in C<$r-E<gt>params>; otherwise, a new object should
+be created with those parameters, and put back into C<$r-E<gt>objects>.
+The template should be changed to C<view>, or C<edit> if there were any
+errors. A hash of errors will be passed to the template.
+
+=cut
+
+sub do_edit { die "This is an abstract method" }
+
+=head2 retrieve
+
+This turns an ID into an object of the appropriate class.
+
+=head2 adopt
+
+This is called on an model class representing a table and allows the
+master model class to do any set-up required.
+
+=head2 related
+
+This can go either in the master model class or in the individual
+classes, and returns a list of has-many accessors. A brewery has many
+beers, so C<BeerDB::Brewery> needs to return C<beers>.
+
+=head2 columns
+
+This is a list of the columns in a table.
+
+=head2 table
+
+This is the name of the table.
+
+=head2 Commands
+
+See the exported commands in C<Apache::MVC::Model::CDBI>.
+
+=head1 Other overrides
+
+Additionally, individual derived model classes may want to override the
+following methods:
+
+=head2 column_names
+
+Return a hash mapping column names with human-readable equivalents.
+
+=cut
+
+sub column_names { my $class = shift; map { $_ => ucfirst $_ } $class->columns }
+
+=head2 description
+
+A description of the class to be passed to the template.
+
+=cut
+
+sub description { "A poorly defined class" }
+
+1;
+
use CGI::Untaint;
use strict;
-sub description { "A poorly defined class" }
-
-sub column_names { my $class = shift; map { $_ => ucfirst $_ } $class->columns }
-
-sub get_objects {
- my ($self, $r) = @_;
- return $self->retrieve(shift @{$r->{args}});
-}
-
sub related {
my ($self, $r) = @_;
# Has-many methods; XXX this is a hack
}
sub search :Exported {
+ return shift->SUPER::search(@_) if caller eq "Class::DBI"; # oops
my ($self, $r) = @_;
my %fields = map {$_ => 1 } $self->columns;
my $oper = "like"; # For now
+ use Carp; Carp::confess("Urgh") unless ref $r;
my %params = %{$r->{params}};
my %values = map { $_ => {$oper, $oper eq "like" ? "%".$params{$_}."%"
:$params{$_} } }
$r->{template_args}{search} = 1;
}
-
1;
+
+=head1 NAME
+
+Apache::MVC::Model::CDBI - Model class based on Class::DBI
+
+=head1 DESCRIPTION
+
+This is a master model class which uses C<Class::DBI> to do all the hard
+work of fetching rows and representing them as objects; instead, it
+concentrates on the actions that can be performed in the URL:
+C<do_edit>, C<delete> and C<search>.
my $class = $r->model_class;
my %args = (
request => $r,
- class => $class,
objects => $r->objects,
base => $r->config->{uri_base},
config => $r->config
my ($self, $r) = @_;
my $template = $self->_tt($r);
my $output;
- warn "Processing ".$r->template;
$template->process($r->template, { $self->_args($r) }, \$output)
|| return $self->error($r, $template->error);
- warn "And off it goes!\n";
$r->{ar}->content_type("text/html");
$r->{ar}->headers_out->set("Content-Length" => length $output);
$r->{ar}->send_http_header;
=head2 Add any additional data to the request
The open-ended C<additional_data> method allows any additional fiddling
-with the request object before it is despatched.
+with the request object before it is despatched. Specifically, it allows
+you to add to the C<template_args> slot, which is a hash of arguments to
+be added to the template.
=head2 Ask model for widget set
=head1 Model class processing
The model's C<process> method is usually a thin wrapper around the
-action that we have selected.
+action that we have selected. It sets the template name to the name of
+the action, fills C<objects> with an object of that class whose ID comes
+from the URL arguments if there is one. For instance, C</beer/foo/12>
+will do the moral equivalent of
+
+ $r->objects([ BeerDB::Beer->retrieve(12) ]);
+
+Then it calls the right method: in this case, the C<foo> method with
+the request object. This method will usually do any actions which are
+required, including modifying the list of objects to be passed to the
+template, or the name of the template to be called.
+
+=head1 Template class processing
+
+Finally, the template processor is handed the objects, the template
+name, and various other bits and pieces, and tries to find the right
+template. It does this by looking first for C</beer/foo>: that is, a
+specific template appropriate to the class. Next, it looks at
+C</custom/foo>, a local modification, before looking for
+C</factory/foo>, one of the default templates that came with
+C<Apache::MVC>.
+
+=head2 Default template arguments
+
+The following things are passed to the Template Toolkit template by
+default:
+
+=over 3
+
+=item request
+
+The whole C<Apache::MVC> request object, for people getting really dirty
+with the templates.
+
+=item objects
+
+The objects handed to us by the model.
+
+=item base
+
+The base URL of the application.
+
+=item config
+
+The whole configuration hash for the application.
+
+=item classmetadata
+
+A hash consisting of:
+
+C<name> - The name of the model class for the request: e.g. C<BeerDB::Beer>.
+
+C<columns> - The names of the columns in this class.
+
+C<colnames> - A hash mapping between the database's idea of a column
+name and a human-readable equivalent. (C<abv> should be mapped to
+C<A.B.V.>, perhaps.)
+
+C<related_accessors> - A list of accessors which are not exactly fields
+in the table but are related by a has-many relationship. For instance,
+breweries have many beers, so C<beers> would appear in the list.
+
+C<moniker> - The human-readable name for the class: C<beer>.
+
+C<plural> - The same, only plural: C<beers>.
+
+C<cgi> - A hash mapping columns and C<HTML::Element> objects
+representing a form field for editing that column.
+
+C<description> - (Perhaps) a user-supplied description of the class.
+
+=back
+
+Additionally, depending on the number of objects, there will be an alias
+for the C<objects> slot with the name of the moniker or plural moniker.
+
+That sounds a bit tricky, but what it means is that if you look at
+C</beer/view/4> then C<beer> will be populated with a C<BeerDB::Beer>
+object with ID 4. On the other hand, if you look at C</beer/list> you
+can get all the beers in C<beers> as well as in C<objects>.
+
-=head2
# vim:ft=perl
use Test::More 'no_plan';
-use Apache::MVC;
-use Apache::FakeRequest;
-package BeerDB;
-our %data;
-use base 'Apache::MVC';
-BeerDB->set_database("dbi:SQLite:dbname=t/beerdb.db");
-
-BeerDB::Brewery->has_many(beers => "BeerDB::Beer");
-BeerDB::Beer->has_a(brewery => "BeerDB::Brewery");
-
-BeerDB::Handpump->has_a(beer => "BeerDB::Beer");
-BeerDB::Handpump->has_a(pub => "BeerDB::Pub");
-BeerDB::Pub->has_many(beers => [ BeerDB::Handpump => 'beer' ]);
-BeerDB::Beer->has_many(pubs => [ BeerDB::Handpump => 'pub' ]);
-
-sub get_request {
- my $self = shift;
- $self->{ar} = Apache::FakeRequest->new(%data);
-}
-
-$data{uri} = "/beer/view/1";
-my $r = BeerDB->handler();
-use Data::Dumper;
-print Dumper($r);
+use_ok('Apache::MVC');
projects / maypole.git / commitdiff