From 4c4e58eb02155a43397f30b900c5b30f755cb874 Mon Sep 17 00:00:00 2001 From: Simon Cozens Date: Sat, 31 Jan 2004 19:02:15 +0000 Subject: [PATCH] Swathes of documentation. git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@38 48953598-375a-da11-a14b-00016c27c3ee --- Makefile.PL | 4 +- lib/Apache/MVC.pm | 87 +++++++++++++++++++++++++++++++++--- lib/Apache/MVC/Model/Base.pm | 87 +++++++++++++++++++++++++++++++----- lib/Apache/MVC/Model/CDBI.pm | 23 +++++----- lib/Apache/MVC/View/TT.pm | 3 -- lib/Apache/MVC/Workflow.pod | 87 ++++++++++++++++++++++++++++++++++-- t/1.t | 25 +---------- 7 files changed, 257 insertions(+), 59 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index 398f6ab..0fd48c0 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -6,7 +6,6 @@ WriteMakefile( 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, @@ -26,7 +25,8 @@ WriteMakefile( 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"); diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm index c9db3ae..910562c 100644 --- a/lib/Apache/MVC.pm +++ b/lib/Apache/MVC.pm @@ -73,7 +73,6 @@ sub handler { $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) { @@ -83,12 +82,10 @@ sub handler { $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); } @@ -104,7 +101,6 @@ sub parse_location { $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; @@ -166,7 +162,7 @@ Apache::MVC - Web front end to a data source 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 @@ -189,7 +185,86 @@ records. So, you set up the database, provide some default templates 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: + + + SetHandler perl-script + PerlHandler ProductDatabase + + +And copy the templates found in F into the +F directory off the web root. When the designers get +back to you with custom templates, they are to go in +F. If you need to do override templates on a +database-table-by-table basis, put the new template in +F>. + +This will automatically give you C, C, C, C and +C 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, +but the basic idea is that a URL part like C gets +translated into a call to Clist>. This +propagates the request with a set of objects from the database, and then +calls the C template; first, a C template if it +exists, then the C and finally C. + +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/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; 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 is a great +introduction to the process we're trying to automate. + +=head1 AUTHOR + +Simon Cozens, C + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. diff --git a/lib/Apache/MVC/Model/Base.pm b/lib/Apache/MVC/Model/Base.pm index afbc60d..b7337be 100644 --- a/lib/Apache/MVC/Model/Base.pm +++ b/lib/Apache/MVC/Model/Base.pm @@ -1,18 +1,11 @@ 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 ]); @@ -21,6 +14,78 @@ sub list :Exported { 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-Eobjects>, then it should be edited +with the parameters in C<$r-Eparams>; otherwise, a new object should +be created with those parameters, and put back into C<$r-Eobjects>. +The template should be changed to C, or C 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 needs to return C. + +=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. + +=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; + diff --git a/lib/Apache/MVC/Model/CDBI.pm b/lib/Apache/MVC/Model/CDBI.pm index 4d6339d..8d75c30 100644 --- a/lib/Apache/MVC/Model/CDBI.pm +++ b/lib/Apache/MVC/Model/CDBI.pm @@ -7,15 +7,6 @@ use Class::DBI::AbstractSearch; 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 @@ -62,9 +53,11 @@ sub adopt { } 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{$_} } } @@ -75,5 +68,15 @@ sub search :Exported { $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 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, C and C. diff --git a/lib/Apache/MVC/View/TT.pm b/lib/Apache/MVC/View/TT.pm index 4c15ea9..babd0f4 100644 --- a/lib/Apache/MVC/View/TT.pm +++ b/lib/Apache/MVC/View/TT.pm @@ -26,7 +26,6 @@ sub _args { my $class = $r->model_class; my %args = ( request => $r, - class => $class, objects => $r->objects, base => $r->config->{uri_base}, config => $r->config @@ -61,11 +60,9 @@ sub process { 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; diff --git a/lib/Apache/MVC/Workflow.pod b/lib/Apache/MVC/Workflow.pod index 14a6930..7a0e9f3 100644 --- a/lib/Apache/MVC/Workflow.pod +++ b/lib/Apache/MVC/Workflow.pod @@ -95,7 +95,9 @@ should return an Apache status code. =head2 Add any additional data to the request The open-ended C 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 slot, which is a hash of arguments to +be added to the template. =head2 Ask model for widget set @@ -114,6 +116,85 @@ We will go into more detail about these last two phases. =head1 Model class processing The model's C 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 with an object of that class whose ID comes +from the URL arguments if there is one. For instance, C +will do the moral equivalent of + + $r->objects([ BeerDB::Beer->retrieve(12) ]); + +Then it calls the right method: in this case, the C 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: that is, a +specific template appropriate to the class. Next, it looks at +C, a local modification, before looking for +C, one of the default templates that came with +C. + +=head2 Default template arguments + +The following things are passed to the Template Toolkit template by +default: + +=over 3 + +=item request + +The whole C 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 - The name of the model class for the request: e.g. C. + +C - The names of the columns in this class. + +C - A hash mapping between the database's idea of a column +name and a human-readable equivalent. (C should be mapped to +C, perhaps.) + +C - 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 would appear in the list. + +C - The human-readable name for the class: C. + +C - The same, only plural: C. + +C - A hash mapping columns and C objects +representing a form field for editing that column. + +C - (Perhaps) a user-supplied description of the class. + +=back + +Additionally, depending on the number of objects, there will be an alias +for the C 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 then C will be populated with a C +object with ID 4. On the other hand, if you look at C you +can get all the beers in C as well as in C. + -=head2 diff --git a/t/1.t b/t/1.t index 2560fe9..fe7939c 100644 --- a/t/1.t +++ b/t/1.t @@ -1,26 +1,3 @@ # 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'); -- 2.39.5