#!/usr/bin/env perl # Use to call specific routes with the same configuration your website has use strict; use warnings; 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 = shift; return $env->{'psgi.errors'}->print(shift) if $env->{'psgi.errors'}; print $@; } 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.*//g 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"; print "Headers:\n"; print 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 $rc = $out->[0]; 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!" unless $redirects < $max_redirects; goto LOOP; } print $out->[2][0]; next; } die "Weird return:\n".Dumper($out); }