view release on metacpan or  search on metacpan

eg/multipart.pl  view on Meta::CPAN

    defined(my $pid = fork) or die "fork failed: $!\n";
    return ($pid, $url) if $pid;

    $SIG{PIPE} = 'IGNORE';

    while (my $conn = $listener->accept) {
        my $request = read_request($conn) or next;
        my $body = '';

        my ($boundary) = ($request->{headers}{'content-type'} // '') =~ /boundary=(\S+)/;
        if ($boundary) {
            for my $part (split /--\Q$boundary\E/, $request->{body}) {
                my ($head, $data) = split /\r\n\r\n/, $part, 2;
                next unless defined $data && $head =~ /name="([^"]+)"/;
                my $name = $1;
                $data =~ s/\r\n\z//;
                $body .= sprintf "%-8s %-20s %d bytes\n", $name,
                    $head =~ /filename="([^"]+)"/ ? $1 : '(inline)', length $data;
            }
        }

t/11-options.t  view on Meta::CPAN

use Test::More tests => 26;
use File::Temp qw(tempfile);
use TestServer;
use EV;
use EV::YACurl ':constants';

TestServer::watchdog(120);

my $server = TestServer->new(sub {
    my ($request) = @_;
    return (200, [], join "\n", $request->{headers}{'content-type'} // '-', $request->{body});
});
my $base = $server->base_url;

sub fetch {
    my (%options) = @_;
    my ($response, $error, $body) = (undef, undef, '');
    my $done = 0;

    EV::YACurl->new({})->request(sub { ($response, $error) = @_; $done = 1 }, {
        CURLOPT_URL => "$base/",

t/lib/TestServer.pm  view on Meta::CPAN

            last unless defined $status;

            $body = '' unless defined $body;
            $headers ||= [];

            my $out = "HTTP/1.1 $status " . ($REASON{$status} || 'Status') . "\r\n"
                    . "Content-Length: " . length($body) . "\r\n";

            my $typed = 0;
            for (my $i = 0; $i < @$headers; $i += 2) {
                $typed = 1 if lc $headers->[$i] eq 'content-type';
                $out .= "$headers->[$i]: $headers->[$i + 1]\r\n";
            }
            $out .= "Content-Type: text/plain\r\n" unless $typed;
            $out .= "\r\n$body";

            last unless _write_all($conn, $out);
            last if lc($request->{headers}{connection} || '') eq 'close';
        }
        close $conn;
        POSIX::_exit(0);