From 9630376c31454201c0031906bec754580cccaf96 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Wed, 4 Sep 2013 00:04:17 +0200 Subject: [PATCH] Add decoding and parsing of From: etc. Decode From:, Sender:, Reply-To:, Subject:; parse From:, Sender:, Reply-To:. Add Mail::Address to prerequisites. Signed-off-by: Thomas Hochstein --- bin/parsedb.pl | 40 ++++++++++++++++++++++++++++++++++++++++ doc/INSTALL | 2 ++ doc/README | 1 + 3 files changed, 43 insertions(+) diff --git a/bin/parsedb.pl b/bin/parsedb.pl index 10a1a5d..fc29747 100755 --- a/bin/parsedb.pl +++ b/bin/parsedb.pl @@ -27,6 +27,9 @@ use DBI; use Getopt::Long qw(GetOptions); Getopt::Long::config ('bundling'); +use Encode qw/decode/; +use Mail::Address; + ################################# Definitions ################################## # define header names with separate database fields @@ -157,6 +160,43 @@ while (my $HeadersR = $DBQuery->fetchrow_hashref) { chomp($OtherHeaders); $Headers{'headers'} = $OtherHeaders; + foreach ('from_','sender', 'replyto', 'subject') { + if ($Headers{$_}) { + my $HeaderName = $_; + $HeaderName =~ s/_$//; + # decode From: / Sender: / Reply-To: / Subject: + if ($Headers{$_} =~ /\?(B|Q)\?/) { + $Headers{$HeaderName.'_parsed'} = decode('MIME-Header',$Headers{$_}); + } + # extract name(s) and mail(s) from From: / Sender: / Reply-To: + # in parsed form, if available + if ($_ ne 'subject') { + my @Address; + # start parser on header or parsed header + # @Address will have an array of Mail::Address objects, one for + # each name/mail (you can have more than one person in From:!) + if (defined($Headers{$HeaderName.'_parsed'})) { + @Address = Mail::Address->parse($Headers{$HeaderName.'_parsed'}); + } else { + @Address = Mail::Address->parse($Headers{$_}); + } + # split each Mail::Address object + foreach (@Address) { + # take address part + $Headers{$HeaderName.'_address'} = $_->address(); + # take name part form "phrase", if there is one: + # From: My Name (Comment) + # otherwise, take it from "comment": + # From: addr@ess (Comment) + $Headers{$HeaderName.'_name'} = $_->comment() + unless $Headers{$HeaderName.'_name'}= $_->phrase; + $Headers{$HeaderName.'_name'} =~ s/^\((.+)\)$/$1/; + # FIMXE - handle more than one Mail::Address object! + } + } + } + } + # order output for database entry: fill @SQLBindVars print "-------------- Next entry:\n" if $OptDebug; my @SQLBindVars; diff --git a/doc/INSTALL b/doc/INSTALL index 1c154af..a5ca01d 100644 --- a/doc/INSTALL +++ b/doc/INSTALL @@ -13,6 +13,8 @@ INSTALLATION INSTRUCTIONS 1) Install the scripts + * Get INN, mysql, Perl, and the necessary modules installed (see README). + * Download the current version of NewsStats from . diff --git a/doc/README b/doc/README index e809cea..0ccfad5 100644 --- a/doc/README +++ b/doc/README @@ -47,6 +47,7 @@ Prerequisites - Config::Auto - Date::Format - DBI + - Mail::Address * mysql 5.0.x