Почтовый клиент

[Liwirit]

Есть вот такая вот программка

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

Она вырубается, если пришло письмо с просьбой подтверждения получения, не могу понять в чём дело.

 

[Silence]

Просто вырубается, или сообщение выдает, например: Can't open file $fname for writing\n

 

[Liwirit]

Просто вырубается без объяснений.