view release on metacpan or  search on metacpan

lib/Plack/Handler/CLI.pm  view on Meta::CPAN

        }
    }

    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__

=head1 NAME

Plack::Handler::CLI - Command line interface to PSGI applications

=head1 VERSION

This document describes Plack::Handler::CLI version 0.05.