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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> POP3 
:(
    Опции темы
dixoNICH
Дата 11.4.2011, 17:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
Код

$invitation=~/\=\?KOI8\-R\?B\?(.*)\?\=/;
$a=$1;
$b = decode_base64($a);
print F Encode::from_to($a, "KOI8-R", "cp1251");

выделяю так то, что должен декодировать и загоняю в cp1251
получаетсяя что то вроде : 12412425151
просто цифры. 
если не декодировать base64 - то так же)
PM MAIL   Вверх
dixoNICH
Дата 11.4.2011, 17:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
Код

$invitation=~/\=\?KOI8\-R\?B\?(.*)\?\=/;
$a=$1;
$b = decode_base64($a);
print F Encode::from_to($a, "KOI8-R", "cp1251");

делаю так.
собственно, выводит что-то в стиле : 12421421421421321 )
без декодировки из бейс64 аналогично
PM MAIL   Вверх
Pfailed
Дата 11.4.2011, 18:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 2
Всего: 39
Прочтите внимательнее документацию по этой функции. Она не возвращает строку,  а изменяет переданную.


--------------------
I'm on CPAN
I'm on github
PM MAIL   Вверх
dixoNICH
Дата 15.4.2011, 07:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
спасибо. 
PM MAIL   Вверх
dixoNICH
Дата 22.4.2011, 20:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
Проблема такая : до меня доходят не все сообщения. точнее, когда как : иногда ничего не приходит, иногда 1 сообщение, иногда 2..n. 
интуитивно понимаю в чём ошибка, точнее догадываюсь.
возможно, что я отправляю ему команду LIST, а он ещё отослал ему всё, а я ему RETR уже шлю.
но, как это исправить - не представляю. прошу помощи (
Код

$,="\n";
open F, ">mail.txt";
use IO::Socket; 
use Encode;
use MIME::Base64;
        my $host="pop.yandex.ru"; #хост #  print "Enter host please : ";my $host=<>;
        my $port=110; #pop3 в основном использует 110 порт.(995 при шифрование)
        my $login = "yaroslavlyzlov\n";#логин
        my $password ="privetik\n"; #пароль 
##################<---------СОЕДИНЯЕМСЯ С СЕРВЕРОМ------->####################
                sub CONNECT {
                $socket =       IO::Socket::INET->new (
                                        PeerAddr => $host,
                                        PeerPort => $port,
                                        Proto => "tcp",
                                        Type => SOCK_STREAM)
                                        or die "Can't connect to $host:$port, $!\n";
                }
                CONNECT;
#########################<----------АВТОРИЗАЦИЯ------------->######################### 
                sub AUTHORIZATION {
                        my $invitation=<$socket>; #приглашение сервера (+OK,-ERR etc)
                        print $socket "USER $login";  
                                my $invitation=<$socket>; #print $invitation;
                        print $socket "PASS $password"; 
                                my $invitation=<$socket>; #print $invitation;
                }
                AUTHORIZATION; 
                
                sub LISTandRETR {
                        print $socket "LIST\015\012";
                        my $invitation=<$socket>;
                        $invitation=~/(\d+)/; # выделяем кол-во сообщений
                        $qt=$1; # колличество сообщений
                        open F, ">mail.txt";
                            #Encode::MIME::Header -- MIME 'B' and 'Q' header encoding
                            #use Encode qw/encode decode/;
                            #$utf8   = decode('MIME-Header', $header);
                            #$header = encode('MIME-Header', $utf8);
                                for($i=1;$i<$qt+1;$i++) {
                                        $invitation=<$socket>; 
                                        $invitation=~m/(\d+)\s(\d+)/; # для вывода номера и размера письма
                                        print "Number : $1\n"; 
                                        print "Octets : $2\n";
                                        $let=$1;
                                        print $socket "RETR $i\015\012";
                                        #print $invitation;
                                        recv $socket, $invitation, $message[$i]+1000000, $k;
                                        #print F $invitation;
                                        $invitation=~m/From:\s.*\s\<(.*)\>/;
                                        print  "From : $1\n";
                                        #$invitation=~m/Subject:\s(.*)/;
                                        #print  "Subject : $1\n";
                                        $invitation=~m/Date:\s(.*)/;
                                        print  "Date : $1\n";
                                        
                                        $invitation=~/\=\?KOI8\-R\?B\?(.*)\?\=/; #выделяем закодированый текст
                                        $a=$1;
                                        $s=decode_base64($a);
                                        Encode::from_to($s, "KOI8-R", "cp1251");
                                        print F "Subject : $s\n";
                                        $invitation=~m/Message-ID:\s(.*)/;
                                        print "Message-ID : $1\n";
                                        #$invitation=~m/Content-Type:(\s).*\n\n(.*)\n\n/;
                                        #print "Message : $2\n";
                                        #print "Message : $2\n";
                                        print "--------------------------\n";                           
                                }
                                print @message;
                                close F;
                } LISTandRETR;
                        
                
        
###################DELETE MESSAGE#################
                sub DELETE { #функция удаления сообщений 
                        print "Remove any post?  Enter yes or no : ";
                        $yes_or_no=<>;
                        chomp $yes_or_no;
                        if($yes_or_no eq "yes") {
                                print "Select the number of messages you want to delete : ";
                                $number_for_del=<>;
                                print $socket "DELE $number_for_del\n";  
                                        my $invitation=<$socket>; 
                                        print $invitation;
                        }       
                }
                DELETE;                 
###################QUIT#################
                sub QUIT {      
                        print $socket "QUIT\n"; 
                                my $invitation=<$socket>;  
                                print $invitation; 
                } 
                print "complete the pop3 session? Enter yes or no, please : ";
                $quit=<>;
                chomp $quit;
                if($quit eq "yes"){QUIT;}
                sub DECODE {
                        $invitation=~/Subject:\s\=\?KOI8\-R\?B\?(.*)\?\=/;
                         $a=$1;
                         $s=decode_base64($a);
                         Encode::from_to($s, "KOI8-R", "cp1251");
                         print F$s."\n";
                        }
PM MAIL   Вверх
dixoNICH
Дата 23.4.2011, 16:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
проблему решил
PM MAIL   Вверх
dixoNICH
Дата 27.4.2011, 12:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
пытался решить проблему. всё сообщение не принять одним recv, пытался делить его на части по 1024 байта.
появилась проблема - он посылает мне первое сообщение несколько раз, не знаю, где я накосячил(

Код

open F, ">mail.txt";
        sub LISTandRETR {
            print $socket "LIST\n";
            my $invitation=<$socket>;
            $invitation=~/(\d+)\s(\d+)/; # выделяем кол-во сообщений и их объём
            $qt=$1; # колличество сообщений
            $s=$2;  # объём почтового ящика
                for($i=1;$i<$qt+1;$i++) {
                    $invitation=<$socket>; 
                    $invitation=~m/(\d+)\s(\d+)/; # для вывода номера и размера письма
                    print "Number : $1\n"; 
                    print "Octets : $2\n";
                    $let=$1;
    #######################################################################
                    print $socket "RETR $i\n";
                    $aaa = $2/1024; $bbb = 1*$2 - $aaa*1024;
                    for (1..$aaa) {
                        recv$socket,$ccc,1024,0;
                        push@hhh,$ccc;
                    }
                    recv$socket,$ccc,$bbb,0;
                    push@hhh,$ccc;
                    $invitation = join '', @hhh;
                    print $invitation;
                    while($invitation=~/Content-Disposition:\sattachment;\sfilename="(.*)"/g){ # filename, baby
                        $filename=$1;
                        open S, ">$filename";
                        close S;
                    }
                }
                close F;
        } LISTandRETR;
PM MAIL   Вверх
shamber
Дата 27.4.2011, 22:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: нет
Всего: 18
dixoNICH, чего-то в вашем скрипте не заметно перебора писем после команды List. видно что вы все время одно и тоже письмо запрашиваете.
Логично получить количество писем в массив. а потом перебрав массив, получить все письма.
PM MAIL Jabber   Вверх
dixoNICH
Дата 28.4.2011, 22:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
почему не заметно? отправляю лист, узнаю кол-во сообщений, запускаю фор от единицы, до кол-во сообщений + 1, в форе отправляю
print $socket "RETR $i\n"; 
потом сразу разбиваю и пушу в массив, потом джоин в строку
PM MAIL   Вверх
shamber
Дата 29.4.2011, 10:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: нет
Всего: 18
For проглядел. Однако я погонял код у себя:
0. добавьте use strict;
1. ваша регулярка для получения количества писем не очень, на моем почтовом ящике не сработала лучше переписать так (\d+)\D+(\d+)
2. В моем случае, писем много и после запроса их индексов, а вы ведь после первого же письма сразу хотите получать тело, в тело попадают остатки команды LIST.
3. ваш код my $aaa = $2/1024; my $bbb = 1*$2 - $aaa*1024; ну очень плохо отрабатывает например размер 1921. 
может лучше  my $aaa = int($size/1024); my $bbb = ($size % 1024);

А вообще попробуйте так:

Код

sub LISTandRETR {
    print $socket "LIST\n";
    my $invitation=<$socket>;
    $invitation=~/(\d+)\D+(\d+)/; # выделяем кол-во сообщений и их объём
    my $qt=$1; # колличество сообщений
    my $s=$2;  # объём почтового ящика
    my @list;
    while(1){
        my $str = <$socket>;
        push @list,$str;
        last unless $str=~/(\d+)/;
    }
    my $i=0;
    while($i<$qt) {
        $invitation=$list[$i];
        $i++;
        $invitation=~m/(\d+)\s(\d+)/; # для вывода номера и размера письм
        my $num = $1;
        my $size = $2;
        print "Number : $num\n";
        print "Octets : $size\n";
        my $let=$1;
#######################################################################
        print $socket "RETR $num\n";                
        my $str;
        my $buf;
        vec(my $win, fileno($socket), 1) = 1;
        my $timeout = 10;
        while(1){
            my $p = select($win, undef, undef, $timeout);
            if($p>0){
                sysread($socket,$str,1024);
            }else{
             print "Timeout\n";
            }
            $buf .=$str;
            last if $str=~/\n?\.\r\n$/; #выходим когда получили точку
        }   
        print F $buf;
        while($buf=~/Content-Disposition:\sattachment;\sfilename="(.*)"/g){ # filename, baby
            my $filename=$1;
            open S, ">$filename";
            close S;
        }
    }
}





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


Бывалый
*


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

Репутация: нет
Всего: нет
не работает, вообще ничего никуда не выводит. вот мой код, возможно у вас заработает smile почта тестовая уже в коде есть

Код

$,="\n";
open F, ">mail.txt";
use IO::Socket; 
use Encode;
use MIME::Base64;
    my $host="pop.yandex.ru"; #хост #  print "Enter host please : ";my $host=<>;
    my $port=110; #
    my $login = "yaroslavlyzlov\n";
    my $password ="privetik\n"; 
##################<---------СОЕДИНЯЕМСЯ С СЕРВЕРОМ------->####################
        sub CONNECT {
        $socket =    IO::Socket::INET->new (
                    PeerAddr => $host,
                    PeerPort => $port,
                    Proto => "tcp",
                    Type => SOCK_STREAM)
                    or die "Can't connect to $host:$port, $!\n";
        }
        CONNECT;
#########################<----------АВТОРИЗАЦИЯ------------->######################### 
        sub AUTHORIZATION {
            my $invitation=<$socket>; #приглашение сервера (+OK,-ERR etc)
            print $socket "USER $login";  
                my $invitation=<$socket>; #print $invitation;
            print $socket "PASS $password"; 
                my $invitation=<$socket>; #print $invitation;
        }
        AUTHORIZATION; 
        open F, ">mail.txt";
        sub LISTandRETR {
    print $socket "LIST\n";
    my $invitation=<$socket>;
    $invitation=~/(\d+)\D+(\d+)/; # выделяем кол-во сообщений и их объём
    my $qt=$1; # колличество сообщений
    my $s=$2;  # объём почтового ящика
    my @list;
    while(1){
        my $str = <$socket>;
        push @list,$str;
        last unless $str=~/(\d+)/;
    }
    my $i=0;
    while($i<$qt) {
        $invitation=$list[$i];
        $i++;
        $invitation=~m/(\d+)\s(\d+)/; # для вывода номера и размера письм
        my $num = $1;
        my $size = $2;
        print "Number : $num\n";
        print "Octets : $size\n";
        my $let=$1;
#######################################################################
        print $socket "RETR $num\n";                
        my $str;
        my $buf;
        vec(my $win, fileno($socket), 1) = 1;
        my $timeout = 10;
        while(1){
            my $p = select($win, undef, undef, $timeout);
            if($p>0){
                sysread($socket,$str,1024);
            }else{
             print "Timeout\n";
            }
            $buf .=$str;
            last if $str=~/\n?\.\r\n$/; #выходим когда получили точку
        }   
        print  $buf;
        while($buf=~/Content-Disposition:\sattachment;\sfilename="(.*)"/g){ # filename, baby
            my $filename=$1;
            open S, ">$filename";
            close S;
        }
    }
}
            
        
    
###################DELETE MESSAGE#################
        sub DELETE { #функция удаления сообщений 
            print "Remove any post?  Enter yes or no : ";
            $yes_or_no=<>;
            chomp $yes_or_no;
            if($yes_or_no eq "yes") {
                print "Select the number of messages you want to delete : ";
                $number_for_del=<>;
                print $socket "DELE $number_for_del\n";  
                    my $invitation=<$socket>; 
                    print $invitation;
            }    
        }
        DELETE;            
###################QUIT#################
        sub QUIT {    
            print $socket "QUIT\n"; 
                my $invitation=<$socket>;  
                print $invitation; 
        } 
        print "complete the pop3 session? Enter yes or no, please : ";
        $quit=<>;
        chomp $quit;
        if($quit eq "yes"){QUIT;} 
        
        
        
PM MAIL   Вверх
shamber
Дата 29.4.2011, 22:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: нет
Всего: 18
Вот вы все равно упорствуете. посмотрите. что я вам написал нулевым пунктом?
Код

use strict;

Дальше ваши ошибки
Код

Global symbol "$socket" requires explicit package name at C:\Perl\!My\vingrad\trest.pl line 22.
Global symbol "$socket" requires explicit package name at C:\Perl\!My\vingrad\trest.pl line 23.
Global symbol "$socket" requires explicit package name at C:\Perl\!My\vingrad\trest.pl line 24.
Global symbol "$socket" requires explicit package name at C:\Perl\!My\vingrad\trest.pl line 25.
Global symbol "$socket" requires explicit package name at C:\Perl\!My\vingrad\trest.pl line 26.
Global symbol "$socket" requires explicit package name at C:\Perl\!My\vingrad\trest.pl line 31.
Global symbol "$socket" requires explicit package name at C:\Perl\!My\vingrad\trest.pl line 32.
Global symbol "$socket" requires explicit package name at C:\Perl\!My\vingrad\trest.pl line 38.
Global symbol "$socket" requires explicit package name at C:\Perl\!My\vingrad\trest.pl line 53.
Global symbol "$socket" requires explicit package name at C:\Perl\!My\vingrad\trest.pl line 56.
Global symbol  ...\test.pl aborted due to compilation errors.


Потом сравните мою 39 строку и вашу 68. Дальше писать?
И кстати, что за странный способ писать подпрограмму, а потом ее вызвать?(Да и еще забывать ее вызывать?)
Во вложении почту узнаете?

Добавлено @ 22:51
Код

use strict;
use IO::Socket::INET; 
use Encode;
use MIME::Base64;
    my $host="pop.yandex.ru"; #хост #  print "Enter host please : ";my $host=<>;
    my $port=110; #
    my $login = "yaroslavlyzlov\n";
    my $password ="privetik\n";
    my $socket;
    open F, ">mail.txt";
    CONNECT();
    AUTHORIZATION();
    LISTandRETR();
##################<---------СОЕДИНЯЕМСЯ С СЕРВЕРОМ------->####################
        sub CONNECT {
        $socket =    IO::Socket::INET->new (
                    PeerAddr => $host,
                    PeerPort => $port,
                    Proto => "tcp",
                    Type => SOCK_STREAM)
                    or die "Can't connect to $host:$port, $!\n";
        }
#########################<----------АВТОРИЗАЦИЯ------------->######################### 
        sub AUTHORIZATION {
            my $invitation=<$socket>; #приглашение сервера (+OK,-ERR etc)
            print $socket "USER $login";  
            $invitation=<$socket>; #print $invitation;
            print $socket "PASS $password"; 
            $invitation=<$socket>; #print $invitation;
        }

sub LISTandRETR {
    print $socket "LIST\n";
    my $invitation=<$socket>;
    $invitation=~/(\d+)\D+(\d+)/; # выделяем кол-во сообщений и их объём
    my $qt=$1; # колличество сообщений
    my $s=$2;  # объём почтового ящика
    my @list;
    while(1){
        my $str = <$socket>;
        push @list,$str;
        last unless $str=~/(\d+)/;
    }
    my $i=0;
    while($i<$qt) {
        $invitation=$list[$i];
        $i++;
        $invitation=~m/(\d+)\s(\d+)/; # для вывода номера и размера письм
        my $num = $1;
        my $size = $2;
        print "Number : $num\n";
        print "Octets : $size\n";
        my $let=$1;
#######################################################################
        print $socket "RETR $num\n";                
        my $str;
        my $buf;
        vec(my $win, fileno($socket), 1) = 1;
        my $timeout = 10;
        while(1){
            my $p = select($win, undef, undef, $timeout);
            if($p>0){
                sysread($socket,$str,1024);
            }else{
             print "Timeout\n";
            }
            $buf .=$str;
            last if $str=~/\n?\.\r\n$/; #выходим когда получили точку
        }   
        print F $buf;
        while($buf=~/Content-Disposition:\sattachment;\sfilename="(.*)"/g){ # filename, baby
            my $filename=$1;
            open S, ">$filename";
            close S;
        }
    }
}

Вообщем, ищите отличия, в них вся соль.

Это сообщение отредактировал(а) shamber - 1.5.2011, 01:44

Присоединённый файл ( Кол-во скачиваний: 4 )
Присоединённый файл  mail.7z 61,93 Kb
PM MAIL Jabber   Вверх
dixoNICH
Дата 1.5.2011, 01:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


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

Репутация: нет
Всего: нет
извините за мою не компетентность smile
огромное спасибо за помощь!
PM MAIL   Вверх
shamber
Дата 1.5.2011, 01:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

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

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

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


 




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


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

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