#!/usr/local/bin/perl5.8.0
use strict;
use warnings;

use ExtUtils::Command qw(mkpath);
use File::Spec::Functions qw(catfile);
use MIME::Parser;

my $Base    = $ENV{ATTACHMENT_ROOT} || $ENV{HOME};
my $message = do { local $/; <> };
my $from    = from( \$message );

my $parser = MIME::Parser->new();

my $path = catfile( $Base, $from );            
do { local @ARGV = ( $path ); mkpath; } unless -d $path;
$parser->output_dir( $path );

my $entity = $parser->parse_data( $message );

sub from
        {
        my $message = shift;
        
        my( $from ) = $$message =~ m/^From:\s+(.*)/mg;
        
        $from =~ s/\s* \(.*?\) \s*//x;
        $from =~ s/.* < (.*@.*) > .*/$1/x;
        
        return $from;
        }