требуется консультация по модулю Perl

[МихаилKK]

Требуется краткосрочная консультация по модулю на perl.
Стучать в icq 388-142-45(восемь)

[Алексей++]

МихаилKK, это приказ ? ))

[МихаилKK]

Нет, это мольба о помощи к СВЕДУЮЩИМ

[Алексей++]

ааа, ну тогда остаётся их дождаться. Учитывай, кстати, что обычно люди спят ночью.

[McZim]

МихаилKK, мы готовы вам помочь на форуме. Излагайте.

[RXL]

МихаилKK, совершенно согласен с McZim: мы с тобой не являемся хорошими знакомыми, а также мы не коммерческая компания. Т.ч. аска отменяется - пишите свою задачу здесь, приводите код, объясните, что это и что не получается сделать.

[МихаилKK]

Спасибо за отклик! проблема в следующем:
Делался perl скрипт, который занимается парсингом сайтов.
В принципе, это обычный прокси-скрипт, который тянет к себе сайты,
однако ему не хватает корректной работы с js содержимым на этих сайтах.
Статический html, css он тянет нормально, но необходимо еще обрабатывать еще
и javascript и отдавать сайт в таком же виде как оригинальный.

Код:

#!/usr/bin/perl
use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use LWP::UserAgent;
use Encode qw(encode decode);
use URI::Escape;

my $PROXY_URL = "http://localhost/proxy/cgi2.pl?u=";
#my $PROXY_URL = "http://dealextreme.com.ua/cgi-bin/proxy/cgi2.pl?u=";

#=======================================================================
my $cgi = CGI->new;
my $URL = $cgi->param("u");

# если не указан протокол в начале ссылки - добавить http по умолчанию
if ($URL !~ m|^\w+://|) {
$URL = "http://" . $URL;
}

my $content = do_the_job();

# отдать тело ответа клиенту
print $content;

#=======================================================================

sub do_the_job {
#my $URL = shift;

my $req_uri = URI->new( $URL );
if (!$req_uri) {
print "Content-Type: text/plain\n\n";
print "Invalid uri [$URL]\n";
#die;
return;
}

my $req_host = $req_uri->scheme . "://" . $req_uri->host;
my $url = $req_uri->canonical;

# запрос от прокси-агента
my $ua = LWP::UserAgent->new;
#$ua->default_header('Referer' => uri_escape($PROXY_URL . $req_host));
$ua->default_header('Referer' => uri_escape($URL));

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

# успешен ли был запрос?
if ($resp->is_success) {
$Content = $resp->content;
} else {
print "Content-Type: text/html; charset=utf-8\n\n";
print $resp->status_line;
#die;
return;
}

# разбор ответа
my $resp_uri = $resp->base;
my $BASE_URI = URI->new($resp_uri->scheme . "://" . $resp_uri->host);
my $PROXIED_URI = $PROXY_URL . $BASE_URI;
my $Content_Type = $resp->content_type;
my $Output_Encoding = $resp->content_charset;

# печатаем заголовки ответа - MIME и кодировку
print "Content-Type: " . $Content_Type;
if ($Output_Encoding) {
print "; charset=" . $Output_Encoding;
}
print "\n\n";

# пропустить обработку следующих MIME-типов
my $processing_needed = 1;
#image/*, */*xml
#application/x-shockwave-flash
for (qw(image xml flash)) {
if ($Content_Type =~ /\Q$_\E/i) {
$processing_needed = 0;
$Output_Encoding = undef;
last;
}
}

# переработка содержимого если нужно
if ($processing_needed) {
$Content = process_content($Content, $Content_Type);
}

# вернуть тело ответа
return $Content;
}

#-----------------------------------------------------

sub process_content {
my ($content, $Content_Type) = @_;

if ($Content_Type =~ /javascript/io) {
$content = rewrite_JS($content);
}
elsif ($Content_Type =~ /css/io) {
$content = rewrite_CSS($content);
}
else {
# presuming CType is text/html

# process embedded css
$content =~ s|(<style.*?type=\"text/css\".*?>)(.+?)(</style>)|$1 . rewrite_CSS($2) . $3|gieso;
$content =~ s|(style=([\"\']))(.*?)\2|$1 . rewrite_CSS($3) . $2|gieso;

# process embedded javascript
$content =~ s|(<script type=\"text/javascript\">)(.+?)(</script>)|$1 . rewrite_JS($2) . $3|gieso;
$content =~ s|(<script language=\"javascript.*?\">)(.+?)(</script>)|$1 . rewrite_JS($2) . $3|gieso;

# process HTML
$content = rewrite_HTML($content);
#$content =~ s|\n||go;

# добавляем собственный js
my $JS = <<"JS";
function show_scripts () {
var list = document.getElementsByTagName('script');
var msg = "";
var scr;
for (var i=0; i<list.length; i++) {
scr = list[i];
if (scr.src) {
msg += scr.src + ' *** ';
//g.src = 'http://localhost/proxy/cgi2.pl?u=' + img.src;
}
}
alert(document.location + " *** All scripts:" + msg);
}

//show_scripts();
JS

$content .= "\n<script>". $JS ."</script>";
}
return $content;
}

#-----------------------------------------------------

sub rewrite_JS {
$_ = shift;

# убрать пробелы между "+" и кавычками
#s|(\+)\s+([\'\"])|$1$2|gso;
#s|([\'\"])\s+(\+)|$1$2|gso;
#s|(\+)\s+([^\+])|$1$2|gso;

# заменить ссылки
#s#(\.(?:location|href|src)\s*=\s*([\"\']))(.+?)\2#$1 . $PROXY_URL . get_abs_uri($3,$URL) . $2#gsie;
s#(\.(?:location|href|src)\s*=\s*([\"\']))(.+?)([\"\'])#$1 . $PROXY_URL . get_abs_uri($3,$URL) . $4#gsie;
#s#(\.(?:location|action|href|src)\s*=\s*)([^\"\']+?)([;\s])#$1 . $PROXY_URL . get_abs_uri($2,$URL) . $3#gsie;

#s#((?:background|action|href|src)=([\"\']))(.*?)\2#$1 . replace_link($3) . $2#egsi;
s#(\b(?:background|href|src)\s*=\s*([\"\']))(.*?)([\"\'])#$1 . replace_link($3) . $4#egsi;
#s#(\b(?:background|virtual|action|href|src)\s*=\s*)([^\"\']+?)(\s)#$1 . replace_link($2) . $3#egsi;
#s#((?:open|redirect)\s*\(\s*([\"\']))(.+?)\2#$1 . $PROXY_URL . get_abs_uri($3,$URL) . $2#gsie;

return $_;
}

sub rewrite_CSS {
$_ = shift;

s|(url\([\'\"]?)(.+?)([\'\"]?\))|$1 . $PROXY_URL . get_abs_uri($2,$URL) . $3|gieo ;
s|(\@import ([\"\']))(.+?)\2|$1 . $PROXY_URL . get_abs_uri($3,$URL) . $2|gieo;

return $_;
}


sub rewrite_HTML {
$_ = shift;

# vkontakte
s|var vklogin = false;|var vklogin = true;|gsi;
s|if \(parent && parent != window.+?}\);.+?}||sgo;
#s|Ajax\.postWithCaptcha\(\'\/login\.php\',|Ajax.postWithCaptcha('http://vkontakte.ru/login.php',|sgio;

# all
#s#(background|action|href|src)=([\"\'])([^\2]*?)\2#replace_link($1,$2,$3)#egsi;
#s#((?:background|virtual|action|href|src)=([\"\']))(.*?)\2#$1 . replace_link($3) . $2#egsi;
#s#((?:background|virtual|action|href|src)\s*=\s*([\"\']))(.*?)\2#$1 . replace_link($3) . $2#egsi;
s#(\b(?:background|virtual|action|href|src)\s*=\s*([\"\']))(.*?)([\"\'])#$1 . replace_link($3) . $4#egsi;
#s#((?:background|virtual|action|href|src)\s*=\s*)([^\"\']+?)(\s)#$1 . replace_link($2) . $3#egsi;

# meta
s|(<meta http-equiv=\"Refresh\" content=\"\d+?;URL=)(.+?)\"|$1 . $PROXY_URL . get_abs_uri($2,$URL) . '"'|gsie;

# js-handlers in html tags
# window.open =>
s|(\.open\s*\(\s*([\"\']))(.+?)\2|$1 . $PROXY_URL . get_abs_uri($3,$URL) . $2|gsie;

# flash
s|(<param name=\"movie\" value=([\"\']))([^u].+?)(\2.*?/>)|$1 . $PROXY_URL . get_abs_uri($3,$URL) . $4 |gsie;

s|(\+)\s+([\'\"])|$1$2|gso;
s|([\'\"])\s+(\+)|$1$2|gso;
s|(\+)\s+([^\+])|$1$2|gso;

return $_;
}

sub get_abs_uri {
my ($rel, $base) = @_;

$rel =~ s/^[\"\']//;
$rel =~ s/[\"\']$//;

return uri_escape ( URI->new($rel)->abs($base)->as_string() );
}

sub replace_link {
my $link = shift;
#return "" if $link eq "";

my $str;

# не "абсолютизировать" если это ссылка на локальный для данной страницы javascript-код
# или ссылка на '#'
if ($link =~ /^javascript:/io || $link =~ /^#/o) {
$str = $link;
} else {
$str = $PROXY_URL . get_abs_uri($link, $URL);
}

return $str;
}

sub convert {
my ($content, $to) = @_;
return $content if !defined $to;
return encode ($to, decode('UTF-8', shift));
}

sub convert_from {
my ($content, $from) = @_;
return $content if !defined $from;
return encode ('utf-8', decode($from, shift));
}

[RXL]

МихаилKK, ты хочешь, чтобы кто-то разбирался в твоем коде (почти 250 строк) и сказал, что и как нужно написать? Спроси себя - кому это надо? Т.ч. давай конкретику.

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