user-tools/mail-extract-raw-headers

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 mail-extract-raw-headers - Get named headers from RFC822-format input.
   8
   9 =head1 SYNOPSIS
  10
  11 mail-extract-raw-headers [OPTIONS] <NAME> [<NAME> [...]]
  12
  13 =head1 OPTIONS
  14
  15 =over 4
  16
  17 =item -k, --keep-newlines, --keep-linefeeds
  18
  19 Keep linefeeds in multiline text.
  20
  21 =item -n, --header-names
  22
  23 Output the header name(s) too, not only the contents.
  24
  25 =back
  26
  27 =cut
  28
  29
  30 use Getopt::Long qw/:config no_ignore_case bundling no_getopt_compat/;
  31 use Pod::Usage;
  32 #use Data::Dumper;
  33 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  34
  35 $OptKeepLF = 0;
  36 $OptNames = 0;
  37
  38 GetOptions(
  39         'k|keep-newlines|keep-linefeeds' => \$OptKeepLF,
  40         'n|header-names' => \$OptNames,
  41         'help|?' => sub { pod2usage(-exitval=>0, -verbose=>99); },
  42 ) or pod2usage(-exitval=>2, -verbose=>99);
  43
  44 if(not @ARGV)
  45 {
  46         pod2usage(-exitval=>2, -verbose=>99);
  47 }
  48
  49 @asked_headers = map {lc} @ARGV;
  50
  51
  52 sub getheaders($)
  53 {
  54         my $hname = lc shift;
  55         my @return;
  56
  57         for my $hdr_ref (@Headers)
  58         {
  59                 if(lc $hdr_ref->{"name"} eq $hname)
  60                 {
  61                         push @return, $hdr_ref->{"content"};
  62                 }
  63         }
  64         return @return;
  65 }
  66
  67 @found_headers = ();
  68
  69 # read headers
  70 while(<STDIN>)
  71 {
  72         if(/^\r?\n?$/)
  73         {
  74                 # End of Headers
  75                 last;
  76         }
  77
  78         # does not care line ending
  79         s/\r?\n?$//;
  80
  81         if(my($hdr_name, $content) = /^(\S+?):[ ]?(.*)/)
  82         {
  83                 if(lc $hdr_name ~~ @asked_headers)
  84                 {
  85                         my $hdr_name_pretty = $hdr_name;
  86                         $hdr_name_pretty =~ s/[^-]*/\L\u$&/g;
  87
  88                         my $hdr_hash = { "name" => $hdr_name, "pretty_name" => $hdr_name_pretty, "content" => $content, };
  89                         push @found_headers, $hdr_hash;
  90                         $last_hdr_ref = $hdr_hash;
  91                 }
  92                 else
  93                 {
  94                         $last_hdr_ref = undef;
  95                 }
  96         }
  97         elsif(/^\s+(.*)/ and defined $last_hdr_ref)
  98         {
  99                 # it is a folded header
 100                 $last_hdr_ref->{"content"} .= "\n" if $OptKeepLF;
 101                 $last_hdr_ref->{"content"} .= $1;
 102         }
 103 }
 104
 105 print join "", map {
 106         if($OptNames)
 107         {
 108                 sprintf "%s: %s\n", $_->{'pretty_name'}, $_->{'content'};
 109         }
 110         else
 111         {
 112                 sprintf "%s\n", $_->{'content'};
 113         }
 114 } @found_headers;