Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

guha's scratchpad

by guha (Priest)
on Jun 01, 2004 at 16:24 UTC ( #358183=scratchpad: print w/ replies, xml ) Need Help??

To bart, diotalevi and other helping brains
#!perl -w use Foo::FatalsToEmail qw(Mailhost Address +); die "with an icepick in the forehead";
In another file
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 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"; } }
The %config hash is never updated via the import sub
C:\Labbet\OLD>perl 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 [] 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 with an icepick in the forehe +ad at line 7. (send_mail saw to: at C:/DEV/Perl/site/lib/Foo/ line +85. )

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.

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 :)

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"; }

Connecting to network shared drive
Log In?

What's my password?
Create A New User
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (4)
As of 2016-02-09 10:58 GMT
Find Nodes?
    Voting Booth?

    How many photographs, souvenirs, artworks, trophies or other decorative objects are displayed in your home?

    Results (310 votes), past polls