view release on metacpan or  search on metacpan

lib/HTTP/Daemon/Threaded/CGIAdapter.pm  view on Meta::CPAN

=pod

=begin classdoc

Convert an <cpan>HTTP::Request</cpan> object into a CGI protocol
environment, and process the response emitted by the CGI handler.
Uses <cpan>IO::Scalar</cpan> to redirect STDIN and STDOUT to scalar
buffers, so that the CGI handler input and output are buffered until the
handler exits, at which point, the accumulated output buffer is
turned into an <cpan>HTTP::Response</cpan> object and then sent
back to the client.
<p>
Derived from <cpan>HTTP::Request::AsCGI</cpan>, by Christian Hansen, C<ch@ngmedia.com>
<p>
<b>WARNING:</b> <cpan>IO::Scalar</cpan> relies on filehandle ties, which are still
considered experimental in some releases of Perl 5.8. However, the functionality
used within this package is limited to simple input or output, and thus far
appears to function well.
<p>
Developers should be judicious in their use of the CGI interface for
HTTP::Daemon::Threaded: if the request is to return a very large (i.e.,
multi-megabyte) response, the underlying I/O buffering may consume
significant memory resources. Likewise, this package does not support
some methods of "Comet"-style streaming client-server interaction, as the 
response buffer will not be dispatched to the client until the CGI
invokation has completed.
<p>
Copyright&copy 2008, Dean Arnold, Presicient Corp., USA<br>
All rights reserved.
<p>
Licensed under the Academic Free License version 3.0, as specified in the
at <a href='http://www.opensource.org/licenses/afl-3.0.php'>OpenSource.org</a>.

@author D. Arnold
@since 2008-Mar-14
@see <cpan>HTTP::Request::AsCGI</cpan>

=end classdoc

=cut

package HTTP::Daemon::Threaded::CGIAdapter;

use strict;
use warnings;
use bytes;

use Carp;
use Socket;
use IO::Handle;
use IO::Scalar;
use HTTP::Response;

our $VERSION = '0.91';

sub new {
    my ($class, $request, $fd, $content_type)   = @_;

    my $self = bless { 
    	restored => 0, 
    	setuped => 0,
    	request => $request
    }, $class;

    my $host = $request->header('Host');
    my $uri  = $request->uri->clone;
    $uri->scheme('http')    unless $uri->scheme;
    $uri->host('localhost') unless $uri->host;
    $uri->port(80)          unless $uri->port;
    $uri->host_port($host)  unless !$host || ( $host eq $uri->host_port );

    $uri = $uri->canonical;

	my $sockaddr = getpeername($fd);
	my ($port, $addr) = sockaddr_in($sockaddr);

    my %environment = (
        GATEWAY_INTERFACE => 'CGI/1.1',
        HTTP_HOST         => $uri->host_port,
        HTTPS             => ( $uri->scheme eq 'https' ) ? 'ON' : 'OFF',
        PATH_INFO         => $uri->path,
        QUERY_STRING      => $uri->query || '',
        SCRIPT_NAME       => '/',
        SERVER_NAME       => $uri->host,