Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Perl: Общие вопросы > Как заставить LWP обойти все ссылки на сайте?

Автор: trigger 20.9.2006, 14:13

Вопрос конечно децкий.

Подскажите плз как заставить LWP собрать все ссылки сайту и собрать контент.
в топиках - не понял ничего.
Заранее кланяюсь.

Автор: nitr 20.9.2006, 14:22

trigger, здесь поиск на форуме, уже слишком много отвечали на этот деццкий вопрос ;)

Автор: trigger 20.9.2006, 14:48

про наличие поиска осведомлен я и написал что не понял ничиго.

Автор: nitr 20.9.2006, 15:55

trigger, тогда ты просишь написать за тебя всё? smile

напиши чего ты не понял и в каком посте smile

Добавлено @ 15:55
бедм выяснять и учить ;)

Автор: trigger 20.9.2006, 17:12

приятно..... но писать за меня не надо smile

хотя спасибо !

Скрипт ниже честно содрал - не работает  попытался разобраться как работает - понял только на уровне подсознания. Может есть и другие варианты!?

Я понимаю что модулю LWP дать адрес и он скачает страницу и всякие атрибуты.
Но я не понимаю как заставить его проверить наличие ссылок (документов) - тоесть пойти дальше по сайту , собрать это все воедино, и какими методами этого добиться.

выражение
my $base = 'http://www.someplace.com'; переменной присвоили адрес
my %href = ($base => 1);  ниже мне совершенно непонятно - это толкает его дальше ?

Прошу прощения что не в цвете
=================================
то что нашел на форуме :
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Headers;
my $base = 'http://www.someplace.com';
my %href = ($base => 1); # общее хранилище ссылок инициализируем начальным адресом
my $ua = LWP::UserAgent->new;
my ($res, $content);

# временный хеш для новых ссылок
my %new_href = (1 => 1);

# если есть хоть одна новая ссылка
while (scalar keys %new_href) {
    # они должны быть уже в %href smile

    %new_href = ();
    # проходим по хешу еще раз
    while (my($k, $v) = each %href) {
    # если сылка еще не посещалась
        if ($v) {
         $res = $ua->get($k);
         # если нормально получили документ
         if ($res->is_succes) {
                # обнуляем посещенную ссылку
                $href{$k} = 0;
                $content = $res->content;

                while ($content =~ /<a href=(["'])?($base.+)\1[\s>]/gi) {
                    # если такой ссылки еще нет
                    $new_href{$2} = 1 unless (exists($href{$2}));
                    # для проверки
                    print $2,"\n";
                }
         } else { print $res->status_line, "\n" }
      } # if
     } # while
     # складываем старый хеш и новый.
     %href = (%href, %new_href)
}
# выводим ключи хеша
print join "\n", keys %href;

===================

Автор: nitr 20.9.2006, 17:37

вот тут глянь smile

))
тока комменты убери
http://forum.vingrad.ru/index.php?showtopic=107053&view=findpost&p=815557

Код


#!/usr/bin/perl -w
use strict;
use LWP::UserAgent;

my $ua = LWP::UserAgent->new; #новый экземпляр
my $content = $ua->get('http://forum.vingrad.ru/index.php?showforum=5')->content; #воть вся страничка тут ;)

my $hash;
$hash->{$_}++ while $content =~ m{<A[^>]*?HREF=["'](.+?)['"][^>]*?>.*?</A>}smig;

print join "\n", sort keys %$hash;

в общем.. много вариантов ;)

Автор: Nab 20.9.2006, 17:50

Так что не работает то в том примере что ты привел?
Его проверял я, и человек которому я его сделал... все работает... но он собирает только ссылки, а не контент, Второе ссылки могут генерироваться JavaScript поэтому по ним так просто не пройдешься... давай сайт на котором тестировал...

Автор: trigger 20.9.2006, 18:19

nitr подставил выдает вот это:
Use of uninitialized value in hash element at C:\t\scripts\files\link_graber.pl line 9.

8:  my $hash;
9:  $hash->{$_}++ while $content =~ m{<A[^>]*?HREF=["'](.+?)['"][^>]*?>.*?</A>}smig; это проход по ссылкам  правильно понял?

сайт как пример использовал http://www.gpr.com.ua.

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

Добавлено @ 18:30
Nab
Can't locate object method "is_succes" via package "HTTP::Headers" (perhaps you forgot to load "HTTP::Headers"?) at (eval 19)[C:/usr/site/lib/HTTP/Message.pm:85] line 1.

это выдало в вашем  варианте подскажите в чем может быть проблема?
HTTP::Headers - как положено есть

Автор: Nab 20.9.2006, 19:03

а какая версия перла то у вас?

Автор: trigger 20.9.2006, 19:19

5.6.1

Автор: nitr 20.9.2006, 23:05

Код


#!/usr/bin/perl -w    
use strict;    
use LWP::UserAgent;    
my $ua = LWP::UserAgent->new; #новый экземпляр    
my $content = $ua->get('http://www.gpr.com.ua')->content; #воть вся страничка тут ;)    
my $hash;    
$hash->{"http://www.gpr.com.ua$1"}++ while $content =~ m{<A[^>]*?HREF=["'](.+?)['"][^>]*?>.*?</A>}smig;    
print join "\n", sort keys %$hash;

работаить

Добавлено @ 23:07
хошь в массив их... к примеру посл. строку поменять на

Код


my @urls = sort keys %$hash;

Автор: Nab 21.9.2006, 02:48

Цитата(trigger @ 20.9.2006, 19:19)

5.6.1

В версии LWP::* которая идет с этим перлом реализован еще старый стиль, и запрос и ответ нужно создавать отдельно...
Как его изменить смотрите как был сделан первый вариант diverd в том топике откуда вы этот пример утянули.

Автор: trigger 21.9.2006, 11:41

nitr Огромное спасибо smile

если правильно понимаю :

Код



my $content = $ua->get('http://www.gpr.com.ua')->content; # тут забираем контент со страницы

my $hash;  #объявляем хеш  
$hash->{"http://www.gpr.com.ua$1"}++ while $content =~ m{<A[^>]*?HREF=["'](.+?)['"][^>]*?>.*?</A>}smig;    
# тут с помощью регулярки проходим по содержимому и если встречается 
#ссылка запихиваем ее в хеш только поясните пожалуйста 
#выражение {"http://www.gpr.com.ua$1"}++ на пальцах.

print join "\n", sort keys %$hash; # ну а тут вывод на печать ключи

данный пример проходит по ссылкам только на первой странице, получается теперь придеца взять каждый ключь объявленного хеша передать его как следующющий запрос и в ней собрать опять ссылки и там проверки на есть уже или нет такой ссылки - правильно мыслю ?

Добавлено @ 11:44
Nab спасибо понял

Автор: nitr 21.9.2006, 11:52

да по всем ссылкам самому писать скрипт ;)

это несложно

{"http://www.gpr.com.ua$1"}++ добавляем в хеш smile

, чтобы повтором не было
http://www.gpr.com.ua это для красоты ссылок ;)

Автор: trigger 21.9.2006, 11:57

Огромное Вам спасибо

Автор: nitr 21.9.2006, 12:10

так попробуй по всем страничкам... но его можно "наворотить", это как пример

Код


#!/usr/bin/perl -w    
use strict;    
use LWP::UserAgent;    
get_a("http://www.gpr.com.ua");

sub get_a {
    my $url = shift;
    my $ua = LWP::UserAgent->new; #новый экземпляр    
    my $content = $ua->get($url)->content; #воть вся страничка тут ;)    
    my $hash;    
    $hash->{"$url$1"}++ while $content =~ m{<A[^>]*?HREF=["'](.+?)['"][^>]*?>.*?</A>}smig;    
    foreach (sort keys %$hash) {
        get_a($_);
    }
}

Автор: trigger 21.9.2006, 13:14

Код


get_a("http://www.gpr.com.ua");

Код


foreach (sort keys %$hash) {
get_a($_);
}

это не понял поясните что это и что сдесь происходит get_a вообще смутило меня
я понимаю что это подпрограмма но...

Автор: nitr 21.9.2006, 13:48

это так и есть... так сказать... рекурсия... в самой функции (процедуре) вызываем саму себя =)

вот и получаем ссылки и проходим по всем... это небыстрый процесс smile

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

я протестить не могу, на работе нахожусь smile

пишу скрипты без проверки ... но рабочие 100% ;)

Автор: trigger 21.9.2006, 23:44

жаль но не работает - хотя дело наверное в версии моего перла
смешно - но до сих пор мучаюсь

Автор: nitr 22.9.2006, 02:46

вот держи труженник...

Код


#!/usr/bin/perl -w
use strict;
use LWP::UserAgent;

our $hash;
get_a('http://www.gpr.com.ua');
print join "\n", sort keys %$hash;  #либо в массив my @urls = sort keys %$hash;

sub get_a {
    my $url = shift;
    my $link = 'http://www.gpr.com.ua';
    my $ua = LWP::UserAgent->new;
    my $content = $ua->get($url)->content;
    while ($content =~ m{<\s*?A[^>]*?HREF\s*?=\s*?["'](.+?)['"][^>]*?>.*?<\s*?/A\s*?>}smig) {
        my $link = $link.$1;
        $hash->{"$link"} = 0 unless exists $hash->{"$link"} || $link !~ m{http://www.gpr.com.ua/}; #в твоём случае и такое надо ;) чтобы левые ссылки не проверяить
    }
    foreach (sort keys %$hash) {
    next if $hash->{$_} == 1;                #дальше... тут уже были 
    $hash->{$_} = 1;                         #пометим что были
         get_a($_);
    }
}

Автор: trigger 22.9.2006, 12:52

О ЧЕЛОВЕЧИЩЕ с большой буквы - благодарен я безбрежно Вашему терпению и помощи немощным как я. Обещаю что когда всетки буду знать PERL достаточно хорошо то буду также относиться к таким деревянным как я на данный момент. Хвала тебе и оды пою.

Жаль конечно что что своим умом не дошел до этого. Опыт скромный

Еще разз спасибо !