From ce6a4c9c85fd9ea388abc677089564bc46e687be Mon Sep 17 00:00:00 2001 From: Simon Cozens Date: Sat, 31 Jan 2004 17:38:02 +0000 Subject: [PATCH] This gives us non-object-based templated pages. And a little start on documentation. git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@36 48953598-375a-da11-a14b-00016c27c3ee --- TODO | 3 +- lib/Apache/MVC.pm | 78 ++++++++++++++++++++++++++++++++------ lib/Apache/MVC/View/TT.pm | 49 ++++++++++++++---------- lib/BeerDB.pm | 1 - templates/custom/frontpage | 1 - 5 files changed, 98 insertions(+), 34 deletions(-) diff --git a/TODO b/TODO index 9ca3744..b533435 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,4 @@ -How to process pages with no objects? (/, etc.) -Advanced earching +Advanced searching Ordering of results Ordering of columns Pages with several ?(different kinds) of objects? diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm index 467f0f9..c9db3ae 100644 --- a/lib/Apache/MVC.pm +++ b/lib/Apache/MVC.pm @@ -6,7 +6,7 @@ use UNIVERSAL::require; use Apache::Constants ":common"; use strict; use warnings; -our $VERSION = "1.0"; +our $VERSION = "0.1"; __PACKAGE__->mk_classdata($_) for qw( _config init_done view_object ); __PACKAGE__->mk_accessors ( qw( config ar params objects model_class args action template )); @@ -73,16 +73,24 @@ sub handler { $r->get_request(); $r->parse_location(); + warn "Parsed location\n"; $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(); + if ($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. + $r->model_class->process($r); + } else { + warn "Plain template $r->{path}"; + # Otherwise, it's just a plain template. + delete $r->{model_class}; + $r->{path} =~ s{/}{}; # De-absolutify + $r->template($r->{path}); + warn $r->template; + } + return $r->view_object->process($r); } sub get_request { @@ -93,8 +101,11 @@ sub get_request { sub parse_location { my $self = shift; - my $uri = $self->{ar}->path_info(); - my @pi = split /\//, $uri; + $self->{path} = $self->{ar}->uri; + my $loc = $self->{ar}->location; + $self->{path} =~ s/^$loc//; # I shouldn't need to do this? + warn "Path is $self->{path}"; + my @pi = split /\//, $self->{path}; shift @pi while @pi and !$pi[0]; $self->{table} = shift @pi; $self->{action} = shift @pi; @@ -112,7 +123,6 @@ sub is_applicable { return DECLINED() unless exists $config->{ok_tables}{$self->{table}}; # Does the action method exist? - # XXX We should set the method class to the class for the table my $cv = $self->model_class->can($self->{action}); warn "We don't have that action ($self->{action})" unless $cv; return DECLINED() unless $cv; @@ -137,3 +147,49 @@ sub additional_data {} sub authenticate { return OK } 1; + +=head1 NAME + +Apache::MVC - Web front end to a data source + +=head1 SYNOPSIS + + package BeerDB; + use base 'Apache::MVC'; + sub handler { Apache::MVC::handler("BeerDB", @_) } + BeerDB->set_database("dbi:mysql:beerdb"); + BeerDB->config->{uri_base} = "http://your.site/"; + BeerDB->config->{display_tables} = [qw[beer brewery pub style]]; + # Now set up your database: + # has-a relationships + # untaint columns + + 1; + +=haed1 DESCRIPTION + +A large number of web programming tasks follow the same sort of pattern: +we have some data in a datasource, typically a relational database. We +have a bunch of templates provided by web designers. We have a number of +things we want to be able to do with the database - create, add, edit, +delete records, view records, run searches, and so on. We have a web +server which provides input from the user about what to do. Something in +the middle takes the input, grabs the relevant rows from the database, +performs the action, constructs a page, and spits it out. + +This module aims to be the most generic and extensible "something in the +middle". + +An example would help explain this best. You need to add a product +catalogue to a company's web site. Users need to list the products in +various categories, view a page on each product with its photo and +pricing information and so on, and there needs to be a back-end where +sales staff can add new lines, change prices, and delete out of date +records. So, you set up the database, provide some default templates +for the designers to customize, and then write an Apache handler like +this: + + package MyCorp::ProductDatabase; + use base 'Apache::MVC'; + __PACKAGE__->set_database("dbi:mysql:products"); + diff --git a/lib/Apache/MVC/View/TT.pm b/lib/Apache/MVC/View/TT.pm index 083b359..4c15ea9 100644 --- a/lib/Apache/MVC/View/TT.pm +++ b/lib/Apache/MVC/View/TT.pm @@ -1,4 +1,5 @@ package Apache::MVC::View::TT; +use Apache::Constants; use Lingua::EN::Inflect; use Template; use File::Spec; @@ -10,10 +11,11 @@ sub new { bless {}, shift } # Not worth having sub _tt { my ($self, $r) = @_; - my $root = $r->config->{template_root}; + my $root = $r->{ar}->document_root . "/". $r->{ar}->location; + warn "Root was $root"; Template->new({ INCLUDE_PATH => [ $root, - File::Spec->catdir($root, $r->model_class->moniker), + ($r->model_class && File::Spec->catdir($root, $r->model_class->moniker)), File::Spec->catdir($root, "custom"), File::Spec->catdir($root, "factory") ]}); @@ -29,23 +31,25 @@ sub _args { base => $r->config->{uri_base}, config => $r->config # ... - ); - $args{classmetadata} = { - name => $class, - columns => [ $class->columns ], - colnames => { $class->column_names }, - related_accessors => [ $class->related($r) ], - moniker => $class->moniker, - plural => $class->plural_moniker, - cgi => { $class->to_cgi }, - description => $class->description - }; + ) ; + if ($class) { + $args{classmetadata} = { + name => $class, + columns => [ $class->columns ], + colnames => { $class->column_names }, + related_accessors => [ $class->related($r) ], + 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){ - $args{$r->model_class->plural_moniker} = $r->objects; - } else { - ($args{$r->model_class->moniker}) = @{$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}; + } } # Overrides @@ -57,8 +61,11 @@ sub process { my ($self, $r) = @_; my $template = $self->_tt($r); my $output; + warn "Processing ".$r->template; $template->process($r->template, { $self->_args($r) }, \$output) - || $self->error($r, $template->error); + || return $self->error($r, $template->error); + + warn "And off it goes!\n"; $r->{ar}->content_type("text/html"); $r->{ar}->headers_out->set("Content-Length" => length $output); $r->{ar}->send_http_header; @@ -68,7 +75,11 @@ sub process { sub error { my ($self, $r, $error) = @_; + warn $error; + if ($error =~ /not found$/) { return DECLINED } $r->{ar}->send_http_header("text/plain"); $r->{ar}->print($error); exit; } + +1; diff --git a/lib/BeerDB.pm b/lib/BeerDB.pm index a523561..e9f1eb4 100644 --- a/lib/BeerDB.pm +++ b/lib/BeerDB.pm @@ -2,7 +2,6 @@ package BeerDB; use base 'Apache::MVC'; sub handler { Apache::MVC::handler("BeerDB", @_) } BeerDB->set_database("dbi:mysql:beerdb"); -BeerDB->config->{template_root} = "/opt/beer"; BeerDB->config->{uri_base} = "http://neo.trinity-house.org.uk/beerdb/"; BeerDB->config->{display_tables} = [qw[beer brewery pub style]]; BeerDB::Brewery->untaint_columns( printable => [qw/name notes url/] ); diff --git a/templates/custom/frontpage b/templates/custom/frontpage index f19217b..a7698e8 100644 --- a/templates/custom/frontpage +++ b/templates/custom/frontpage @@ -46,4 +46,3 @@ SRC="/images/itunes.png">Stream music
-[% INCLUDE small_blog %] -- 2.39.5