1#@!#!123s

��JFIF�� 1#@!#!123s
: / usr / share / doc / perl-MIME-tools / examples /
Filename : mimeref
back
#!/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;