one-line-queuelist

   1 #!/usr/bin/perl
   2 #
   3 #From root@relay1.mail.uk.psi.net Mon Mar 23 10:54:54 1998
   4 #Date: Mon, 23 Mar 1998 10:51:14 +0000
   5 #From: Super-User <root@relay1.mail.uk.psi.net>
   6 #To: ph10@cus.cam.ac.uk
   7 #Subject: Contrib - single line mail queue printer in perl
   8 #
   9 #this simple hacked script produces the queue with one line per message,
  10 #to allow you to do the equivalent of
  11 #       eximq1l | grep 'hotmail.com' | awk '{print $3}'
  12 #to extract the message IDs of interesting messages for nefarious purposes.
  13 #
  14
  15 open ( MQ, "/usr/bin/exim -bp|") or die "can't run the exim command\n";
  16
  17
  18 $state = 0;     # simple state machine
  19 $recips = 0;
  20 while ( <MQ> )
  21 {
  22         $line = $_;
  23         chop $line;
  24         if ($state == 0)        # line read is the sender info
  25         {
  26                 print "$line ";
  27                 $state = 1;
  28                 $recips = 0;
  29         }
  30         else                    # line read is a recip
  31         {
  32                 if ($line =~ /^$/)      # if blank, about to start new mail
  33                 {
  34                         $state = 0;
  35                         print "\n";
  36                 }
  37                 else                    # append recipient to line
  38                 {
  39                         if ($recips > 0)        # separate recipients with :
  40                         {
  41                                 print ':';
  42                         }
  43                         if ($line =~ /^\s+\S\s+(.*)/)
  44                         {
  45                                 print "$1";
  46                         }
  47                         elsif ($line =~ /^\s+(.*)/)
  48                         {
  49                                 print "$1";
  50                         }
  51                         ++$recips;
  52                 }
  53         }
  54 }
  55
  56 # end