Код:

#!/usr/bin/perl
use 5.8.0;
use strict;
use Net::POP3;
#use Convert::Cyr qw(chcp);
use MIME::Base64;
use MIME::QuotedPrint;
use Getopt::Long qw(GetOptions);
use Data::Dumper;
use Encode;
#use Date::Calc;

my(%t, %opt);
GetOptions(
	   \%t,
	   'parfile=s', 'testfile=s');

die "\nspecify parameter file: <path to perl.exe> get_mail.pl -parfile=<param file name>\n" unless ($t{parfile} || $t{testfile}); 
my $mails;
if ($t{parfile}) {
   #чтение опцый
	open PAR, "$t{parfile}" || die "error opening file $t{parfile}\n";
	while (my $l=<PAR>) {
		chomp $l;
		if ($l=~/(.+)=(.+)/) {
			$opt{lc($1)}=$2;
		}
	}
	#проверка опций
	die "specify SMTP server\n" unless $opt{'smtp_server'};
	die "specify output dir prefix\n" unless $opt{'subprefix'};
	$opt{'clearflag'} = uc($opt{'clearflag'}) eq "Y" ? "Y" : "N";
	#чтение писем из pop3-яшшыка
	$mails = get_mails_from_pop3(\%opt);
} elsif ($t{testfile}) {
   $opt{subprefix}="TESTING";
   $opt{debug}="Y";
	open TESTFILE, $t{testfile} || die "can\'t open file $t{testfile}\n : ".$!;
#	local undef $/;
	my $cnt;
	$cnt.=$_ while(<TESTFILE>);
	close TESTFILE;
	my @m;
	push @m, parse_mail($cnt);
	$mails = \@m;
} else {
	die "no parameters to process. stop\n";
}
close PAR;

#print Data::Dumper::Dumper([\%opt]);  
#exit(0);

#### read mail


#### parse mail
my $msg=0;
foreach my $mail (@{$mails}){
    $msg++;
    my $dir = $opt{subprefix}.$msg;
    unless (-d "$dir") {
    	mkdir "$dir"
    }
	my $f=0;
	foreach my $file (@{$mail->{'files'}}){
		open FILE, ">"."$dir/".$file->{name} or next;
		binmode FILE;
		print FILE $file->{'file'};
		close FILE;
	}
}
printf "Received messages:%d\n",$msg;


#------------------------------------
sub get_mails_from_pop3{
	my ($opt)=@_;
	my $debug;# = 1 if $opt->{'test'};
	my $pop = Net::POP3->new($opt->{'smtp_server'}, Timeout => 60, Debug=> $debug) or die "Can not create new POP3 mail \n";
	my $auth=$pop->login($opt->{'login'},$opt->{'password'});
	die "POP3: Not authenticated\n" unless $auth;
	my $list=$pop->list();
	#---------- Only list with messages
	return $list if $opt->{'list'};
	
	my @messages;
	if($list){
		foreach my $num (keys %{$list}){
			my $message = $pop->get($num);
			my $letter ='';
			if ($message){
				foreach (@{$message}){
					$letter .=$_;
				}
				printf "reading msg %d\n", $num if $opt{debug} eq "Y";
				#дампим в фаел
				if ($opt{dumpraw} eq "Y") {
					open RAW, ">rawmsg".$num;
					print RAW $letter;
					close RAW;
				}
				push @messages, parse_mail($letter);
			}
			$pop->delete($num) if $opt->{'clearflag'} eq "Y";
		}
	}	
	$pop->quit();
	return \@messages;
}

#--------------------------------------
sub parse_mail{
	my ($letter) = @_;

	my $header = $1 if $letter=~/^(.*?)\n\n(.*?)$/s;
	my (%mail,  @files, $boundary);
	$mail{from}    = $1 if $header =~m/^From:\s*(.*)$/m;
	$mail{from}   ||= 'anonymous';
	$mail{name}    = $1 if $mail{from} =~m/(.*?)\s(.*)$/;
	if (! $mail{name}){
		$mail{name}  ||= $1 if $mail{from} =~m/(.*?)\@(.*)$/; 
	}
        
	$mail{subject} = $1 if $header =~ m/^Subject:\s*(.*)$/m;
	$mail{content_type} = $1 if $header =~ m/^Content-Type:\s*(.*)/m;

	$boundary = '--'.$1 if($letter =~ m/boundary="(.*)"$/m);
	if ($mail{content_type} =~ m|multipart|) {  #1
		if ($mail{content_type} =~ m|mixed|) { #2
			if ($letter =~ m/boundary="(.*)"$/m){ #3
				$boundary = '--'.$1;
				$letter =~ m/[^"]$boundary(.*)/s;
				my @arr = split $boundary, $1;
				printf STDERR "message from: %s\n", $mail{from} if $opt{debug} eq "Y";
				printf STDERR "multipart message of %d pieces\n", scalar(@arr) if $opt{debug} eq "Y";
				foreach my $item (@arr) {
					if ($item =~ m/filename=/m) {
						my %hash;
						#определение имени файла
						if ($item =~ m|filename="?(.+?)"?$|sm) {
							my $filename = $1;
							if ($filename =~ m|\?B\?|) {
								#зокодировано как MIME
								$hash{name}=deMIME($filename);
								printf STDERR "filename:%s, decoded:%s\n", $filename, $hash{name} if $opt{'debug'} eq "Y";
							} else {
								#не кодировано
								$hash{name}=$filename;
								printf STDERR "filename=%s\n", $filename if $opt{'debug'} eq "Y";
							}
						} else {
							die "Can\'t read file name\n";
						}
						$hash{content_type} = $1 if $item=~ m/^Content-Type:\s*(.*);/im;
						if ($item =~ m/^Content-Transfer-Encoding:\sbase64$/im) {
							$hash{file} = $1 if $item =~ m/\n\n(.*)\n$/s;
							$hash{file} = decode_base64($hash{file});
						} elsif ($item =~ m/^Content-Transfer-Encoding:\squoted-printable$/im) {
							$hash{file} = $1 if $item =~ m/\n\n(.*)\n\n$/s;
							$hash{file} = decode_qp($hash{file});
						} else {
							$hash{file} = $1 if $item =~ m/\n\n(.*)\n\n$/s;
						}
						push @files, \%hash if $hash{name};
						printf STDERR "file size: %d\n", length($hash{file}) if $opt{debug} eq "Y";
					} 
				}
			} #3
		} #/2
	} elsif ($mail{content_type}=~m|application\/octet-stream|i && $header =~ m|content-disposition:\s+?inline|mi) {#/1
		#пытаемся понять - не странное ли это письмо, которое состоит из одного bodypart с Content-Disposition: inline
		$mail{content_transfer_encoding} = $1 if $header =~ m|Content-Transfer-Encoding:\s+?(.+)|m;
		my %hash;
		if ($header =~ m|filename="?(.+?)"?$|sm) {
		   #разбор с именем файла
			my $filename = $1;
			if ($filename =~ m|\?B\?|) {
				#зокодировано как MIME
				$hash{name}=deMIME($filename);
				printf STDERR "filename:%s, decoded:%s\n", $filename, $hash{name} if $opt{'debug'} eq "Y";
			} else {
				#не кодировано
				$hash{name}=$filename;
				printf STDERR "filename=%s\n", $filename if $opt{'debug'} eq "Y";
			}
			
			#содержымое файла
			if ($letter =~ m|.+\n\n(.+)\n$|s) {
				my $body = $1;
				if (lc($mail{content_transfer_encoding}) eq "base64") {
					$hash{file} = decode_base64($body);
				} elsif (lc($mail{content_transfer_encoding}) eq "quoted-printable") {
					$hash{file} = decode_qp($body);
				} else {
					die "Can\'t read file: unknown transfer-encoding method\n";
				}
			} else {
				die "Can\'t read message body - malformed?\n";
			}
			push @files, \%hash;
		} else {
			die "Can\'t read file name in single-part message!\n";
		}
	} #1
       
	$mail{files} = \@files;
#	print Data::Dumper::Dumper(\%mail);
#	exit;
	return \%mail;
}
#---------------------------


sub deMIME {
	my $mimed = shift;
	my $result;
	if ($mimed =~ m|=\?.+?\?B\?|) {
		while ($mimed =~ m|=\?(.+)\?B\?(.+)\?=|g) {
			my $enc = $1;
			my $body = decode_base64($2);
			if (lc($enc) eq "koi8-r") {
				Encode::from_to($body, "koi8-r", "cp1251");
			}
			$result .= $body;
		}
	} else {
		$result = $mimed;
	}
	return $result;
}

Код:

Received: from --- ([10.10.1.22]) by --- with Microsoft SMTPSVC(6.0.3790.1830);
	 Wed, 16 Dec 2009 15:03:03 +0300
Date: Wed, 16 Dec 2009 15:03:03 +0300
From: tsreport <tsreport@---.ru>
X-Mailer: The Bat! (v1.62 Christmas Edition) Personal
Reply-To: tsreport <tsreport@---.ru>
X-Priority: 3 (Normal)
Message-ID: <63624069828.20091216150303@---.ru>
To: ---
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="----------D91C53244750CC"
Return-Path: ---
X-OriginalArrivalTime: 16 Dec 2009 12:03:03.0617 (UTC) FILETIME=[B8789B10:01CA7E47]

------------D91C53244750CC
Content-Type: text/plain; charset=Windows-1251
Content-Transfer-Encoding: 8bit

Здравствуйте, 



-- 
С уважением,
 tsreport                          mailto:---
------------D91C53244750CC
Content-Type: application/x-zip-compressed; name="091215_4.zip"
Content-Transfer-Encoding: base64
Content-Disposition: attachment; filename="091215_4.zip"
......

Код:

Received: from --- ([10.10.1.22]) by --- with Microsoft SMTPSVC(6.0.3790.1830);
	 Wed, 16 Dec 2009 12:53:21 +0300
Date: Wed, 16 Dec 2009 12:53:20 +0300
From: Micex <MC0172300000@--->
X-Mailer: The Bat! (v1.62 Christmas Edition) Personal
Reply-To: Micex <MC0172300000@--->
X-Priority: 3 (Normal)
Message-ID: <112616287656.20091216125320@--->
To: ---
Subject: =?koi8-r?B?RndkOiDrzMnSyc7Hz9fZxSDP1N7F1Nkg2sEgMTUuMTIuMjAwOQ==?=
In-Reply-To: <66C877A6F6A4A348863902DF3E1D3F4C2F45DF227C@--->
References: <66C877A6F6A4A348863902DF3E1D3F4C2F45DF227C@--->
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="----------12ACD338341737"
Return-Path: MC0172300000@---
X-OriginalArrivalTime: 16 Dec 2009 09:53:21.0004 (UTC) FILETIME=[99AC1AC0:01CA7E35]

------------12ACD338341737
Content-Type: text/plain; charset=koi8-r
Content-Transfer-Encoding: 8bit

ъДТБЧУФЧХКФЕ, ---



---------- рЕТЕУЩМБЕНПЕ РЙУШНП ----------
пФ:                   ьдп <ufookedo@--->
л:                    <MC0172300000@--->
б ФБЛЦЕ Л:           
чТЕНС УПЪДБОЙС:      Tue, 15 Dec 2009 20:04:55 +0300
фЕНБ:                 ПФЮЕФЩ ЪБ 15.12.2009
рТЙЛТЕРМЕООЩЕ ЖБКМЩ: MC01723_EQR04_00T_151209_004008788.txt.p7s.zip.p7e, MC01723_EQR05_00T_151209_004008898.txt.p7s.zip.p7e, MC01723_EQR15_00T_151209_004009111.txt.p7s.zip.p7e, MC01723_EQR19_00T_151209_004009190.txt.p7s.zip.p7e, MC01723_EQM06_00T_151209_004009513.xml.p7s.zip.p7e, MC01723_EQM6C_00T_151209_004009636.xml.p7s.zip.p7e, 

                         mailto:MC0172300000@mars.micex.ru
------------12ACD338341737
Content-Type: application/octet-stream;
	name="MC01723_EQR04_00T_151209_004008788.txt.p7s.zip.p7e"
Content-Description: MC01723_EQR04_00T_151209_004008788.txt.p7s.zip.p7e
Content-Disposition: attachment;
	filename="MC01723_EQR04_00T_151209_004008788.txt.p7s.zip.p7e"; size=9974;
	creation-date="Tue, 15 Dec 2009 20:02:31 GMT";
	modification-date="Tue, 15 Dec 2009 20:02:31 GMT"
Content-Transfer-Encoding: base64
....