#!/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;