tpsgi 1.8 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465
  1. #!/usr/bin/env starman
  2. #pacakge bin::tpsgi;
  3. #ABSTRACT: PSGI application which simplifies migrating legacy/cgi applications to PSGI
  4. use strict;
  5. use warnings;
  6. use FindBin::libs;
  7. use File::Basename qw{dirname};
  8. use TPSGI;
  9. my %options = main(@ARGV);
  10. =head1 USAGE
  11. tpsgi ... starman options
  12. tpsgi obeys a config file, ~/.tpsgi.ini which is in Config::Simple (key=value) format, with the keys being:
  13. verbose # Whether to print all log messages or not
  14. custom_log # Custom location for default (rotated) log
  15. routers # Router module(s), separate with comma
  16. indices # Dirindex files. In addition to index.html, index.htm, index.cgi
  17. loggers # Logger module(s), separate with comma
  18. auth # Authentication module
  19. domain # Domain name of the application, used by things like service files
  20. basedir # Directory you want to base this out of (defaults to HOME).
  21. user # Who to run as
  22. The idea is that this application is going to be run in a chroot with the user's homedir being the application dir.
  23. =cut
  24. sub main {
  25. my (@args) = @_;
  26. my %options = TPSGI::get_config();
  27. foreach my $route (@{$options{routers}}) {
  28. my $libdir = dirname($route);
  29. push(@INC, $libdir);
  30. }
  31. return %options;
  32. }
  33. our $app = sub {
  34. $options{verbose} = 1;
  35. # Change your dir into whatever basedir you need to be in
  36. chdir($options{'basedir'}) or warn "Can't chdir into $options{'basedir'}: $!";
  37. my $self = TPSGI->new(%options);
  38. return eval { $self->app(@_) } || do {
  39. my $env = shift;
  40. $env->{'psgi.errors'}->print($@);
  41. # Redact the stack trace past line 1, it usually has things which should not be shown
  42. $self->{cur_query}->{message} = $@;
  43. $self->{cur_query}->{message} =~ s/\n.*//g if $self->{cur_query}->{message};
  44. return $self->error($self->{cur_query});
  45. };
  46. };