File Coverage

blib/lib/Plack/Handler/CLI.pm

Criterion	Covered	Total	%
statement	68	77	88.3
branch	20	28	71.4
condition	5	5	100.0
subroutine	11	12	91.6
pod	1	1	100.0
total	105	123	85.3

package Plack::Handler::CLI;
use 5.008_001;
use Mouse;

our $VERSION = '0.05';

use IO::Handle  (); # autoflush
use Plack::Util ();
use URI ();

use constant {
    _RES_STATUS  => 0,
    _RES_HEADERS => 1,
    _RES_BODY    => 2,
};

BEGIN {
    if(eval { require URI::Escape::XS }) {
        *_uri_escape = \&URI::Escape::XS::encodeURIComponent;
    }
    else {
        require URI::Escape;
        *_uri_escape = \&URI::Escape::uri_escape_utf8;
    }
}

my $CRLF = "\015\012";

has need_headers => (
    is      => 'ro',
    isa     => 'Bool',
    default => 1,
);

has stdin => (
    is      => 'ro',
    isa     => 'FileHandle',
    default => sub { \*STDIN },
);

has stdout => (
    is      => 'ro',
    isa     => 'FileHandle',
    default => sub { \*STDOUT },
);

has stderr => (
    is      => 'ro',
    isa     => 'FileHandle',
    default => sub { \*STDERR },
);

sub run {
    my($self, $app, $argv_ref) = @_;

    my @argv;
    if($argv_ref) {
        @argv = @{$argv_ref};
    }
    else {
        # skip after *.psgi
        @argv = @ARGV;
        if(grep { /\.psgi \z/xms } @argv) {
            while(@argv) {
                my $a = shift @argv;
                last if $a =~ /\.psgi \z/xms;
            }
        }
    }

    my @params;
    while(defined(my $s = shift @argv)) {
        if($s =~ s/\A -- //xms) {
            my($name, $value) = split /=/, $s, 2;
            if(not defined $value) {
                $value = @argv
                    ? shift(@argv)
                    : Plack::Util::TRUE;
            }
            push @params, $name, $value;
        }
        else {
            unshift @argv, $s; # push back
            last;
        }
    }

    my $uri = URI->new();
    if ( @argv &&  $argv[0] =~ m{\Ahttp} ) {
    	$uri = URI->new(shift @argv);
    }

    $uri->scheme('http') if not $uri->scheme;
    $uri->host('localhost') if not $uri->host;
    $uri->path_segments($uri->path_segments, @argv);
    $uri->query_form($uri->query_form, @params);

    my %env = (
        # HTTP
        HTTP_USER_AGENT => sprintf('%s/%s', ref($self), $self->VERSION),

        HTTP_COOKIE  => '', # TODO?
        HTTP_HOST    => $uri->host,

        # Client
        REQUEST_METHOD => 'GET',
        REQUEST_URI    => $uri,
        QUERY_STRING   => $uri->query,
        PATH_INFO      => $uri->path || '/',
        SCRIPT_NAME    => '',
        REMOTE_ADDR    => '0.0.0.0',
        REMOTE_USER    => $ENV{USER},

        # Server
        SERVER_PROTOCOL => 'HTTP/1.0',
        SERVER_PORT     => 0,
        SERVER_NAME     => 'localhost',
        SERVER_SOFTWARE => ref($self),

        # PSGI
        'psgi.version'      => [1,1],
        'psgi.url_scheme'   => $uri->scheme,
        'psgi.input'        => $self->stdin,
        'psgi.errors'       => $self->stderr,
        'psgi.multithread'  => Plack::Util::FALSE,
        'psgi.multiprocess' => Plack::Util::TRUE,
        'psgi.run_once'     => Plack::Util::TRUE,
        'psgi.streaming'    => Plack::Util::FALSE,
        'psgi.nonblocking'  => Plack::Util::FALSE,

        %ENV, # override
    );
    $env{SCRIPT_NAME} = '' if $env{SCRIPT_NAME} eq '/';

    my $res = Plack::Util::run_app($app, \%env);

    if (ref $res eq 'ARRAY') {
        $self->_handle_response($res);
    }
    elsif (ref $res eq 'CODE') {
        $res->(sub {
            $self->_handle_response($_[0]);
        });
    }
    else {
        die "Bad response $res";
    }
}

sub _handle_response {
    my ($self, $res) = @_;

    my $stdout = $self->stdout;

    $stdout->autoflush(1);

    if($self->need_headers) {
        my $hdrs = "Status: $res->[_RES_STATUS]" . $CRLF;

        $hdrs .= "Server: " . ref($self) . $CRLF;

        my $headers = $res->[_RES_HEADERS];
        while (my ($k, $v) = splice @$headers, 0, 2) {
            $hdrs .= "$k: $v" . $CRLF;
        }
        $hdrs .= $CRLF;

        print $stdout $hdrs;
    }

    my $body = $res->[_RES_BODY];
    my $cb   = sub { print $stdout @_ };
    Plack::Util::foreach($body, $cb);
    return;
}

no Mouse;
__PACKAGE__->meta->make_immutable();
__END__