Category: | Text Processing |
Author/Contact Info | Tim Lewis (LewisT@UAH.EDU) |
Description: | PINE is a common text-based email viewer on many UNIX systems. The PINE program stores email in large text files which makes it very handy to archive your old email... except that there's no table of contents at the beginning of the file to let you know what messages are stored there. This script solves that problem by parsing the PINE email store and creating a separate table of contents from the headers of each email. The resulting TOC lists the message number, title, sender info and date in formatted columns. I usually concatinate the TOC and email storage file, and then save the resulting file in my email archives.
Note: This script works very well with version 3.96 of PINE, which I use, but there are other versions that I have not tested it on. PLEASE comment on this code. I'm a fairly new perl programmer and would appreciate feedback on how to improve my programming. |
#!/usr/bin/perl use warnings; use strict; if (!$ARGV[0]) { print "Usage: pinetoc inputfile outputfile\n"; die; } open (INFILE, "<$ARGV[0]") or die "Could not open input file!\n"; open (OUTFILE, ">$ARGV[1]") or die "Could not open input file!\n"; ##### Variables ##### my $From = ""; # Used to store the from address my $Subject = ""; # Used to store the subject my $Date = ""; # Used to store the message date my $LetterNum = 0; # Counts the number of emails my $HeaderFlag = -1; # Flag is < 0 when we're searching for a n +ew email # Flag is > 0 and < 7 when we're getting header info # Flag is > 6 when we've found all the header info ##### Main Loop ##### while (<INFILE>){ # Look for a new message (all messages have a header line beginnin +g "X-UIDL: ") if (/^X-UIDL: \w{32}/) { if ($HeaderFlag > 0) { # We haven't got all the header info yet... but we'll writ +e anyway &WriteTOCline ($LetterNum, $From, $Subject, $Date, $Header +Flag); } $LetterNum++; # Clear the message data variables $HeaderFlag = 0; $From = ""; $Subject = ""; $Date = ""; } if ($HeaderFlag < 0) { # Do nothing -- already found the header info, so we're search +ing for a new letter } elsif ($HeaderFlag < 7) { if ($_ =~ "^From:") { s/(From: |"|(\[|<)[^\]>](\]|>)|\n)//g; # remove a bunch +a stuff to isolate the name s/^\s*|\s*$//g; # remove leading or trailin +g whitespace $From = $_; $HeaderFlag += 1; } elsif ($_ =~ "^Subject:") { s/Subject:|\n//g; # remove stuff to isolate the + subject s/^\s*|\s*$//g; # remove leading or trailin +g whitespace $Subject = $_; if ($Subject eq "") { $Subject = "(Blank subject)"; } $HeaderFlag += 2; } elsif ($_ =~ "^Date:") { ($Date) = ($_ =~ /Date: (\w+, \w+ \w+ \w+)/); $HeaderFlag += 4; } } else { # We've got all the header info &WriteTOCline ($LetterNum, $From, $Subject, $Date, $HeaderFlag +); $HeaderFlag = -1; } } close INFILE; close OUTFILE; exit 0; ##### Subroutine for writing the TOC ##### sub WriteTOCline { my($LetterNum, $From, $Subject, $Date, $HeaderFlag) = @_; my @Error = ("","From", "Subject", "", "Date"); my $ErrorNum = $HeaderFlag ^ 7; if ($ErrorNum > 7) { print "Error: Too much header info in letter $LetterNum titled + '$Subject'\n"; } elsif ($ErrorNum >0) { print "Error: Missing '$Error[$ErrorNum]' field in message $Le +tterNum\n"; } # Write to output file (all cases) printf OUTFILE "%-4d %-30.30s %-20.20s %-16.16s\n", $LetterNum, + $Subject, $From, $Date or die "Could not write to output file!\n"; } |
|
---|
Replies are listed 'Best First'. | |
---|---|
(jjhorner)PineTOC
by jjhorner (Hermit) on Aug 01, 2000 at 04:35 UTC | |
by Tally (Novice) on Aug 01, 2000 at 18:04 UTC | |
RE: PineTOC
by splinky (Hermit) on Aug 01, 2000 at 08:28 UTC | |
by Tally (Novice) on Aug 01, 2000 at 18:54 UTC |
Back to
Code Catacombs