Catalyst::Engine::Zeus::Base - Base class for Zeus Engine


Catalyst-Engine-Zeus documentation Contained in the Catalyst-Engine-Zeus distribution.

Index


Code Index:

NAME

Top

Catalyst::Engine::Zeus::Base - Base class for Zeus Engine

SYNOPSIS

Top

See Catalyst.

DESCRIPTION

Top

This class overloads some methods from Catalyst::Engine.

METHODS

Top

$c->zeus

Returns an Zeus::ModPerl object.

OVERLOADED METHODS

Top

This class overloads some methods from Catalyst::Engine.

$c->finalize_body
$c->finalize_headers
$c->handler
$c->prepare_body
$c->prepare_connection
$c->prepare_headers
$c->prepare_path
$c->prepare_request($r)
$c->run

SEE ALSO

Top

Catalyst Catalyst::Engine.

AUTHOR

Top

Christian Hansen ch@ngmedia.com

COPYRIGHT

Top


Catalyst-Engine-Zeus documentation Contained in the Catalyst-Engine-Zeus distribution.
package Catalyst::Engine::Zeus::Base;

use strict;
use base qw[Catalyst::Engine];

use Zeus::ModPerl            ();
use Zeus::ModPerl::Constants ();
use Zeus::ModPerl::File      ();

Zeus::ModPerl::Constants->import(':common');

use URI;
use URI::http;

__PACKAGE__->mk_accessors(qw/zeus/);

sub finalize_body {
    my $c = shift;
    $c->zeus->print( $c->response->body );
}

sub finalize_headers {
    my $c = shift;

    for my $name ( $c->response->headers->header_field_names ) {
        next if $name =~ /^Content-(Length|Type)$/i;
        my @values = $c->response->header($name);
        $c->zeus->headers_out->add( $name => $_ ) for @values;
    }

    if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) {
        my @values = $c->response->header('Set-Cookie');
        $c->zeus->err_headers_out->add( 'Set-Cookie' => $_ ) for @values;
    }

    $c->zeus->status( $c->response->status );

    if ( my $type = $c->response->header('Content-Type') ) {
        $c->zeus->content_type($type);
    }

    if ( my $length = $c->response->content_length ) {
        $c->zeus->set_content_length($length);
    }

    $c->zeus->send_http_header;

    return 0;
}

sub handler ($$) {
    shift->SUPER::handler(@_);
}

sub prepare_body {
    my $c = shift;
    
    my $body = undef;
    
    while ( read( STDIN, my $buffer, 8192 ) ) {
        $body .= $buffer;
    }
    
    $c->request->body($body);
}

sub prepare_connection {
    my $c = shift;
    $c->request->address( $c->zeus->connection->remote_ip );
    $c->request->hostname( $c->zeus->connection->remote_host );
    $c->request->protocol( $c->zeus->protocol );
    $c->request->user( $c->zeus->user );
    
    if ( $ENV{HTTPS} || $c->zeus->get_server_port == 443 ) {
        $c->request->secure(1);
    }
}

sub prepare_headers {
    my $c = shift;
    $c->request->method( $c->zeus->method );
    $c->request->header( %{ $c->zeus->headers_in } );
}

sub prepare_path {
    my $c = shift;
    
    my $base;
    {
        my $scheme = $c->request->secure ? 'https' : 'http';
        my $host   = $c->zeus->hostname;
        my $port   = $c->zeus->get_server_port;
        my $path   = $c->zeus->location || '/';
        
        unless ( $path =~ /\/$/ ) {
            $path .= '/';
        }

        $base = URI->new;
        $base->scheme($scheme);
        $base->host($host);
        $base->port($port);
        $base->path($path);

        $base = $base->canonical->as_string;
    }
    
    my $location = $c->zeus->location || '/';
    my $path = $c->zeus->uri || '/';
    $path =~ s/^($location)?\///;
    $path =~ s/^\///;

    $c->req->base($base);
    $c->req->path($path);
}

sub prepare_request {
    my ( $c, $r ) = @_;
    $c->zeus($r);
}

sub run { }

1;