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);
|
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;
|
||||||
|
|
|
@ -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>.
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue