Модераторы: korob2001, ginnie

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Получение почты, Надо получить почту и сохранить аттач 
:(
    Опции темы
pishka
  Дата 26.12.2008, 10:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 61
Регистрация: 26.12.2008

Репутация: нет
Всего: нет
Уважаемые, помогите пожалуйста "ламеру". Вообщем встала задача - получить почту с адреса и сохранить прикрепленный аттач (текстовый файл).  smile
Понятия не имею как и че - перл вижу второй раз в жизни, а сделать надо =(
Может кто нибудь делал подобно подскажите пожалуйста как?   smile  Желательно пример.
PM MAIL   Вверх
shamber
Дата 26.12.2008, 11:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 17
Всего: 18
для получения почты используйте модуль Net::POP3;

Код

use Net::POP3;

    # Constructors
    $pop = Net::POP3->new('pop3host');
    $pop = Net::POP3->new('pop3host', Timeout => 60);
#подключаемся
    if ($pop->login($username, $password) > 0) {
#получаем список собщений
      my $msgnums = $pop->list; #

      foreach my $msgnum (keys %$msgnums) {
#сохраняем каждое вложение отдельно
        open(File,">".$msgnum);
        my $msg = $pop->get($msgnum);
        print File @$msg;
        close File;
#если нужно удалять то раскомментируй
        #$pop->delete($msgnum);
      }
    }
    $pop->quit;



Если разберетесь, то напишим как вытаскивать вложения
PM MAIL Jabber   Вверх
pishka
Дата 26.12.2008, 12:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 61
Регистрация: 26.12.2008

Репутация: нет
Всего: нет
shamber
Спасибо.
Заработало... письма сохранил. Как быть с вложениями? 
Появился вопрос есть ли возможность как нибудь проверить что за письма мы сохраняем. Ну тоесть сохранять письма только с определенной темой или от определнного адреса?

Это сообщение отредактировал(а) pishka - 26.12.2008, 13:04
PM MAIL   Вверх
shamber
Дата 26.12.2008, 14:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 17
Всего: 18


Цитата(pishka @  26.12.2008,  12:40 Найти цитируемый пост)
у тоесть сохранять письма только с определенной темой или от определнного адреса?

можно

для вложений используйте MIME::Parser;
Код

use MIME::Parser;;
use IO::File;
my $parser = new MIME::Parser;

$entity = $parser->parse_open("/some/file.msg");
#  $entity -- это объект MIME::Entity

# Получить какой-нибудь заголовок письма можно у $entity->head (объект MIME::Head):
my $subject = $entity->head->get('Subject');
#А дальше нужно парсить
Dump(@parts);

sub Dump{
my $entity = shift;
my @parts = $entity->parts;
    if (@parts) {                     # если есить части то рекурсия
    my $i;
    foreach $i (0 .. $#parts) {   
        $self->Dump($parts[$i]);
    }
    }
    else {   
     # получаем тип MIME
            my ($type, $subtype) = split('/', $entity->head->mime_type);
            my $body = $entity->bodyhandle;# тело части
            #далее проверка типа
             if ($type =~ /^(text|message)$/ ) {     # сообщение: сохраняем
        if ($IO = $body->open("r")) {
        $self->{message} .= $_ while (defined($_ = $IO->getline));
        $IO->close;
        }
        else {       # 
        print "$0: couldn't find/open : $!";
                 
        }elsif($type =~ /^(application|text)/ ){
                   #сохраняем текстовое вложение;
                        if (defined $entity->head->recommended_filename){
        $body->path; #здесь имя файла где находиться вложение. можете его сохранять туда куда нужно.
        }
        }
                       
                 }
    }
}     
}



писал в форум, проверяйте.
PM MAIL Jabber   Вверх
pishka
Дата 29.12.2008, 05:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 61
Регистрация: 26.12.2008

Репутация: нет
Всего: нет
shamber
НЕ работает. Вот так переписал и запустил:
Код

use MIME::Parser;
use IO::File;
my $parser = new MIME::Parser;

$entity = $parser->parse_open("file.msg");
my $subject = $entity->head->get('Subject');
Dump(@parts);
sub Dump{
my $entity = shift;
my @parts = $entity->parts;
    if (@parts) {                     # если есить части то рекурсия
    my $i;
    foreach $i (0 .. $#parts) {   
        $self->Dump($parts[$i]);
    }
    }
    else {   
     my ($type, $subtype) = split('/', $entity->head->mime_type);
     my $body = $entity->bodyhandle;# тело части
     if ($type =~ /^(text|message)$/ ) {     # сообщение: сохраняем
     if ($IO = $body->open("r")) {
     $self->{message} .= $_ while (defined($_ = $IO->getline));
     $IO->close;
     }
     else {
     print "$0: couldn't find/open : $!";
     }elsif($type =~ /^(application|text)/ ){
     #сохраняем текстовое вложение;
     if (defined $entity->head->recommended_filename){
     $body->path; #здесь имя файла где находиться вложение. можете его сохранять туда куда нужно.
     }
     }
     }
    }
}     
}

В папке лежит файл письма file.msg При запуске скрипта:

File::Temp version 0.18 required--this is only version 0.13 at /usr/lib/perl5/site_perl/5.8.0/MIME/Tools.pm line 14.
BEGIN failed--compilation aborted at /usr/lib/perl5/site_perl/5.8.0/MIME/Tools.pm line 14.
Compilation failed in require at /usr/lib/perl5/site_perl/5.8.0/MIME/Parser.pm line 142.
BEGIN failed--compilation aborted at /usr/lib/perl5/site_perl/5.8.0/MIME/Parser.pm line 142.
Compilation failed in require at ww.pl line 1.
BEGIN failed--compilation aborted at ww.pl line 1.


Можно немножко поподробнее, не совсем понял код. Построчно...
Я так понял это блок кода парсинга уже сохраненного файла почты... Вопрос - а возможно ли предыдущий код получения попты впихнуть вот этот парсер сохранения аттача?

Что то вроде

Код

use Net::POP3;
$pop = Net::POP3->new('pop3host');
$pop = Net::POP3->new('pop3host', Timeout => 60);
    if ($pop->login($username, $password) > 0) {
    my $msgnums = $pop->list; #
    foreach my $msgnum (keys %$msgnums) {
    [color=red][U]И вот тут код парсера[/U][/color]
    Тоесть я хочу что бы вовремя получения почты проверка была на адрес отправителя и если он соответствует, то мы просто вытаские аттач и сохраняяем его в папку.
    $pop->delete($msgnum);
    }
}
$pop->quit;


Извиняюсь за возможно глупые вопросы просто в перле вообще не рублю... =(


Это сообщение отредактировал(а) pishka - 29.12.2008, 05:56
PM MAIL   Вверх
shamber
Дата 29.12.2008, 10:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 17
Всего: 18
обновите File::Temp для начала.

Добавлено @ 10:11
Цитата(pishka @  29.12.2008,  05:42 Найти цитируемый пост)
а возможно ли предыдущий код получения попты впихнуть вот этот парсер сохранения аттача?

возможно

Добавлено @ 10:12
Напишите, вы поняли, как проверять адрес отправителя?

Это сообщение отредактировал(а) shamber - 29.12.2008, 10:12
PM MAIL Jabber   Вверх
pishka
Дата 29.12.2008, 11:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 61
Регистрация: 26.12.2008

Репутация: нет
Всего: нет
Ну проверять отправителся видимо вот так:
Код

my $from = $entity->head->get('From');
if $from == '[email protected]' {И вот тут код для если отправитель нас устраивает}

Верно?


Проверить не могу ругается на модуль MIME::Parser этого не хватает этого не хватает блаблабла не могу установить что то заблокированно. Полная попа вообщем...
PM MAIL   Вверх
shamber
Дата 29.12.2008, 11:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 17
Всего: 18
pishka, а вы как устанавливаете? какая ОС?
PM MAIL Jabber   Вверх
pishka
Дата 29.12.2008, 12:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 61
Регистрация: 26.12.2008

Репутация: нет
Всего: нет
Ы... теперь типа уже не важно это. Мне сказали не будут ниче обновлять из за такой фигни и вместо этого дали вот такой пример, сказали вот тебе тут типа аттачи выпихиваются сделай так же.
Ацкий код:
Код

#!/usr/bin/perl
use strict;
use warnings;
use encoding 'cp1251';
use bytes;
use lib '..', '.';
#use CAM::DBF;
use Xbase;
use Encode;
use Net::POP3;
use Net::Netmask;
use MIME::Base64;

my $pop = Net::POP3->new($mail_server) or die "Can't open connection to $mail_server : $!\n";

$pop->login($username, $password) or die "Can't authenticate : $!\n";

my $messages = $pop->list or die "Can't get list of undeleted messages: $!\n";

my $mailSubject = '';
my $mailFrom = '';
my $mailTo = '';
my $mailFilesCount = 0;

my $bAttachStart = 0;
my $bAttachBody = 0;
my $sAttachBody = '';
my $sBoundary = '';

my $msgid;
my $message;
my @mailFiles;
my $AttachFileName;
my $buf;
my $i;
my $s;
my $len;

foreach $msgid (keys %$messages) {
  $message = $pop->get($msgid);
  unless (defined $message) {
    warn "Couldn't fetch $msgid from server: $!\n";
    next;
  }
  # $message -
  #print @$message;
  #print @$message[15];
  #print $message->[15];
  
    for ($i=0; $i <= $#$message; $i++) {
    $s = $message->[$i];
    $len = length($s);

        if ($s =~ /(Subject: )(.*)/)
        {
                $mailSubject = $2;
        }

        if ($s =~ /(From: )(.*)/)
        {
                $mailFrom = $2;
        }

        if ($s =~ /(To: )(.*)/)
        {
                $mailTo = $2;
        }

        if ($s =~ /(boundary=")(-{3,}\w*)/)
        {
                $sBoundary = $2;
        }

        if ($s =~ /^(Content-Disposition: attachment;)/)
        {
                $bAttachStart = 1;
        }
        if ($s =~ /(filename=")(.*)(")/)
        {
                $AttachFileName = $2;
                $mailFiles[$mailFilesCount] = $2;
                $mailFilesCount++;
        }

        if ($bAttachStart == 1) {
                if ($bAttachBody == 1)
                {
                        if ($s =~ /($sBoundary)/)
                        {
                                $buf = decode_base64($sAttachBody);
                                $len = length($buf);
                #print $len . "\n";
                                unlink($AttachFileName);
                                open my $fh, ">$my_path/ATTACH/$AttachFileName";
                                binmode $fh, ":bytes";
                                #print $fh $buf;
                                syswrite $fh, $buf, $len;
                                close $fh;
                                $bAttachStart = 0;
                                $bAttachBody = 0;
                                $sAttachBody = '';
                                $AttachFileName = '';
                        }
                        else
                        {
                                #$s =~ s/^\s*//;                      # Kill leading whitespace
                                $sAttachBody .= $s;
                        }
                }
                if ($len == 1) { $bAttachBody = 1; }
        }

  }

#  print "From: $mailFrom\n";
#  print "To  : $mailTo\n";
#  print "Subject: $mailSubject\n";
#  print "Files:";
#  for ($i=0; $i <= $mailFilesCount-1; $i++) {
#       print " \"" . $mailFiles[$i] . "\"";
#  }
#  print "\n";

  $pop->delete($msgid);
}
$pop->quit();

for ($i=0; $i <= $mailFilesCount-1; $i++) {
  system ("unzip -o ".$my_path."/ATTACH/" . $mailFiles[$i] . " -d ".$my_path."/FILES/");
}



Эм... порнография какая то, shamber, можешь мне его объяснить что б я балбес его понял???
PM MAIL   Вверх
shamber
Дата 29.12.2008, 12:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 17
Всего: 18
а что конкретно не понятно. просто люди предлагают, вместо модуля MIME:: парсить все ручками, какие строчки вам не понятны?
хотя конечно не особо хорошо написан.



Это сообщение отредактировал(а) shamber - 29.12.2008, 12:45
PM MAIL Jabber   Вверх
pishka
Дата 29.12.2008, 12:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 61
Регистрация: 26.12.2008

Репутация: нет
Всего: нет
shamber
конкретно блок сохранения аттача. у меня скрипт запускается, раблотает но не сохраняет файлик.

Добавлено через 5 минут и 35 секунд
Файл с именем аттача появляется, да вот только пустой  smile 
PM MAIL   Вверх
shamber
Дата 29.12.2008, 13:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 17
Всего: 18
Чуть чуть переделал скрипт, у меня нормально отработал.

Код

#!/usr/bin/perl
use strict;
use warnings;
use encoding 'cp1251';
use bytes;
use lib '..', '.';
use Net::POP3;
use MIME::Base64;

my $my_path ="C:/"; #здесь папка куда сохраняем 
my $mail_server = "pop.yandex.ru";
my $username = 'bla';# здесь имя ползователя
my $password = 'pass'; # здесь пароль
my $pop = Net::POP3->new($mail_server) or die "Can't open connection to $mail_server : $!\n";
$pop->login($username, $password) or die "Can't authenticate : $!\n";
my $messages = $pop->list or die "Can't get list of undeleted messages: $!\n";
my $mailSubject = '';
my $mailFrom = '';
my $mailTo = '';
my $mailFilesCount = 0;
my $bAttachStart = 0;
my $bAttachBody = 0;
my $sAttachBody = '';
my $sBoundary = '';
my $msgid;
my $message;
my @mailFiles;
my $AttachFileName;
my $buf;
my $i;
my $s;
my $len;

foreach $msgid (keys %$messages) {
  $message = $pop->get($msgid);
  unless (defined $message) {
    warn "Couldn't fetch $msgid from server: $!\n";
    next;
  }

  while (my $s = shift @{$message}){
    $len = length($s);
        if($s =~ /(Subject: )(.*)/){
                $mailSubject = $2;
        }elsif($s =~ /(From: )(.*)/){
                $mailFrom = $2;
        }elsif($s =~ /^(To: )(.*)/){
                $mailTo = $2;
        }elsif($s =~ /(boundary=")(-{3,}\w*)/){
                $sBoundary = $2;
        }elsif($s =~ /^(Content-Disposition: attachment;)/){
                $bAttachStart = 1;
                if ($s =~ /(filename=")(.*)(")/){
                  $AttachFileName = $2;
                  $mailFiles[$mailFilesCount] = $2;
                  $mailFilesCount++;
                  }
        }
        if ($bAttachStart == 1) {
                if ($bAttachBody == 1)
                {
                        if ($s =~ /($sBoundary)/)
                        {
                                $buf = decode_base64($sAttachBody);
                                $len = length($buf);
                #print $len . "\n";
                                unlink($AttachFileName);
                                open my $fh, ">$my_path/$AttachFileName";
                                binmode $fh, ":bytes";
                                #print $fh $buf;
                                syswrite $fh, $buf, $len;
                                close $fh;
                                $bAttachStart = 0;
                                $bAttachBody = 0;
                                $sAttachBody = '';
                                $AttachFileName = '';
                        }
                        else
                        {
                                #$s =~ s/^\s*//;                      # Kill leading whitespace
                                $sAttachBody .= $s;
                        }
                }
                if ($len == 1) { $bAttachBody = 1; }
        }
  }

  #$pop->delete($msgid);  #раскомментируйте если нужно удалять письма
  }

$pop->quit();


Добавлено через 4 минуты и 51 секунду
pishka, если пустой, то нужно смотреть права доступа.

Это сообщение отредактировал(а) shamber - 29.12.2008, 13:10
PM MAIL Jabber   Вверх
pishka
Дата 29.12.2008, 13:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 61
Регистрация: 26.12.2008

Репутация: нет
Всего: нет
shamber
Переписал твой, запустил.
У меня аттач попрежнему сохраняет пустым  smile  Не пойму почему...
PM MAIL   Вверх
shamber
Дата 29.12.2008, 13:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 17
Всего: 18
Цитата(pishka @  29.12.2008,  13:32 Найти цитируемый пост)
У меня аттач попрежнему сохраняет пустым  smile  Не пойму почему... 

Цитата(shamber @  29.12.2008,  13:06 Найти цитируемый пост)
pishka, если пустой, то нужно смотреть права доступа.
PM MAIL Jabber   Вверх
pishka
Дата 29.12.2008, 13:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 61
Регистрация: 26.12.2008

Репутация: нет
Всего: нет
Извиняюсь за вопрос: права на что?
На запись в файл?

Добавлено через 1 минуту и 26 секунд
Из под rootA работаю
PM MAIL   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Perl"
korob2001
sharq
  • В этом разделе обсуждаются общие вопросы по языку Perl
  • Если ваш вопрос относится к системному программированию, задавайте его здесь
  • Если ваш вопрос относится к CGI программированию, задавайте его здесь
  • Интерпретатор Perl можно скачать здесь ActiveState, O'REILLY, The source for Perl
  • Справочное руководство "Установка perl-модулей", можно скачать здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, korob2001, sharq.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Perl: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0834 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.