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:
parent
6d72dad2c0
commit
9630376c31
|
@ -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 <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
|
||||
print "-------------- Next entry:\n" if $OptDebug;
|
||||
my @SQLBindVars;
|
||||
|
|
|
@ -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
|
||||
<http://th-h.de/download/scripts.php>.
|
||||
|
||||
|
|
|
@ -47,6 +47,7 @@ Prerequisites
|
|||
- Config::Auto
|
||||
- Date::Format
|
||||
- DBI
|
||||
- Mail::Address
|
||||
|
||||
* mysql 5.0.x
|
||||
|
||||
|
|
Loading…
Reference in a new issue