VPF::Сбор ссылок со всего сайта!!! - Форум программистов

DiverD

Дата 12.9.2006, 18:12 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

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

Репутация: 1
Всего: 2

Вот код:

Код


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

our $h0st = 'http://127.0.0.1/7357/2';
our @one_src; # массив для первой страницы
our %href; # общее хранилище ссылок

#конектимся по первому результату
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(GET => $h0st);
$req->header('Accept' => 'text/html');
my $res = $ua->request($req);
push @one_src,$res->content =~ /<a href="(.+?)".+/g;


    my @a; 
    foreach(@one_src)
    {
        # уст пройденную ссылку в 1
    $href{$_} = 1; 
    my $ua = LWP::UserAgent->new;
    my $req = HTTP::Request->new(GET => $_);
    $req->header('Accept' => 'text/html');
    my $res = $ua->request($req);
        # добовляем в массив новые ссылку от результата парсинга
    push @a,$res->content =~ /<a href="(.+?)".+/g;
    }
    
    foreach(@a)
   {
      unless(exists $href{$_}) 
        { 
            $href{$_} = 0; # уст не пройденную ссылку в 0
        }
   }
    
    # выводим ключи хеша
    print join "\n",keys %href;

Сдесь в хеш не пройденный ссылки заносятся в хеш, мне нужна (я так пологаю) повторять конекты при помощи while(){} до тех пор пока в хене все значения будут равны 0.
Как ето сделать я не знаю - прошу помочь.

--------------------

[ FreeBSD & pERL p0WER eVERY dAY ]

Nab

Дата 12.9.2006, 20:03 (ссылка)

(нет голосов)

Загрузка ...

Опытный

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

Репутация: 3
Всего: 37

Если я правильно понял то нужно просто обойти все дерево сайта?

код удален,

Варианты решений даны внизу...

первый, при любой внешней ссылке начинает сканить весь инет smile

а второй только по указанному сайту, что правильно smile

Это сообщение отредактировал(а) Nab - 12.9.2006, 21:50

--------------------

Чтобы правильно задать вопрос нужно знать больше половины ответа...
Perl Community
FREESCO in Ukraine

DiverD

Дата 12.9.2006, 21:24 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

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

Репутация: 1
Всего: 2

Большой спасибо НАБУ за помощь вот его 2а варианта:

Код


#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
my %href = ('http://127.0.0.1/7357/2' => 1); # общее хранилище ссылок инициализируем начальным адресом
my $ua = LWP::UserAgent->new;
my ($res, $content);

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

# если есть хоть одна новая ссылка
while (scalar keys %new_href) {
    # они должны быть уже в %href :)
    %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=(["'])?(.+)\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;

Код


#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
my $base = 'http://127.0.0.1/7357/2';
my %href = ($base => 1); # общее хранилище ссылок инициализируем начальным адресом
my $ua = LWP::UserAgent->new;
my ($res, $content);

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

# если есть хоть одна новая ссылка
while (scalar keys %new_href) {
    # они должны быть уже в %href :)
    %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;

--------------------

[ FreeBSD & pERL p0WER eVERY dAY ]

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Системное программирование \| Следующая тема »