From: Simon Cozens 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; }