tPSGI/bin/tpsgi

#!/usr/bin/env starman

#pacakge bin::tpsgi;

#ABSTRACT: PSGI application which simplifies migrating legacy/cgi applications to PSGI, but also has advanced features for normal psgi apps

use strict;
use warnings;

use Cwd;
use FindBin::libs;
use File::Basename qw{dirname};

use TPSGI;

my %options = main(@ARGV);

=head1 USAGE

tpsgi ... starman options

tpsgi obeys a config file, ~/.tpsgi.ini which is in Config::Simple (key=value) format, with the keys being:

    verbose     # Whether to print all log messages or not
    custom_log  # Custom location for default (rotated) log
    routers     # Router module(s), separate with comma
    indices     # Dirindex files.  In addition to index.html, index.htm, index.cgi
    loggers     # Logger module(s), separate with comma
    auth        # Authentication module
    domain      # Domain name of the application, used by things like service files
    basedir     # Directory you want to chdir into on startup (defaults to HOME).
    user        # Who to run as
    http_user   # Who's proxying this application (used for statics)

The idea is that this application is going to be run in a chroot with the user's homedir being the application dir.

=cut

sub main {
    my (@args) = @_;

    my %options = TPSGI::get_config();
    foreach my $route (@{$options{routers}}) {
        my $libdir = dirname($route);
        push(@INC, $libdir);
    }

    return %options;
}

our $app = sub {
    umask 0022;

    # Change your dir into whatever basedir you need to be in
    chdir($options{'basedir'}) or die "Can't chdir into $options{'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=$options{basedir}/prof/nytprof.out";
    require Devel::NYTProf;
    mkdir "$options{basedir}/prof";

    my $self = TPSGI->new(%options);
    return eval { $self->app(@_) } || do {
		my $env = shift;
        $env->{'psgi.errors'}->print($@);

		# 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});
    };
};