#!/usr/bin/perl -w
=head1 NAME
mimeref - create a .ref file for a message
=head1 SYNOPSIS
Usage:
mimeref [-options] *.msg
Options:
-d DIR Output directory for parser (default is ./testout/mimeref)
-w Write the .ref file
=head1 DESCRIPTION
Parse a message file, and spit out a .ref file.
The .ref files are not really useful; they're just used by
the t/Ref.t test.
=head1 AUTHOR
Eryq, eryq@zeegee.com
=cut
use strict;
use lib "./lib";
use MIME::Parser;
use File::Path;
use Getopt::Std;
use Data::Dumper;
### Get options:
my %opts;
getopts("d:wv", \%opts) || die "usage error ($!)\n";
my (@msgs) = @ARGV; @msgs or die "missing message\n";
### Get path to output space:
my $output_base = $opts{'d'} || "./testout/mimeref";
(-d $output_base) or mkdir($output_base, 0777) or die "mkdir $output_base: $!\n";
MIME::Tools->debugging($opts{'v'});
$Data::Dumper::Terse = 1;
$Data::Dumper::Indent = 1;
$Data::Dumper::Useqq = 1;
foreach my $msg (@msgs) {
do_msg($msg);
}
exit 0;
#------------------------------
sub do_msg {
my $msg = shift;
### Create a parser:
my $parser = new MIME::Parser;
$parser->output_under($output_base);
$parser->extract_nested_messages(1);
### Parse:
my $ent = eval { $parser->parse_open($msg) || die "parse failed: $!\n"; };
if (!$ent) {
rmtree $parser->output_dir;
die $@;
}
### Decompose:
my $ref = {};
$ref->{Parser} = {
Name => "anonymous",
Message => $msg,
OutputToCore => $parser->output_to_core,
ExtractNested => $parser->extract_nested_messages,
};
summarize($ref, $ent);
$ent->dump_skeleton() if $opts{'v'};
if ($opts{'w'}) {
my $refpath = $msg;
$refpath =~ s/\.msg$//; $refpath .= ".ref";
open OUT, ">$refpath" or die "$refpath: $!\n";
print OUT Dumper($ref);
close OUT;
print STDERR "Wrote: $refpath\n";
}
else {
print Dumper($ref);
}
rmtree $parser->output_dir;
}
#------------------------------
sub set {
my ($hash, $param, $val) = @_;
if (defined($val)) {
$hash->{$param} = $val;
}
}
sub c {
my $x = shift;
$x =~ s/\r?\n$// if defined($x);
$x;
}
#------------------------------
sub summarize {
my ($ref, $ent, $name) = @_;
$name ||= "Msg";
my $head = $ent->head;
$head->unfold;
my $body = $ent->bodyhandle;
my $sum = {};
set($sum, From => c($head->get("From", 0)));
set($sum, To => c($head->get("To", 0)));
set($sum, Subject => c($head->get("Subject", 0)));
set($sum, Type => $head->mime_type);
set($sum, Encoding=> $head->mime_encoding);
set($sum, Charset => $head->mime_attr("content-type.charset"));
set($sum, Boundary => $head->multipart_boundary);
set($sum, Disposition => $head->mime_attr("content-disposition"));
set($sum, Filename => $head->recommended_filename);
if ($body and $body->path) {
set($sum, Size => (-s $body->path));
}
$ref->{$name} = $sum;
my $root = (($name eq 'Msg') ? 'Part' : $name);
for (1 .. $ent->parts) {
summarize($ref, $ent->parts($_ - 1), "${root}_$_");
}
}
1;