package LWP::UserAgent::Local;

use LWP::UserAgent;
use base 'LWP::UserAgent';
use IPC::Run3 'run3';
use IO::String;

=pod

The ScriptAlias parameter to LWP::UserAgent::Local::new is used to
find what part of a URI's path corresponds to the script name

The ScriptAlias is matched against the path; the single path component
that follows is the script name.

Ultimately, it should take multiple ScriptAliases and should map them
to file-system paths.

=cut

sub new {
    $class = shift;
    my %super_args = %{ $_[0] };
    delete $super_args{ScriptAlias};
    delete $super_args{AddHandler};
    $this  = $class->SUPER::new(%super_args);
    %$this = %{ $_[0] };
    $this;
}

sub request {&simple_request}

sub simple_request {
    my $this      = shift;
    my $request   = shift;
    my ($options) = @_;

    Carp::croak
        "LWP::UserAgent::Local::request requires an HTTP::Request argument"
        unless ref $request && $request->isa('HTTP::Request');

    my $request_method = $request->method();
    $request_method = "GET" unless $request_method;

    my $script_alias = $this->{ScriptAlias};
    if ( $this->{AddHandler} ) {
        my ( $handler, $ext ) = split / +/, $this->{AddHandler};
        return unless $request->uri->path() =~ /$ext$/;
    }
    my ( $script_name, $path )
        = ( $request->uri->path()
            =~ m|^(?:\w+://[^/]*/?)?$script_alias([^/]*)(/?.*)| );
    $script_name
        or die "Couldn't determine script name from "
        . $request->uri()->path();
    $ENV{REQUEST_URI} = $script_alias;

    $this->{cookie_jar}->add_cookie_header($request) if $this->{cookie_jar};

    shift;
    ###delete $ENV{$_} foreach (grep {/^HTTP_/} (keys %ENV));
    $request->headers()->scan(
        sub {
            $header_name = $_[0];
            $header_name =~ tr/a-z-/A-Z_/;
            $ENV{ "HTTP_" . $header_name } = $_[1];
        }
    );

    $ENV{REQUEST_METHOD} = $request_method;
    foreach $header (@headers) {
        my ( $header_name, $header_val ) = $header =~ /(.*?):(.*)/;
        $header_name =~ tr/a-z-/A-Z_/;
        $ENV{ "HTTP_" . $header_name } = $header_val;
    }
    $ENV{SCRIPT_NAME}     = $script_name;
    $ENV{PATH_INFO}       = $path;
    $ENV{QUERY_STRING}    = $request->uri->query || '';
    $ENV{HTTP_USER_AGENT} = "Ezra's Local User Agent 0.1";
    print $ENV{REQUEST_METHOD} . " => "
        . $ENV{SCRIPT_NAME}
        . $ENV{PATH_INFO} . "\n"
        if $options->{verbose};

    my $content = $request->content();
    if ($content) {
        $ENV{CONTENT_LENGTH} = length $request->content();
    }
    run3 [$^X, "./$script_name"],
        \$content, \my $output, undef,
        { binmode_stdin => 1 }
        or die "Couldn't spawn ./$script_name";
    print STDERR "$script_name exit status: $?\n" if $?;

    my $RESPONSE = IO::String->new($output);

    my $response = new HTTP::Response();
    $response->request($request);
    my $status_line = '';
    while ( ( $line = <$RESPONSE> ) !~ /^\s*$/ ) {
        if ( $line =~ /^Status:/i ) {
            $status_line = $line;
        }
        else {
            my ( $hdr_name, $hdr_val ) = ( $line =~ /(.*?):(.*)/ );
            $response->header( $hdr_name => $hdr_val );
        }

        #	print "S: ", $line;
    }

    $this->{cookie_jar}->extract_cookies($response) if $this->{cookie_jar};
    $status_line =~ s/Status: //i;
    my ( $response_code, $response_desc )
        = $status_line =~ /^(\d\d\d)(\s.*)?$/;
    $response->code($response_code);
    $response->message($response_desc);

    local $/ = undef;
    $body = <$RESPONSE>;
    $response->content($body);

    close $RESPONSE;
    $response;
}

1;