WriteMakefile(
NAME => 'Apache::MVC',
VERSION_FROM => 'lib/Apache/MVC.pm', # finds $VERSION
- PREREQ_PM => {}, # e.g., Module::Name => 1.1
+ PREREQ_PM => {
+ DBD::SQLite => 0, # For testing
+ Class::DBI::Loader => 0,
+ Apache::Request => 0,
+ Template => 0,
+ }, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/Apache/MVC.pm', # retrieve abstract from module
AUTHOR => 'Simon Cozens <simon@nonet>') : ()),
);
+
+if (!-e "t/beerdb.db") {
+ print "Making SQLite DB\n";
+ require DBD::SQLite;
+ require DBI;
+ my $dbh = DBI->connect("dbi:SQLite:dbname=t/beerdb.db");
+
+ my $sql = join ( '', (<DATA>) );
+
+ for my $statement (split /;/, $sql) {
+ $statement =~ s/\#.*$//mg; # strip # comments
+ $statement =~ s/auto_increment//g;
+ next unless $statement =~ /\S/;
+ eval { $dbh->do($statement) };
+ die "$@: $statement" if $@;
+ }
+}
+
+__DATA__
+
+create table brewery (
+ id int not null auto_increment primary key,
+ name varchar(30),
+ url varchar(50),
+ notes text
+);
+
+create table beer (
+ id int not null auto_increment primary key,
+ brewery integer,
+ style integer,
+ name varchar(30),
+ url varchar(120),
+# tasted date,
+ score integer(2),
+ price varchar(12),
+ abv varchar(10),
+ notes text
+);
+
+create table handpump (
+ id int not null auto_increment primary key,
+ beer integer,
+ pub integer
+);
+
+create table pub (
+ id int not null auto_increment primary key,
+ name varchar(60),
+ url varchar(120),
+ notes text
+);
+
+INSERT INTO beer (id, brewery, name, abv) VALUES
+ (1, 1, "Organic Best Bitter", "4.1");
+INSERT INTO brewery (id, name, url) VALUES
+ (1, "St Peter's Brewery", "http://www.stpetersbrewery.co.uk/");
+INSERT INTO pub (id, name) VALUES (1, "Turf Tavern");
+INSERT INTO handpump (id, pub, beer) VALUES (1, 1,1);
+
use base qw(Class::Accessor Class::Data::Inheritable);
use attributes ();
use Class::DBI::Loader;
+use UNIVERSAL::require;
+use Apache::Constants ":common";
use strict;
use warnings;
our $VERSION = "1.0";
__PACKAGE__->mk_classdata($_) for qw( _config init_done view_object );
-__PACKAGE__->mk_accessors ( qw( config ar params objects model_class args ));
+__PACKAGE__->mk_accessors ( qw( config ar params objects model_class
+args action template ));
__PACKAGE__->config({});
__PACKAGE__->init_done(0);
my $config = $class->config;
$config->{model} ||= "Apache::MVC::Model::CDBI";
$config->{view} ||= "Apache::MVC::View::TT";
+ $config->{model}->require;
+ $config->{view}->require;
$config->{classes} = [ $class->config->{loader}->classes ];
$config->{display_tables} ||= [ $class->config->{loader}->tables ];
- for my $class (@{$config->{classes}}) {
+ for my $subclass (@{$config->{classes}}) {
no strict 'refs';
- push @{$class."::ISA"}, $class->config->{model};
+ push @{$subclass."::ISA"}, $class->config->{model};
}
$class->view_object($class->config->{view}->new);
+ $class->init_done(1);
}
sub handler {
# See Apache::MVC::Workflow before trying to understand this.
- my $class = (caller(0))[0];
+ # XXX This needs to work with Apache without method handlers
+ my $class = shift;
$class->init unless $class->init_done;
my $r = bless { config => $class->config }, $class;
$r->get_request();
$r->parse_location();
$r->model_class($r->class_of($r->{table}));
my $status = $r->is_applicable;
- return $status unless $status == 200;
+ return $status unless $status == OK;
$status = $r->call_authenticate;
- return $status unless $status == 200;
- $r->find_objects();
+ return $status unless $status == OK;
$r->additional_data();
- $r->class->process($r);
+ $r->model_class->process($r);
+ $r->view_object->process($r);
+ return $r; # For debugging.
}
sub get_request {
$self->{table} = shift @pi;
$self->{action} = shift @pi;
$self->{args} = \@pi;
+
+ $self->{params} = $self->{ar}->content;
}
sub is_applicable {
my $self = shift;
- require Apache::Constants;
- Apache::Constants->import(":common");
my $config = $self->config;
- my %ok = map {$_ => 1} @{$config->{displaying_tables}};
+ my %ok = map {$_ => 1} @{$config->{display_tables}};
return DECLINED() unless exists $ok{$self->{table}};
# Does the action method exist?
# Is it exported?
$self->{method_attribs} = join " ", attributes::get($cv);
return DECLINED()
- unless $self->{method_attribs} =~ /\b(Exported|Class|Single|Multiple)\b/i;
+ unless $self->{method_attribs} =~ /\bExported\b/i;
return OK();
}
-sub find_objects {
- # First, how many arguments are we?
+sub call_authenticate {
+ my $self = shift;
+ return $self->model_class->authenticate($self) if
+ $self->model_class->can("authenticate");
+ return $self->authenticate();
}
-sub authenticate { return 200 }
+sub additional_data {}
+
+sub authenticate { return OK }
1;
--- /dev/null
+package Apache::MVC::Model::Base;
+our %remember;
+sub MODIFY_CODE_ATTRIBUTES {
+ $remember{$_[1]} = $_[2]; ()
+}
+
+sub FETCH_CODE_ATTRIBUTES { $remember{$_[1]}
+}
+
+sub view :Exported {
+ my ($self, $r) = @_;
+ return $self->retrieve(shift @{$r->{args}});
+}
+
+sub process {
+ my ($class, $r) = @_;
+ $r->template( my $method = $r->action );
+ $r->objects([ $class->$method($r) ]);
+}
--- /dev/null
+package Apache::MVC::Model::CDBI;
+use base 'Apache::MVC::Model::Base';
+
+1;
--- /dev/null
+package Apache::MVC::View::TT;
+use Lingua::EN::Inflect;
+use Template;
+use File::Spec;
+use UNIVERSAL::moniker;
+
+sub template_root { "/opt/houseshare/templates" } # For now
+
+sub new { bless {}, shift } # Not worth having
+
+sub process {
+ my ($self, $r) = @_;
+ my $root = $self->template_root;
+ my $template = Template->new({ INCLUDE_PATH => [
+ $root,
+ File::Spec->catdir($root, $r->model_class->moniker),
+ File::Spec->catdir($root, "custom"),
+ File::Spec->catdir($root, "factory")
+ ]});
+ my %args = (
+ request => $r,
+ class => $r->model_class,
+ objects => $r->objects,
+ # ...
+ );
+
+ # User-friendliness facility for custom template writers.
+ if (@{$r->objects} > 1){
+ $args{$r->model_class->plural_moniker} = $r->objects;
+ } else {
+ ($args{$r->model_class->moniker}) = @{$r->objects};
+ }
+
+ $template->process($r->template, \%args);
+}
BeerDB::Beer $r->call_authenticate
->authenticate ------------+------------ $r->authenticate
|
- $r->find_objects
- |
$r->additional_data
|
$r->model_class->process($r)
+ |
+ $r->view_object->process($r)
=head1 DESCRIPTION
Next, the C<is_applicable> method works out if this is actually
something that C<Apache::MVC> should care about - whether the class
exists in the application, whether it supports the given action, and so
-on. This should return an Apache status code; C<OK> if the request
-should proceed, C<DECLINED> if it should be passed on to the default
-handlers, or whatever other codes for permissions problems.
+on. The action is "supported" if it exists in the model class (or its
+ancestors) and is marked with the C<:Exported> attribute; this stops web
+users from firing off random subroutines in your code.
+
+This should return an Apache status code; C<OK> if the request should
+proceed, C<DECLINED> if it should be passed on to the default handlers,
+or whatever other codes for permissions problems.
=head2 Are we allowed to do this?
We then look for an appropriate C<authenticate> method to call; first
-it will try
Calling the C<authenticate> method of the model class, or,
+it will try
calling the C<authenticate> method of the model class, or,
if that does not exist, the C<authenticate> method on itself. By
default, this allows access to everyone for everything. Similarly, this
should return an Apache status code.
-=head2 Find the appropriate objects
-
-The C<find_objects> method is called to populate the C<objects> slot of
-the request object with the appropriate objects from the model class.
-
-This takes the right number of arguments off the C<args> slot by
-examining the attributes of the method in question. Read more about this
-in L<Apache::MVC::Model::Default>.
-
=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.
-=head2 Ask model to take over
+=head2 Ask model for widget set
+
+Asking the model class to C<process> the current request allows it to do
+any work it needs for the given command, and populate the C<objects> and
+C<template> slots of the request.
+
+=head2 Ask view to process template
+
+Now the view class has its C<process> method called, finds the
+appropriate templates, passes the C<objects> and any additional data to
+the template, and pushes the output to the web server.
+
+We will go into more detail about these last two phases.
+
+=head1 Model class processing
+
+The model's C<process> method is usually a thin wrapper around the
+action that we have selected.
-The C<process> method of the model class is called with the request
-object, and is expected to perform any actions it needs, and then
-despatch control to the view.
+=head2
# vim:ft=perl
use Test::More 'no_plan';
-
-package Fake::Loader;
-
-package Fake::MVC;
+use Apache::MVC;
+use Apache::FakeRequest;
+package BeerDB;
+our %data;
use base 'Apache::MVC';
+BeerDB->set_database("dbi:SQLite:dbname=t/beerdb.db");
-sub set_database {
- my $self = shift;
- $self->config->{loader} = bless {}, Fake::Loader;
-}
+BeerDB::Brewery->has_many(beers => "BeerDB::Beer");
+BeerDB::Beer->has_a(brewery => "BeerDB::Brewery");
-sub get_request {}
+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 parse_location {
+sub get_request {
my $self = shift;
- my @pi = @Fake::MVC::url;
- shift @pi while @pi and !$pi[0];
- $self->{table} = shift @pi;
- $self->{action} = shift @pi;
- $self->{args} = \@pi;
+ $self->{ar} = Apache::FakeRequest->new(%data);
}
+
+$data{uri} = "/beer/view/1";
+my $r = BeerDB->handler();
+use Data::Dumper;
+print Dumper($r);
projects / maypole.git / commitdiff