+__PACKAGE__->model_classes_loaded(0);
+
+=head1 HOOKABLE METHODS
+
+As a framework, Maypole provides a number of B<hooks> - methods that are
+intended to be overridden. Some of these methods come with useful default
+behaviour, others do nothing by default. Hooks include:
+
+ Class methods
+ -------------
+ debug
+ setup
+ setup_model
+ load_model_subclass
+ init
+
+ Instance methods
+ ----------------
+ start_request_hook
+ is_model_applicable
+ get_session
+ authenticate
+ exception
+ additional_data
+ preprocess_path
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item debug
+
+ sub My::App::debug {1}
+
+Returns the debugging flag. Override this in your application class to
+enable/disable debugging.
+
+You can also set the C<debug> flag via L<Maypole::Application>.
+
+Some packages respond to higher debug levels, try increasing it to 2 or 3.
+
+
+=cut
+
+sub debug { 0 }
+
+=item config
+
+Returns the L<Maypole::Config> object
+
+=item setup
+
+ My::App->setup($data_source, $user, $password, \%attr);
+
+Initialise the Maypole application and plugins and model classes.
+Your application should call this B<after> setting up configuration data via
+L<"config">.
+
+It calls the hook C<setup_model> to setup the model. The %attr hash contains
+options and arguments used to set up the model. See the particular model's
+documentation. However here is the most usage of setup where
+Maypole::Model::CDBI is the base class.
+
+ My::App->setup($data_source, $user, $password,
+ { options => { # These are DB connection options
+ AutoCommit => 0,
+ RaiseError => 1,
+ ...
+ },
+ # These are Class::DBI::Loader arguments.
+ relationships => 1,
+ ...
+ }
+ );
+
+Also, see L<Maypole::Manual::Plugins>.
+
+=cut
+
+
+sub setup
+{
+ my $class = shift;
+
+ $class->setup_model(@_);
+}
+
+=item setup_model
+
+Called by C<setup>. This method builds the Maypole model hierarchy.
+
+A likely target for over-riding, if you need to build a customised model.
+
+This method also ensures any code in custom model classes is loaded, so you
+don't need to load them in the driver.
+
+=cut
+
+sub setup_model {
+ my $class = shift;
+ $class = ref $class if ref $class;
+ my $config = $class->config;
+ $config->model || $config->model('Maypole::Model::CDBI');
+ $config->model->require or die sprintf
+ "Couldn't load the model class %s: %s", $config->model, $@;
+
+ # among other things, this populates $config->classes
+ $config->model->setup_database($config, $class, @_);
+
+ $config->model->add_model_superclass($config);
+
+ # Load custom model code, if it exists - nb this must happen after the
+ # 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());
+ $config->model->adopt($subclass) if $config->model->can("adopt");
+ }
+
+}
+
+=item load_model_subclass($subclass)
+
+This method is called from C<setup_model()>. It attempts to load the
+C<$subclass> package, if one exists. So if you make a customized C<BeerDB::Beer>
+package, you don't need to explicitly load it.
+
+If automatic loading causes problems, Override load_model_subclass in your driver.
+
+sub load_model_subclass {};
+
+Or perhaps during development, if you don't want to load up custom classes, you
+can override this method and load them manually.
+
+=cut
+
+sub load_model_subclass {
+ my ($class, $subclass) = @_;
+
+ my $config = $class->config;
+
+ # Load any external files for the model base class or subclasses
+ # (e.g. BeerDB/DBI.pm or BeerDB/Beer.pm) based on code borrowed from
+ # Maypole::Plugin::Loader and Class::DBI.
+ if ( $subclass->require ) {
+ warn "Loaded external module for '$subclass'\n" if $class->debug > 1;
+ } else {
+ (my $filename = $subclass) =~ s!::!/!g;
+ die "Loading '$subclass' failed: $@\n"
+ unless $@ =~ /Can\'t locate \Q$filename\E\.pm/;
+ warn "No external module for '$subclass'"
+ if $class->debug > 1;
+ }
+}
+
+=item init
+
+Loads the view class and instantiates the view object.
+
+You should not call this directly, but you may wish to override this to add
+application-specific initialisation - see L<Maypole::Manual::Plugins>.
+
+=cut
+
+sub init
+{
+ my $class = shift;
+ my $config = $class->config;
+ $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);
+}
+
+=item new
+
+Constructs a very minimal new Maypole request object.
+
+=cut
+
+sub new
+{
+ my ($class) = @_;
+ my $self = bless {
+ config => $class->config,
+ }, $class;
+
+ $self->stash({});
+ $self->params({});
+ $self->query({});
+ $self->template_args({});
+ $self->args([]);
+ $self->objects([]);
+ return $self;
+}
+
+=item view_object
+
+Get/set the Maypole::View object
+
+=back
+
+=head1 INSTANCE METHODS
+
+=head2 Workflow
+
+=over 4
+
+=item handler
+
+This method sets up the class if it's not done yet, sets some defaults and
+leaves the dirty work to C<handler_guts>.
+
+=cut
+
+# handler() has a method attribute so that mod_perl will invoke
+# BeerDB->handler() as a method rather than a plain function
+# BeerDB::handler() and so this inherited implementation will be
+# found. See e.g. "Practical mod_perl" by Bekman & Cholet for
+# more information <http://modperlbook.org/html/ch25_01.html>
+sub handler : method {
+ # See Maypole::Workflow before trying to understand this.
+ my ($class, $req) = @_;
+
+ $class->init unless $class->init_done;
+
+ my $self = $class->new;
+
+ # initialise the request
+ $self->headers_out(Maypole::Headers->new);
+ $self->get_request($req);
+
+ $self->parse_location;
+
+ # hook useful for declining static requests e.g. images, or perhaps for
+ # sanitizing request parameters
+ $self->status(Maypole::Constants::OK()); # set the default
+ $self->__call_hook('start_request_hook');
+ return $self->status unless $self->status == Maypole::Constants::OK();
+ die "status undefined after start_request_hook()" unless defined
+ $self->status;
+ $self->get_session;
+ $self->get_user;
+ my $status = $self->handler_guts;
+ return $status unless $status == OK;
+ # TODO: require send_output to return a status code
+ $self->send_output;
+ return $status;
+}
+
+=item component
+
+ Run Maypole sub-requests as a component of the request
+
+ [% request.component("/beer/view_as_component/20") %]
+
+ Allows you to integrate the results of a Maypole request into an existing
+request. You'll need to set up actions and templates
+which return fragments of HTML rather than entire pages, but once you've
+done that, you can use the C<component> method of the Maypole request object
+to call those actions. You may pass a query string in the usual URL style.
+
+You should not fully qualify the Maypole URLs.
+
+Note: any HTTP POST or URL parameters passed to the parent are not passed to the
+component sub-request, only what is included in the url passed as an argyument
+to the method
+
+=cut
+
+sub component {
+ my ( $r, $path ) = @_;
+ my $self = bless { parent => $r, config => $r->{config}, } , ref $r;
+ $self->stash({});
+ $self->params({});
+ $self->query({});
+ $self->template_args({});
+ $self->args([]);
+ $self->objects([]);
+
+ $self->get_user;
+ my $url = URI->new($path);
+ $self->{path} = $url->path;
+ $self->parse_path;
+ $self->params( $url->query_form_hash );
+ $self->handler_guts;
+ return $self->output;
+}
+
+sub get_template_root {
+ my $self = shift;
+ my $r = shift;
+ return $r->parent->get_template_root if $r->{parent};
+ return $self->NEXT::DISTINCT::get_template_root( $r, @_ );
+}
+
+sub view_object {
+ my $self = shift;
+ my $r = shift;
+ return $r->parent->view_object if $r->{parent};
+ return $self->NEXT::DISTINCT::view_object( $r, @_ );
+}
+
+# Instead of making plugin authors use the NEXT::DISTINCT hoopla to ensure other
+# plugins also get to call the hook, we can cycle through the application's
+# @ISA and call them all here. Doesn't work for setup() though, because it's
+# too ingrained in the stack. We could add a run_setup() method, but we'd break
+# lots of existing code.
+sub __call_hook
+{
+ my ($self, $hook) = @_;
+
+ my @plugins;
+ {
+ my $class = ref($self);
+ no strict 'refs';
+ @plugins = @{"$class\::ISA"};
+ }
+
+ # this is either a custom method in the driver, or the method in the 1st
+ # plugin, or the 'null' method in the frontend (i.e. inherited from
+ # Maypole.pm) - we need to be careful to only call it once
+ my $first_hook = $self->can($hook);
+ $self->$first_hook;
+
+ my %seen = ( $first_hook => 1 );
+
+ # @plugins includes the frontend
+ foreach my $plugin (@plugins)
+ {
+ next unless my $plugin_hook = $plugin->can($hook);
+ next if $seen{$plugin_hook}++;
+ $self->$plugin_hook;
+ }
+}
+
+=item handler_guts
+
+This is the main request handling method and calls various methods to handle the
+request/response and defines the workflow within Maypole.
+
+=cut
+
+# The root of all evil
+sub handler_guts {
+ my ($self) = @_;
+ $self->build_form_elements(1) unless (defined ($self->config->build_form_elements) && $self->config->build_form_elements == 0);
+ $self->__load_request_model;
+
+ my $applicable = $self->is_model_applicable == OK;
+
+ my $status;
+
+ # handle authentication
+ eval { $status = $self->call_authenticate };
+ if ( my $error = $@ ) {
+ $status = $self->call_exception($error, "authentication");
+ if ( $status != OK ) {
+ $self->warn("caught authenticate error: $error");
+ return $self->debug ?
+ $self->view_object->error($self, $error) : ERROR;
+ }
+ }
+ if ( $self->debug and $status != OK and $status != DECLINED ) {
+ $self->view_object->error( $self,
+ "Got unexpected status $status from calling authentication" );
+ }
+
+ return $status unless $status == OK;
+
+ # We run additional_data for every request
+ $self->additional_data;
+
+ if ($applicable) {
+ eval { $self->model_class->process($self) };
+ if ( my $error = $@ ) {
+ $status = $self->call_exception($error, "model");
+ if ( $status != OK ) {
+ $self->warn("caught model error: $error");
+ return $self->debug ?
+ $self->view_object->error($self, $error) : ERROR;
+ }
+ }
+ } else {
+ $self->__setup_plain_template;
+ }
+
+ # less frequent path - perhaps output has been set to an error message
+ if ($self->output) {
+ $self->{content_type} ||= $self->__get_mime_type();
+ $self->{document_encoding} ||= "utf-8";
+ return OK;
+ }
+
+ # normal path - no output has been generated yet
+ my $processed_view_ok = $self->__call_process_view;
+
+ $self->{content_type} ||= $self->__get_mime_type();
+ $self->{document_encoding} ||= "utf-8";
+
+ return $processed_view_ok;
+}
+
+my %filetypes = (
+ 'js' => 'text/javascript',
+ 'css' => 'text/css',
+ 'htm' => 'text/html',
+ 'html' => 'text/html',
+ );
+
+sub __get_mime_type {
+ my $self = shift;
+ my $type = 'text/html';
+ if ($self->path =~ m/.*\.(\w{3,4})$/) {
+ $type = $filetypes{$1};
+ } else {
+ my $output = $self->output;
+ if (defined $output) {
+ $type = $mmagic->checktype_contents($output);
+ }
+ }
+ return $type;
+}
+
+sub __load_request_model
+{
+ my ($self) = @_;
+ # We may get a made up class from class_of
+ my $mclass = $self->config->model->class_of($self, $self->table);
+ if ( eval {$mclass->isa('Maypole::Model::Base')} ) {
+ $self->model_class( $mclass );
+ }
+ elsif ($self->debug > 1) {
+ $self->warn("***Warning: No $mclass class appropriate for model. @_");
+ }
+}
+
+
+# is_applicable() returned false, so set up a plain template. Model processing
+# will be skipped, but need to remove the model anyway so the template can't
+# access it.
+sub __setup_plain_template
+{
+ my ($self) = @_;
+
+ # It's just a plain template
+ $self->build_form_elements(0);
+ $self->model_class(undef);
+
+ unless ($self->template) {
+ # FIXME: this is likely to be redundant and is definately causing problems.
+ my $path = $self->path;
+ $path =~ s{/$}{}; # De-absolutify
+ $self->path($path);
+ $self->template($self->path);
+ }
+}
+
+# The model has been processed or skipped (if is_applicable returned false),
+# any exceptions have been handled, and there's no content in $self->output
+sub __call_process_view {
+ my ($self) = @_;
+
+ my $status = eval { $self->view_object->process($self) };
+
+ my $error = $@ || $self->{error};
+
+ if ( $error ) {
+ $status = $self->call_exception($error, "view");
+
+ if ( $status != OK ) {
+ warn "caught view error: $error" if $self->debug;
+ return $self->debug ?
+ $self->view_object->error($self, $error) : ERROR;
+ }
+ }
+
+ 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 { }
+
+=item build_form_elements
+
+$r->build_form_elements(0);
+
+Specify (in an action) whether to build HTML form elements and populate
+the cgi element of classmetadata in the view.
+
+You can set this globally using the accessor of the same name in Maypole::Config,
+this method allows you to over-ride that setting per action.
+
+=cut
+
+=item get_request
+
+You should only need to define this method if you are writing a new
+Maypole backend. It should return something that looks like an Apache
+or CGI request object, it defaults to blank.
+
+=cut
+
+sub get_request { }
+
+=item parse_location
+
+Turns the backend request (e.g. Apache::MVC, Maypole, CGI) into a Maypole
+request. It does this by setting the C<path>, and invoking C<parse_path> and
+C<parse_args>.
+
+You should only need to define this method if you are writing a new Maypole
+backend.
+
+=cut
+
+sub parse_location
+{
+ die "parse_location is a virtual method. Do not use Maypole directly; " .
+ "use Apache::MVC or similar";
+}
+
+=item start_request_hook
+
+This is called immediately after setting up the basic request. The default
+method does nothing.
+
+The value of C<< $r->status >> is set to C<OK> before this hook is run. Your
+implementation can change the status code, or leave it alone.
+
+After this hook has run, Maypole will check the value of C<status>. For any
+value other than C<OK>, Maypole returns the C<status> immediately.
+
+This is useful for filtering out requests for static files, e.g. images, which
+should not be processed by Maypole or by the templating engine:
+
+ sub start_request_hook
+ {
+ my ($r) = @_;
+
+ $r->status(DECLINED) if $r->path =~ /\.jpg$/;
+ }
+
+Multiple plugins, and the driver, can define this hook - Maypole will call all
+of them. You should check for and probably not change any non-OK C<status>
+value:
+
+ package Maypole::Plugin::MyApp::SkipFavicon;
+
+ sub start_request_hook
+ {
+ my ($r) = @_;
+
+ # check if a previous plugin has already DECLINED this request
+ # - probably unnecessary in this example, but you get the idea
+ return unless $r->status == OK;
+
+ # then do our stuff
+ $r->status(DECLINED) if $r->path =~ /favicon\.ico/;
+ }
+
+=cut
+
+sub start_request_hook { }
+
+=item is_applicable
+
+B<This method is deprecated> as of version 2.11. If you have overridden it,
+please override C<is_model_applicable> instead, and change the return type
+from a Maypole:Constant to a true/false value.
+
+Returns a Maypole::Constant to indicate whether the request is valid.
+
+=cut
+
+sub is_applicable { return shift->is_model_applicable(@_); }
+
+=item is_model_applicable
+
+Returns true or false to indicate whether the request is valid.
+
+The default implementation checks that C<< $r->table >> is publicly
+accessible and that the model class is configured to handle the
+C<< $r->action >>.
+
+=cut
+
+sub is_model_applicable {
+ my ($self) = @_;
+
+ # Establish which tables should be processed by the model
+ my $config = $self->config;
+
+ $config->ok_tables || $config->ok_tables( $config->display_tables );
+
+ $config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } )
+ if ref $config->ok_tables eq "ARRAY";
+
+ my $ok_tables = $config->ok_tables;
+
+ # Does this request concern a table to be processed by the model?
+ my $table = $self->table;
+
+ my $ok = 0;
+
+ if (exists $ok_tables->{$table})
+ {
+ $ok = 1;
+ }
+
+ if (not $ok)
+ {
+ $self->warn ("We don't have that table ($table).\n"
+ . "Available tables are: "
+ . join( ",", keys %$ok_tables ))
+ if $self->debug and not $ok_tables->{$table};
+
+ return DECLINED;
+ }
+
+ # Is the action public?
+ my $action = $self->action;
+ return OK if $self->model_class->is_public($action);
+
+ $self->warn("The action '$action' is not applicable to the table '$table'")
+ if $self->debug;
+
+ return DECLINED;
+}
+
+=item get_session
+
+Called immediately after C<start_request_hook()>.
+
+This method should return a session, which will be stored in the request's
+C<session> attribute.
+
+The default method is empty.
+
+=cut
+
+sub get_session { }
+
+=item get_user
+
+Called immediately after C<get_session>.
+
+This method should return a user, which will be stored in the request's C<user>
+attribute.
+
+The default method is empty.
+
+=cut
+
+sub get_user {}
+
+=item call_authenticate
+
+This method first checks if the relevant model class
+can authenticate the user, or falls back to the default
+authenticate method of your Maypole application.
+
+=cut
+
+sub call_authenticate
+{
+ my ($self) = @_;
+
+ # Check if we have a model class with an authenticate() to delegate to
+ return $self->model_class->authenticate($self)
+ if $self->model_class and $self->model_class->can('authenticate');
+
+ # Interface consistency is a Good Thing -
+ # the invocant and the argument may one day be different things
+ # (i.e. controller and request), like they are when authenticate()
+ # is called on a model class (i.e. model and request)
+ return $self->authenticate($self);
+}
+
+=item authenticate
+
+Returns a Maypole::Constant to indicate whether the user is authenticated for
+the Maypole request.
+
+The default implementation returns C<OK>
+
+=cut
+
+sub authenticate { return OK }
+
+
+=item call_exception
+
+This model is called to catch exceptions, first after authenticate, then after
+processing the model class, and finally to check for exceptions from the view
+class.
+
+This method first checks if the relevant model class
+can handle exceptions the user, or falls back to the default
+exception method of your Maypole application.