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