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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Жду замечаний и коментариев, сборщик контента 
:(
    Опции темы
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;
PM MAIL WWW ICQ   Вверх
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 
PM MAIL   Вверх
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
PM MAIL ICQ   Вверх
tishaishii
Дата 18.1.2007, 20:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Создатель
***


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

Репутация: 4
Всего: 8
Ну, стандарт не предусматривает теги с пробелом после "<", если, конечно, не создан свой како-то не стандартный парсер.
А, вообще, думаю, Perl для нормального поисковика не сгодится. Пиши, хотя бы, на Ц.
PM MAIL ICQ Skype   Вверх
trigger
Дата 18.1.2007, 22:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
Спасибо за проявленое внимание - прочитаю вникну и чуток позже аргументирую некоторые действия
PM MAIL WWW ICQ   Вверх
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
PM MAIL ICQ   Вверх
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
PM MAIL WWW ICQ   Вверх
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;
PM MAIL ICQ   Вверх
trigger
Дата 19.1.2007, 11:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

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

тогда что касаемо доменов как microsoft.com там редирект идет  подскажите 
пожалуйста 
PM MAIL WWW ICQ   Вверх
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, означающий редирект? Счас почитаю, подправлю.
PM MAIL ICQ   Вверх
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.
PM MAIL ICQ   Вверх
shamber
Дата 19.1.2007, 12:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

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

P.S. слажал

Это сообщение отредактировал(а) shamber - 19.1.2007, 13:46
PM MAIL Jabber   Вверх
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
PM MAIL WWW ICQ   Вверх
JAPH
Дата 19.1.2007, 13:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
shamber, моя опера по этой ссылке выдаёт "Невозможно найти удалённый сервер". Что-то тут не то.
PM MAIL ICQ   Вверх
shamber
Дата 19.1.2007, 13:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 17
Всего: 18
JAPH,  Исправил..... com и org перепутал

Это сообщение отредактировал(а) shamber - 19.1.2007, 13:50
PM MAIL Jabber   Вверх
JAPH
Дата 19.1.2007, 14:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Ух ты! Рискнул, запустил, работает!!!
Только вот появились вопросы:
1. что такое code, size, begin, end_p в таблице pull? В них 0 и всё.
2. чё-то у меня не заработал $ua->get. Так что строки 65 и 104 заменились на
Код

my $resp    = $ua -> request(HTTP::Request->new('GET', $url));
my $content = $ua -> request(HTTP::Request->new('GET', $url)) -> content;


Пока что тестирование получилось неполным, поскольку подопытный сайт содержит только одну абсолютную ссылку, остальные относительные smile. Их сознательно игнорируем или переделывать будем? smile 
После создания относительных будет главный тест - на "скрипты с хвостом". С разными хвостами. Их проходить все поголовно или как-то отсеивать (UNIQUE тут уже не поможет)? smile  smile 




--------------------
perldoc perlstyle


Это сообщение отредактировал(а) JAPH - 19.1.2007, 15:13
PM MAIL ICQ   Вверх
trigger
Дата 19.1.2007, 16:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
Цитата(JAPH @  19.1.2007,  14:51 Найти цитируемый пост)
Их сознательно игнорируем или переделывать будем? smile 


однозначно - потому как в основном это ссылки на другие сайты а в некоторых случаях и на внутренние - ну а внутренние мы итак найдем


Цитата(JAPH @  19.1.2007,  14:51 Найти цитируемый пост)
После создания относительных будет главный тест - на "скрипты с хвостом". С разными хвостами. Их проходить все поголовно или как-то отсеивать (UNIQUE тут уже не поможет)? smile  smile 


непонял вопроса




Цитата(JAPH @  19.1.2007,  14:51 Найти цитируемый пост)
1. что такое code, size, begin, end_p в таблице pull? В них 0 и всё.


ну а это для работы - другие параметры даты размеры ответы

JAPH кстати можно глянуть на то что вы с правками внесли ато пока нет времени добраться до того что я написал и внести правки?
PM MAIL WWW ICQ   Вверх
JAPH
Дата 19.1.2007, 17:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Хм, странно. Представить не могу, как относительная ссылка (вроде "lib/main.php?page=4") приведёт на другой сайт. smile 
Хвостом я назвал параметры в URI - всё, начиная с "?" включительно.

Пока вот что получилось:
Код

#!/usr/bin/perl -w
use strict; use warnings;
use DBI qw(:sql_types);
use LWP::UserAgent;
use HTTP::Response;
my $host = "localhost";
my $base = "amonitoring";
my $dsn = "dbi:mysql:opit"; #Подправьте!!
my $dbh = DBI -> connect($dsn, "root", "", {PrintError => 0, RaiseError => 1});
print "Enter your 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 `ID`, `url`, `name` FROM sites ORDER BY id};
    my $sth = $dbh -> prepare($stmt);
    $sth -> execute();
    $sth -> bind_columns(\(my ($id, $url, $name))); #Это имеет смысл делать, если в результате более одной записи
    while (my $row = $sth -> fetchrow_hashref()) { #С каждым кандидатом:
        print "Processing: $url\n"; #Отладочное, покажет процесс
        my $siteid = $id;
        my $ua = LWP::UserAgent -> new;
        my $resp = $ua -> request(HTTP::Request -> new('GET', $url)); #Пытаемся получить контент
        my $content = $resp -> content();
        my $status = $resp -> status_line();
        if ($status =~ /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()) {
                    my ($siteid, $status, $id, $url) = @$row{'siteID', 'status', 'ID', 'url'};
                    get_content($id, $url); #Берём контент
                    parse_for_links() #И из него выдёргиваем ссылки, добавляя их со статусом 1
                } else { $mark = 0 }
            }
        } elsif ($status =~ /500/) { print "$url CLOSED" }
    }
} else {
    # сделать что-то неприличное
    # например, ничего не сделать
}
sub get_content { #Запрашивает контент по адресу $_[1] и заносит его в базу в строку, определяемую $_[0]
    my ($id, $url) = @_;
    if ($url) {
        my $ua = LWP::UserAgent -> new;
        my $content = $ua -> request(HTTP::Request -> new('GET', $url)) -> content;
        #quote убрана ввиду того, что prepare-execute само экранирует всё нужное.
        #Поэкспериментируйте, скажите, что лучше. Я всегда пользуюсь этим вариантом
        my $sth = $dbh -> prepare("UPDATE pull SET temp_content=?, status=2 WHERE ID=?");
        $sth -> execute($content, $id)
    }
}
sub get_links { #Выбирает ссылки из $_[0], заносит их в базу
    my ($content, $siteid, $url) = @_;
    while ($content =~ m{<\s*A[^>]*?HREF\s*?=\s*?["']?([^>'"\s]+)}sig) {
        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:|^javascript:|^http://.*?/.*?(\.css|\.ico|\.gif|\.jpe?g|\.png|\.js|\.zip|\.rar|\.gz|\.exe|\.com|\.swf|\.xml|\.mp3|\.ra|\.bmp|\.avi|\.pdf|\.doc|\.rtf|\.ppt|\.pps)(\?.*)?$}i;
            my $sth = $dbh -> prepare("INSERT IGNORE INTO pull(sitesID, url, status) VALUES (?, ?, 1)");
            $sth -> execute($siteid, $fool_url)
        }
    }
}
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]+)}sig){
            my $fool_url = $main_url.$1;
            foreach ($fool_url) {
                next if $fool_url !~ m{$url/};
                my $double = $main_url."http";
                next if $fool_url =~ m{$double};
                next if $fool_url =~ m{^mailto:|^javascript:|^http://.*?/.*?(\.css|\.ico|\.gif|\.jpe?g|\.png|\.js|\.zip|\.rar|\.gz|\.exe|\.com|\.swf|\.xml|\.mp3|\.ra|\.bmp|\.avi|\.pdf|\.doc|\.rtf|\.ppt|\.pps)(\?.*)?$}i;
                print "Found new: $fool_url\n"; #Наверно, отладочное, но хоть процесс виден
                if ($fool_url) {
                     my $sth = $dbh -> prepare("INSERT IGNORE INTO  pull(sitesID,url,status) VALUES (?, ? ,1)");
                     $sth -> execute($siteid, $fool_url)
                }
            }
        }
        #а теперь поменять статус - то есть пометить как отработанную строку
        $sth = $dbh -> prepare("UPDATE IGNORE pull SET status=3 WHERE ID=?");
        $sth -> execute($id)
    }
}


Это сообщение отредактировал(а) JAPH - 19.1.2007, 17:29
PM MAIL ICQ   Вверх
trigger
Дата 19.1.2007, 17:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
Цитата(JAPH @  19.1.2007,  17:20 Найти цитируемый пост)
Хм, странно. Представить не могу, как относительная ссылка (вроде "lib/main.php?page=4") приведёт на другой сайт. smile 
Хвостом я назвал параметры в URI - всё, начиная с "?" включительно.

я чето ступил имел ввиду то что чужие урлы откидывать и внутренние но полные

"?"  кажеца съедал все ссылки - тока не помню где тестил 


За примерчик спасибо
prepare - кажеца строка добавляется , но используя do добавляется две smile

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

и подумаю над алгоритмом сбора редиректов - интересно капец - но уже дома
PM MAIL WWW ICQ   Вверх
trigger
Дата 19.1.2007, 18:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
извиняюсь за бред.

я понял о чем речь относительно "?" 
действительно это станет  проблемой в случаях подмены контента по url-у и тогда документ утратит свою уникальную ссылку 
что не редко встречается взять даже fishki.net
придется поломать голову хотя должен же быть какойто алгоритм - узнаю.
PM MAIL WWW ICQ   Вверх
JAPH
Дата 19.1.2007, 20:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Реализовал поддержку относительных ссылок. Скрипт стал короче на 13 строк smile
Но
  • пришлось изменить формат ввода по add: надо добавлять корректный адрес, пусть даже http://localhost/, то есть он обязан содержать 3 слэша. Иначе начинается вереница ошибок 400 Bad Request.
  • Кроме того, если документ недоступен (404, 403, сервер перегружен и т.п.), нужно помечать такие url статусом 4, иначе цикл while($mark) никогда не закончится.
  • Что касается адресов с хвостами (?PHPSESSID=2135f25hd&param=4#entry28), скрипт тупо считает их как разные документы (то есть осталось единственное ограничение по UNIQUE). - TODO
  • Изменился третий параметр get_links, чтоб её можно было применить в parse_for_links. Он теперь требует адрес ресурса, в котором находятся обрабатываемые им ссылки.
  • С учётом алгоритма отсева ссылок (get_links), я думаю, поле main_url становится ненужным.
Так что вот версия. Тестируем, выводим жуков. smile
Код

#!/usr/bin/perl -w
use strict; use warnings;
use DBI qw(:sql_types);
use LWP::UserAgent;
use HTTP::Response;
my $dbh = DBI -> connect("dbi:mysql:opit", "root", "", {PrintError => 0, RaiseError => 1});
print "Enter your command: ";
chomp(my $choice = <STDIN>);
if ($choice eq "add") { #Добавление сайта - кандидата на обыск
    print "Do index for: ";
    chomp(my $add_url = <STDIN>);
    print "Added $add_url\n";
    $dbh -> do("INSERT INTO sites (url) VALUES (?)", {}, $add_url)
} elsif ($choice eq "check") { #Собственно обыск
    my $sth = $dbh -> prepare("SELECT `ID`, `url`, `name` FROM sites ORDER BY id");
    $sth -> execute();
    $sth -> bind_columns(\(my ($id, $url, $name)));
    while (my $row = $sth -> fetchrow_hashref()) { #С каждым кандидатом:
        my $siteid = $id;
        #Пытаемся получить контент
        my $resp = LWP::UserAgent -> new -> request(HTTP::Request -> new('GET', $url));
        my $content = $resp -> content();
        my $status = $resp -> status_line();
        print "Trying GET $url: $status\n";
        if ($status =~ /200/) { #Если удачно
            #то выбрать из контента ссылки и занести их в базу
            get_links($content, $siteid, $url);
            #Теперь пройдёмся по ссылкам на этом сайте
            my $mark = 1;
            while ($mark) { #Пока не кончатся необработанные ссылки
                my $sth = $dbh -> prepare("SELECT * FROM pull WHERE status='1' ORDER BY ID LIMIT 1");
                $sth -> execute();
                if ($row = $sth -> fetchrow_hashref()) {
                    my ($siteid, $status, $id, $url) = @$row{'siteID', 'status', 'ID', 'url'};
                    get_content($id, $url); #Берём контент
                    parse_for_links() #И из него выдёргиваем ссылки, добавляя их со статусом 1
                } else { $mark = 0 }
            }
        }
    }
} else {
    # сделать что-то неприличное
    # например, ничего не сделать
}
sub get_content { #Запрашивает контент по адресу $_[1] и заносит его в базу в строку, определяемую $_[0]
    my ($id, $url) = @_;
    if ($url) { # НУЖНА ЛИ ЭТА ПРОВЕРКА?
        my $req = LWP::UserAgent -> new -> request(HTTP::Request -> new('GET', $url));
        my $st = $req -> status_line();
        print "Trying GET $url: $st\n";
        if ($st =~ /200/) {
            my $sth = $dbh -> prepare("UPDATE pull SET temp_content=?, status=2 WHERE ID=?");
            $sth -> execute($req -> content(), $id)
        } else { #При ошибке меняем статус на 4, чтоб не возвращаться к левым ссылкам бесконечно
            my $sth = $dbh -> prepare("UPDATE pull SET status=4 WHERE ID=?");
            $sth -> execute($id)
        }
    }
}
sub get_links { #Выбирает ссылки из $_[0], заносит их в базу. ВНИМАНИЕ! Требует URL РЕСУРСА, А НЕ ИМЯ САЙТА!
    my ($content, $siteid, $url) = @_;
    while ($content =~ m{<\s*A[^>]*?HREF\s*?=\s*?["']?([^>'"\s]+)}sig) {
        my $fool_url = $1;
        next if $fool_url =~ m{^mailto:|^javascript:}i; #Если вовсе не ссылка
        next if $fool_url =~ m{^http://}i; #Нет полным ссылкам
        if (substr($fool_url, 0, 1) eq '/') { #Если абсолютная ссылка
            $fool_url = ($url =~ m{^(http://.*?)/})[0] . $fool_url #Цепляем имя сайта
        } else { #Если относительная
            $fool_url = ($url =~ m{^(http://.*/)})[0] . $fool_url #Цепляем всё, кроме имени файла
        }
        next if $fool_url =~ m{^http://.*?/.*?(\.css|\.ico|\.gif|\.jpe?g|\.png|\.js|\.zip|\.rar|\.gz|\.exe|\.com|\.swf|\.xml|\.mp3|\.ra|\.bmp|\.avi|\.pdf|\.doc|\.rtf|\.ppt|\.pps)(\?.*)?$}i;
        print "Got a new: $fool_url\n"; #Отладочное, посмотреть, что тут творится
        my $sth = $dbh -> prepare("INSERT IGNORE INTO pull(sitesID, url, status) VALUES (?, ?, 1)");
        $sth -> execute($siteid, $fool_url)
    }
}
sub parse_for_links { #Выбирает ссылки из контента, хранящегося в базе
    my $sth = $dbh -> prepare("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");
    $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'};
        get_links($content, $siteid, $url); #Выбрать ссылки
        #и поменять статус на 3, то есть пометить строку, как обработанную
        $sth = $dbh -> prepare("UPDATE IGNORE pull SET status=3 WHERE ID=?");
        $sth -> execute($id)
    }
}


Это сообщение отредактировал(а) JAPH - 19.1.2007, 21:12
PM MAIL ICQ   Вверх
trigger
Дата 21.1.2007, 02:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
поясните пожалуйста следующие строки на пальцах.  
как работает смещение - не врублюсь чета?

Код

#......

        if (substr($fool_url, 0, 1) eq '/') { #Если абсолютная ссылка
            $fool_url = ($url =~ m{^(http://.*?)/})[0] . $fool_url #Цепляем имя сайта
        } else { #Если относительная
            $fool_url = ($url =~ m{^(http://.*/)})[0] . $fool_url #Цепляем всё, кроме имени файла
        }
#......



относительно жуков:
глотает ссылки типа 
../main.html 
../dor/main.html
../../dor/main.html

потом как пример есть и такое:
есть домен http://somehost/
http://somehost/data/main.html  - сюда приводит редирект
http://somehost/data/wheather.html  - реальная страница(раздел) - забирается в базу
но в тотже момент -
http://somehost/wheather.html тоже туда попадает - и статус 4 ей обеспечен
PM MAIL WWW ICQ   Вверх
JAPH
Дата 21.1.2007, 09:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

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

Глотает ссылки типа ../адрес

Работает он с ними корректно, проблемы начнутся, когда в документах есть ссылки друг на друга вроде pages/p1.html и ../index.html. Он будет бесконечно по ним бегать.
Поэтому надо убирать такие ссылки. Добавьте после выделенного вами участка (строки 66-70)
Код

        1 while $fool_url =~ s</[^/]+/\.\./></>;


Что касается самих этих строк, то работают они так:
$fool_url до них имеет вид либо "pages/p1.html", либо "/site/index.html". Поэтому различить относительные и абсолютные ссылки можно по первому символу, что и делает строка 66.

Далее, если это абсолютная ссылка, то к ней нужно присобачить только имя сайта без завершающего слэша (http://somesite).
Поэтому к URL применяется ^http://.*?/
Работает он так:
сначала отыскивается http://,
затем .*? лениво цепляет к найденному по одному символу до тех пор, пока не удастся дойти до слэша.
Как только находится слэш, поиск успешно завершается. Он всегда успешен, так как в URL всегда хотя бы 3 слэша.
Далее, из найденного ^(http://.*?)/ выделяет имя сайта без завершающего слэша;
поиск производится в списковом контексте, (m{^(http://.*?)/}), поэтому возвращается список вроде ("http://somesite"), из которого выделяется найденная строка (m{^(http://.*?)/})[0], чтоб её присоединить к fool_url.

Если ссылка относительная, то делается ^(http://.*/), что приводит к тому, что
сначала отыскивается http://,
затем .* жадно съедает весь остаток строки,
затем "маленькая машинка" видит, что нужен слэш, но от строки ничего не осталось; поэтому звёздочку заставляют отдавать по одному символу до тех пор, пока не удастся "выбить" слэш. Так что совпадение будет примерно таким - "http://somesite/path/" или "http://somesite/".
Найденное по тому же принципу присоединяется к fool_url.

Теперь, что касается последнего примера. Поподробнее можно? Какие ссылки были в документах, на которых вы тестировали? smile 
Что выводил скрипт?

Это сообщение отредактировал(а) JAPH - 21.1.2007, 09:26
PM MAIL ICQ   Вверх
JAPH
Дата 21.1.2007, 10:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Получилось воссоздать ошибку при редиректах. Подправил get_content, теперь вроде нормально. Смотрим:
Код

sub get_content {
    my ($id, $url) = @_;
    if ($url) {
        my $req = LWP::UserAgent -> new -> request(HTTP::Request -> new('GET', $url));
        my $st = $req -> status_line();
        print "Trying GET $url: $st\n";
        print "This BASE: " . $req -> base() . "\n"; #Показываем адрес документа после всех редиректов
        if ($st =~ /200/) { #Если документ удалось получить,
            #то в базе нужно подправить адрес на тот, где он (документ) действительно расположен
            my $sth = $dbh -> prepare("UPDATE pull SET temp_content=?, status=2, url=? WHERE ID=?");
            $sth -> execute($req -> content(), $req -> base(), $id)
        } else {
            my $sth = $dbh -> prepare("UPDATE pull SET status=4 WHERE ID=?");
            $sth -> execute($id)
        }
    }
}
PM MAIL ICQ   Вверх
JAPH
Дата 21.1.2007, 12:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Некоторые скрипты вполне могут уходить в бесконечный цикл, так что получить контент от них возможно дня через три smile . Нужно делать таймаут.
Получилось упростить логику работы скрипта.
Кстати, то, что главная страница не сохраняется в pull.temp_content, это так надо?
Полная версия:
Код

#!/usr/bin/perl -w
use strict; use warnings;
use DBI qw(:sql_types);
use LWP::UserAgent;
use HTTP::Response;
my $dbh = DBI -> connect("dbi:mysql:opit", "root", "", {PrintError => 0, RaiseError => 1});
print "Enter your command: ";
chomp(my $choice = <STDIN>);
if ($choice eq "add") {
    print "Do index for: ";
    chomp(my $add_url = <STDIN>);
    print "Added $add_url\n";
    $dbh -> do("INSERT INTO sites (url) VALUES (?)", {}, $add_url)
} elsif ($choice eq "check") {
    $dbh -> do("INSERT IGNORE INTO pull(sitesID, url, status) SELECT `ID`, `url`, 1 FROM sites");#Пересылаем нужные сайты в таблицу pull, помечая ссылки на их главные страницы статусом 1
    my $mark = 1;
    while ($mark) {
        my $sth = $dbh -> prepare("SELECT * FROM pull WHERE status='1' ORDER BY ID LIMIT 1");
        $sth -> execute();
        if (my $row = $sth -> fetchrow_hashref()) {
            my ($siteid, $status, $id, $url) = @$row{'siteID', 'status', 'ID', 'url'};
            get_content($id, $url);
            parse_for_links()
        } else { $mark = 0 }
    }
}
sub get_content {
    my ($id, $url) = @_;
    (my $ua = LWP::UserAgent -> new) -> timeout(1); #Ставим таймаут (1 секунда)
    my $req = $ua -> request(HTTP::Request -> new('GET', $url));
    my $st = $req -> status_line();
    print "Trying GET $url: $st\n";
    print "This BASE: " . $req -> base() . "\n";
    if ($st =~ /200/) {
        my $sth = $dbh -> prepare("UPDATE pull SET temp_content=?, status=2, url=? WHERE ID=?");
        $sth -> execute($req -> content(), $req -> base(), $id)
    } else {
        my $sth = $dbh -> prepare("UPDATE pull SET status=4 WHERE ID=?");
        $sth -> execute($id)
    }
}
sub parse_for_links {
    my $sth = $dbh -> prepare("SELECT p.ID AS ID, p.url AS url, p.temp_content AS temp_content, p.status AS status, p.sitesID AS sitesID FROM pull p, sites s WHERE p.status=2 AND p.sitesID = s.ID ORDER BY ID LIMIT 1");
    $sth -> execute();
    if (my $row = $sth -> fetchrow_hashref()) {
        my ($id, $siteid, $url, $content, $status) = @$row{'ID', 'sitesID', 'url', 'temp_content', 'status'};
        get_links($content, $siteid, $url);
        $sth = $dbh -> prepare("UPDATE pull SET status=3 WHERE ID=?");
        $sth -> execute($id)
    }
}
sub get_links {
    my ($content, $siteid, $url) = @_;
    while ($content =~ m{<\s*A[^>]*?HREF\s*?=\s*?["']?([^>'"\s]+)}sig) {
        my $fool_url = $1;
        next if $fool_url =~ m{^mailto:|^javascript:|^http:}i;
        if (substr($fool_url, 0, 1) eq '/') { $fool_url = ($url =~ m{^(http://.*?)/})[0] . $fool_url }
        else { $fool_url = ($url =~ m{^(http://.*/)})[0] . $fool_url }
        1 while $fool_url =~ s#/[^/]+/\.\./#/#;
        next if $fool_url =~ m{^http://.*?/.*?(\.css|\.ico|\.gif|\.jpe?g|\.png|\.js|\.zip|\.rar|\.gz|\.exe|\.com|\.swf|\.xml|\.mp3|\.ra|\.bmp|\.avi|\.pdf|\.doc|\.rtf|\.ppt|\.pps)(\?.*)?$}i;
        print "Got a new: $fool_url\n";
        my $sth = $dbh -> prepare("INSERT IGNORE INTO pull(sitesID, url, status) VALUES (?, ?, 1)");
        $sth -> execute($siteid, $fool_url)
    }
}
PM MAIL ICQ   Вверх
trigger
Дата 21.1.2007, 17:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

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

приветствую JAPH
Цитата(JAPH @  21.1.2007,  12:49 Найти цитируемый пост)
Кстати, то, что главная страница не сохраняется в pull.temp_content, это так надо?


такова была лоогика в самом начале - выдрать с первой все ссылки и занести в базу- а потом цыклический обход каждой и сбор контента 
в этот момент получалось что когда формировались ссылки конкатенацией основного url сайта с тем что сохранялось в $1 - вот и получалась что первая страница (ссылка) готова и на втором этапе из нее брался контент - тоесть  относительно игнорировалось содержимое первой страницы- при первом заходе интересовали только новые ссылки.

теперь что касается предыдущего вопроса
Цитата(JAPH @  21.1.2007,  09:16 Найти цитируемый пост)
Теперь, что касается последнего примера. Поподробнее можно? Какие ссылки были в документах, на которых вы тестировали? smile 
Что выводил скрипт?


как пример брался www.korrespondent.net - хотя я не проверял сейчас работу скрипта то может это уже не актуально ?
PM MAIL WWW ICQ   Вверх
JAPH
Дата 21.1.2007, 17:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Но ведь не зря контент всех остальных страниц сохраняется? Наверняка потом из него будет выдёргиваться нечто, чтоб помещать в другие таблицы. А главная чем хуже?

Скрипт уже адекватно реагирует на редиректы (надеюсь). Проверьте smile 
PM MAIL ICQ   Вверх
trigger
Дата 21.1.2007, 17:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
 хм - вот тут редирект не поймал  smile 
www.umj.com.ua

Enter your command: check
www.umj.com.ua/:500 read timeout
www.umj.com.ua/arhiv/56/index.php

Цитата(JAPH @  21.1.2007,  17:23 Найти цитируемый пост)
Но ведь не зря контент всех остальных страниц сохраняется? Наверняка потом из него будет выдёргиваться нечто, чтоб помещать в другие таблицы. А главная чем хуже?


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

Это сообщение отредактировал(а) trigger - 21.1.2007, 17:44
PM MAIL WWW ICQ   Вверх
JAPH
Дата 21.1.2007, 18:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Обычно на первой странице в заголовках, кратких описаниях и т.п. говорится, о чём сайт в целом, так что там много терминов, ключевых слов, про которые рассказывает сайт.

По поводу ошибки с редиректом - ну не стал скрипт ждать, пока ему отдадут страницу. Увеличьте время таймаута в строке 29 до 5 секунд (стандартное).

========
Плюс ко всему, у меня нет возможности тестировать скрипт на файлах из интернета - доступ платный. Так что я надеюсь на вас, чтоб вы проверяли его работоспособность в реальных условиях, а также, при ошибках, приводили хотя бы релевантный html-код страниц, если исходный php/... недоступен. Я по этим данным пытаюсь воспроизвести ошибку на локалхосте, и уже в домашних условиях лечу скрипт.
Кстати, выводы-то поставлены специально, чтоб понимать, где ошибка. Скрипт же вывел - read timeout! smile

Это сообщение отредактировал(а) JAPH - 21.1.2007, 18:33
PM MAIL ICQ   Вверх
nitr
Дата 21.1.2007, 21:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 37
Всего: 84
Люди, а не вилосипед ли делаете (с извлечением ссылок), модули для того и пишутся...
к примеру HTML::LinkExtor
( HTML::LinkExtractor )
HTML::TokeParser
HTML::Tagset

Можно и др. парсеры найти ;) (пакет HTML::Parser)


--------------------
user posted image
user posted image
I love ArchLinux
PM   Вверх
trigger
Дата 21.1.2007, 22:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
Цитата(JAPH @  21.1.2007,  18:05 Найти цитируемый пост)
Обычно на первой странице в заголовках, кратких описаниях и т.п. говорится, о чём сайт в целом, так что там много терминов, ключевых слов, про которые рассказывает сайт.


первая страница в любом случае берется тем более что это не столь важно что там в title и keyword.
по поводу трафика я уже съел его весь smile - по сему завтра натравлю его на рабочую локаль и сообщу если что. 

nitr
да виласипет ну и что smile  - мне было интересно самому сделать
грабер - сделал но кривовато вот JAPH (Just another perl hacker) и подключился - может ему самому интересно

Это сообщение отредактировал(а) trigger - 21.1.2007, 22:23
PM MAIL WWW ICQ   Вверх
JAPH
Дата 21.1.2007, 22:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
=for offtop
nitr, ну предложите не велосипед. За что народ ни берётся - всё уже сделано до нас. Так всякую охоту что-либо делать отобьёте.
Кроме того, то, что написано собственноручно, просто и понятно. А вот попробуйте растолковать, что да зачем в этих модулях делается? Вот меня интересует вопрос - как DBI.PM умудряется обмениваться данными с MySQL, где конкретно это происходит? (Может, создать отдельную тему, расскажете?)

trigger, it's really interesting. Всё жду, когда предложите, что делать с параметрами. Так и оставить, пусть бегает по всевозможным ссылкам? Или ограничиться одной такой?
Была бы возможность просто стащить исходный код такого скрипта, да вот только не получится.
PM MAIL ICQ   Вверх
nitr
Дата 21.1.2007, 23:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 37
Всего: 84
JAPH, dbi.perl.org, а работает он по средствам "драйверов" (DBD).
Цитата
А вот попробуйте растолковать, что да зачем в этих модулях делается?

Открой модуль - прочти smile Я ничего сложного в этом не нахожу. Да и практически все они написаны неплохо, читабельные.

Я ж не против того чем вы заняты. Это совет! Думаю неплохой ;)

Добавлено @ 23:25 
Цитата
Так всякую охоту что-либо делать отобьёте.

Не хорошо думаете ;)

Просто я прочёл про перекрестные ссылки у вас выше smile Можно хешем... но неплохо будет использовать модули.

з.ы.: Не буду более вам мешать. моё дело посоветовать решение проблемы (в случае ссылок), ну а ваше...


--------------------
user posted image
user posted image
I love ArchLinux
PM   Вверх
Nab
Дата 22.1.2007, 00:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 26
Всего: 37
Вот как много написали... smile
Читаю и удивляюсь....

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

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

Но по крайней мере глупо игнорировать миллионы человеко-часов потраченные на разработку модулей...
Когда у вас будет серьезный проект для которого необходимо будет решение целой кучи задач очень разных, то написание всего на pure Perl, без использования модулей отобъет у заказчика желание дожидаться результата smile

Кстати а зачем вы испльзуете LWP? почему не работаете на прямую с сокетами?
Я вот знаю nitr этим страдает smile но у него задача была иная и в LWP она не решалась, хотя всего один нюансик не работал, но делает он это сам просто от того, что готового решения нет...

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




--------------------
 Чтобы правильно задать вопрос нужно знать больше половины ответа...
Perl Community 
FREESCO in Ukraine 
PM MAIL   Вверх
nitr
Дата 22.1.2007, 00:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 37
Всего: 84
Цитата(Nab @  22.1.2007,  00:05 Найти цитируемый пост)
Но по крайней мере глупо игнорировать миллионы человеко-часов потраченные на разработку модулей...Когда у вас будет серьезный проект для которого необходимо будет решение целой кучи задач очень разных, то написание всего на pure Perl, без использования модулей отобъет у заказчика желание дожидаться результата smile

Именно, да и ещё занимаются продвижением смоих модулей, поддержкой. И есть люди помогающие им и т.п.

Извините, если посчитали оффтопом.

Цитата
Кстати а зачем вы испльзуете LWP? почему не работаете на прямую с сокетами?
Я вот знаю nitr этим страдает smile но у него задача была иная и в LWP она не решалась, хотя всего один нюансик не работал, но делает он это сам просто от того, что готового решения нет...

Да, но к сожалению. В принципе можно использовать HTTP::Response, HTTP::Request и URI::*

В таких случаях я пиши своё. Ну или так называемые надработки smile

З.Ы.: Всё на это мой совет исчерпан smile Спасибо, ну и извините, если не помог ;)


--------------------
user posted image
user posted image
I love ArchLinux
PM   Вверх
JAPH
Дата 22.1.2007, 10:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Nab, я, конечно, согласен, что игнорировать CPAN не стоит, но это когда действительно нужно будет сделать нечто ограниченное по времени. А пока программирование есть хобби, имхо можно и позаниматься "велостроительством".
PM MAIL ICQ   Вверх
trigger
Дата 22.1.2007, 17:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
 smile  наслушались критики спасибо всем 

1.если знать только модули (не спорю нужны) 
а не знать как работает - далеко уйдем ?

2. никто ничего не продвигает сдесь
Цитата(nitr @  22.1.2007,  00:13 Найти цитируемый пост)
Именно, да и ещё занимаются продвижением смоих модулей, поддержкой. И есть люди помогающие им и т.п.

   может стоит обидется ? 
3. советы дельные спасибо конечно 

вот истина 
Цитата(JAPH @  21.1.2007,  22:30 Найти цитируемый пост)
Кроме того, то, что написано собственноручно, просто и понятно. 


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

Былобы великодушно с Вашей стороны  уважаемые критики (осмелюсь назвать вас ГУРУ)  подсказать стоящий с вашей точки зрения алгоритм(ы) и методы его осуществления.

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

такчто слушаим Вас..... smile 

JAPH
не понимаю зачем это нужно  можно в цикле проходить каждый сайт по очереди
и каждый раз заносить первую страницу незачем 
Цитата(JAPH @  21.1.2007,  12:49 Найти цитируемый пост)
 $dbh -> do("INSERT IGNORE INTO pull(sitesID, url, status) SELECT `ID`, `url`, 1 FROM sites");#Пересылаем нужные сайты в таблицу pull, помечая ссылки на их главные страницы статусом 1


ругается сюда на синтакс SQL  при заносе контента 
$sth -> execute($req -> content(), $req -> base(), $id) 

я еще так не тестил сирозно но скрипт отваливается - сори нет времени  пока посмотреть - понедельниг оказался тижолым 
PM MAIL WWW ICQ   Вверх
JAPH
Дата 22.1.2007, 19:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Господи... trigger, расставьте хоть точки в конце каждой мысли! Я так и не понял, что вы имели в виду, говоря
Цитата(trigger @  22.1.2007,  17:18 Найти цитируемый пост)
не понимаю зачем это нужно  можно в цикле проходить каждый сайт по очереди
и каждый раз заносить первую страницу незачем 

Что такое ЭТО? Хоть бы упомянули, о чём речь...
Почему "каждый раз"? Всего один запрос. MySQL его единожды обработает, и никакого цикла не надо. Если можно без цикла, лучше, быстрее, красивее без него. Тем более порядок обхода сайтов не очень-то важен - что сначала все с одного домена, затем с другого, что вперемешку,- всё равно в базе хранится "оптимизированно", т.е. вразброс. Извлекать потом можно по очереди, главную страницу не учитывать (хотя на странице "Ссылки"/"Контакты" тоже не очень-то много полезной информации, но она спокойно забирается и не вызывает возражений smile ).

Что касается ошибки с синтаксисом SQL. Не удалось воспроизвести. smile  Что содержалось на странице? Я пытался вставить кавычку, два минуса подряд, Ctrl+Z, Ctrl+D, Ctrl+C, всё сразу, просто оставить страницу пустой - ну не ругается, и всё! Поконкретнее опишите ситуацию, наставьте print`ов, а ещё лучше пройдитесь отладчиком, если не лень smile. Синтаксис абсолютно корректный (с точки зрения моей MySQL smile я присоединяюсь smile).

=begin offtop
Цитата(trigger @  22.1.2007,  17:18 Найти цитируемый пост)
может стоит обидется ? 

А смысл? Лучше не надо - будем консультироваться по стандартным модулям smile. [Кстати, в них главная страница забирается?  smile ]
Но параллельно писать свои smile.
И называть так же, как стандартные - чтоб никто потом не догадался! smile 
=end offtop
PM MAIL ICQ   Вверх
trigger
Дата 23.1.2007, 02:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
да с точками и запятыми не сложилось smile - извиняюсь 

сначала что непонятно:
1. строка 
$dbh -> do("INSERT IGNORE INTO pull(sitesID, url, status) SELECT `ID`, `url`, 1 FROM sites");
#Пересылаем нужные сайты в таблицу pull, помечая ссылки на их главные страницы статусом 1
Я не могу понять зачем это делать?
1. в таблице pull колонка url имеет UNIQUE атрибут и при добавлении каждый раз одной и тойже ссылки (например http://localhost/) скорее будет выдаваться ошибка или запись проигнорируется (щас сажусь тестить).

поясню как было задумано по действиям.
1. делаем выбор что делать (в данном случае check)
    выбираем допустим один url из таблицы sites 
    проверяем связь с ресурсом а не с базой
    если связь есть - забираем контент и парсим на ссылки.
    Выбрав все ссылки заносим их в базу (там уже находится http://localhost/) первая страница и все остальные.
    потом каждая выбирается и берется контент по каждой ссылке.
    
Предположим у нас проиндексирована часть сайта - ну просто устали ждать.
 и при повторном запуске скрипта делаем INSERT IGNORE INTO pull(sitesID, url, status)   -  база их проигнорирует из-за UNIQUE и возможно выдаст ошибку.

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

Это сообщение отредактировал(а) trigger - 23.1.2007, 03:35
PM MAIL WWW ICQ   Вверх
JAPH
Дата 23.1.2007, 10:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Понял, в чём проблема - два редиректа на один и тот же ресурс. Надо дописать:
Код

$sth -> execute($req -> content(), $req -> base(), $id) or $dbh -> do("DELETE FROM pull WHERE ID=?", {}, $id)

Так, если неудачно выполняется execute (ошибка duplicate key), эта запись удаляется.
Для корректной работы надо в соединении с базой убрать RaiseError => 1.

Описанный вами check-алгоритм как раз и реализуется, только в исходном варианте это было прописано явно, а сейчас это уже труднее заметить.
Почему делается INSERT-SELECT? Потому что изначально предполагается, что сайтами-кандидатами на обыск заполнена только таблица sites, pull при этом пустая. Этот запрос переводит все эти записи в pull, как если бы у нас была страничка из ссылок на нужные сайты.
Проверка на связь с ресурсом, при успехе проход по всем страницам сайта? Проверка идёт, когда из базы выбирается ссылка на этот сайт, занесённая из sites. Если что-то не получилось - нет связи, сервер перегружен, ленивый сервер,...,- то скрипт об этом напишет, пометит ссылку (фактически, целый сайт) статусом 4 и спокойно пойдёт работать с другими сайтами.
Остальное должно быть понятно - оно почти не изменилось.
Кстати, надо бы подумать, в какой момент возвращаться к строкам статуса 4 и возвращать им статус 1. Может, делать их статус = номеру ошибки? (403, 404, 500)

Ещё одно. Как насчёт ссылок вроде "#top"? Моё предложение - удалять такие хвосты.
Код

#...
$fool_url =~ s/#.*$//;
next unless $fool_url;
if (substr($fool_url, 0, 1) eq '/') {
#...
PM MAIL ICQ   Вверх
trigger
Дата 23.1.2007, 10:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
ок щас подставлю и запускаю - огромное спасибо.
Есть предложение!
Во избежание ненужного разростание данной ветки переходить в приват... 
PM MAIL WWW ICQ   Вверх
JAPH
Дата 23.1.2007, 11:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Понял, в чём проблема - два редиректа на один и тот же ресурс. Надо в запрос вставить IGNORE. Проверьте, поможет ли.

Описанный вами check-алгоритм как раз и реализуется, только в исходном варианте это было прописано явно, а сейчас это уже труднее заметить.
Почему делается INSERT-SELECT? Потому что изначально предполагается, что сайтами-кандидатами на обыск заполнена только таблица sites, pull при этом пустая. Этот запрос переводит все эти записи в pull, как

Всё это игнорируем. Не могу понять, как это сообщение появилось, когда меня не было в интернете  smile  Тем более, оно неверно, его нормальная версия выше

Это сообщение отредактировал(а) JAPH - 24.1.2007, 19:42
PM MAIL ICQ   Вверх
trigger
Дата 23.1.2007, 11:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
я понял все прекрасно. 
скрипт работает - запустил час назад.
пока не отвалился smile

Это сообщение отредактировал(а) trigger - 23.1.2007, 11:48
PM MAIL WWW ICQ   Вверх
trigger
Дата 23.1.2007, 16:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
ээээээээээээээээээээээ ... Ну в общем пока все замечательно - тестировал 
для начала на малом проекте - 1700 документов - битые ссылки отловились - заодно и поправились smile

Что касаемо более больших проектов  - 3 000   и   15 000 документов проглотил нормально 
ну а остальные надоело ждать smile

осталось только нормально проверить его на отношение к миру - дома начну проверять на чемто небольшом 
PM MAIL WWW ICQ   Вверх
JAPH
Дата 23.1.2007, 19:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 3
Всего: 23
Удачи! smile Главное, чтоб не "отвалился", тогда можно дальше делать.
Если очень хочется, новой темой.
Но в привате-то зачем? Секреты, что ли? OpenSource smile 
PM MAIL ICQ   Вверх
Страницы: (3) [Все] 1 2 3 
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Perl"
korob2001
sharq
  • В этом разделе обсуждаются общие вопросы по языку Perl
  • Если ваш вопрос относится к системному программированию, задавайте его здесь
  • Если ваш вопрос относится к CGI программированию, задавайте его здесь
  • Интерпретатор Perl можно скачать здесь ActiveState, O'REILLY, The source for Perl
  • Справочное руководство "Установка perl-модулей", можно скачать здесь

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

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


 




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


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

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