package CGI::Faster;
use strict;
use warnings;
# use CGI;
use CGI::Fast();

our $VERSION = "0.02";
our @ISA = qw(CGI);

my $prog=$0;
if (substr($0, 0, 1) ne "/" && $::lib) {
    $prog = $::lib;
    $prog =~ s|lib/*\z|bin/|;
    my $p = $0;
    $p =~ s|.*/||s;
    $prog .= $p;
}
my $when = self_time();
$CGI::POST_MAX = 10*1024;
$CGI::DISABLE_UPLOADS = 1;
my (%keep, %env);
my @keep = qw(USER HOME LOGNAME PATH);	# The fsuexec safe ones
@keep{@keep} = ();
my $taint = substr($ENV{"PATH"}, 0, 0);
FCGI::Finish($FCGI::global_request);
$FCGI::global_request = FCGI::RequestX(\*STDIN, \*STDOUT, \*ERR, \%env, 0, 0);

END {
    &FCGI::Finish($FCGI::global_request);
}

# workaround for known bug in libfcgi
{
    my $ignore;
    while (($ignore) = each %ENV) { }
}

# override the initialization behavior so that
# state is NOT maintained between invocations 
sub save_request {
    # no-op
}

sub new {
    return if self_time() != $when;

    my $self = shift;
    my $initializer = shift;
    unless (defined $initializer) {
        my $rc = FCGI::Accept($FCGI::global_request);
        return undef unless $rc >= 0;
        my ($tag, $val);
        delete @env{@keep};
        for $tag (keys %ENV) {
            next if exists $keep{$tag};
            delete $ENV{$tag};
        }
        while (($tag, $val) = each %env) {
            $ENV{$tag} = $val . $taint;
        }
    }

    return $CGI::Q = $self->SUPER::new($initializer, @_);
}

# Return mtime of executable
sub self_time {
    my @stat = stat($prog) or die "Could not stat $prog: $!";
    return $stat[9];
}

sub error {
    my $error = CGI::escapeHTML($@);
    print STDERR "$@";
    my ($self) = CGI::self_or_default(@_);
    # Netscape header seems to ignore encoding of <TITLE>
    # We in turn ignore netscape.
    my $prog = CGI::escapeHTML($self->script_name());
    my $admin = $ENV{"SERVER_ADMIN"};
    if ($admin) {
        $admin = '<A HREF="mailto:' . CGI::escapeHTML($admin) . '">' . 
            'server administrator</A>';
    } else {
        $admin = "server administrator";
    }
    my $now = gmtime;
    $now =~ s/ /&nbsp;/g;

    print( $self->header, $self->start_html("$prog: Internal Error"),
          <<"EOF", $self->end_html, "\n");
  <H1>Abnormal end: $error</H1>
  please contact the $admin and inform him of the time the error occurred
  ($now&nbsp;UT), and anything you might have done that may have caused the
  error.
  <P>
EOF
}

1;
