Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

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 192.168.0.100 Address guha@xxxxx.se +); die "with an icepick in the forehead";
In another file FatalsToEmail.pm
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"; } }
The %config hash is never updated via the import sub
Output:
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. )

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?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (10)
As of 2014-07-30 19:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (240 votes), past polls