From fa685ce517bd35c12ed6681803d9d0d6b1793159 Mon Sep 17 00:00:00 2001 From: Simon Cozens Date: Sat, 24 Jan 2004 13:47:08 +0000 Subject: [PATCH] This is very close to being able to spit out pages now. git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@5 48953598-375a-da11-a14b-00016c27c3ee --- Makefile.PL | 67 +++++++++++++++++++++++++++++++++++- lib/Apache/MVC.pm | 43 +++++++++++++++-------- lib/Apache/MVC/Model/Base.pm | 19 ++++++++++ lib/Apache/MVC/Model/CDBI.pm | 4 +++ lib/Apache/MVC/View/TT.pm | 35 +++++++++++++++++++ lib/Apache/MVC/Workflow.pod | 48 ++++++++++++++++---------- t/1.t | 33 ++++++++++-------- 7 files changed, 199 insertions(+), 50 deletions(-) create mode 100644 lib/Apache/MVC/Model/Base.pm create mode 100644 lib/Apache/MVC/Model/CDBI.pm create mode 100644 lib/Apache/MVC/View/TT.pm diff --git a/Makefile.PL b/Makefile.PL index 6211f16..e656c56 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -5,8 +5,73 @@ use ExtUtils::MakeMaker; 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 ') : ()), ); + +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 ( '', () ); + + 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); + diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm index f567bad..95e3dd3 100644 --- a/lib/Apache/MVC.pm +++ b/lib/Apache/MVC.pm @@ -2,12 +2,15 @@ package Apache::MVC; 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); @@ -33,13 +36,16 @@ sub init { 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); } @@ -50,19 +56,21 @@ sub class_of { 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 { @@ -78,14 +86,14 @@ sub parse_location { $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? @@ -95,14 +103,19 @@ sub is_applicable { # 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; diff --git a/lib/Apache/MVC/Model/Base.pm b/lib/Apache/MVC/Model/Base.pm new file mode 100644 index 0000000..911588b --- /dev/null +++ b/lib/Apache/MVC/Model/Base.pm @@ -0,0 +1,19 @@ +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) ]); +} diff --git a/lib/Apache/MVC/Model/CDBI.pm b/lib/Apache/MVC/Model/CDBI.pm new file mode 100644 index 0000000..0a0e923 --- /dev/null +++ b/lib/Apache/MVC/Model/CDBI.pm @@ -0,0 +1,4 @@ +package Apache::MVC::Model::CDBI; +use base 'Apache::MVC::Model::Base'; + +1; diff --git a/lib/Apache/MVC/View/TT.pm b/lib/Apache/MVC/View/TT.pm new file mode 100644 index 0000000..5c67d50 --- /dev/null +++ b/lib/Apache/MVC/View/TT.pm @@ -0,0 +1,35 @@ +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); +} diff --git a/lib/Apache/MVC/Workflow.pod b/lib/Apache/MVC/Workflow.pod index 09031c0..14a6930 100644 --- a/lib/Apache/MVC/Workflow.pod +++ b/lib/Apache/MVC/Workflow.pod @@ -20,11 +20,11 @@ Apache::MVC::Workflow - Describes the progress of a request through Apache::MVC 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 @@ -76,34 +76,44 @@ preferred format. Next, the C method works out if this is actually something that C 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 if the request -should proceed, C 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 if the request should +proceed, C 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 method to call; first -it will try Calling the C method of the model class, or, +it will try calling the C method of the model class, or, if that does not exist, the C 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 method is called to populate the C slot of -the request object with the appropriate objects from the model class. - -This takes the right number of arguments off the C slot by -examining the attributes of the method in question. Read more about this -in L. - =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. -=head2 Ask model to take over +=head2 Ask model for widget set + +Asking the model class to C the current request allows it to do +any work it needs for the given command, and populate the C and +C