Selaa lähdekoodia

Fix multipart boundary, HTTP::Body dep, NYTProf overhead, error fallback

- lib/TPSGI.pm: add `use HTTP::Body` (was used in extract_query but never
  declared); remove duplicate `use File::Find` and `use Plack::MIME`
- lib/TPSGI.pm: fix multipart range boundary terminator: `\--` was a literal
  backslash before `--`, producing malformed RFC 2046 closing delimiter
- bin/tpsgi: make Devel::NYTProf opt-in via NYTPROF env var; previously the
  profiler was loaded unconditionally on every request, adding overhead in
  production with no benefit
- bin/tpsgi: fix last-resort error fallback — it referenced `$self->{cur_query}`
  which doesn't exist (TPSGI uses a package-level `$cur_query`); replaced with
  a static 500 response that can't itself throw
- Makefile.PL: add missing declared deps: HTTP::Body, HTTP::Parser::XS,
  Date::Format, File::Basename, File::Copy, Linux::Perl::inotify, Plack;
  sort alphabetically

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
Kōan 5 kuukautta sitten
vanhempi
sitoutus
5d9ca359fc
3 muutettua tiedostoa jossa 27 lisäystä ja 19 poistoa
  1. 10 3
      Makefile.PL
  2. 15 13
      bin/tpsgi
  3. 2 3
      lib/TPSGI.pm

+ 10 - 3
Makefile.PL

@@ -21,24 +21,31 @@ WriteMakefile(
         "Config::Simple" => "0",
         "Cwd" => "0",
         "Data::Dumper" => "0",
+        "Date::Format" => "0",
         "DateTime::Format::HTTP" => "0",
+        "Devel::NYTProf" => "0",
+        "File::Basename" => "0",
+        "File::Copy" => "0",
         "File::Find" => "0",
         "File::Path" => "0",
         "File::Touch" => "0",
         "FindBin::libs" => "0",
+        "HTTP::Body" => "0",
+        "HTTP::Parser::XS" => "0",
         "IO::Compress::Gzip" => "0",
+        "Linux::Perl::inotify" => "0",
         "List::Util" => "0",
         "Log::Dispatch" => "0",
         "Log::Dispatch::FileRotate" => "0",
         "Log::Dispatch::Screen" => "0",
         "Mojo::File" => "0",
+        "Plack" => "0",
         "Plack::MIME" => "0",
         "POSIX" => "0",
-        "Sys::Hostname" => "0",
-        "UUID" => "0",
-        "Devel::NYTProf" => "0",
         "Starman" => "0",
+        "Sys::Hostname" => "0",
         "URL::Encode" => "0",
+        "UUID" => "0",
     },
     test => {TESTS => 't/*.t'}
 );

+ 15 - 13
bin/tpsgi

@@ -54,21 +54,23 @@ our $app = sub {
     # Change your dir into whatever basedir you need to be in
     chdir("$options{tpsgi_dir}/$options{basedir}") or die "Can't chdir into $options{tpsgi_dir}/$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{tpsgi_dir}/prof/nytprof.out";
-    require Devel::NYTProf;
-    mkdir "$options{tpsgi_dir}/prof";
+    # Profiler is opt-in: set NYTPROF env var to enable.
+    # The default path is used when NYTPROF is set without a file= clause.
+    if ($ENV{NYTPROF}) {
+        $ENV{NYTPROF} = "sigexit=1:savesrc=0:start=no:file=$options{tpsgi_dir}/prof/nytprof.out"
+            unless $ENV{NYTPROF} =~ /file=/;
+        require Devel::NYTProf;
+        mkdir "$options{tpsgi_dir}/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};
+    # TPSGI::app already catches all _app exceptions internally.
+    # This outer eval is a last-resort safety net only.
+    my $result = eval { $self->app(@_) };
+    return $result if defined $result;
 
-		return $self->error($self->{cur_query});
-    };
+    my $env = $_[0];
+    $env->{'psgi.errors'}->print($@) if $env && ref $env eq 'HASH' && $env->{'psgi.errors'};
+    return [500, ['Content-Type', 'text/plain', 'Content-Length', 21], ['Internal Server Error']];
 };

+ 2 - 3
lib/TPSGI.pm

@@ -18,6 +18,7 @@ use IO::Compress::Gzip;
 use Time::HiRes qw{usleep gettimeofday tv_interval};
 
 # For CGI features
+use HTTP::Body;
 use HTTP::Parser::XS qw{HEADERS_AS_HASHREF};
 use CGI::Emulate::PSGI;
 
@@ -25,14 +26,12 @@ use Date::Format qw{strftime};
 use List::Util();
 use File::Find;
 use Sys::Hostname();
-use Plack::MIME ();
 use DateTime::Format::HTTP();
 
 use URL::Encode();
 use File::Touch;
 use File::Path;
 use File::Copy;
-use File::Find;
 use Cwd            qw{abs_path};
 
 use File::Basename qw{dirname basename};
@@ -443,7 +442,7 @@ sub _range {
             }
         }
         $fh->close();
-        $writer->write("\n--$CHUNK_SEP\--\n") if $is_multipart;
+        $writer->write("\n--$CHUNK_SEP--\n") if $is_multipart;
         $writer->close;
     };
 }