Perl читает Gmail и анализирует вложения - успешно на моем компьютере, но не удалось на другом - PullRequest
0 голосов
/ 23 марта 2012

Я подготовил скрипт для проверки получения электронного письма (читай Gmail) от указанного пользователя с указанным заголовком темы с использованием регулярного выражения и. Если он совпадает, он загрузит вложение в выходной каталог.

Модуль Perl, который я использовал, это Mail :: POP3Client (для получения соединения) и MIME :: Parser (для разбора вложений). Сервер электронной почты, на котором я работаю, - Gmail.

Однако странная вещь случается. Он работает на моем ПК, но не работает на другом ПК! Вы можете скачать код и заменить ARGV [i] своей личной информацией и попробовать запустить эту кодировку;

Если возвращенное количество писем не равно -1, это означает, что соединение установлено успешно.

Очень странно, что этот код работает на моем компьютере, но не работает на другом компьютере (всегда отображается -1 электронная почта)! Я думаю, это из-за неправильной установки модуля Perl или из-за того, что почта была заблокирована брандмауэром?

Сообщение об ошибке: Есть [-1] электронные письма!

Коды:

#!/usr/bin/perl -w
use strict;
use warnings;
use Mail::POP3Client;
use MIME::Parser;
use MIME::Entity;
use File::Copy;
use File::Glob ':glob';

my ($DAY,$MONTH,$YEAR);
my $host   = 'pop.gmail.com';
my $user   = $ARGV[0];
my $passwd = $ARGV[1];
my $sender =$ARGV[2];
my $outputloc=$ARGV[3];
my $subject=$ARGV[4];
my $attachedfile=$ARGV[5];
my $outfile=$ARGV[6];
my $today=return_time();
my $flag=0;

$attachedfile =~s/date/$today/g;
$outfile =~s/date/$today/g;


my $client = new Mail::POP3Client(
    USER     => $user,
    PASSWORD => $passwd,
    HOST     => "pop.gmail.com",
    PORT     => 995,
    USESSL   => 'true',
);
my $parser = MIME::Parser->new;
$parser->output_dir("T:/dailyfiles/TEMP");
my $mgrnum = $client->Count;
print "There are [$mgrnum] emails!\n";

for ( my $i = 1 ; $i <= $mgrnum ; $i++ ) {
    my $headandbody = $client->HeadAndBody($i);
    my $entity = $parser->parse_data($headandbody);
    $parser->decode_headers(1);
    my $Subject=$entity->head->get('Subject');
    my $From=$entity->head->get('From');
    my $To=$entity->head->get('To');
    my $Date=$entity->head->get('Date');
    my $MIME_type=$entity->mime_type;
    print "From      = ",$From;
    print "To        = ",$To;
    print "Cc        = ",$entity->head->get('Cc'),"\n";
    print "Subject   = ",$Subject;
    print "Date      = ",$Date;
    print "MIME type = ",$entity->mime_type,"\n";
    print "Parts     = ",scalar $entity->parts,"\n";
    print "=========================================================\n";
    exit if ( (scalar $entity->parts) == 1 );
    chomp($Subject);
    chomp($From);

    if($Subject eq $subject && $From eq $sender) {
      chdir "T:/dailyfiles/TEMP"; 
      my @list = bsd_glob('*.txt');
      my @list2 = bsd_glob('*.html');
      unlink(@list,@list2); 
      my $dir="T:/dailyfiles/TEMP/";
      opendir(DIR,$dir) or die$!;
      while(defined(my $file=readdir DIR)){
       my $oldfile=$file;
       if($file =~/$attachedfile/){
        $flag=1;
        print "Original Attachment: $oldfile\n";
        print "Renamed Attachment: ",$outfile,"\n";
        if (-e $outfile) {
          warn "can't rename $oldfile to $outfile: $file exists ";
       } elsif (rename $oldfile, $outfile) {
       } else {
         warn "rename $oldfile to $outfile failed:$! ";
      }
       ## copy and move files
       move("T:/dailyfiles/TEMP/$outfile",$outputloc.$outfile);
       print "STATUS: Required email arrival. Expected attachment forwarded to $outputloc.\n";
       print "=========================================================\n";
    }
} 
     if($flag==0){
     print "STATUS: Required email arrival. However, attachment is disqualified.\n";    
    }
    }
    else{
     print "STATUS: Required email not yet come. Try later.\n";
    }
}

delete_dir();  

##subroutines go here
sub return_time{
    ($DAY,$MONTH,$YEAR)=(gmtime)[3,4,5];
     $today=sprintf("%04d%02d%02d",$YEAR+1900,$MONTH+1,$DAY);
     return $today;  
}

sub delete_dir{
my $dir="T:/dailyfiles/TEMP/";
opendir(DIR,$dir) or die$!;
while(defined(my $file=readdir DIR)){
    unlink($dir.$file);
 }  
}

Ответы [ 3 ]

1 голос
/ 23 марта 2012

Читая документацию Mail :: POP3Client, я вижу, что вы должны проверить соединение POP3 после создания объекта. Полученная ошибка означает, что произошла ошибка подключения:

new возвращает действительный объект Mail :: POP3Client во всех случаях. Для проверки на При сбое соединения вам нужно будет проверить количество сообщений: -1 указывает на ошибку соединения. Вероятно, это когда-нибудь изменится в будущем, чтобы вернуть undef при ошибке, установив $! как побочный эффект. Это изменение не произойдет ни в одной версии 2.x.

Вы можете сделать это так:

my $client = new Mail::POP3Client(
  USER     => $user,
  PASSWORD => $passwd,
  HOST     => "pop.gmail.com",
  PORT     => 995,
  USESSL   => 'true',
);
die "Can't connect to the server" if $client->Count == -1;
0 голосов
/ 23 марта 2012

Проверьте версию модулей, которые вы используете.

0 голосов
/ 23 марта 2012

Это хорошая идея для отслеживания ошибок:

my $client = new Mail::POP3Client(
    USER     => $user,
    PASSWORD => $passwd,
    HOST     => "pop.gmail.com",
    PORT     => 995,
    USESSL   => 'true',
) || die $!;
#  ^^^^^^^^^ insert this and you will show connection error
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...