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 ));
$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 {
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;
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;
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");
+
package Apache::MVC::View::TT;
+use Apache::Constants;
use Lingua::EN::Inflect;
use Template;
use File::Spec;
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")
]});
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
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;
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;
projects / maypole.git / commitdiff