tPSGI/call.pl

#!/usr/bin/env perl
# Use to call specific routes with the same configuration your website has

use 5.040;
use warnings FATAL => 'all';
use re '/aa';

use Data::Dumper;
use FindBin::libs;
use Carp::Always;

#Grab our custom routes
use TPSGI;

=head1 USAGE

    call.pl METHOD ROUTE QUERY_STRING COOKIE REPEAT_X_TIMES MAX_REDIRECTS

Max redirects default is 6.

=cut

my $host = $ENV{DOMAIN} // 'localhost';

my %env = (
    REQUEST_METHOD => $ARGV[0],
    PATH_INFO      => $ARGV[1],
    QUERY_STRING   => $ARGV[2],
    REQUEST_URI    => "http://$host/" . $ARGV[1],
    HTTP_HOST      => $host,
    HTTP_COOKIE    => $ARGV[3],
    'psgi.errors'  => *STDERR,
    'psgi.input'   => *STDIN,
);

sub emit_error {
    my ( $env, $err ) = @_;
    return $env->{'psgi.errors'}->print($err) if $env->{'psgi.errors'};
    print $err;
    return;
}

my %cfg;
our $app = sub {

    # Allow re-run
    if (%cfg) {
        chdir( $cfg{tpsgi_dir} ) || warn "Can't chdir to $cfg{tpsgi_dir}: $_";
    }

    %cfg = TPSGI::get_config();

    # We are debugging here
    $cfg{verbose} = 1;

    # Change your dir into whatever basedir you need to be in
    chdir( $cfg{'basedir'} ) || warn "Can't chdir to $cfg{'basedir'}: $_";

    # If we have manually set the NYTPROF var, use it and don't try to control
    # When to stop or start it.
    $ENV{NYTPROF} ||= "sigexit=1:savesrc=0:start=no:file=$cfg{tpsgi_dir}/prof/nytprof.out";
    require Devel::NYTProf;
    mkdir "$cfg{tpsgi_dir}/prof";

    my $self = TPSGI->new(%cfg);
    local $@;

    return eval { $self->app(@_) } || do {
        my $env = shift;
        emit_error( $env, $@ );

        # Redact the stack trace past line 1, it usually has things which should not be shown
        $self->{cur_query}->{message} = $@;
        $self->{cur_query}->{message} =~ s/\n.*//gxs if $self->{cur_query}->{message};
        return $self->error( $self->{cur_query} );
    };
};

sub stream_to_stdout {
    my ($input) = @_;
    my ( $code, $headers ) = @$input;
    print "RC: $code\n", "Headers:\n", Dumper($headers);
    return \*STDOUT;
}

my $limit         = $ARGV[4] || 1;
my $max_redirects = $ARGV[5] || 6;
my $redirects     = 0;

for ( 1 .. $limit ) {
  LOOP:
    my $out = $app->( \%env );

    if ( ref $out eq 'CODE' ) {
        $out->( \&stream_to_stdout );
        next;
    }
    if ( ref $out eq 'ARRAY' ) {

        # Might be a redirect, so check
        my %hdr = @{ $out->[1] };
        my $to  = $hdr{Location};
        if ($to) {
            $env{REQUEST_URI} = "http://$host/$to";
            $env{PATH_INFO}   = $to;
            $redirects++;
            die "Max redirects reached!" if $redirects >= $max_redirects;
            goto LOOP;
        }

        print $out->[2][0];
        next;
    }
    die "Weird return:\n" . Dumper($out);
}