X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole.pm;h=b08edbda68cdbf10c1493cbfd4e24c629f8ed6ea;hb=70a0d09c3f228f792775b4ac03894d0d37b5c444;hp=56c94e3748fb28fa9e92daac0f79c881662287ae;hpb=90b7b082066bee6303621aab49b166546445085c;p=maypole.git diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 56c94e3..b08edbd 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -1,4 +1,5 @@ package Maypole; +use Class::C3; use base qw(Class::Accessor::Fast Class::Data::Inheritable); use UNIVERSAL::require; use strict; @@ -12,7 +13,7 @@ use URI::QueryParam; use NEXT; use File::MMagic::XS qw(:compat); -our $VERSION = '2.11_pre5'; +our $VERSION = '2.12'; our $mmagic = File::MMagic::XS->new(); # proposed privacy conventions: @@ -183,7 +184,7 @@ __PACKAGE__->mk_classdata($_) for qw( config init_done view_object model_classes __PACKAGE__->mk_accessors( qw( params query objects model_class template_args output path args action template error document_encoding content_type table - headers_in headers_out stash status parent) + headers_in headers_out stash status parent build_form_elements) ); __PACKAGE__->config( Maypole::Config->new() ); @@ -299,14 +300,10 @@ sub setup_model { # among other things, this populates $config->classes $config->model->setup_database($config, $class, @_); - foreach my $subclass ( @{ $config->classes } ) { - next if $subclass->isa("Maypole::Model::Base"); - no strict 'refs'; - unshift @{ $subclass . "::ISA" }, $config->model; - } + $config->model->add_model_superclass($config); # Load custom model code, if it exists - nb this must happen after the - # unshift, to allow code attributes to work, but before adopt(), + # adding the model superclass, to allow code attributes to work, but before adopt(), # in case adopt() calls overridden methods on $subclass foreach my $subclass ( @{ $config->classes } ) { $class->load_model_subclass($subclass) unless ($class->model_classes_loaded()); @@ -384,13 +381,12 @@ sub new config => $class->config, }, $class; - $self->stash({}); - $self->params({}); - $self->query({}); - $self->template_args({}); - $self->args([]); - $self->objects([]); - + $self->stash({}); + $self->params({}); + $self->query({}); + $self->template_args({}); + $self->args([]); + $self->objects([]); return $self; } @@ -540,15 +536,13 @@ sub __call_hook This is the main request handling method and calls various methods to handle the request/response and defines the workflow within Maypole. -B. - =cut # The root of all evil sub handler_guts { my ($self) = @_; - + $self->build_form_elements(1); $self->__load_request_model; my $applicable = $self->is_model_applicable == OK; @@ -681,6 +675,29 @@ sub __call_process_view { return $status; } +=item warn + +$r->warn('its all gone pete tong'); + +Warn must be implemented by the backend, i.e. Apache::MVC +and warn to stderr or appropriate logfile. + +You can also over-ride this in your Maypole driver, should you +want to use something like Log::Log4perl instead. + +=cut + +sub warn { } + +=head2 build_form_elements + +$r->build_form_elements(0); + +Specify whether to build HTML form elements and populate +the cgi element of classmetadata. + +=cut + =item get_request You should only need to define this method if you are writing a new @@ -798,9 +815,9 @@ sub is_model_applicable { if (not $ok) { - warn "We don't have that table ($table).\n" + $self->warn ("We don't have that table ($table).\n" . "Available tables are: " - . join( ",", keys %$ok_tables ) + . join( ",", keys %$ok_tables )) if $self->debug and not $ok_tables->{$table}; return DECLINED; @@ -810,7 +827,7 @@ sub is_model_applicable { my $action = $self->action; return OK if $self->model_class->is_public($action); - warn "The action '$action' is not applicable to the table '$table'" + $self->warn("The action '$action' is not applicable to the table '$table'") if $self->debug; return DECLINED;