MasonX::Maypole - use Mason as the frontend and view for Maypole version 2

    package BeerDB;
    use warnings;
    use strict;

    use Class::DBI::Loader::Relationship;

    use Maypole::Application qw( -Debug2 MasonX AutoUntaint );

    BeerDB->setup( 'dbi:mysql:beerdb', 'username', 'password' );

    BeerDB->config->{template_root}  = '/home/beerdb/www/www/htdocs';
    BeerDB->config->{uri_base}       = '/';
    BeerDB->config->{rows_per_page}  = 10;
    BeerDB->config->{display_tables} = [ qw( beer brewery pub style ) ];
    BeerDB->config->{application_name} = 'The Beer Database';

    BeerDB->config->masonx->{comp_root}  = [ [ factory => '/var/www/maypole/factory' ] ];
    BeerDB->config->masonx->{data_dir}   = '/home/beerdb/www/www/mdata';
    BeerDB->config->masonx->{in_package} = 'BeerDB::TestApp';

    BeerDB->auto_untaint;

    BeerDB->config->{loader}->relationship($_) for (
        'a brewery produces beers',
        'a style defines beers',
        'a pub has beers on handpumps',
        );

    1;

package MasonX::Maypole;
use warnings;
use strict;
use Carp;

use HTML::Mason 1.30; # for dynamic comp roots
use Maypole 2.10;     # for Maypole::Application support

# need to get rid of this, and a couple of bits and pieces, to allow CGI mode
use base 'Apache::MVC';

our $VERSION = 0.51;

Maypole::Config->mk_accessors( qw( masonx factory_root ) );

__PACKAGE__->mk_classdata( 'mason_ah' );

# This only gets called once. Mason's path searching mechanism replaces
# get_template_root and Maypole::View::Base::paths.
sub init 
{
    my ( $r ) = @_;

    my $mason_cfg = $r->config->masonx;
    
    $mason_cfg->{comp_root} = [ $r->_paths ];
    
    $mason_cfg->{decline_dirs} ||= 0;
    $mason_cfg->{in_package}   ||= 'HTML::Mason::Commands';
    $mason_cfg->{dynamic_comp_root} = 1;
    
    $r->mason_ah( MasonX::Maypole::ApacheHandler->new( %{ $mason_cfg } ) );
    
    $r->config->view || $r->config->view( 'MasonX::Maypole::View' );
        
    # set up the view object
    $r->SUPER::init;
}

# MasonX::Maypole::View::path() wraps this
sub _paths
{
    my ( $r ) = @_; # class during startup, object during requests

    my $root    = $r->config->template_root || $r->get_template_root;
    my $factory = $r->config->factory_root; 
    
    $root = ref $root eq 'ARRAY' ? $root : [ $root ];
    
    my @paths;

    foreach my $path ( @$root ) 
    {
        if ( ref $r ) # false during startup - calling model_class() is a fatal error
        {
            if ( my $model = $r->model_class )
            {
                my $model_path = File::Spec->catdir( $path, $model->moniker );
                
                $model =~ s/::/_/g;
                
                push @paths, [ $model, $model_path ] if -d $model_path;
            }
        }
                
        my $custom = File::Spec->catdir( $path, 'custom'  );
        
        push @paths, [ custom => $custom ] if -d $custom;
        
        push @paths, [ default => $path ];
        
        my $this_factory = File::Spec->catdir( $path, 'factory' );
        push @paths, [ factory => $this_factory ] if -d $this_factory;
    }
    
    push @paths, [ factory => $factory ] if $factory;
    
    return @paths;
}

# override the method in Apache::MVC
sub parse_args 
{
    my ( $r ) = @_;

    # set and return request args in Mason request object
    my $args = $r->mason_ah->request_args( $r->ar );

    $r->{params} = $args;
    $r->{query}  = $args;
}

sub send_output 
{
    my ( $r ) = @_;
    
    #
    # set up the Mason request object
    #
    
    # if there was an error, there may already be a report in the output slot
    die $r->output if $r->output;

    my $m = $r->mason_ah->prepare_request( $r->ar );
    
    unless ( ref $m )
    {
        warn "prepare_request returned this: [$m] instead of a Mason request object";
        return $m;
    }
    
    #
    # set headers (Mason will set content-length and call send_http_header)
    #
    $r->ar->content_type(
          $r->content_type =~ m/^text/
        ? $r->content_type . "; charset=" . $r->document_encoding
        : $r->content_type
    );
    
    foreach ( $r->headers_out->field_names ) 
    {
        next if /^Content-(Type|Length)/;
        $r->{ar}->headers_out->set( $_ => $r->headers_out->get( $_ ) );
    }
    
    #
    # set dynamic comp roots
    #
    $m->interp->comp_root( [ $r->view_object->paths( $r ) ] );

    if ( $r->debug > 1 )
    {
        Data::Dumper->require or die "Failed to load Data::Dumper: $@";
        warn "Comp roots: " . Data::Dumper::Dumper( $m->interp->comp_root );
    }
    
    # now generate and send output
    my $status = $m->exec;
    
    # Maypole doesn't actually check this status, but for the sake of good form:
    return $status;
}

sub get_template_root { $_[0]->config->template_root }

sub get_request 
{
    my ( $self, $r ) = @_;
    
    $self->{ar} = Apache::Request->instance( $r ); 
}

{
    # copied from MasonX::WebApp
    package MasonX::Maypole::ApacheHandler;
    use base 'HTML::Mason::ApacheHandler';

    sub request_args
    {
        my ( $self, $apr ) = @_;

        return $apr->pnotes('__request_args__') if $apr->pnotes('__request_args__');

        my $args = ($self->SUPER::request_args($apr))[0] || {};

        $apr->pnotes( __request_args__ => $args );

        return $args;
    }
}

1; # End of MasonX::Maypole2