X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole.pm;h=597ab7c5a66f679696e62a84279c49f9501957fe;hb=21e814818fb4a6e59e4615c2dd1320016a9dc6f8;hp=11fbe52791014fda2e9c0cb6af9abbf187fd1748;hpb=4ab33d12a514e0531e16f3d2812b15258de258c5;p=maypole.git diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 11fbe52..597ab7c 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -1,18 +1,21 @@ package Maypole; -use base qw(Class::Accessor Class::Data::Inheritable); +use base qw(Class::Accessor::Fast Class::Data::Inheritable); use attributes (); use UNIVERSAL::require; use strict; use warnings; -our $VERSION = "1.8"; +use Maypole::Config; +use Maypole::Constants; + +our $VERSION = '2.0'; + __PACKAGE__->mk_classdata($_) for qw( config init_done view_object ); __PACKAGE__->mk_accessors( - qw( ar params query objects model_class - args action template ) + qw( ar params query objects model_class template_args output path + args action template error document_encoding content_type table) ); -__PACKAGE__->config( {} ); +__PACKAGE__->config( Maypole::Config->new() ); __PACKAGE__->init_done(0); -use Maypole::Constants; sub debug { 0 } @@ -27,26 +30,27 @@ sub setup { sub { Maypole::handler( $calling_class, @_ ) }; } my $config = $calling_class->config; - $config->{model} ||= "Maypole::Model::CDBI"; - $config->{model}->require; - die "Couldn't load the model class $config->{model}: $@" if $@; - $config->{model}->setup_database( $config, $calling_class, @_ ); - for my $subclass ( @{ $config->{classes} } ) { + $config->model || $config->model("Maypole::Model::CDBI"); + $config->model->require; + die "Couldn't load the model class $config->model: $@" if $@; + $config->model->setup_database( $config, $calling_class, @_ ); + for my $subclass ( @{ $config->classes } ) { no strict 'refs'; - unshift @{ $subclass . "::ISA" }, $config->{model}; - $config->{model}->adopt($subclass) - if $config->{model}->can("adopt"); + unshift @{ $subclass . "::ISA" }, $config->model; + $config->model->adopt($subclass) + if $config->model->can("adopt"); } } sub init { my $class = shift; my $config = $class->config; - $config->{view} ||= "Maypole::View::TT"; - $config->{view}->require; - die "Couldn't load the view class $config->{view}: $@" if $@; - $config->{display_tables} ||= [ @{ $class->config->{tables} } ]; - $class->view_object( $class->config->{view}->new ); + $config->view || $config->view("Maypole::View::TT"); + $config->view->require; + die "Couldn't load the view class " . $config->view . ": $@" if $@; + $config->display_tables + || $config->display_tables( [ $class->config->tables ] ); + $class->view_object( $class->config->view->new ); $class->init_done(1); } @@ -65,9 +69,10 @@ sub handler { return $status; } +# The root of all evil sub handler_guts { my $r = shift; - $r->model_class( $r->config->{model}->class_of( $r, $r->{table} ) ); + $r->model_class( $r->config->model->class_of( $r, $r->{table} ) ); my $applicable = $r->is_applicable; unless ( $applicable == OK ) { @@ -83,7 +88,7 @@ sub handler_guts { if ( my $error = $@ ) { $status = $r->call_exception($error); if ( $status != OK ) { - warn "caught model error: $error"; + warn "caught authenticate error: $error"; return $r->debug ? $r->view_object->error( $r, $error ) : ERROR; } } @@ -106,7 +111,15 @@ sub handler_guts { } } if ( !$r->{output} ) { # You might want to do it yourself - return $r->view_object->process($r); + eval { $status = $r->view_object->process($r) }; + if ( my $error = $@ ) { + $status = $r->call_exception($error); + if ( $status != OK ) { + warn "caught view error: $error" if $r->debug; + return $r->debug ? $r->view_object->error( $r, $error ) : ERROR; + } + } + return $status; } else { return OK; } } @@ -114,26 +127,18 @@ sub handler_guts { sub is_applicable { my $self = shift; my $config = $self->config; - $config->{ok_tables} ||= $config->{display_tables}; - $config->{ok_tables} = { map { $_ => 1 } @{ $config->{ok_tables} } } - if ref $config->{ok_tables} eq "ARRAY"; - warn "We don't have that table ($self->{table})" + $config->ok_tables || $config->ok_tables( $config->display_tables ); + $config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } ) + if ref $config->ok_tables eq "ARRAY"; + warn "We don't have that table ($self->{table}).\n" + . "Available tables are: " + . join( ",", @{ $config->{display_tables} } ) if $self->debug - and not $config->{ok_tables}{ $self->{table} }; - return DECLINED() unless exists $config->{ok_tables}{ $self->{table} }; - - # Does the action method exist? - my $cv = $self->model_class->can( $self->{action} ); - warn "We don't have that action ($self->{action})" - if $self->debug and not $cv; - return DECLINED() unless $cv; - - # Is it exported? - $self->{method_attribs} = join " ", attributes::get($cv); - do { - warn "$self->{action} not exported" if $self->debug; - return DECLINED(); - } unless $self->{method_attribs} =~ /\bExported\b/i; + and not $config->ok_tables->{ $self->{table} }; + return DECLINED() unless exists $config->ok_tables->{ $self->{table} }; + + # Is it public? + return DECLINED unless $self->model_class->is_public( $self->{action} ); return OK(); } @@ -178,149 +183,218 @@ sub parse_path { $self->{args} = \@pi; } +sub get_template_root { "." } +sub get_request { } + +sub parse_location { + die "Do not use Maypole directly; use Apache::MVC or similar"; +} + +sub send_output { + die "Do not use Maypole directly; use Apache::MVC or similar"; +} + =head1 NAME Maypole - MVC web application framework =head1 SYNOPSIS -See L. +See L. =head1 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. - -Maypole aims to be the most generic and extensible "something in the -middle" - an MVC-based web application framework. - -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 ProductDatabase; - use base 'Apache::MVC'; - __PACKAGE__->set_database("dbi:mysql:products"); - ProductDatabase->config->{uri_base} = "http://your.site/catalogue/"; - ProductDatabase::Product->has_a("category" => ProductDatabase::Category); - # ... - - sub authenticate { - my ($self, $request) = @_; - return OK if $request->{ar}->get_remote_host() eq "sales.yourcorp.com"; - return OK if $request->{action} =~ /^(view|list)$/; - return DECLINED; - } - 1; +This documents the Maypole request object. For user documentation, see +L. -You then put the following in your Apache config: +=head2 CLASS METHODS - - SetHandler perl-script - PerlHandler ProductDatabase - +=head3 config -And copy the templates found in F into the -F directory off the web root. When the designers get -back to you with custom templates, they are to go in -F. If you need to do override templates on a -database-table-by-table basis, put the new template in -F>. +Returns the L object -This will automatically give you C, C, C, C and -C commands; for instance, a product list, go to +=head3 setup - http://your.site/catalogue/product/list + My::App->setup($data_source, $user, $password, \%attr); -For a full example, see the included "beer database" application. +Initialise the maypole application and model classes. Your application should +call this after setting configuration via L<"config"> -=head1 HOW IT WORKS +=head3 init -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 -calls the C template; first, a C template if it -exists, then the C and finally C. +You should not call this directly, but you may wish to override this to +add +application-specific initialisation. -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: +=head3 view_object - package ProductDatabase::Model; - use base 'Maypole::Model::CDBI'; +Get/set the Maypole::View object - sub supersearch :Exported { - my ($self, $request) = @_; - # Do stuff, get a bunch of objects back - $r->objects(\@objects); - $r->template("template_name"); - } +=head3 debug -Then your top-level application package should change the model class: -(Before calling C) + sub My::App::debug {1} - ProductDatabase->config->{model} = "ProductDatabase::Model"; +Returns the debugging flag. Override this in your application class to +enable/disable debugging. -(The C<:Exported> attribute means that the method can be called via the -URL C/supersearch/...>.) +=head2 INSTANCE METHODS -Alternatively, you can put the method directly into the specific model -class for the table: +=head3 parse_location - sub ProductDatabase::Product::supersearch :Exported { ... } +Turns the backend request (e.g. Apache::MVC, Maypole, CGI) into a +Maypole +request. It does this by setting the C, and invoking C +and +C. -By default, the view class uses Template Toolkit as the template -processor, and the model class uses C; it may help you to be -familiar with these modules before going much further with this, -although I expect there to be other subclasses for other templating -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. +You should only need to define this method if you are writing a new +Maypole +backend. -=head1 USING MAYPOLE +=head3 path -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; another important one is -L. +Returns the request path -If you are implementing Maypole subclasses, you need to provide at least -the C and C methods. You may also want to -provide C and C. See the -L documentation for what these are expected to do. +=head3 parse_path -=cut +Parses the request path and sets the C, C and C +properties -sub get_template_root { "." } -sub get_request { } +=head3 table -sub parse_location { - die "Do not use Maypole directly; use Apache::MVC or similar"; -} +The table part of the Maypole request path -sub send_output { - die "Do not use Maypole directly; use Apache::MVC or similar"; -} +=head3 action + +The action part of the Maypole request path + +=head3 args + +A list of remaining parts of the request path after table and action +have been +removed + +=head3 parse_args + +Turns post data and query string paramaters into a hash of C. + +You should only need to define this method if you are writing a new +Maypole +backend. + +=head3 params + +Returns a hash of request parameters. The source of the parameters may +vary +depending on the Maypole backend, but they are usually populated from +request +query string and POST data. + +B Where muliple values of a parameter were supplied, the +C +value +will be an array reference. + +=head3 get_template_root + +Implimentation-specific path to template root. + +You should only need to define this method if you are writing a new +Maypole +backend. Otherwise, see L + +=head3 is_applicable + +Returns a Maypole::Constant to indicate whether the request is valid. + +The default implimentation checks that C<$r-Etable> is publicly +accessible +and that the model class is configured to handle the C<$r-Eaction> + +=head3 authenticate + +Returns a Maypole::Constant to indicate whether the user is +authenticated for +the Maypole request. + +The default implimentation returns C + +=head3 model_class + +Returns the perl package name that will serve as the model for the +request. It corresponds to the request C
attribute. + +=head3 additional_data + +Called before the model processes the request, this method gives you a +chance +to do some processing for each request, for example, manipulating +C. + +=head3 objects + +Get/set a list of model objects. The objects will be accessible in the +view +templates. + +If the first item in C<$r-Eargs> can be Cd by the model +class, +it will be removed from C and the retrieved object will be added +to the +C list. See L for more information. + +=head3 template_args + + $r->template_args->{foo} = 'bar'; + +Get/set a hash of template variables. + +=head3 template + +Get/set the template to be used by the view. By default, it returns +C<$r-Eaction> + +=head3 exception + +This method is called if any exceptions are raised during the +authentication +or +model/view processing. It should accept the exception as a parameter and +return +a Maypole::Constant to indicate whether the request should continue to +be +processed. + +=head3 error + +Get/set a request error + +=head3 output + +Get/set the response output. This is usually populated by the view +class. You +can skip view processing by setting the C. + +=head3 document_encoding + +Get/set the output encoding. Default: utf-8. + +=head3 content_type + +Get/set the output content type. Default: text/html + +=head3 send_output + +Sends the output and additional headers to the user. =head1 SEE ALSO -There's more documentation, examples, and a wiki at the Maypole web site: +There's more documentation, examples, and a wiki at the Maypole web +site: -http://maypole.simon-cozens.org/ +http://maypole.perl.org/ -L, L. +L,L, L. =head1 MAINTAINER @@ -332,7 +406,9 @@ Simon Cozens, C =head1 THANK YOU -Jesse Scheidlower, Jody Belka, Markus Ramberg, Mickael Joanne, Simon Flack and all the others who've helped. +Danijel Milicevic, Jesse Sheidlower, Jody Belka, Marcus Ramberg, +Mickael Joanne, Simon Flack, Veljko Vidovic and all the others who've +helped. =head1 LICENSE