X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole.pm;h=4e551eb45d241151495907c4fa0a8ca1a9c2ea78;hb=de775747b2afbf82d6b9858e958dc5a19ddfd31f;hp=deb207193303e6f3366caed0786f78f8ce83fdbf;hpb=2317e7e16027c6fa312dbdff201d83084412a463;p=maypole.git diff --git a/lib/Maypole.pm b/lib/Maypole.pm index deb2071..4e551eb 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -5,7 +5,7 @@ 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 )); @@ -13,9 +13,14 @@ __PACKAGE__->config({}); __PACKAGE__->init_done(0); -sub set_database { +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} ||= "Maypole::Model::CDBI"; $config->{model}->require; @@ -64,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; @@ -110,16 +93,14 @@ sub is_applicable { sub call_authenticate { my $self = shift; return $self->model_class->authenticate($self) if - $self->model_class->can("authenticate"); - return $self->authenticate(); + $self->model_class->can("authenticate"); + return $self->authenticate($self); # Interface consistency is a Good Thing } sub additional_data {} sub authenticate { return OK } -1; - =head1 NAME Maypole - MVC web application framework @@ -154,7 +135,7 @@ this: package ProductDatabase; use base 'Maypole'; __PACKAGE__->set_database("dbi:mysql:products"); - BeerDB->config->{uri_base} = "http://your.site/catalogue/"; + ProductDatabase->config->{uri_base} = "http://your.site/catalogue/"; ProductDatabase::Product->has_a("category" => ProductDatabase::Category); # ... @@ -209,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 @@ -227,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 @@ -234,3 +234,8 @@ Simon Cozens, C =head1 LICENSE You may distribute this code under the same terms as Perl itself. + +=cut + +1; +