package FatalsToEmail;
use strict;

my %config =
  (
   Address => "webmaster",      # email address
   Mailhost => "localhost",     # mail server
   Cache => undef,              # undef means don't use
   Seconds => 60,
  );

sub import {
  my $package = shift;
  while (@_) {
    my $key = ucfirst lc shift;
    die "missing argument to $key" unless @_;
    die "unknown argument $key" unless exists $config{$key};
    $config{$key} = shift;
  }
}

$SIG{__DIE__} = \&trapper;

sub trapper {
  my $message = shift;
  my $time = localtime;
  my ($pack, $file, $line) = caller;

  my $prefix = localtime;
  $prefix .= ":$$:$file:$line: ";
  $message =~ s/^/$prefix/mig;

  print STDOUT <<END;
Content-Type: text/html

<h1>Sorry!</h1>
<p>An error has occurred; details have been logged.
Please try your request again later.
END

  send_mail($message);
  
  die "${prefix}died - email sent to $config{Address} via $config{Mailhost}\n";
}

sub send_mail {
  my $message = shift;

  eval {
    ## do I need to cache this?
    if (defined (my $cache = $config{Cache})) {
      if (open CACHE, "+<$cache") {
        flock CACHE, 2;
        ## it's mine, see if it's old enough
        if (time - (stat(CACHE))[9] > $config{Seconds}) {
          ## yes, suck any content, and zero the file
          my $buf;
          $buf .= "\n...[truncated]...\n" if read(CACHE, $buf, 8192) >= 8192;
          $message = $buf . $message;
          seek CACHE, 0, 0;
          truncate CACHE, 0;
          close CACHE;
        } else {
          ## no, so just drop the stuff at the end
          seek CACHE, 0, 2;
          print CACHE $message;
          close CACHE;
          return;
        }
      } else {
        ## it doesn't exist, so create an empty file for stamping, and email
        open CACHE, ">>$cache" or die "Cannot create $cache: $!";
        close CACHE;
      }
    }

    eval { require Net::SMTP; 1 } or die "no Net::SMTP";
    my $mail = Net::SMTP->new($config{Mailhost})
      or die "Net::SMTP->new returned $@";
    $mail->mail($config{Address}) or die "from: $@";
    $mail->to($config{Address}) or die "to: $@";
    $mail->data("Subject: CGI FATAL ERROR in $0\n\n", $message)
      or die "data: $@";
    $mail->quit or die "quit: $@";
  };
  if ($@) {
    die "$message(send_mail saw $@)\n";
  }
}