X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole.pm;h=54f0c0d7ec7c5640d0a348064c8180fe9b50fa81;hb=cb585659f8b5f12f0a32c93ac88971fe84d4c1f3;hp=55aa509c1f84def086eccc44ebabc10136a994e7;hpb=dc05783cf83b60a298f12e52ac6d67c489f35868;p=maypole.git diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 55aa509..54f0c0d 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -1,12 +1,11 @@ package Maypole; 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 = "0.2"; +our $VERSION = "1.0"; __PACKAGE__->mk_classdata($_) for qw( config init_done view_object ); __PACKAGE__->mk_accessors ( qw( ar params query objects model_class args action template )); @@ -14,26 +13,18 @@ __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, @_) }; - } -} - -sub set_database { - my ($calling_class, $dsn) = @_; +sub setup { + my $calling_class = shift; $calling_class = ref $calling_class if ref $calling_class; + { + no strict 'refs'; + # Naughty. + *{$calling_class."::handler"} = sub { Maypole::handler($calling_class, @_) }; + } my $config = $calling_class->config; - $config->{model} ||= "Apache::MVC::Model::CDBI"; + $config->{model} ||= "Maypole::Model::CDBI"; $config->{model}->require; - $config->{dsn} = $dsn; - $config->{loader} = Class::DBI::Loader->new( - namespace => $calling_class, - dsn => $dsn - ); - $config->{classes} = [ $config->{loader}->classes ]; + $config->{model}->setup_database($config, $calling_class, @_); for my $subclass (@{$config->{classes}}) { no strict 'refs'; unshift @{$subclass."::ISA"}, $config->{model}; @@ -45,28 +36,23 @@ sub set_database { sub init { my $class = shift; my $config = $class->config; - $config->{view} ||= "Apache::MVC::View::TT"; + $config->{view} ||= "Maypole::View::TT"; $config->{view}->require; - $config->{display_tables} ||= [ $class->config->{loader}->tables ]; + $config->{display_tables} ||= [ @{$class->config->{tables}} ]; $class->view_object($class->config->{view}->new); $class->init_done(1); } -sub class_of { - my ($self, $table) = @_; - return $self->config->{loader}->_table2class($table); -} - sub handler { - # See Apache::MVC::Workflow before trying to understand this. + # See Maypole::Workflow before trying to understand this. 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})); + $r->model_class($r->config->{model}->class_of($r, $r->{table})); my $status = $r->is_applicable; if ($status == OK) { $status = $r->call_authenticate; @@ -83,28 +69,6 @@ sub handler { return $r->view_object->process($r); } -sub get_request { - my $self = shift; - require Apache; require Apache::Request; - $self->{ar} = Apache::Request->new(Apache->request); -} - -sub parse_location { - my $self = shift; - $self->{path} = $self->{ar}->uri; - my $loc = $self->{ar}->location; - $self->{path} =~ s/^$loc//; # I shouldn't need to do this? - $self->{path} ||= "frontpage"; - my @pi = split /\//, $self->{path}; - shift @pi while @pi and !$pi[0]; - $self->{table} = shift @pi; - $self->{action} = shift @pi; - $self->{args} = \@pi; - - $self->{params} = { $self->{ar}->content }; - $self->{query} = { $self->{ar}->args }; -} - sub is_applicable { my $self = shift; my $config = $self->config; @@ -137,15 +101,13 @@ sub additional_data {} sub authenticate { return OK } -1; - =head1 NAME Maypole - MVC web application framework =head1 SYNOPSIS -See L. +See L. =head1 DESCRIPTION @@ -171,7 +133,7 @@ for the designers to customize, and then write an Apache handler like this: package ProductDatabase; - use base 'Apache::MVC'; + use base 'Maypole'; __PACKAGE__->set_database("dbi:mysql:products"); BeerDB->config->{uri_base} = "http://your.site/catalogue/"; ProductDatabase::Product->has_a("category" => ProductDatabase::Category); @@ -208,7 +170,7 @@ For a full example, see the included "beer database" application. =head1 HOW IT WORKS -There's some documentation for the workflow in L, +There's some documentation for the workflow in L, but the basic idea is that a URL part like C gets translated into a call to Clist>. This propagates the request with a set of objects from the database, and then @@ -219,7 +181,7 @@ If there's another action you want the system to do, you need to either subclass the model class, and configure your class slightly differently: package ProductDatabase::Model; - use base 'Apache::MVC::Model::CDBI'; + use base 'Maypole::Model::CDBI'; sub supersearch :Exported { my ($self, $request) = @_; @@ -228,6 +190,9 @@ subclass the model class, and configure your class slightly differently: $r->template("template_name"); } +Then your top-level application package should change the model class: +(Before calling C) + ProductDatabase->config->{model_class} = "ProductDatabase::Model"; (The C<:Exported> attribute means that the method can be called via the @@ -246,6 +211,22 @@ systems and database abstraction layers as time goes on. The article at C is a great introduction to the process we're trying to automate. +=head1 USING MAYPOLE + +You should probably not use Maypole directly. Maypole is an abstract +class which does not specify how to communicate with the outside world. +The most popular subclass of Maypole is L, which interfaces +the Maypole framework to Apache mod_perl. + +If you are implementing Maypole subclasses, you need to provide at least +the C and C methods. See the +L documentation for what these are expected to do. + +=cut + +sub get_request { die "Do not use Maypole directly; use Apache::MVC or similar" } +sub parse_location { die "Do not use Maypole directly; use Apache::MVC or similar" } + =head1 AUTHOR Simon Cozens, C @@ -253,3 +234,8 @@ Simon Cozens, C =head1 LICENSE You may distribute this code under the same terms as Perl itself. + +=cut + +1; +