#!perl -w
use Foo::FatalsToEmail qw(Mailhost 192.168.0.100 Address guha@xxxxx.se
+);

die "with an icepick in the forehead";
[download]

package FatalsToEmail;
use strict;
use Data::Dumper;

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;
  }
  print "Done import\n";
}

$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{Mail
+host}\n";
}

sub send_mail {
  my $message = shift;
  print Dumper(\%config);
  
  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;
      }
    }

    $^W = 0;  # Suppress warnings generated by Domain.pm 
    eval { require Net::SMTP; 1 } or die "no Net::SMTP";
    my $mail = Net::SMTP->new($config{Mailhost}, Debug   => 1)
      or die "Net::SMTP->new returned $@";
    $mail->mail($config{Address}) or die "from: $@";
    $mail->to($config{Address}) or die "to: $@";
    $mail->data("Subject: FATAL ERROR in $0\n\n", $message)
      or die "data: $@";
    $mail->quit or die "quit: $@";

  };
  
  if ($@) {
    die "$message(send_mail saw $@)\n";
  }
}
[download]

C:\Labbet\OLD>perl test.pl
Content-Type: text/html

<h1>Sorry!</h1>
<p>An error has occurred; details have been logged.
Please try your request again later.
$VAR1 = {
          'Seconds' => 60,
          'Address' => 'webmaster',
          'Mailhost' => 'localhost',
          'Cache' => undef
        };

Net::SMTP: Net::SMTP(2.24)
Net::SMTP:   Net::Cmd(2.21)
Net::SMTP:     Exporter(5.562)
Net::SMTP:   IO::Socket::INET(1.25)
Net::SMTP:     IO::Socket(1.26)
Net::SMTP:       IO::Handle(1.21)

Net::SMTP=GLOB(0x1a91ab0)<<< 220 GunnarsDator Microsoft ESMTP MAIL Ser
+vice, Vers
ion: 6.0.2600.1106 ready at  Mon, 5 May 2003 22:49:08 +0200
Net::SMTP=GLOB(0x1a91ab0)<<< 250-GunnarsDator Hello [127.0.0.1]
Net::SMTP=GLOB(0x1a91ab0)<<< 250-AUTH GSSAPI NTLM LOGIN
Net::SMTP=GLOB(0x1a91ab0)<<< 250-AUTH=LOGIN
Net::SMTP=GLOB(0x1a91ab0)<<< 250-SIZE 2097152
Net::SMTP=GLOB(0x1a91ab0)<<< 250-PIPELINING
Net::SMTP=GLOB(0x1a91ab0)<<< 250-DSN
Net::SMTP=GLOB(0x1a91ab0)<<< 250-ENHANCEDSTATUSCODES
Net::SMTP=GLOB(0x1a91ab0)<<< 250-8bitmime
Net::SMTP=GLOB(0x1a91ab0)<<< 250-BINARYMIME
Net::SMTP=GLOB(0x1a91ab0)<<< 250-CHUNKING
Net::SMTP=GLOB(0x1a91ab0)<<< 250-VRFY
Net::SMTP=GLOB(0x1a91ab0)<<< 250 OK
Net::SMTP=GLOB(0x1a91ab0)>>> MAIL FROM:<webmaster>
Net::SMTP=GLOB(0x1a91ab0)<<< 250 2.1.0 webmaster@GunnarsDator....Sende
+r OK
Net::SMTP=GLOB(0x1a91ab0)>>> RCPT TO:<webmaster>
Net::SMTP=GLOB(0x1a91ab0)<<< 250 2.1.5 webmaster@GunnarsDator
Mon May  5 22:49:07 2003:3412:test.pl:7: with an icepick in the forehe
+ad at test.pl line 7.
(send_mail saw to:  at C:/DEV/Perl/site/lib/Foo/FatalsToEmail.pm line 
+85.
)
[download]

To VSarkiss

So you want the line printed if it does not end in "matches)"? That co
+uld be as simple as: 

while (<STDIN>)
{
    next unless /matches\)$/;
    print LOG;
}
Changing "unless" to "if" is what I'm yabbing about but never mind.
[download]

This contains NEW info, there is always something new to learn along t
+he perly path
CB snapshot 2003-02-04

<broquaint> Corion: yeah, just noticed :-/
broquaint trundles off to a meeting
<bart> I think $ARGV[0] is for the next file...
<BazB> Mmm. So is there actually a way to track the current file with 
+ARGV?
<bart> $ARGV
<Corion> BazB: The scalar $ARGV contains the name of the currently ope
+n file, and @ARGV contains all the command line arguments.
<bart> One whole family: ARGV the handle, $ARGV the filename, @ARGV th
+e list of files still to process
<BazB> Sorry, Corion, got confused by broquaint's comment.
<BazB> Thanks, Corion, bart.
castaway files away that bit of info for later use :)
[download]

To sch

the y-file
fruit:apple:cox
fruit:apple:pippin
fruit:apple:granny
fruit:banana:yellow
fruit:banana:yellow
fruit:banana:green
fruit:banana:yellow

the script
#!perl 
use strict;
use warnings;
use diagnostics;

my ($type, $desc, %fruit);

open (FH, "y") || die "Cannot find file";
while (<FH>) {
    (undef, $type, $desc) = split /:/;
    $fruit{$type}{$desc}++;
}
close FH;

foreach my $type (keys(%fruit)) {
    print "$type : ",scalar keys %{ $fruit{$type} }, "\n";
}
[download]