view release on metacpan or  search on metacpan

lib/Ambrosia/CommonGatewayInterface/ApacheRequest.pm  view on Meta::CPAN

package Ambrosia::CommonGatewayInterface::ApacheRequest;
use strict;
use warnings;

use Apache ();
use Apache::Request;
use Apache::Constants qw':methods :http';

use Ambrosia::Meta;

class sealed
{
    extends => [qw/Ambrosia::CommonGatewayInterface/],
    public  => [qw/header_params/],
    private => [qw/__core/]
};

our $VERSION = 0.010;

sub open
{
    my $self = shift;
    my $params = shift;

    my $r = $self->__core = Apache->request;
    $self->_handler = new Apache::Request($r);

    if ( $params )
    {
        $self->delete_all;
        foreach ( keys %$params)
        {
            $self->_handler->param($_, $params->{$_});
        }
    }
    $self->SUPER::open();
    return $self->_handler;
}

################################################################################

sub input_data
{
    shift->_handler->param(@_);
}

sub output_data
{
    my $self = shift;
    my ($nph, $no_cache, $header) = prepare_header(@_);

    if ( $self->IS_OK )
    {
        $self->__core->status(&HTTP_OK);
    }
    elsif( $self->IS_REDIRECT )
    {
        $self->__core->status(&HTTP_MOVED_TEMPORARILY);
    }
    elsif( $self->IS_ERROR )
    {
        $self->__core->status(&HTTP_INTERNAL_SERVER_ERROR);
    }

    $self->__core->send_http_header if $nph;
    $self->__core->no_cache if $no_cache;
    $self->__core->send_cgi_header(join(crlf(), @$header, crlf()));

    return '';
}

################################################################################

sub crlf() { "\r\n"; }

sub prepare_header
{
    my %params = @_;
    my @headers = ();
    my $type = 'Content-Type: text/html';
    my $charset = '';
    my $date;
    my $nph;
    my $status;
    my $no_cache;

    foreach ( keys %params )
    {
        /-?([[:alnum:]]+)(?:[-_](\w+))?/;
        my $k = uc($1 . ($2 ? ('-' . $2) : ''));

        if ( $k eq 'TYPE' || $k eq 'CONTENT-TYPE')
        {
            $type = 'Content-Type: ' . $params{$_};
        }
        elsif( $k eq 'CHARSET' )