From: Simon Cozens <simon@simon-cozens.org>
Date: Sat, 24 Jan 2004 16:12:19 +0000 (+0000)
Subject: Now it really is producing pages.
X-Git-Tag: 2.10~354
X-Git-Url: https://git.decadent.org.uk/gitweb/?a=commitdiff_plain;h=58398cbb7b75bf3106e8503b81ee782178c248c3;p=maypole.git

Now it really is producing pages.


git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@8 48953598-375a-da11-a14b-00016c27c3ee
---

diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm
index 95e3dd3..42d0d91 100644
--- a/lib/Apache/MVC.pm
+++ b/lib/Apache/MVC.pm
@@ -7,13 +7,21 @@ 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 action template ));
 __PACKAGE__->config({});
 __PACKAGE__->init_done(0);
 
+
+sub import {
+    my $real = shift;
+    if ($real ne "Apache::MVC") {
+        no strict 'refs';
+        *{$real."::handler"} = sub { Apache::MVC::handler($real, @_) };
+    }
+}
+
 # This is really dirty.
 sub config {
     my $self = shift;
@@ -56,18 +64,19 @@ sub class_of {
 
 sub handler {
     # See Apache::MVC::Workflow before trying to understand this.
-    # 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 == OK;
     $status = $r->call_authenticate;
     return $status unless $status == OK;
     $r->additional_data();
+    
     $r->model_class->process($r);
     $r->view_object->process($r);
     return $r; # For debugging.
@@ -81,7 +90,10 @@ sub get_request {
 
 sub parse_location {
     my $self = shift;
-    my @pi = split /\//, $self->{ar}->uri();
+    my $uri = $self->{ar}->uri();
+    my $loc = $self->{ar}->location();
+    $uri =~ s/^$loc//;
+    my @pi = split /\//, $uri;
     shift @pi while @pi and !$pi[0];
     $self->{table} = shift @pi;
     $self->{action} = shift @pi;
diff --git a/lib/Apache/MVC/Model/Base.pm b/lib/Apache/MVC/Model/Base.pm
index 911588b..1fe178f 100644
--- a/lib/Apache/MVC/Model/Base.pm
+++ b/lib/Apache/MVC/Model/Base.pm
@@ -12,6 +12,11 @@ sub view :Exported {
     return $self->retrieve(shift @{$r->{args}});
 }
 
+sub list :Exported {
+    my ($self, $r) = @_;
+    return $self->retrieve_all;
+}
+
 sub process {
     my ($class, $r) = @_;
     $r->template( my $method = $r->action );
diff --git a/lib/Apache/MVC/Model/CDBI.pm b/lib/Apache/MVC/Model/CDBI.pm
index 0a0e923..c06703a 100644
--- a/lib/Apache/MVC/Model/CDBI.pm
+++ b/lib/Apache/MVC/Model/CDBI.pm
@@ -1,4 +1,10 @@
 package Apache::MVC::Model::CDBI;
 use base 'Apache::MVC::Model::Base';
+use Class::DBI::AsForm;
+use Class::DBI::FromCGI;
+
+sub description { "A poorly defined class" }
+
+sub column_names { my $class = shift; map { $_ => ucfirst $_ } $class->columns }
 
 1;
diff --git a/lib/Apache/MVC/View/TT.pm b/lib/Apache/MVC/View/TT.pm
index 9cdc0df..f1b005e 100644
--- a/lib/Apache/MVC/View/TT.pm
+++ b/lib/Apache/MVC/View/TT.pm
@@ -3,6 +3,7 @@ use Lingua::EN::Inflect;
 use Template;
 use File::Spec;
 use UNIVERSAL::moniker;
+use strict;
 
 
 sub new { bless {}, shift } # Not worth having
@@ -20,12 +21,22 @@ sub _tt {
 
 sub _args {
     my ($self, $r) = @_;
+    my $class = $r->model_class;
     my %args = (
         request => $r,
-        class   => $r->model_class,
+        class   => $class,
         objects => $r->objects,
         # ...
     );
+    $args{classmetadata} = {
+        name => $class,
+        columns => [ $class->columns ],
+        colnames => { $class->column_names },
+        moniker => $class->moniker,
+        plural  => $class->plural_moniker,
+        cgi => { $class->to_cgi },
+        description => $class->description
+    };
 
     # User-friendliness facility for custom template writers.
     if (@{$r->objects} > 1){
@@ -44,16 +55,14 @@ sub process {
     || $self->error($r, $template->error);
     $r->{ar}->content_type("text/html");
     $r->{ar}->headers_out->set("Content-Length" => length $output);
-    $r->send_http_header;
-    $r->print($output);
+    $r->{ar}->send_http_header;
+    $r->{ar}->print($output);
     return 200;
 }
 
 sub error {
     my ($self, $r, $error) = @_;
-    $r->{ar}->content_type("text/plain");
-    $r->send_http_header;
-    $r->print($error);
-    return 500;
+    $r->{ar}->send_http_header("text/plain");
+    $r->{ar}->print($error);
     exit;
 }