HTTP::Engine::Interface::ModPerl - mod_perl Adaptor for HTTP::Engine

  # App.pm
  package App;
  use Mouse; # or use Moose or use Any::Moose
  use Data::Dumper;
  use HTTP::Engine;

  sub setup_engine {
      my($self, $conf) = @_;
      $conf->{request_handler} = sub { $self->handle_request(@_) };
      HTTP::Engine->new(
          interface => $conf,
      );
  }

  sub handle_request {
      my($self, $req) = @_;
      HTTP::Engine::Response->new(
          status => 200,
          body => Dumper($req),
      );
  }




  # app.pl
  use strict;
  use warnings;
  use App;
  App->new->setup_engine({
      module => 'ServerSimple',
      args => { port => 9999 },
  })->run;




  # App/ModPerl.pm
  package App::ModPerl;
  use Mouse; # or use Moose or use Any::Moose
  extends 'HTTP::Engine::Interface::ModPerl';
  use App;

  sub create_engine {
      my($class, $r, $context_key) = @_;

      App->new->setup_engine({
          module => 'ModPerl',
      });
  }




  # in httpd.conf
  PerlSwitches -Mlib=/foo/bar/app/lib
  <VirtualHost 127.0.0.1:8080>
      <Location />
          SetHandler modperl
          PerlOptions +SetupEnv
          PerlResponseHandler App::ModPerl
      </Location>
  </VirtualHost>

  # in httpd.conf
  PerlSwitches -Mlib=/foo/bar/app/lib
  <VirtualHost 127.0.0.1:8080>
      ServerName www.example.com
      ServerAlias host1.example.com
      ServerAlias host2.example.com
      ServerAlias host3.example.com
      <Location />
          SetHandler modperl
          PerlOptions +SetupEnv
          PerlSetEnv HTTP_ENGINE_CONTEXT_KEY YOUR_CHOICE_APPLICATION_UNIQUE_KEY
          PerlResponseHandler App::ModPerl
      </Location>
  </VirtualHost>

    SetHandler modperl
    PerlOptions +SetupEnv

    SetHandler perl-script

package HTTP::Engine::Interface::ModPerl;
my $CURRENT_ENGINE;
use HTTP::Engine::Interface
    builder => 'CGI',
    writer  => {
        output_header => sub {
            my ($self, $req, $res) = @_;
            my $r = $req->_connection->{apache_request} or die "missing apache request";
            $r->status( $res->status );
            my $content_type;
            $res->headers->scan(
                sub {
                    my ($key, $val) = @_;
                    $content_type = $val if lc $key eq 'content-type';
                    $r->headers_out->add($key => $val);
                }
            );
            $r->content_type($content_type) if $content_type;
        },
        write => sub {
            my ($self, $buffer) = @_;
            $CURRENT_ENGINE->interface->apache->print( $buffer );
        },
    }
;


BEGIN
{
    if (! exists $ENV{MOD_PERL_API_VERSION} ||
         $ENV{MOD_PERL_API_VERSION} != 2)
    {
        die "HTTP::Engine::Interface::ModPerl only supports mod_perl2";
    }
}

use Apache2::Const -compile => qw(OK);
use Apache2::Connection;
use Apache2::RequestRec;
use Apache2::RequestIO  ();
use Apache2::RequestUtil;
use Apache2::ServerRec;
use APR::Table;
use HTTP::Engine;
has 'apache' => (
    is       => 'rw',
    isa      => 'Apache2::RequestRec',
    weak_ref => 1,
);

has 'context_key' => (
    is      => 'rw',
    isa     => 'Str',
);

my %HE;

sub handler : method
{
    my $class = shift;
    my $r     = shift;

    local %ENV = %ENV;

    # ModPerl is currently the only environment where the inteface comes
    # before the actual invocation of HTTP::Engine

    my $context_key = $ENV{HTTP_ENGINE_CONTEXT_KEY} || join ':', $ENV{SERVER_NAME}, $ENV{SERVER_PORT}, $r->location;
    my $engine   = $HE{ $context_key };
    if (! $engine ) {
        $engine = $class->create_engine($r, $context_key);
        $HE{ $context_key } = $engine;
    }
    $CURRENT_ENGINE = $engine;

    $engine->interface->apache( $r );
    $engine->interface->context_key( $context_key );


    $engine->interface->handle_request(
        _connection => {
            input_handle   => $r,
            output_handle  => \*STDOUT,
            env            => \%ENV,
            apache_request => $r,
        },
    );

    return &Apache2::Const::OK;
}

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

    HTTP::Engine->new(
        interface => HTTP::Engine::Interface::ModPerl->new(
            request_handler   => sub { HTTP::Engine::Response->new(status => 200) },
        )
    );
}

sub run { die "THIS IS DUMMY" }

__INTERFACE__

__END__