Feersum

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

  if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
    my $hint = $hints{$func};
    $hint =~ s/^/   /mg;
    print "   --- hint for $func ---\n", $hint;
  }
  $rv || 0;
}

sub usage
{
  my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
  my %M = ( 'I' => '*' );
  $usage =~ s/^\s*perl\s+\S+/$^X $0/;
  $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;

  print <<ENDUSAGE;

Usage: $usage

See perldoc $0 for details.

ENDUSAGE

  exit 2;
}

sub strip
{
  my $self = do { local(@ARGV,$/)=($0); <> };
  my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
  $copy =~ s/^(?=\S+)/    /gms;
  $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
  $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
  eval { require Devel::PPPort };
  \$@ and die "Cannot require Devel::PPPort, please install.\\n";
  if (eval \$Devel::PPPort::VERSION < $VERSION) {
    die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
      . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"

xt/core-01-access-log-streaming.t  view on Meta::CPAN

        $body = $b;
        $cv->send; undef $cli;
    };
$cv->recv;
like $body, qr/chunk1.*chunk2/s, "got full streaming response";

# Wait for response_guard to fire (after close)
select undef, undef, undef, 0.5 * TIMEOUT_MULT;

ok -f $log_file, "access_log file created for streaming response";
my $log = do { local (@ARGV, $/) = ($log_file); <> } // '';
like $log, qr{^GET /stream 0\.\d+}m, "access_log entry has elapsed time > 0 (stream completed)";

# Verify elapsed time is >= 0.2s (the delay between chunks)
my ($elapsed) = $log =~ /(\d+\.\d+)/;
ok defined($elapsed) && $elapsed >= 0.1,
    "elapsed time reflects streaming duration (${elapsed}s)";

reap_server($pid);
pass "streaming access_log clean shutdown";

xt/core-07-continue-partial-write.t  view on Meta::CPAN

ssize_t write(int fd, const void *buf, size_t count) {
    static ssize_t (*real)(int, const void *, size_t);
    if (!real) real = (ssize_t(*)(int,const void*,size_t))dlsym(RTLD_NEXT,"write");
    if (count == sizeof(CONT)-1 && memcmp(buf, CONT, count) == 0)
        return real(fd, buf, 10);
    return real(fd, buf, count);
}
C
system("$cc -shared -fPIC -o $dir/shim.so $dir/shim.c -ldl 2>$dir/cc.err") == 0
    && -f "$dir/shim.so"
    or plan skip_all => "shim build failed: " . do { local(@ARGV,$/)=("$dir/cc.err"); <> // '' };

plan tests => 2;

my $parent_pid = $$;
END { $? = 0 if $$ != $parent_pid }

my ($lsock, $port) = get_listen_socket();
my $marker = "$dir/marker";

# The server must be started with the shim preloaded, so exec a fresh perl.

xt/core-07-continue-partial-write.t  view on Meta::CPAN

my $body = "PADDINGxPADDING";        # a harmless body; must reach the handler
$c->syswrite("POST /first HTTP/1.1\r\nHost: x\r\nContent-Length: "
    . length($body) . "\r\nExpect: 100-continue\r\n\r\n");
sleep 0.5 * TIMEOUT_MULT;             # wait past the interim, then send the body
$c->syswrite($body);
sleep 1.0 * TIMEOUT_MULT;
close $c;

kill 'QUIT', $spid; waitpid $spid, 0;

my $m = do { local (@ARGV,$/) = ($marker); -e $marker ? <> : '' };
my $blen = length($body);
like $m, qr{path=/first\b}, "the POST handler ran for its own request"
    or diag "server markers:\n$m";
like $m, qr{body_bytes=$blen\b}, "the handler received the full body, not reparsed as a request"
    or diag "server markers:\n$m";

xt/runner-04-combos.t  view on Meta::CPAN

}

select undef, undef, undef, 1.5 * TIMEOUT_MULT;

http_get($port2);
$n_tests++;  # simple_client
select undef, undef, undef, 0.5 * TIMEOUT_MULT;

$n_tests += 2;
ok -f $log_file, "preload_app=0 + access_log: log file created";
my $log = do { local (@ARGV, $/) = ($log_file); <> } // '';
like $log, qr/^GET \//, "preload_app=0 + access_log: entry logged";

kill 'QUIT', $m2; waitpid $m2, 0;
$n_tests++;
pass "preload_app=0 + access_log clean shutdown";

###############################################################################
# Test 3: hot_restart + pre_fork + reuseport (if available)
###############################################################################

xt/runner-18-features.t  view on Meta::CPAN

my $cv5 = AE::cv;
my $c5; $c5 = simple_client GET => '/test-path', port => $port5, sub {
    $cv5->send; undef $c5;
};
$cv5->recv;

# Give guard time to fire (response_guard fires after send completes)
select undef, undef, undef, 0.5 * TIMEOUT_MULT;

ok -f $log_file, "access_log file created";
my $log_content = do { local (@ARGV, $/) = ($log_file); <> } // '';
like $log_content, qr{^GET /test-path \d}, "access_log captured method, uri, elapsed";

reap_server($pid5);
is $? & 127, 0, "access_log test shut down cleanly";