#!/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";
}
In reply to PineTOC
by Tally
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.