diplodocus.org Git - minc/blob - summarize-mime

   1 #!/usr/local/bin/perl
   2
   3 =head1 NAME
   4
   5 B<summarize-mime> - summarize headers and MIME structure of email messages
   6
   7 =head1 SYNOPSIS
   8
   9 B<summarize-mime> I<message-files>
  10
  11 =head1 DESCRIPTION
  12
  13 Print From, To, Date, and Subject header fields along with a summary of the MIME
  14 structure of the email message in each file.
  15
  16 =cut
  17
  18 use strict;
  19 use warnings;
  20 use v5.14;
  21
  22 use DateTime::Format::Mail;
  23 use Email::MIME;
  24
  25 my @fields = ('From', 'To', 'Subject');
  26
  27 sub say_header {
  28     my $message = shift;
  29     my $field = shift;
  30     for my $value ($message->header($field)) {
  31         say "$field: $value";
  32     }
  33 }
  34
  35 sub say_date {
  36     my $message = shift;
  37     my $parser = DateTime::Format::Mail->new(loose => 1);
  38     my $any_valid = 0;
  39     my $last;
  40     for my $value ($message->header('date')) {
  41         my $dt = eval { $parser->parse_datetime($value) };
  42         if ($@) {
  43             warn("$@");
  44             $last = $value;
  45             next;
  46         }
  47         $dt->set_time_zone('local');
  48         say 'Date: ', $parser->format_datetime($dt);
  49     }
  50     if (!$any_valid && $last) {
  51         say "Date: $last";
  52     }
  53 }
  54
  55 MAIN: {
  56     my $errors = 0;
  57     for my $fn (@ARGV) {
  58         say $fn;
  59         my $fp;
  60         if (!open($fp, $fn)) {
  61             $errors++;
  62             warn("open($fn): $!");
  63             next;
  64         }
  65         my $text = join('', (<$fp>));
  66         my $parsed = Email::MIME->new($text);
  67         for my $field (@fields) {
  68             say_header($parsed, $field);
  69         }
  70         say_date($parsed);
  71         say $parsed->debug_structure;
  72     }
  73     exit($errors);
  74 }