Код. Скачивания Архива Mail.ru Агента

Тема в разделе "Perl программирование", создана пользователем nikjig7948, 2 май 2013.

  1. nikjig7948

    nikjig7948 New Member

    Регистрация:
    2 май 2013
    Сообщения:
    4
    Симпатии:
    0
    Доброго времени суток, форумчане-программисты.

    У меня есть такой код, функция которого скачивание архива Mail.ru агенте. Но, этот код не доработанный. То есть, скачаивается все подряд. Можно ли изменить его так, чтобы можно было указать переписку с конкретным e-mail'ом и указать время.

    Заранее благодарю. Спасибо за внимание.


    #!/usr/bin/perl
    use LWP::UserAgent;
    use HTTP::Cookies;
    ################# Config ###############
    my $email = 'your_mail@mail.ru';
    my $pass = 'your_password';
    ############### End Config ##############
    my $ua = LWP::UserAgent->new;
    $ua->agent("Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.19) Gecko/2010031422 Firefox/3.0.19");
    my $cookie_jar = HTTP::Cookies->new();
    $ua->cookie_jar($cookie_jar);
    sub logg
    {
    my ($data, $file) = @_;
    open(OUT, "> ".$file);
    print OUT "$data\n";
    close(OUT);
    }
    sub authorization
    {
    my ($email, $pass) = @_;
    my ($login, $domain) = $email =~ /^(.+?)@(.+?)$/;
    $cookie_jar->clear();
    my $ex = $ua->post('http://win.mail.ru/cgi-bin/auth', ['Login' => $login, 'Domain' => $domain, 'Password' => $pass]);
    if ($ex->headers_as_string() =~/Set-Cookie: Mpop=/)
    {
    return 1;
    }
    }
    sub get_users
    {
    my $ex = $ua->post('http://e.mail.ru/cgi-bin/mrimhistory?', ['mrim_hist_password' => $pass, 'PasswordAsk' => 'on'], Referer => 'http://e.mail.ru/cgi-bin/mrimhistory')->content();
    my @allusers = $ex =~ /class=letavtor title=\"(.+?)\"/g;
    while(1)
    {
    my ($nextpage) = $ex =~ /<a href=\"(.+?)\" id=\"nextbut\">/;
    last if (!$nextpage);
    $ex = $ua->get('http://e.mail.ru/cgi-bin/'.$nextpage)->content();
    my @users = $ex =~ /class=letavtor title=\"(.+?)\"/g;
    foreach (@users)
    {
    push(@allusers, $_);
    }
    }
    return @allusers;
    }
    sub get_messages
    {
    my ($user) = @_;
    my $i = 0;
    my $ex = $ua->get('http://e.mail.ru/cgi-bin/mrimhistory?mode=1&email='.$user)->content();
    my @allmess = $ex =~/<td class=\"letavtor\"><nobr><span.+?>(.+?)<nobr><\/span><\/td>.+?<td class=lettem>(.+?)<\/td>.+?<td class=dat title=\"(.+?)\">/gs;
    while(1)
    {
    my ($nextpage) = $ex =~ /<a href=\"(.+?)\" id=\"nextbut\">/;
    last if (!$nextpage);
    $ex = $ua->get('http://e.mail.ru/cgi-bin/'.$nextpage)->content();
    my @mess = $ex =~/<td class=\"letavtor\"><nobr><span.+?>(.+?)<nobr><\/span><\/td>.+?<td class=lettem>(.+?)<\/td>.+?<td class=dat title=\"(.+?)\">/gs;
    foreach (@mess)
    {
    push(@allmess, $_);
    }
    print "\t\tpage:".$i++."\n";
    }
    my $arhive = '';
    while(@allmess)
    {
    my $data = pop(@allmess);
    my $message = pop(@allmess);
    my $name = pop(@allmess);
    $arhive .= $name.' : '.$data."<br>\r\n".$message."<br><br>\r\n\r\n";
    }
    logg($arhive, $user.'.html');
    }
    authorization($email, $pass);
    my @allusers = get_users();
    print "Users: ".scalar(@allusers)."\n\n\n";
    foreach (@allusers)
    {
    print "\t".$_."\n";
    get_messages($_);
    }




    Кстати, новичкам или дубам вроде меня подсказка. Для того, чтобы попытаться скачать архив надо скачать и установить ActivePerl-5.16.3.1603-MSWin32-x86-296746

    Добавлено: Алгоритм такой: что скрипт сохраняет не по волшебству, а как будто вы заходите в браузере в файл> сохранить страницу, только скрипт сам листает и сам сохраняет в один файл !

    1) Неплохо бы модернизировать скрипт, что бы он сохранял например 10 страниц с последними сообщениями; или вообще чтобы можно было скачать страницы например с 20 по 50

    2) как исключить/скачать сразу несколько контактов? (в теме был пример на только на один контакт)
     
  2. chorny

    chorny Member

    Регистрация:
    21 дек 2010
    Сообщения:
    7
    Симпатии:
    0
    добавил исключение контактов и улучшил код (в том числе используя perltidy)
    <!--shcode--><pre><code class='perl'>#!/usr/bin/perl

    use 5.010;
    use strict;
    use warnings;

    use LWP::UserAgent;
    use HTTP::Cookies;
    ################# Config ###############
    my $email = 'your_mail@mail.ru';
    my $pass = 'your_password';
    my @skip_users = ('user1@sss','....');
    ############### End Config ##############
    my $ua = LWP::UserAgent->new;
    $ua->agent(
    "Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.19) Gecko/2010031422 Firefox/3.0.19"
    );
    my $cookie_jar = HTTP::Cookies->new();
    $ua->cookie_jar($cookie_jar);

    sub logg {
    my ( $data, $file ) = @_;
    open( OUT, "> " . $file );
    print OUT "$data\n";
    close(OUT);
    }

    sub authorization {
    my ( $email, $pass ) = @_;
    my ( $login, $domain ) = $email =~ /^(.+?)@(.+?)$/;
    $cookie_jar->clear();
    my $ex = $ua->post( 'http://win.mail.ru/cgi-bin/auth',
    [ 'Login' => $login, 'Domain' => $domain, 'Password' => $pass ] );
    if ( $ex->headers_as_string() =~ /Set-Cookie: Mpop=/ ) {
    return 1;
    }
    }

    sub get_users {
    my $ex = $ua->post(
    'http://e.mail.ru/cgi-bin/mrimhistory?',
    [ 'mrim_hist_password' => $pass, 'PasswordAsk' => 'on' ],
    Referer => 'http://e.mail.ru/cgi-bin/mrimhistory'
    )->content();
    my @allusers = $ex =~ /class=letavtor title=\"(.+?)\"/g;
    while (1) {
    my ($nextpage) = $ex =~ /<a href=\"(.+?)\" id=\"nextbut\">/;
    last if ( !$nextpage );
    $ex = $ua->get( 'http://e.mail.ru/cgi-bin/' . $nextpage )->content();
    my @users = $ex =~ /class=letavtor title=\"(.+?)\"/g;
    foreach (@users) {
    push( @allusers, $_ );
    }
    }
    return @allusers;
    }

    sub get_messages {
    my ($user) = @_;
    my $i = 0;
    my $ex =
    $ua->get( 'http://e.mail.ru/cgi-bin/mrimhistory?mode=1&email=' . $user )
    ->content();
    my @allmess = $ex =~
    /<td class=\"letavtor\"><nobr><span.+?>(.+?)<nobr><\/span><\/td>.+?<td class=lettem>(.+?)<\/td>.+?<td class=dat title=\"(.+?)\">/gs;
    while (1) {
    my ($nextpage) = $ex =~ /<a href=\"(.+?)\" id=\"nextbut\">/;
    last if ( !$nextpage );
    $ex = $ua->get( 'http://e.mail.ru/cgi-bin/' . $nextpage )->content();
    my @mess = $ex =~
    /<td class=\"letavtor\"><nobr><span.+?>(.+?)<nobr><\/span><\/td>.+?<td class=lettem>(.+?)<\/td>.+?<td class=dat title=\"(.+?)\">/gs;
    foreach (@mess) {
    push( @allmess, $_ );
    }
    print "\t\tpage:" . $i++ . "\n";
    }
    my $arhive = '';
    while (@allmess) {
    my $data = pop(@allmess);
    my $message = pop(@allmess);
    my $name = pop(@allmess);
    $arhive .=
    $name . ' : ' . $data . "<br>\r\n" . $message . "<br><br>\r\n\r\n";
    }
    logg( $arhive, $user . '.html' );
    }

    authorization( $email, $pass );
    my @allusers = get_users();
    print "Users: " . scalar(@allusers) . "\n\n\n";
    foreach my $user (@allusers) {
    next if $user ~~ @skip_users;
    print "\t" . $user . "\n";
    get_messages($user);
    }[/CODE]
     
  3. nikjig7948

    nikjig7948 New Member

    Регистрация:
    2 май 2013
    Сообщения:
    4
    Симпатии:
    0
    Спасибо за оперативный (реактивный) ответ. :(

    А можно переписку только "с определенными контактами"? И за определенный период?
     
  4. Jewel

    Jewel New Member

    Регистрация:
    4 май 2013
    Сообщения:
    1
    Симпатии:
    0
    nikjig7948 отличное решение!
     
  5. nikjig7948

    nikjig7948 New Member

    Регистрация:
    2 май 2013
    Сообщения:
    4
    Симпатии:
    0
    chorny, Спасибо!
    Отлично работал. Но, кажется, в самом Mail.ru были какие то изменения. И наш код скачивает только первую страницу. Почему так, не знаю. (( :rolleyes:
     
  6. dP06

    dP06 New Member

    Регистрация:
    1 июл 2013
    Сообщения:
    1
    Симпатии:
    0

    Скорее всего, изменения были в структуре сайта майл.ру. Немного поигралс с адресами страниц, но ничего не помогло.. Кто может помочь?
     
  7. nikjig7948

    nikjig7948 New Member

    Регистрация:
    2 май 2013
    Сообщения:
    4
    Симпатии:
    0
    Народ, есть кто-нибудь?
     
Загрузка...

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