tpsgi 1.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364
  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. http_user # Who's proxying this application (used for statics)
  23. The idea is that this application is going to be run in a chroot with the user's homedir being the application dir.
  24. =cut
  25. sub main {
  26. my (@args) = @_;
  27. my %options = TPSGI::get_config();
  28. foreach my $route (@{$options{routers}}) {
  29. my $libdir = dirname($route);
  30. push(@INC, $libdir);
  31. }
  32. return %options;
  33. }
  34. our $app = sub {
  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. };