Есть вот такая вот программка | Код |
#!/usr/bin/perl
# file: pop3_cli_e.pl [host] [username] [pass] [savepath]
use strict;
use lib '.';
use PopParser;
use PromptUtil;
#use Time::localtime;
#use POSIX qw(strftime) ;
use constant HOST => 'mailserver.name';
use constant USER => 'username';
use constant PASS => 'password';
use constant PATH => 'c:\\1\\';
my $host = shift || HOST;
my $username = shift || USER;
my $pass = shift || PASS;
my $default_path = shift || PATH;
my $entity;
my $curr_mess_num=0;
my $koi8_cnt=0;
my $dir;
$SIG{INT} = sub { exit 0 };
my $term = "__";
mkdir($default_path,07777);
my $pop = PopParser->new($host) or die "Connect to host: $!\n";
my $message_count = $pop->apop($username => $pass) || $pop->login($username => $pass)
or die "Can't log in: ",$pop->message,"\n";
print "You have ",$message_count+=0," messages in your inbox.\n\n";
for my $msgnum (1..$message_count) {
print "MESSAGE $msgnum of $message_count\n";
$koi8_cnt=0;
print_header($pop->top($msgnum));
if (prompt("\nRead it (y/n)",'y') eq 'y') {
next unless $entity = $pop->get($msgnum);
display_entity($entity);
$entity->purge;
}
if (prompt('Delete this message (y/n)','n') eq 'y') {
$pop->delete($msgnum);
}
} continue { print "\n" }
$pop->quit;
exit 0;
sub print_header {
my $header = join '',@{shift()};
$header =~ s/\n\s+/ /gm;
my (%fields) = $header =~ /([\w-]+):\s+(.+)$/mg;
print join "\t",@fields{'Date','From','Subject'},"\n";
}
sub display_entity {
my $entity = shift;
my $head = $entity->head;
$head->print if $head->get('From');
print "\n";
if ($entity->is_multipart) {
handle_multipart($entity);
} else {
display_part($entity);
}
}
sub handle_multipart {
my $entity = shift;
my @parts = $entity->parts;
my @text = grep $_->mime_type eq 'text/plain',@parts;
my @attachments = grep $_->mime_type ne 'text/plain',@parts;
display_part($_) foreach (@text);
return unless my $atcount = @attachments;
for (my $i=0;$i<@attachments;$i++) {
print "\tATTACHMENT ",$i+1," of ".@attachments,"\n";
display_entity($attachments[$i]);
}
}
sub display_part {
my $part = shift;
my $head = $part->head;
my $type = $head->mime_type;
my $description = $head->get('Content-Description');
my ($default_name) = $head->get('Content-Disposition') =~ /filename="([^\"]+)"/;
my $body = $part->bodyhandle;
#все дальнейшие извращения связаны с koi8
#я не пытаюсь его сконвертить, а просто сохраняю по своим правилам
my $conv_filename;
my $substr;
my $prefix;
my $f="/";
my $t="_";
$prefix="_koi8__" if $default_name;
substr($type,0) =~ s/$f/$t/g if $default_name;
$substr=substr($default_name,2,4) if $default_name;
if ($substr eq 'koi8'){
$koi8_cnt++;
$conv_filename="$type$prefix$koi8_cnt.koi";
}
else {
$conv_filename=$default_name if $default_name;
}
print "\tType: $type.\n";
print "\tDescription: $description\n" if $description;
print "\tFilename: $conv_filename\n" if $default_name;
save_body($body,$default_path,$conv_filename,$type);
}
sub save_body {
my ($body,$default_path,$conv_filename,$type) = @_;
my $fname = $conv_filename;
return if $type eq 'text/plain';
return if $type eq 'text/html';
$fname = "text_plain.dat" if $type eq 'text/plain';
$fname = "text_html.dat" if $type eq 'text/html';
open(F,">$dir\\$fname") or die "Can't open file $fname for writing\n", $!;
binmode(F);
$body->print(\*F) && print "Attachment saved to $dir \n";
close(F) ;
}
|
Она вырубается, если пришло письмо с просьбой подтверждения получения, не могу понять в чём дело. Это сообщение отредактировал(а) sharq - 12.5.2006, 14:03 |
Проблемы с почтовым клиентом 
Дата 12.5.2006, 13:50 (
Загрузка ...
