From: Simon Cozens <simon@simon-cozens.org>
Date: Sat, 24 Jan 2004 13:47:08 +0000 (+0000)
Subject: This is very close to being able to spit out pages now.
X-Git-Tag: 2.10~357
X-Git-Url: https://git.decadent.org.uk/gitweb/?a=commitdiff_plain;h=fa685ce517bd35c12ed6681803d9d0d6b1793159;p=maypole.git

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
---

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 <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);
+
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<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
diff --git a/t/1.t b/t/1.t
index ff8ae73..2560fe9 100644
--- a/t/1.t
+++ b/t/1.t
@@ -1,23 +1,26 @@
 # 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);