view release on metacpan or  search on metacpan

lib/Apache2/Controller.pm  view on Meta::CPAN

if you set or return an http status higher than the HTTP_OK family
(HTTP_MULTIPLE_CHOICES (300) or higher.)

You should also not fiddle with the connection by causing
Apache2 to close it prematurely, else the post-response handlers 
may not run or won't run synchronously before another request 
is received that may have depended on their behavior.
(For example, you can't use a C<< PerlCleanupHandler >>
to do things like that because the request has already closed,
and it doesn't get processed before taking in the next request,
even when running in single-process mode.)

=head1 ERRORS

If you decide to set an error status code, you can print your
own content and return that status code.

If you want to use error templates, 
barf L<Apache2::Controller::X> objects.  These print a stack trace
to the error log at the WARN level of L<Log::Log4perl> from
this module's namespace.  If errors crop up from
other A2C request phase handlers, try setting
WARN log level for L<Apache2::Controller::NonResponseBase>
or L<Apache2::Controller::NonResponseRequest>.

Also see L<Apache2::Controller::Render::Template>.

You can use or subclass L<Apache2::Controller::X>,
to use C<< a2cx() >>,
or you can throw your own exception objects,
or just C<< die() >>, or C<< croak() >>,
or set C<< $self->status >>, headers etc., possibly printing content, 
or return the appropriate status from your controller method.

See L<Apache2::Controller::X> for help on throwing exceptions
with HTTP status, data dumps, etc.

If your code does break, die or throw an exception, this is 
caught by Apache2::Controller.  If your controller module implements
an C<<error() >> method, 
then C<< $handler->error() >> will be called passing the C<< $EVAL_ERROR >>
or exception object as the first argument.

 package MyApp::C::Foo;
 use YAML::Syck;
 # ...
 sub error {
     my ($self, $X) = @_;
     $self->status( Apache2::Const::HTTP_BAD_REQUEST );
     $self->content_type('text/plain');
     $self->print("Take this job and shove it!\n", "\n", $X, "\n");
     if ($X->isa('Apache2::Controller::X')) {
        # usually you wouldn't show gory details to the user...
        $self->print(Dump($X->dump)) if $X->dump;
        $self->print($X->trace) if $X->trace;  
     }
 }

For instance 
L<Apache2::Controller::Render::Template> implements
C<< error() >> for you, which looks for
the appropriately named error template as
F<template_dir/errors/###.html>.

Of course, all exceptions are sent to the error log using
L<Log::Log4perl> DEBUG() before the handler completes, and
any refusal status greater or equal to 400 (HTTP_BAD_REQUEST) 
will be written to the access log with L<Apache2::Log> log_reason() 
using the first few characters of the error.

See L<Apache2::Controller::Session/ERRORS> for how to control
whether or not a session is saved.  Usually it is automatically
saved, but not if you have an error.

C<< error() >> does not have to roll back DBI handles if you
use L<Apache2::Controller::DBI::Connector>, as this is
rolled back automatically in the C<< PerlLogHandler >>
phase if you don't commit the transaction.

=head1 CONTROLLER CLOSURES

Apache2::Controller's package space structure lets you take advantage
of closures that access variables in your controller subclass
package space, which are cached by modperl in child processes
across independent web requests.  Be careful with that and use
Devel::Size to keep memory usage down.  I have no idea how this
would work under threaded mpm.

=head1 CONTENT TYPE

Your controller should set content type with C<< $self->content_type() >>
to something specific if you need that.  Otherwise it will let
mod_perl set it to whatever it chooses when you start to print.
This is usually text/html.

=head1 LOGGING

Apache2::Controller uses L<Log::Log4perl>.  See that module
for information on how to set up a format file or statement.
For example, in a perl startup script called at Apache2 start time,
do something like:

 use Log::Log4perl; 
     log4perl.rootLogger=DEBUG, LogFile
     log4perl.appender.LogFile=Log::Log4perl::Appender::File
     log4perl.appender.LogFile.filename=/var/log/mysite_error_log
     log4perl.appender.LogFile.layout=PatternLayout
     log4perl.appender.LogFile.layout.ConversionPattern=%M [%L]: %m%n
 };
 Log::Log4perl->init(\$logconf);

These settings will be cloned to every modperl child on fork.

=head1 MVC

Apache2::Controller provides the controller, mainly.  
L<Apache2::Controller::Render::Template> is one example
of a view that can be used as a second base with
C<use base> in your controller module.  As for the Model
part of Model-View-Controller, Apache2::Controller leaves
that entirely up to you and does not force you to
wrap anything in an abstraction class.  

The C<handler()> subroutine is in your base class and your
controller modules will be running from memory in the mod_perl
child interpreter.  So,
you can use package namespace effectively to store data
that will persist in the mod_perl child across requests.

=head1 LOAD BALANCING

A2C does not have to load 
all site modules for every page handler, which could help with load-balancing
highly optimized handlers for specific URI's while having a universal
application installer.  

Picture if you will, a programming utopia in which all engineers
are respected, highly paid and content, and managers make
correct decisions to rely on open-source software.

You deploy the same Apache, the
same CPAN modules and your whole application package to every server,
and attach a url-generating subroutine to the L<Template|Template> stash
that puts in a different hostname when the URI is one of your
load-intensive functions.  

 <a href="[% myurl('/easy') %]">easy</a> "http://pony.x.y/easy"

 <a href="[% myurl('/hard') %]">hard</a> "http://packhorse.x.y/hard"

Web designers can be taught to use this function C<< myurl() >>, 
but system admins
maintain the map that it loads to figure out what servers to use.

Then the Apache2 config files on those
packhorse servers would pre-load only the subclassed controllers
that you needed, and redirect all other uri requests to the pony servers.

=cut

use strict;
use warnings FATAL => 'all';
use English '-no_match_vars';

use base qw( Apache2::Controller::Methods );

use Readonly;
use Scalar::Util qw( blessed );
use Log::Log4perl qw(:easy);

use YAML::Syck;
use Digest::SHA qw( sha224_base64 );
use URI;
use HTTP::Status qw( status_message );
use Scalar::Util qw( looks_like_number );

use Apache2::Controller::X;
use Apache2::Controller::Funk qw( log_bad_request_reason );

use Apache2::Request;
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::RequestUtil ();
use Apache2::Log;
use Apache2::Const -compile => qw( :common :http );

=head1 FUNCTIONS

=head2 a2c_new

 $handler = MyApp::C::ControllerSubclass->a2c_new( Apache2::RequestRec object )

This is called by handler() to create the Apache2::Controller object
via the module chosen by your L<Apache2::Controller::Dispatch> subclass.

We use C<< a2c_new >> instead of the conventional C<< new >>
because, in case you want to suck in the L<Apache2::Request>
methods with that module's automagic, then you don't get
confused about how C<<SUPER::>> behaves.  Otherwise you
get into a mess of keeping track of the order of bases
so you don't call C<< Apache2::Request->new() >> by accident,
which breaks everything.

=head3 subclassing C<a2c_new()>

To set params for the L<Apache2::Request> object,
you have to subclass C<a2c_new()>.

 package MyApp::ControllerBase;
 use base qw( Apache2::Controller Apache2::Request );

 sub a2c_new {
     my ($class, $r) = @_;
     return SUPER::new(
         $class, $r,
         POST_MAX => 65_535,
         TEMP_DIR => '/dev/shm',
     );
     # $self is already blessed in the class hierarchy
 }

 package MyApp::Controller::SomeURI;
 use base qw( MyApp::ControllerBase );
 sub allowed_methods qw( uri_one uri_two );
 sub uri_one { # ...

If you need to do the same stuff every time a request
starts, you can override the constructor through a
class hierarchy.

 package MyApp::ControllerBase;
 use base qw( Apache2::Controller Apache2::Request );

 sub new {
     my ($class, $r, @apr_override_args) = @_;

lib/Apache2/Controller.pm  view on Meta::CPAN

my %temp_dirs  = ( );
my %post_maxes = ( );

sub a2c_new {
    my ($class, $r, @apr_opts) = @_;

    DEBUG sub {
        "new $class, reqrec is '$r', apr_opts:\n".Dump(\@apr_opts)
    };

    my $self = {
        class       => $class,
    };

    bless $self, $class;

    DEBUG "creating Apache2::Request object";
    my $req = Apache2::Request->new( $r, @apr_opts );
    DEBUG "request object is '$req'";

    $self->{r} = $req;  # for Apache2::Request subclass automagic

    my $pnotes_a2c = $req->pnotes->{a2c} || { };

    my $method = $pnotes_a2c->{method};

    $self->{method}      = $method;
    $self->{path_args}   = $pnotes_a2c->{path_args};

    # don't instantiate the 'session' key of $self unless it's implemented
    # in some earlier stage of the apache lifecycle.
    my $session = $pnotes_a2c->{session};
    if ($session) {
        $self->{session} = $session;
        DEBUG(sub{"found and attached session to controller self:\n".Dump($session)});
        # this is the same reference as the pnotes reference still,
        # so the cleanup handler will find all changes made to it
    }

    DEBUG sub { Dump({
        # for simple debugging, stringify objects, otherwise this can get huge
        map {($_ => defined $self->{$_} ? "$self->{$_}" : undef)} keys %$self 
    }) };

    return $self;
}

=head1 METHODS

Methods are also extended by other modules in the A2C family.
See L<Apache2::Controller::Methods>.

=head2 handler

 # called from Apache, your subclass pushed to PerlResponseHandler
 # by your A2C dispatch handler:
 MyApp::Controller::Foo->handler( Apache2::RequestRec object )

The handler is pushed from an Apache2::Controller::Dispatch
subclass and via your dispatched subclass of Apache2::Controller.
It should not be set in the config file.  It looks
for the controller module name in C<< $r->pnotes->{a2c}{controller} >>
and for the method name in C<< $r->pnotes->{a2c}{method} >>.

Errors are intercepted and if the handler object was created
and implements an C<< $handler->error($exception) >> method 
then the exception will be passed as the argument.

An HTTP status code of HTTP_BAD_REQUEST or greater will 
cause log_reason to be called with a truncated error string
and the uri for recording in the access log.

=cut

my %supports_error_method = ( );

sub handler : method {
    my ($class, $r) = @_;
    return $class if !defined $r;

    my $pnotes_a2c = $r->pnotes->{a2c} || { };

    my $method = $pnotes_a2c->{method};

    DEBUG("$class -> $method");

    my ($handler, $status, $X, $used_error_method_successfully) = ( );
    eval {

        $handler = $class->a2c_new($r);
        $method  = $handler->{method};

        DEBUG("executing $class -> $method()");
        my $args = $pnotes_a2c->{path_args} || [];
        $status = $handler->$method(@{$args});
        $status = $r->status() if !defined $status;

        if (defined $status) {
            if (ref $status || !looks_like_number($status)) {
                a2cx message => "Controller returned or set non-numeric status",
                    status  => Apache2::Const::SERVER_ERROR,
                    dump    => { controller_set_status => $status };
            }
            elsif ($status < 0) {
                a2cx message => "controller must set http status >= 0",
                    status  => Apache2::Const::SERVER_ERROR,
                    dump    => { controller_set_status => $status };
            }
        }
    };
    if ($X = $EVAL_ERROR) {

        my $ref = ref($X);
        my $blessed = $ref && blessed($X);

        my $error_method_status;

        # if appropriate and able to call self->error(), do that now
        if ($handler && !$pnotes_a2c->{use_standard_errors}) {

            eval {
                if (exists $supports_error_method{$class}) {
                    $error_method_status = $handler->error($X);
                } 
                elsif ($class->can('error')) {
                    $supports_error_method{$class} = 1;
                    $error_method_status = $handler->error($X); 
                }
                $used_error_method_successfully = 1;
            };

            # trap unknown errors that might have been thrown
            # by the error() subroutine
            $X = Exception::Class->caught('Apache2::Controller::X')
                || $EVAL_ERROR 
                || $X;
        }

        my $x_status = $ref && $blessed && $X->can('status')
            ? $X->status : undef;

        $status 
          = defined $x_status               ? $x_status
          : defined $error_method_status    ? $error_method_status
          : !defined $status                ? Apache2::Const::SERVER_ERROR
          : $status == Apache2::Const::OK   ? Apache2::Const::HTTP_OK
          : Apache2::Const::SERVER_ERROR
          ;

        WARN "Exception processing status: $status";

        if ($ref && $blessed) {
            WARN sub { "dump:\n"    .Dump($X->dump)     } if $X->can('dump');
            WARN sub { "data:\n"    .Dump($X->data)     } if $X->can('data');
            WARN sub { "trace:\n"   .Dump($X->trace)    } if $X->can('trace');
            WARN "$X";
        }
        else {
            WARN("Caught an unknown error: $X");