Perl Cd Bookshelf [Electronic resources] نسخه متنی

18.15. Program: rfrm

This program fetches a
list of messages waiting on a POP3 server and summarizes that
list:

# ./rfrm
Nathan Torkington    Re: YAPC
Rob Brown            Re: Net::Ping syn round trip time
Rael Dornfest        Re: Book Proposal - Blosxom in a Nutshell
spam@example.com     Extend your ping times 633%!!!!

Tell the program which POP3 server to contact and the username and
password to authenticate with using a ~/.rfrmrc
file like this:

SERVER=pop3.example.com
USER=gnat
PASS=I(heart)Perl

The program verifies that your .rfrmrc file
isn''t readable or writable by anyone but you, and stops if it is.

The program is shown in Example 18-4.

Example 18-4. rfrm

#!/usr/bin/perl -w
# rfrm - get a list of mail messages waiting on a pop server
use Net::POP3;
use strict;
my ($Pop_host, $Pop_user, $Pop_pass) = read_conf( ) or usage( );
my $pop = Net::POP3->new($Pop_host)
or die "Can''t connect to $Pop_host: $!\n";
defined ($pop->login($Pop_user, $Pop_pass))
or die "Can''t authenticate\n";
my $messages = $pop->list
or die "Can''t get a list of messages\n";
foreach my $msgid (sort { $a <=> $b } keys %$messages) {
my ($msg, $subject, $sender, $from);
$msg = $pop->top($msgid, 0); # returns ref to array
$msg = join "\n", @$msg;     # now it''s one big string
# extract From and Subject lines, and boil From down
$subject = $sender = '''';
if ($msg =~ /^Subject: (.*)/m) { $subject = $1 }
if ($msg =~ /^From: (.*)/m)    { $sender  = $1 }
($from = $sender) =~ s{<.*>}{  };
if ($from =~ m{\(.*\)}) { $from = $1 }
$from ||= $sender;
# print boiled down summary of this message
printf("%-20.20s %-58.58s\n", $from, $subject);
}
sub usage {
die <<EOF ;
usage: rfrm
Configure with ~/.rfrmrc thus:
SERVER=pop.mydomain.com
USER=myusername
PASS=mypassword
EOF
}
sub read_conf {
my ($server, $user, $pass, @stat);
open(FH, "< $ENV{HOME}/.rfrmrc") or return;
# paranoia check
@stat = stat(FH) or die "Can''t stat ~/.rfrmrc: $!\n";
if ($stat[2] & 177) {
die "~/.rfrmrc should be mode 600 or tighter\n";
}
# read config file  
while (<FH>) {
if (/SERVER=(.*)/) { $server = $1 }
if (/USER=(.*)/)   { $user   = $1 }
if (/PASS=(.*)/)   { $pass   = $1 }
}
close FH;
# must have something for every value
return unless $server && $user && $pass;
return ($server, $user, $pass);
}