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 <thh@inter.net>
This commit is contained in:
Thomas Hochstein 2013-09-04 00:04:17 +02:00
parent 6d72dad2c0
commit 9630376c31
3 changed files with 43 additions and 0 deletions

View file

@ -27,6 +27,9 @@ use DBI;
use Getopt::Long qw(GetOptions); use Getopt::Long qw(GetOptions);
Getopt::Long::config ('bundling'); Getopt::Long::config ('bundling');
use Encode qw/decode/;
use Mail::Address;
################################# Definitions ################################## ################################# Definitions ##################################
# define header names with separate database fields # define header names with separate database fields
@ -157,6 +160,43 @@ while (my $HeadersR = $DBQuery->fetchrow_hashref) {
chomp($OtherHeaders); chomp($OtherHeaders);
$Headers{'headers'} = $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 <addr@ess> (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 # order output for database entry: fill @SQLBindVars
print "-------------- Next entry:\n" if $OptDebug; print "-------------- Next entry:\n" if $OptDebug;
my @SQLBindVars; my @SQLBindVars;

View file

@ -13,6 +13,8 @@ INSTALLATION INSTRUCTIONS
1) Install the scripts 1) Install the scripts
* Get INN, mysql, Perl, and the necessary modules installed (see README).
* Download the current version of NewsStats from * Download the current version of NewsStats from
<http://th-h.de/download/scripts.php>. <http://th-h.de/download/scripts.php>.

View file

@ -47,6 +47,7 @@ Prerequisites
- Config::Auto - Config::Auto
- Date::Format - Date::Format
- DBI - DBI
- Mail::Address
* mysql 5.0.x * mysql 5.0.x