#!/usr/bin/perl
use strict;
use warnings;

use ExtUtils::Command qw(mkpath);
use File::Spec::Functions qw(catfile);
use Mail::MboxParser;

ARGUMENT: foreach my $argument ( @ARGV )
	{
	unless( -r $argument )
		{
		warn "Cannot read from $argument: skipping\n";
		next ARGUMENT;
		}
		
	my $mailbox = Mail::MboxParser->new( $argument );
	unless( ref $mailbox )
		{
		warn "Could not parse mailbox $argument!\n";
		next ARGUMENT;
		}
	
	MESSAGE: foreach my $message ($mailbox->get_messages) 
		{
		my $from        = from( $message );
		my $attachments = $message->get_attachments;
		
		next MESSAGE unless keys %$attachments; # no attachments
				
		my $path = catfile( $ENV{HOME}, qw(Documents Attachments), $from );		

		{ local @ARGV = ( $path ); mkpath; }
		
		ATTACHMENT: while( my( $name, $index ) = each %$attachments )
			{
			save( $message, $path, $name, $index );
			}
	    }
 	}
 	   
sub from
	{
	my $message = shift;
	my $address = $message->header->{from};
	
	if( $address =~ m/<(.*@.*)>/ ) { $address = $1 };
	
	return $address;
	}
	
sub save
	{
	my( $message, $path, $name, $index ) = @_;
	
	my $file = catfile( $path, $name );

	my $last = (
		sort { $b <=> $a }
		grep { /^\d$/ }
		map { s/^$file\.?//; $_ ? $_ : 0 } 
		glob( $file . "*" )
			)[0];

	$file .= "." . ($last + 1) if defined $last;
	
	my $fh;
	unless( open $fh, "> $file" )
		{
		warn "Could not write to $file: $!\n";
		return;
		}
	
	unless( $message->store_entity_body( $index, handle => $fh ) )
		{
		warn "Could not save attachment for $file: " . $message->error . "\n";
		return;
		}
	}

##</code><code>##

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