|
@@ -4,8 +4,10 @@
|
|
|
use strict;
|
|
use strict;
|
|
|
use warnings;
|
|
use warnings;
|
|
|
|
|
|
|
|
|
|
+use Data::Dumper;
|
|
|
use FindBin::libs;
|
|
use FindBin::libs;
|
|
|
use FindBin;
|
|
use FindBin;
|
|
|
|
|
+use Carp::Always;
|
|
|
|
|
|
|
|
chdir $FindBin::Bin;
|
|
chdir $FindBin::Bin;
|
|
|
$ENV{HOME}=$FindBin::Bin;
|
|
$ENV{HOME}=$FindBin::Bin;
|
|
@@ -23,21 +25,46 @@ my %env = (
|
|
|
HTTP_HOST => $host
|
|
HTTP_HOST => $host
|
|
|
);
|
|
);
|
|
|
|
|
|
|
|
|
|
+sub emit_error {
|
|
|
|
|
+ my $env = shift;
|
|
|
|
|
+ return $env->{'psgi.errors'}->print(shift) if $env->{'psgi.errors'};
|
|
|
|
|
+ print $@;
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
our $app = sub {
|
|
our $app = sub {
|
|
|
my $self = TPSGI->new(TPSGI::get_config());
|
|
my $self = TPSGI->new(TPSGI::get_config());
|
|
|
|
|
+ local $@;
|
|
|
return eval { $self->app(@_) } || do {
|
|
return eval { $self->app(@_) } || do {
|
|
|
my $env = shift;
|
|
my $env = shift;
|
|
|
- $env->{'psgi.errors'}->print($@);
|
|
|
|
|
|
|
+ emit_error($env, $@);
|
|
|
|
|
|
|
|
# Redact the stack trace past line 1, it usually has things which should not be shown
|
|
# Redact the stack trace past line 1, it usually has things which should not be shown
|
|
|
$self->{cur_query}->{message} = $@;
|
|
$self->{cur_query}->{message} = $@;
|
|
|
$self->{cur_query}->{message} =~ s/\n.*//g if $self->{cur_query}->{message};
|
|
$self->{cur_query}->{message} =~ s/\n.*//g if $self->{cur_query}->{message};
|
|
|
-
|
|
|
|
|
return $self->error($self->{cur_query});
|
|
return $self->error($self->{cur_query});
|
|
|
};
|
|
};
|
|
|
};
|
|
};
|
|
|
|
|
+
|
|
|
|
|
+sub stream_to_stdout {
|
|
|
|
|
+ my ($input) = @_;
|
|
|
|
|
+ my ( $code, $headers ) = @$input;
|
|
|
|
|
+ print "RC: $code\n";
|
|
|
|
|
+ print "Headers:\n";
|
|
|
|
|
+ print Dumper($headers);
|
|
|
|
|
+ return \*STDOUT;
|
|
|
|
|
+}
|
|
|
|
|
+
|
|
|
my $limit = $ARGV[3] || 1;
|
|
my $limit = $ARGV[3] || 1;
|
|
|
-for ( 0 .. $limit ) {
|
|
|
|
|
|
|
+
|
|
|
|
|
+for ( 1 .. $limit ) {
|
|
|
my $out = $app->( \%env );
|
|
my $out = $app->( \%env );
|
|
|
- print $out->[2][0];
|
|
|
|
|
|
|
+ if (ref $out eq 'CODE') {
|
|
|
|
|
+ $out->(\&stream_to_stdout);
|
|
|
|
|
+ next;
|
|
|
|
|
+ }
|
|
|
|
|
+ if (ref $out eq 'ARRAY') {
|
|
|
|
|
+ print $out->[2][0];
|
|
|
|
|
+ next;
|
|
|
|
|
+ }
|
|
|
|
|
+ die "Weird return:\n".Dumper($out);
|
|
|
}
|
|
}
|