Program: rfrm (Perl Cookbook, 2nd Edition)

## 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);
>     }

Copyright © 2003 O'Reilly & Associates. All rights reserved.