VPF::Жду замечаний и коментариев - Форум программистов

trigger

Дата 18.1.2007, 17:06 (ссылка)

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

Загрузка ...

Шустрый

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

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

Итак - изрядно мучаясь родил - пока голову smile

По завершении это будет поисковик с построением индекса
и всякого такого для решения узкого круга задач.
На данный момент есть только сборщик контента с сайта (нескольких)
изначально от рекурсии пришлось отказаться - из-за того что скрипт отваливается на больших ресурсах.
В процессе парсинг и индекс.
Прошу указать на ошибки и недостатки в указанном ниже коде.
А также советы и т.д. приму с благодарностью.

код с некоторыми комментами.

Код


#!/usr/bin/perl -w
use strict;
use DBI qw(:sql_types);
use LWP::UserAgent;
use HTTP::Response;


# статус равен 1 (взяты ссылки но контента нет)
# статус равен 2 (есть ссылки и контент)
# статус равен 3 (взяты ссылки из контента)
# 
#         Что править :
#                 1. регулярные выражения при выборке ссылок
#                        (скорее создать правила для каждого ресурса)

my $host="localhost";
my $base="amonitoring";
my $dsn = "DBI:mysql:host=$host;database=$base";
my $dbh = Connect();

sub Connect{
        my $dbh=DBI->connect ($dsn, "root","", {PrintError=>0, RaiseError=>1});
        return ($dbh);
    }

# ---------------------------
# ЛОГИКА 
# ---------------------------

# 
# сделать выборку урлов которые можно (нужно) индексировать - выбор по имени - добавить имя в choice
# 
# now available command:
# add  - add new url
# check  - check for new urls
# 

# ---------------------------
# сделать выбор действия 
# ---------------------------


print "insert youre command: ";
        chomp(my $choice = <STDIN>);
        if ($choice eq "add"){
        print "do index for: ";
        chomp(my $add_url = <STDIN>);
        print "$add_url\n********************\n";
        $dbh->do ("INSERT INTO sites (url) VALUES ('$add_url')");
    }
        
        elsif ($choice eq "check"){
        
        my $stmt = qq {SELECT * FROM sites ORDER BY id};
        my $sth = $dbh->prepare($stmt);
        $sth -> execute ();

        my $row;
                while ($row = $sth->fetchrow_hashref()){
                my ($id,$url,$name) = ($row->{ID},$row->{url},$row->{name});
                my $siteid=$id;
        
        # теперь сделать запрос на состояние ответа
                my $ua = LWP::UserAgent->new;
                my $resp = $ua->get("$url");    
        my $content = $resp->content();
        my $status = $resp->status_line();
            
                        if ($status =~m/200/){
                                print "have answer from server $status\n";
                # тогда выбрать из контента ссылки и занести их в базу
                get_links ($content,$siteid,$url);
                
                                #создать цыкл обхода всех строк базы где статус равен 1 ()
                                my $mark = 1;    
                                while ($mark){    
                                    my $get_id = "SELECT * FROM pull WHERE status='1' ORDER BY ID LIMIT 1";    
                                    my $sth = $dbh->prepare($get_id);    
                                    $sth -> execute ();    
                                    if ($row = $sth->fetchrow_hashref()){
                                        $mark = 1;
                                        my ($siteid,$status, $id, $url) = @$row{'siteID','status', 'ID', 'url'};
                                        get_content ($id,$url);
                                        parse_for_links ();
                                    } else { $mark = 0 }
                                    
                                }       #конец  цыкла обхода всех строк базы где статус равен 1 ()
            }
                        elsif($status =~m/500/) {print "$url CLOSED";}
        }    
    }
    else {
                 # сделать чтото неприличное
                }
    

# ---------------------------
# get_content
# ---------------------------
sub get_content {
        my ($id,$url)= @_;
        if ($url){
                my $ua = LWP::UserAgent->new;
                my $content = $ua->get($url)->content;
                my $contentq = $dbh->quote($content);           # экранируем контент для заноса в базу
                my $sth = $dbh->do("UPDATE pull SET temp_content=$contentq, status=2 WHERE ID=$id" );
        }
}   



# ---------------------------
# get_links
# ---------------------------
sub get_links {
        my ($content,$siteid,$url) = @_;
                while ($content =~ m{<\s*?A[^>]*?HREF\s*?=\s*?["'](.+?)['"][^>]*?>.*?<\s*?/A\s*?>}smig) {
                my $fool_url = $url.$1;
                        foreach ($fool_url) {
                        next if $fool_url !~ m{$url/};
                        my $double=$url."http";
                        next if $fool_url =~ m{$double};
                        next if $fool_url =~ m/mailto|.css|.ico|.gif|.jpe?g|JavaScript|.png|.js|.zip|.rar|.gz|.exe|.com|.swf|.xml|.mp3|.ra|.bmp|.avi|.pdf|.doc|.rtf|.ppt|.pps/;
                        my $sth = $dbh->do("INSERT IGNORE INTO  pull(sitesID,url,status) VALUES ('$siteid','$fool_url','1')");
                        }
                }
}


# ---------------------------
# parse_base_links
# ---------------------------
sub parse_for_links{

        my $get = "SELECT p.ID AS ID, p.url AS url, p.temp_content AS temp_content, p.status, p.sitesID AS sitesID, s.url AS main_url
                                                FROM pull p, sites s 
                                                                WHERE status=2 AND p.sitesID = s.ID
                                                                                ORDER BY ID LIMIT 1";

        my $sth = $dbh->prepare($get);    
        $sth -> execute ();
        
        if (my $row = $sth->fetchrow_hashref()){
                my ($id,$siteid,$url,$content, $status,$main_url) = @$row{'ID','sitesID','url','temp_content','p.status','main_url'};
                
                #
                # произвести проверку на ссылки
                #
                        while ($content =~ m{<\s*?A[^>]*?HREF\s*?=\s*?["'](.+?)['"][^>]*?>.*?<\s*?/A\s*?>}smig){
                        my $fool_url = $main_url.$1;
                        foreach ($fool_url) {
                        my $double=$main_url."http";
                        next if $fool_url =~ m{$double};
                        next if $fool_url =~ m/mailto|.css|.ico|.gif|.jpe?g|JavaScript|.png|.js|.zip|.rar|.gz|.exe|.com|.swf|.xml|.mp3|.ra|.bmp|.avi|.pdf|.doc|.rtf|.ppt|.pps/;
                        #print "find new $fool_url\n";
                                        if ($fool_url){
                                        my $sth = $dbh->do("INSERT IGNORE INTO  pull(sitesID,url,status) VALUES ('$siteid','$fool_url','1')");
                                        }
                                }
                        }
                #
                # произвести проверку на ссылки
                #                
                $sth = $dbh->do("UPDATE IGNORE pull SET status=3 WHERE ID=$id" );
                }
        }

$dbh->disconnect;

print "
DONE";
sleep 20;

Nab

Дата 18.1.2007, 19:22 (ссылка)

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

Загрузка ...

Опытный

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

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

trigger, построение поисковика, вполне незаурядная вещь, и решать ее возможно прийдется долго...
А вот специфичные сборщики контента меня сейчас сильно интересуют... но у Вас очень не оптимально это организовано smile

Первое, в одном модуле не должно быть и функций работы с начальными урлами и функций бота...
Как правило это разные сущности и даще разные программы...
Поиск производиться демоном который крутит бота по всем линкам...
А интерфейс с командами, и для управления поисковой машиной надо вынести... в другую подсистему.

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

Эти вопросы бота не должны волновать, он должен быть параллельным и корректно отрабатывать ответы LWP, к примеру если сайт временно недоступен, не помечать его как пройденный, а отложить на потом...
И заметтьте ожидание ответ по таймауту сжирают больше всего времени, поэтому распараллеливать нужно в обязательном порядке. Для этого думаю лучше всего подойдет POE.

Ну а насчет запросов в базу данных, то у меня есть уровень абстрагирования от хранилища данных, и это правильно я уже забыл когда составлял запросы, все работает очень прозрачно smile

Теперь по поводу поиска....есть много хороших поисковых машин которые ищут прям по базам, но это тоже не бязательно... не знаю зачем вам своя понадобилась...

Поисковую я у себя думаю заюзать swish-e или какую другую, а для сбора контента вот бот мне и нужен...

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

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

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

JAPH

Дата 18.1.2007, 19:42 (ссылка)

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

Загрузка ...

Опытный

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

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

Я выскажусь по конкретной реализации. Долго писал, так что сообщение Nab`а ещё не читал.
К сожалению, не всего знаю (LWP::UserAgent, в частности), но что-то попытаюсь посоветовать.

Замечания по get_links. Строка 119 - зачем foreach? Цикл ведь выполнится только один раз, переменную цикла ($_) не используем? Кстати, каково назначение этого цикла? Сформировать полный URL, если он был относительным? Я в замешательстве - зачем сверять с $url/, добавлять http в конец?
Предлагается (о шаблоне подробнее ниже)

Код


while ($content =~ m{<\s*A[^>]*?HREF\s*?=\s*?["']?([^>'"\s]+)}sig) {    #Значение HREF в $1
    my $fool_url = $1; #Дальше будем юзать шаблоны, поэтому то, чё нашли, сохраним
    #Возможны варианты - полная ссылка (http://vingrad.ru/), относительная ссылка (forum/index.php) или абсолютная ссылка (/index.php)
    if ($fool_url !~ /^http:/i) { #Если полная ссылка, ничё менять не надо, иначе
        if (substr($fool_url, 0, 1) eq '/') { #Если абсолютная ссылка
            $fool_url = ($url =~ m{^(http://.*?)/})[0].$fool_url #Надо добавить адрес хоста из $url исходного сайта
        } else { #Иначе относительная ссылка
            $fool_url = ($url =~ m{^(http://.*/)}i)[0].$fool_url } #Приписываем адрес обрабатываемого сайта в начало ссылки, отбросив имя текущего файла, например, из Http://where.ru/info/test.htm выделим лишь Http://where.ru/info/
    }
    next if $fool_url =~ m/mailto|.css|.ico|.gif|.jpe?g|JavaScript|.png|.js|.zip|.rar|.gz|.exe|.com|.swf|.xml|.mp3|.ra|.bmp|.avi|.pdf|.doc|.rtf|.ppt|.pps/; #Если не то что надо, сразу пропускаем (http://www.microsoft.com, кстати, тоже :))
    #my $sth = - не нужен. $dbh -> do не возвращает statement handler.
    #Он может вернуть число - на сколько рядов подействовал запрос (здесь будет возвращена 1)
    #Да и где дальше используется $sth?
    $dbh->do("INSERT IGNORE INTO  pull(sitesID,url,status) VALUES ('$siteid','$fool_url','1')");
}

Теперь, что касается регвыров. Зачем нам мучать машину регвыров, если текст ссылки нам безразличен - нам нужен только открывающий тег, даже просто атрибут HREF. Поэтому, по частям,-
m{
<\s* #Странно, я не видел тегов с пробелом после "<". Ну пусть будет. Квантификатор жадный - пробельные символы не съедят А - нечего бояться. Может, быстрее будет
A
[^>]*? #Здесь ленивая *, надо найти HREF
HREF\s*=\s*
["']?([^>'"\s]+) #Собственно ссылка. Её не всегда заключают в кавычки (!). Квантификатор обязательно жадный (не то получатся ссылки вида "h" вместо "http://where.ru/")
}sigx #Зачем модификатор m? Позиционированием ^ и $ мы не пользуемся. x - потому что с комментами smile

Что касается того, что не нужны файлы вроде .avi, так их нужно привязывать к концу строки или к "?".
Насчёт http://www.microsoft.com, если ссылку запишут буквально так, будет плохо. Так что вариант

Код


next if $fool_url =~ m{^mailto:|^http://.*?/.*?(\.avi|\.exe)(\?.*)?$}i; #Надо добавить все те расширения.

То же к parse_for_links.
Зараз ещё посмотрю, может, ещё попридираюсь smile

tishaishii

Дата 18.1.2007, 20:06 (ссылка)

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

Загрузка ...

Создатель

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

Репутация: 4
Всего: 8

Ну, стандарт не предусматривает теги с пробелом после "<", если, конечно, не создан свой како-то не стандартный парсер.
А, вообще, думаю, Perl для нормального поисковика не сгодится. Пиши, хотя бы, на Ц.

trigger

Дата 18.1.2007, 22:01 (ссылка)

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

Загрузка ...

Шустрый

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

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

Спасибо за проявленое внимание - прочитаю вникну и чуток позже аргументирую некоторые действия

JAPH

Дата 18.1.2007, 23:16 (ссылка)

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

Загрузка ...

Опытный

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

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

Не до конца разобрался с ролью БД. Конечная цель скрипта на данной стадии какая?
Если не трудно, можно показать структуру таблиц? Например, просто привести запрос, создающий нужные таблицы (всё равно он пригодится).
А для чего sleep 20 в самом конце?
Косметическая придирка: строки 58 и 59 - $row можно объявить в цикле:

Код


while (my $row = $sth->fetchrow_hashref()) { # и т.д.

Да, и ещё: строка 81 - зачем лишний раз $mark = 1? Он не меняется, пока управление не перейдёт к ветке else, то есть пока мы всё не обработаем.

Вижу, очень часто встречаются строки типа 60ой. Может, глянуть в сторону bind_columns?

Цитата(DBI.PM)

bind_col

Код


  $rc = $sth->bind_col($column_number, \$var_to_bind);

Binds an output column (field) of a select statement to a perl variable. You do not need to do this but it can be useful for some applications.

Whenever a row is fetched from the database the corresponding perl variable is automatically updated. There is no need to fetch and assign the values manually. This makes using bound variables very efficient. See bind_columns below for an example. Note that column numbers count up from 1.

The binding is performed at a very low level using perl aliasing so there is no extra copying taking place. So long as the driver uses the correct internal DBI call to get the array the fetch function returns, it will automatically support column binding.

For maximum portability between drivers, bind_col should be called after execute.

bind_columns

Код


  $rc = $sth->bind_columns(@list_of_refs_to_vars_to_bind);

Calls bind_col for each column of the select statement. You do not need to bind columns but it can be useful for some applications. The bind_columns method will die if the number of references does not match the number of fields.

For maximum portability between drivers, bind_columns should be called after execute.

For example:

Код


  $dbh->{RaiseError} = 1; # do this, or check every call for errors
  $sth = $dbh->prepare(q{ select region, sales from sales_by_region });
  $sth->execute;
  my ($region, $sales);

  # Bind perl variables to columns:
  $rv = $sth->bind_columns(\$region, \$sales);

  # you can also use perl's \(...) syntax (see perlref docs):
  #     $sth->bind_columns(\($region, $sales));

  # Column binding is the most efficient way to fetch data
  while ($sth->fetch) {
      print "$region: $sales\n";
  }

For compatibility with old scripts, if the first parameter is undef or a hash reference it will be ignored.

Да, кстати. А как будет себя вести этот скрипт, если встретятся циклические ссылки?

Это сообщение отредактировал(а) JAPH - 18.1.2007, 23:41

trigger

Дата 19.1.2007, 00:16 (ссылка)

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

Загрузка ...

Шустрый

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

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

итак структура таблицы и щас объясню основную мысль в продолжении

по поводу POE - что это ? пару слов плз

продолжение:

задача -
отслеживать появление новых документов в которых встречается интересующая тематика
или чтото еще (одним словом событие).
Также важна роль уникальности документа (политика и т.д.).
А также настройка производится под чтото конкретное - smile

загнул про поисковик - smile

Логика выбирается урл который нужно проверять (допустим пока 1)
коннектимся - берем первую страницу 64-66 my $content = $resp->content(); и вытягиваем новые ссылки get_links() (в основном же на первой странице появляются новые ссылки) если есть они заносятся в базу (можно конечно и дать какоето колво ссылок для более уверенного сбора контента)
далее по каждой ссылке забирается контент - опять get_content () заносим его в базу - замечания по использованию базы я принимаю smile

и думаю чтож делать
parse_for_links() используется немного подругому чем get_links().

Задача parse_for_links()
1- экономия трафика
2- выбор техже самых ссылок из базы - там где статус=2
3- занести все найденные ссылки в таблицу со статусом=1 - откуда get_content () берет ссылку для забора контента.

выбор url для забора контента и выбор контента с помошью parse_for_links() из базы производится по одному - что снижает нагрузку на железо

у меня загрузка ЦП была на 65% еще в контру резался

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

- это была логика процесса.

JAPH sleep 20 - просто чтоб увидеть слово DONE - потомучто приятно smile

bind_columns - пошел читать
my $double=$url."http"; встречается такое - smile

где допустим на первой странице
расставляются полные ссылки - так вот так придумал как избежать smile

согласен криво - но я тоже не мастер

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

Nab
еще раз повторюсь - уж шипко загнул про поисковик smile

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

насколько я знаю бот ничего кроме ссылок грубо говоря не возращает - но блин жрет трафик - поэтому и база(пока)

интерфейс с командами - согласен конечно - это на стадии тестирования
парсер - да конечно - но это следующий этап.

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

кстати:
объястите плз - действительно волнует этот вопрос

Цитата(JAPH @ 18.1.2007, 19:42

)

Насчёт http://www.microsoft.com, если ссылку запишут буквально так, будет плохо. Так что вариант

Цитата(JAPH @ 18.1.2007, 19:42

)

next if $fool_url =~ m{^mailto:|^http://.*?/.*?(\.avi|\.exe)(\?.*)?$}i; #Надо добавить все те расширения.

Огромное спасибо за ваше внимание.
Лишнее увидел и то что не предусмотрел.

Это сообщение отредактировал(а) trigger - 19.1.2007, 01:40

JAPH

Дата 19.1.2007, 11:29 (ссылка)

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

Загрузка ...

Опытный

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

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

Хорошо, что привели инфу по таблицам, вопрос про циклические ссылки отпадает.

Что касается доменов типа .com
Ссылки вида http://www.here.com/ (ссылкой сделано автоматически, ходить не надо smile

) подходят под этот шаблон

Цитата(trigger @ 18.1.2007, 17:06

)

Код


m/mailto|.css|.ico|.gif|.jpe?g|JavaScript|.png|.js|.zip|.rar|.gz|.exe|.com|.swf|.xml|.mp3|.ra|.bmp|.avi|.pdf|.doc|.rtf|.ppt|.pps/;

, так что они пропускаются. (Не говоря про то, что точки надо экранировать smile

).
Надо отсеивать только эти расширения, а не имена доменов.
Так что:

Код


next if full_url =~ m{
^mailto:| #mailto помещается в начале
^javascript:| #аналогично
^http:// #шаблон надо применять к уже сформированным ссылкам, так что эта часть точно будет
.*?/ #До первой косой черты - имя хоста, по нему отбора нет.
#Если ссылка вроде http://localhost, она не подойдёт под шаблон из-за отсутствия / в конце,
#и не будет пропущена
.*? #Должно съесть путь и начало имени файла
(\.css|\.ico|\.gif) #И так далее
(\?.*)?$ #Если есть хвост с параметрами, он идёт в конце.
}xi;

trigger

Дата 19.1.2007, 11:50 (ссылка)

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

Загрузка ...

Шустрый

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

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

ага понял

тогда что касаемо доменов как microsoft.com там редирект идет подскажите
пожалуйста

JAPH

Дата 19.1.2007, 12:08 (ссылка)

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

Загрузка ...

Опытный

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

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

Только счас начинаю догадываться, к чему призвано это (см. код ниже). Скажите, правильны ли мои мысли

Код


my $fool_url = $url.$1; #?! Ладно, потом
foreach ($fool_url) {
    next if $fool_url !~ m{$url/}; #Если ссылка началась не с "/", она не нужна (?!)
    my $double=$url."http";
    next if $fool_url =~ m{$double}; #Если ссылка полная, она тоже не нужна
    next if $fool_url =~ m/mailto|.css|.ico|.gif|.jpe?g|JavaScript|.png|.js|.zip|.rar|.gz|.exe|.com|.swf|.xml|.mp3|.ra|.bmp|.avi|.pdf|.doc|.rtf|.ppt|.pps/; #Проверка на типы документов
    my $sth = $dbh->do("INSERT IGNORE INTO  pull(sitesID,url,status) VALUES ('$siteid','$fool_url','1')");#Вставляем адрес этого ресурса
}

А, вообще, странно - ещё можно допустить, что полные ссылки (вида http://localhost/) пропускаются - ищем только по конкретному сайту. Здесь проверка сработает.
Почему пропущены относительные ссылки (допустим, main.htm), не понятно.

Ну хорошо, но только что мы в результате занесём в базу? Ссылку? Разве корректную?
Насколько я понял, $url="http://site.ru/path/doc.html", к примеру (так она передаётся $ua->get в строке 65 -- если я здесь не прав, рассуждения дальше не имеют силы! Пошёл читать pod). Тогда при ссылке "/index.html", которая подразумевает файл "http://site.ru/index.html",
$fool_url="http://site.ru/path/doc.html/index.html", причём все проверки будут пройдены! А вот get($url) в строке 104 её наверняка не съест.

В общем, действительно все полные ссылки надо пропустить?

---------------
что касаемо редиректа, как на это реагирует $ua->get()? Она возвратит статус 30x, означающий редирект? Счас почитаю, подправлю.

JAPH

Дата 19.1.2007, 12:47 (ссылка)

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

Загрузка ...

Опытный

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

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

Sorry, по статусу редирект не распознать.
Просто выдаётся заголовок

Код


Location: http://microsoft.com/wheretogo.html

-------------
Всё проще.

Цитата(LWP::UserAgent.pm)

    $ua->redirect_ok
        This method is called by request() before it tries to do any
        redirects. It should return a true value if a redirect is allowed to
        be performed. Subclasses might want to override this.

        The default implementation will return FALSE for POST request and
        TRUE for all others.

Так что: если не нужно допускать редиректы, надо каким-то образом переопределить redirect_ok.
Если нужно допускать (по умолчанию для запроса GET), то надо корректировать результирующий URL, см. pod для HTTP::Response, про $r->base.

shamber

Дата 19.1.2007, 12:48 (ссылка)

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

Загрузка ...

Эксперт

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

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

trigger, По поводу POE.
Штучка позволяет организовывать многопоточность.
Здесь находится описание и инфа на английском языке

P.S. слажал

Это сообщение отредактировал(а) shamber - 19.1.2007, 13:46

trigger

Дата 19.1.2007, 12:49 (ссылка)

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

Загрузка ...

Шустрый

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

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

первый этап

Код


# ---------------------------
# get_links
# ---------------------------
 sub get_links {
        my ($content,$siteid,$url) = @_;
                while ($content =~ m{<\s*?A[^>]*?HREF\s*?=\s*?["'](.+?)['"][^>]*?>.*?<\s*?/A\s*?>}smig) { # забираем ссылку типа /doc/item.html
                my $fool_url = $url.$1;    # на этом этапе $url - имеет вид http://somehost.com и к ниму конкатенируем /doc/item.html в $1

# тут подробнее
# в момент первого коннкта к ресурсу сам а ссылка вида http://somehost.com в базу не заносится, если есть ссылка вида "/" она забирается
# в $1 и потом только заносится в базу в виде http://somehost.com/
# строки 63-72 - ниже показано
#
#
#
#
#
                        foreach ($fool_url) { 
                        next if $fool_url !~ m{$url/}; # проверяем $fool_url - если имеет ссылку типа  http://somehost.com/ пропускаем 
                        my $double=$url."http"; 
                        next if $fool_url =~ m{$double}; # если в ссылке присутствует полный урл тоже пропустить
                        next if $fool_url =~ m/mailto|.css|.ico|.gif|.jpe?g|JavaScript|.png|.js|.zip|.rar|.gz|.exe|.com|.swf|.xml|.mp3|.ra|.bmp|.avi|.pdf|.doc|.rtf|.ppt|.pps/;
                        my $sth = $dbh->do("INSERT IGNORE INTO  pull(sitesID,url,status) VALUES ('$siteid','$fool_url','1')");
                        # и занести ее в базу
                        }
                }
}

второй этап

Код


# ---------------------------
# parse_base_links
# ---------------------------
sub parse_for_links{
        # выбираем одну строку со статусом 2
        my $get = "SELECT p.ID AS ID, p.url AS url, p.temp_content AS temp_content, p.status, p.sitesID AS sitesID, s.url AS main_url
                                                FROM pull p, sites s 
                                                                WHERE status=2 AND p.sitesID = s.ID
                                                                                ORDER BY ID LIMIT 1";
        my $sth = $dbh->prepare($get);    
        $sth -> execute ();
        
        if (my $row = $sth->fetchrow_hashref()){
                # присваиваем значения переменным 
                my ($id,$siteid,$url,$content, $status,$main_url) = @$row{'ID','sitesID','url','temp_content','p.status','main_url'};
                
                #
                # произвести проверку на ссылки
                #
                        while ($content =~ m{<\s*?A[^>]*?HREF\s*?=\s*?["'](.+?)['"][^>]*?>.*?<\s*?/A\s*?>}smig){ # забираем ссылку типа    
                        # /doc/item.html
                        my $fool_url = $main_url.$1; # тут теперь содержимое $main_url   имеет вид http://somehost.com и к нему приставляем
                                                                       # значение $1 
                        foreach ($fool_url) {
                        my $double=$main_url."http"; # nt;t проверки
                        next if $fool_url =~ m{$double};
                        next if $fool_url =~ m/mailto|.css|.ico|.gif|.jpe?g|JavaScript|.png|.js|.zip|.rar|.gz|.exe|.com|.swf|.xml|.mp3|.ra|.bmp|.avi|.pdf|.doc|.rtf|.ppt|.pps/;
                        #print "find new $fool_url\n";
                                        if ($fool_url){
                                        # опять инсерт
                                        my $sth = $dbh->do("INSERT IGNORE INTO  pull(sitesID,url,status) VALUES ('$siteid','$fool_url','1')");
                                        }
                                }
                        }
                #
                # произвести проверку на ссылки
                #              
                #    а теперь поменять статус - тоесть пометить как отработанную строку  
                $sth = $dbh->do("UPDATE IGNORE pull SET status=3 WHERE ID=$id" );
                }
        }

строки 63-72

Код


        # теперь сделать запрос на состояние ответа

# это каца лишнее - проверю позже 
                my $ua = LWP::UserAgent->new;


                my $resp = $ua->get("$url");  # создать запрос

# тут используется HTTP::Response; для получения ответа от сервака        
my $content = $resp->content(); # получить контент в буфер
my $status = $resp->status_line(); # полчуить ответ вида 200 ОК
            
                        if ($status =~m/200/){
                                print "have answer from server $status\n";
                # тогда выбрать из контента ссылки и занести их в базу
                get_links ($content,$siteid,$url); #  из того что в буфере забрать ссылки и занести в базу

Добавлено @ 12:56
shamber огромное спасибо - пошел читать

JAPH я понял нимного огромное спасибо - пошел вникать.

к логике замечаний нет? smile

да кстати в таблице pull отсутствует temp_content - колонка для полного контента

Это сообщение отредактировал(а) trigger - 19.1.2007, 13:01

JAPH

Дата 19.1.2007, 13:03 (ссылка)

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

Загрузка ...

Опытный

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

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

shamber, моя опера по этой ссылке выдаёт "Невозможно найти удалённый сервер". Что-то тут не то.

shamber

Дата 19.1.2007, 13:47 (ссылка)

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

Загрузка ...

Эксперт

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

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

JAPH, Исправил..... com и org перепутал

Это сообщение отредактировал(а) shamber - 19.1.2007, 13:50

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