view release on metacpan or  search on metacpan

t/poster-post.t  view on Meta::CPAN

        note("Temporary daemon at: $url");
    }
    else { # HTTP-Server for dummies
        while (my $c = $daemon->accept) {
            while (my $r = $c->get_request) {
                if ($r->method eq 'POST' && $r->uri->path eq '/report') {
                    (my $json = uri_unescape($r->decoded_content)) =~ s/^json=//;
                    my $data;
                    $data  =  2 if $r->header('User-Agent') =~ /Test::Smoke/;
                    eval {
                        $data += 40 if decode_json($json)->{sysinfo} eq $^O;
                        1;
                    } or $data = $@ || 'decode_json-error';
                    my $response = HTTP::Response->new(
                        RC_OK(), "OK",
                        HTTP::Headers->new('Content-Type', 'application/json'),
                        encode_json({id => $data}),
                    );
                    $c->send_response($response);
                }
                elsif ($r->method eq 'POST' && $r->uri->path eq '/api/report') {
                    my $json = encode_json(decode_json($r->decoded_content)->{report_data});
                    my $data;
                    $data  =  2 if $r->header('User-Agent') =~ /Test::Smoke/;
                    eval {
                        $data += 40 if decode_json($json)->{sysinfo} eq $^O;
                        1;
                    } or $data = $@ || 'decode_json-error';
                    my $response = HTTP::Response->new(
                        RC_OK(), "OK",
                        HTTP::Headers->new('Content-Type', 'application/json'),
                        encode_json({id => $data}),
                    );
                    $c->send_response($response);
                }
                else {
                    my $response = HTTP::Response->new(
                        RC_NOT_IMPLEMENTED(), 'NOT IMPLEMENTED',
                        HTTP::Headers->new('Content-Type', 'application/json'),
                        uri_unescape($r->decoded_content),
                    );
                    $c->send_response($response);
                    note(">>>Error: @{[$r->as_string]}<<<")
                        unless $r->uri->path eq '/api/report-error';
                }
                $c->close;
            }
        }
    }
}
END {
    unlink "t/$jsnfile";
    if ($pid) {
        note("tear down: $pid");
        $daemon->close;
        kill 9, $pid;
    }
}

# We want to address our daemon directly
for my $envv (qw<ALL_PROXY HTTP_PROXY HTTPS_PROXY>) {
    delete($ENV{$envv})     if exists($ENV{$envv});
    delete($ENV{lc($envv)}) if exists($ENV{lc($envv)});
}

my $sysinfo = { sysinfo => $^O };
SKIP: {
    skip("Could not load LWP::UserAgent", 3) if !has_module('LWP::UserAgent');

    (my $sdb_url = $url->clone)->path('/report');
    my $poster = Test::Smoke::Poster->new(
        'LWP::UserAgent',
        ddir        => $tempdir,
        jsnfile     => $jsnfile,
        smokedb_url => $sdb_url->as_string,
        v           => $debug ? 2 : 0,
    );
    isa_ok($poster, 'Test::Smoke::Poster::LWP_UserAgent');

    ok(write_json($poster->json_filename, $sysinfo), "write_json");
    my $response = eval { $poster->post() };
    $response = $@ if $@;
    is($response, 42, "Got id (LWP::Useragent: $sdb_url")
        or diag(explain({poster => $poster, response => $response}));

    unlink $poster->json_filename;
}

SKIP: {
    skip("Could not load LWP::UserAgent", 3) if !has_module('LWP::UserAgent');

    (my $sdb_url = $url->clone)->path('/api/report');
    my $poster = Test::Smoke::Poster->new(
        'LWP::UserAgent',
        ddir        => $tempdir,
        jsnfile     => $jsnfile,
        smokedb_url => $sdb_url->as_string,
        v           => $debug ? 2 : 0,
    );
    isa_ok($poster, 'Test::Smoke::Poster::LWP_UserAgent');

    ok(write_json($poster->json_filename, $sysinfo), "write_json");
    my $response = eval { $poster->post() };
    $response = $@ if $@;
    is($response, 42, "Got id (LWP::Useragent: $sdb_url")
        or diag(explain({poster => $poster, response => $response}));

    unlink $poster->json_filename;
}

SKIP: {
    my $curlbin = whereis('curl');
    skip("Could not find curl", 3) if !$curlbin;
    skip("curl is from /snap, skipping", 3) if $curlbin =~ m{^/snap/};
    my $curl_version = qx{$curlbin --version};
    my $cv = $curl_version =~ m{curl ([0-9.]+)} ? $1 : '0';

    my $is_v6_address = $url =~ m{^ https?://\[ [0-9a-fA-F:]+ \] /? }x;
    my $needs_globoff = $is_v6_address &&
        (version->parse($cv) < version->parse("7.68.0"));