Прошу помочь с регекспом

[mkth]

При парсинге имеем код примерно такого содержания

Код:

var fr=''; document.write("iframe='http://somesite.php' id='gfdtrtrtre'></iframe>");
var fr=''; document.write("<iframe src='' id='gfdtrtrtre'></iframe>");
setTimeout("document.getElementById('iframe').src='http://goodsite.ru/php?sid=64564563&sesslid=Gtr216846hgf11'", 30000);

Каким образом можно извлечь урл вида src='http://goodsite.ru/php?sid=64564563&sesslid=Gtr216846hgf11, вывести его на печать...
Очень прошу помочь... Может не обязательно использовать регексп, а обойтись HTML Parser...
 
Таким образом осуществляю запрос

Код:

#!/usr/bin/perl

use LWP::UserAgent;

my $ua = LWP::UserAgent->new;
$ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322)');
$ua->default_header('Referer' => "http://mysite.ru");
$ua->default_header('Accept' => "text/html");
$ua->default_header('Accept-Charset' => "windows-1251,utf-8");

my $response = $ua->get('http://site.com');

if ($response->is_success) {
   print $response->decoded_content;
}
else {
   die $response->status_line;
}

Ответ как-то нужно закинуть в буфер и дальше с ним уже разбираться...
Заранее большое спасибо за помощь!

[RXL]

Например:

Код:

$response->decoded_content =~ m%document\.getElementById\('iframe'\)\.src\s*=\s*'\s*(.*?)\s*'%s;
print "$1\n";

[mkth]

Например:

Код:

$response->decoded_content =~ m%document\.getElementById\('iframe'\)\.src\s*=\s*'\s*(.*?)\s*'%s;
print "$1\n";

Спасибо, че то выдает ошибку

[mkth]

Код:

Use of uninitialized value $1 in concatenation (.) or string at C:\script.pl line 17.

[mkth]

Убрал use warnings, но все равно че то ничего не пашет

[mkth]

Код:

#!/usr/bin/perl

use LWP::UserAgent;

my $ua = LWP::UserAgent->new;
$ua->agent('Opera/9.02 (Windows NT 5.1; U; ru)');
$ua->default_header('Referer' => "http//mysite.ru");
$ua->default_header('Accept' => "text/html");
$ua->default_header('Accept-Charset' => "windows-1251");

my $response = $ua->get('http//site.ru');

if ($response->is_success) {
   $response->decoded_content =~ m%document\.getElementById\('iframe'\)\.src\s*=\s*'\s*(.*?)\s*'%s;
print "$1\n";
}

Исправил, но не выводит ничего все равно, почему то

[McZim]

mkth, а ты уверен что site.ru тебе вернет строку которую ты пытаешься распарсить?

Код:

#!/usr/bin/perl

use strict;
use warnings;
use LWP::UserAgent;

my $ua = LWP::UserAgent->new;

my $req = HTTP::Request->new(GET => 'http://site.com');
$req->header('Accept' => 'text/html');

my $response = $ua->request($req);

if ($response->is_success)
{
   print $response->decoded_content;
}

[RXL]

mkth, у тебя ведь вопрос про регулярное выражение? Так скорми ему текст из первого поста и будет ясно, работает оно или нет.

[mkth]

mkth, у тебя ведь вопрос про регулярное выражение? Так скорми ему текст из первого поста и будет ясно, работает оно или нет.

Да, про регулярное выражение... Но у меня данные берутся в результате запроса, а не из файла

[RXL]

mkth, открою секрет: данные не изменяются от помещения их в файл. Не думаю, что это сложно сделать.

Код:

perl myapp.pl >result.txt

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


Вопрос: какова твоя профессия? Перл давно используешь?

[mkth]

Спасибо, сейчас попробую.  Моя профессия - ремонт и наладка электрического и электромеханического оборудования... А Perl использую около 2-3 месяцев, ну то есть, знания мои в нем - на уровне детского садика... Вот так...

[RXL]

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

Добавлено через 3 минуты и 49 секунд:

Код:

my $test_string = <<<EOF;
var fr=''; document.write("iframe='http://somesite.php' id='gfdtrtrtre'></iframe>");
var fr=''; document.write("<iframe src='' id='gfdtrtrtre'></iframe>");
setTimeout("document.getElementById('iframe').src='http://goodsite.ru/php?sid=64564563&sesslid=Gtr216846hgf11'", 30000);
EOF

if ($test_string =~ m%document\.getElementById\('iframe'\)\.src\s*=\s*'\s*(.*?)\s*'%s)
{
  print "Строка найдена: $1\n";
}
else
{
  print "Строка не найдена.\n";
}

[mkth]

Спасибо, но простейшие запросы я все-таки составлять умею...

[mkth]

Исправил немного, а то в консоли вместо русских символов отображались какие то кракозябры

Код:

my $test_string = <<<EOF;
var fr=''; document.write("iframe='http://somesite.php' id='gfdtrtrtre'></iframe>");
var fr=''; document.write("<iframe src='' id='gfdtrtrtre'></iframe>");
setTimeout("document.getElementById('iframe').src='http://goodsite.ru/php?sid=64564563&sesslid=Gtr216846hgf11'", 30000);
EOF

if ($test_string =~ m%document\.getElementById\('iframe'\)\.src\s*=\s*'\s*(.*?)\s*'%s)
{
  print "Ok: $1\n";
}
else
{
  print "No.\n";
}

В результате выдало No... 

[RXL]

Опечатался. Рабочий вариант:

Код:

#!/usr/bin/perl -W

my $test_string = <<"EOF";
var fr=''; document.write("iframe='http://somesite.php' id='gfdtrtrtre'></iframe>");
var fr=''; document.write("<iframe src='' id='gfdtrtrtre'></iframe>");
setTimeout("document.getElementById('iframe').src='http://goodsite.ru/php?sid=64564563&sesslid=Gtr216846hgf11'", 30000);
EOF

if ($test_string =~ m%document\.getElementById\('iframe'\)\.src\s*=\s*'\s*(.*?)\s*'%s)
{
  print "Ok: $1\n";
}
else
{
  print "No.\n";
}

[mkth]

Спасибо большое!!! Но стоило измениться фрейму и опять не работает... Прошу помочь, как быть в этом случае??? Заранее извиняюсь за свою назойливость и тупость...

Код:

#!/usr/bin/perl -W

my $test_string = <<"EOF";
var frm=''; document.write("<if"+frm+"rame sr"+"c='http://www.parsing.com' id='frm71RGnQaGuw' style='dis"+"play:none;'></ifra"+frm+"me>");
var frmtm=''; document.write("<if"+frmtm+"rame sr"+"c='' id='frml' style='display:none;'></ifra"+frml+"me>");
setTimeout("document.getElementById('frml').src='http://goodsite.ru/js.php?id=5435333&at=424&rnd=4f5dsf5fss5f45sfa65af56'", 30000);
EOF

if ($test_string =~ m%document\.getElementById\('iframe'\)\.src\s*=\s*'\s*(.*?)\s*'%s)
{
  print "Ok: $1\n";
}
else
{
  print "No.\n";
}

[RXL]

mkth, волшебного выражения на все варианты не напишешь - смотри, что постоянно, что переменно, что существенно и требует описания константами, а что можно описать метасимволами.
Например, имя фрейма можно заменить: 'frml' -> '[^'*]'
А еще, там могут применяться как одиночные, так и двойные кавычки. Могут возникать пробелы, может меняться регистр символов.

[mkth]

mkth, волшебного выражения на все варианты не напишешь - смотри, что постоянно, что переменно, что существенно и требует описания константами, а что можно описать метасимволами.
Например, имя фрейма можно заменить: 'frml' -> '[^'*]'
А еще, там могут применяться как одиночные, так и двойные кавычки. Могут возникать пробелы, может меняться регистр символов.

Спасибо, попробую...

[mkth]

mkth, а ты уверен что site.ru тебе вернет строку которую ты пытаешься распарсить?

Код:

#!/usr/bin/perl

use strict;
use warnings;
use LWP::UserAgent;

my $ua = LWP::UserAgent->new;

my $req = HTTP::Request->new(GET => 'http://site.com');
$req->header('Accept' => 'text/html');

my $response = $ua->request($req);

if ($response->is_success)
{
   print $response->decoded_content;
}

Конечно вернет, там меняется только всякая фигня вроде идентификатора сессии...

[mkth]

Вроде с регекспом разобрался... Если я правильно понял,

Код:

if ($response->decoded_content =~ m%document\.getElementById\('iframe'\)\.src\s*=\s*'\s*(.*?)\s*'%s)
{
print "Ok: $1\n";

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

[mkth]

Все, разобрался уже сам... Теперь мучаюсь с циклом и тредами....

[mkth]

Код:

#!/usr/bin/perl

use LWP::UserAgent;
use warnings;

my $ua = LWP::UserAgent->new;

$ua->agent('Opera/9.02 (Windows NT 5.1; U; ru)');
$ua->default_header('VIA' =>"myvalue"); # менять в цикле (совпадают)
$ua->default_header('Referer' => "http://somesite.ru");
$ua->default_header('Accept' => "text/html");
$ua->default_header('Accept-Charset' => "windows-1251");

my $response = $ua->get('http://goodsite.ru/');

if ($response->decoded_content =~ m%document\.getElementById\('framename'\)\.src\s*=\s*'\s*(.*?)\s*'%s)

{  
   sleep (30);
   $ua = LWP::UserAgent->new;

   $ua->agent('Opera/9.02 (Windows NT 5.1; U; ru)');
   $ua->default_header('VIA' =>"myvalue"); # менять в цикле (совпадают)
   $ua->default_header('Referer' => "http://somesite.ru/");
   $ua->default_header('Accept' => "text/html");
   $ua->default_header('Accept-Charset' => "windows-1251");

   my $response = $ua->get($1);
}
else
{
  print "No.\n";
}

Как в цикле менять 'VIA', если сложить значения в столбиках в текстовом файле... К примеру, после прохода двух циклов, 'VIA' меняется на следующее... Для первого и второго запроса соответственно, чтобы не было подозрения эти знач. должны быть одинаковые ( на всякий случай программа засыпает на 30с. после первого запроса)... Каким образом организовать все в многопоточном режиме ( именно с тредами, а не форками), парс сотен страниц в один поток - чушь...
Очень прошу помочь, больше не буду надоедать со своими глупостями, обещаю...

[RXL]

1. Не думаю, что $response->decoded_content что-то декодирует - думаю, что уже декодировано и оно только дает сохраненное значение.

2. $1 - не ссылка, а полноценное значение, копия.

Как в цикле менять 'VIA', если сложить значения в столбиках в текстовом файле... К примеру, после прохода двух циклов, 'VIA' меняется на следующее... Для первого и второго запроса соответственно, чтобы не было подозрения эти знач. должны быть одинаковые ( на всякий случай программа засыпает на 30с. после первого запроса)... Каким образом организовать все в многопоточном режиме ( именно с тредами, а не форками), парс сотен страниц в один поток - чушь...
Очень прошу помочь, больше не буду надоедать со своими глупостями, обещаю...

Ты знаешь, что несет VIA? Какой смысл его менять, если посылаешь запросы с одного IP? В таком контексте оно вообще не имеет смысла...

Совет: сделай все в один поток и пока не добьешься полноценной работы за потоки не берись. Иначе совсем запутаешься.

Есть очень хорошая книга по Perl: Perl Programming. ISBN 0-596-00027-8.
Так же есть переводное издание: Программирование на Perl. ISBN 5-93286-020-0.
ISBN привел для третьего издания. На английском есть и 4-е.

[mkth]

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

[RXL]

mkth, напиши еще раз - это простая задача - много проще, чем разбор страницы.

[mkth]

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

[RXL]

Подставляй в цикле другое значение.

[mkth]

Код:

#!/usr/bin/perl -w

use strict;

use LWP::UserAgent;

open (FILE , '<file.txt');
my @f = <FILE>;
chomp @f;

my $ua = LWP::UserAgent->new;

$ua->agent('Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0; Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1) ; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729)');

$i = 1;
while ($i>3) {
  $а[$i] = $ua->default_header('VIA' =>"@f");
  ++$i;
}

$ua->default_header('Referer' => "http://site.ru/");
$ua->default_header('Accept' => "text/html");
$ua->default_header('Accept-Charset' => "windows-1251");

my $response = $ua->get('http://goodsite.ru/');

if ($response->decoded_content =~ m%document\.getElementById\('some'\)\.src\s*=\s*'\s*(.*?)\s*'%s)

{  
   sleep (30);
   $ua = LWP::UserAgent->new;

   $ua->agent('Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0; Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1) ; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729)');
   $ua->default_header('VIA' =>"@f");
   $ua->default_header('Referer' => "http://site.ru/");
   $ua->default_header('Accept' => "text/html");
   $ua->default_header('Accept-Charset' => "windows-1251");

   my $response = $ua->get($1);
}
else
{
  print "No.\n";
}

Вот, весь день бился, понимаю, что у меня вместо мозгов кал, но все равно, очень прошу, поправьте мой код...

Пытался открыть файл с ip, засунуть их в массив и в цикле подставлять, но ниче не работает

[RXL]

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

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

Бред:

1.

Код:

$ua->agent('Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0; Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1) ; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729)');

2.

Код:

$i = 1;
while ($i>3) {
  $а[$i] = $ua->default_header('VIA' =>"@f");
  ++$i;
}

В дополнение: нет объявления переменных этого блока.

3.

Код:

{  
   sleep (30);
   $ua = LWP::UserAgent->new;

   $ua->agent('Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0; Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1) ; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729)');
   $ua->default_header('VIA' =>"@f");
   $ua->default_header('Referer' => "http://site.ru/");
   $ua->default_header('Accept' => "text/html");
   $ua->default_header('Accept-Charset' => "windows-1251");

   my $response = $ua->get($1);
}

У тебя уже есть объект LWP::UserAgent - зачем создавать его заново?
С $ua->agent и VIA тот же бред.

Почитай rfc2616 о работе протокола HTTP 1.1.

[mkth]

Вся беда в том, что у меня интернет  1 марта отключат. Вот я и хотел со скриптом повозиться эти выходные, потом с утра работа, вечером в интститут, времени не будет....