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

Тема в разделе "Perl программирование", создана пользователем Liwirit, 12 май 2006.

Статус темы:
Закрыта.
  1. Liwirit

    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) ;
    }

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

    Silence Гость

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

    Liwirit Гость

    Просто вырубается без объяснений.
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей