Handle more than one entitiy in From: etc.

[usenet/newsstats.git] / bin / parsedb.pl

diff --git a/bin/parsedb.pl b/bin/parsedb.pl
index 10a1a5d..1a0fa39 100755 (executable)
--- 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,48 @@ 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 to @Names and @Adresses
+        my (@Names,@Adresses);
+        foreach (@Address) {
+          # take address part in @Addresses
+          push (@Adresses, $_->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)
+          # and push it in @Names
+          my ($Name);
+          $Name = $_->comment() unless $Name = $_->phrase;
+          $Name =~ s/^\((.+)\)$/$1/;
+          push (@Names, $Name);
+        }
+        # put all @Adresses and all @Names in %Headers as comma separated lists
+        $Headers{$HeaderName.'_address'} = join(', ',@Adresses);
+        $Headers{$HeaderName.'_name'}    = join(', ',@Names);
+      }
+    }
+  }
+
   # order output for database entry: fill @SQLBindVars
   print "-------------- Next entry:\n" if $OptDebug;
   my @SQLBindVars;