view release on metacpan or  search on metacpan

lib/APR/Emulate/PSGI.pm  view on Meta::CPAN

package APR::Emulate::PSGI;

=head1 NAME

APR::Emulate::PSGI - Class that Emulates the mod_perl2 APR Object (Apache2::RequestRec, et al)

=head1 SYNOPSIS

  use APR::Emulate::PSGI;
  my $r = APR::Emulate::PSGI->new($psgi_env);

  # Or in a CGI environment:
  my $r = APR::Emulate::PSGI->new();

=head1 DESCRIPTION

This class emulates the mod_perl2 APR object.  It expects either a
PSGI environment hashref to be passed in, or to read HTTP environment
information from the global %ENV.

Currently this module is little more than a proof of concept.  There
are rough edges.

Use at your own discretion.  Contributions welcome.

=cut

use 5.010000;
use strict;
use warnings;

use URI;
use HTTP::Headers;

# APR::MyPool defined below this package.
# APR::MyTable defined below this package.

our $VERSION = '0.03';

# TODO Replace //= with something 5.6.0 appropriate.

=head1 METHODS

=over 4

=item new

Creates an object that emulates the mod_perl2 APR object.

    my $r = APR::Emulate::PSGI->new($psgi_env);

HTTP environment information is read from the PSGI environment that is
passed in as a parameter.  If no PSGI environment is supplied,
environment information is read from the global %ENV.

=cut

sub new {
    my ( $class, $env ) = @_;
    my $self = bless {
        'psgi_env' => $env,
        'cgi_mode' => ( defined($env) ? 0 : 1 ),
    }, $class;
    return $self;
}

=item psgi_status

Returns the numeric HTTP response that should be used when building
a PSGI response.

    my $status = $r->psgi_status();

The value is determined by looking at the current value of L</status_line>,
or if that is not set, the current value of L</status>, or if that is not
set, defaults to 200.

=cut

sub psgi_status {
    my ($self) = @_;
    my $status = $self->status_line() || $self->status() || '200';
    $status =~ s/\D//g;
    return $status;
}

=item psgi_headers

Returns an arrayref of headers which can be used when building a PSGI
response.

A Content-Length header is not included, and must be added in accordance
with the L<PSGI> specification, while building the PSGI response.

    my $headers_arrayref = $r->psgi_headers();

=cut

sub psgi_headers {
    my ($self) = @_;
    my @headers = ();

    my $status = $self->psgi_status();
    if ($status eq '204' || $status eq '304' || $status =~ /^1/) {
        # Must not return Content-Type header, per PSGI spec.
    }
    else {
        # Add Content-Type header.
        push @headers, (
            'Content-Type',
            ($self->{'content_type'} || 'text/html'),
        );
    }