VPF::Прошу помочь со скриптом - Форум программистов

mkth

Дата 4.2.2010, 03:14 (ссылка)

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

Загрузка ...

Новичок

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

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

Здравствуйте... Вот в инете нарыл скрипт перлового прокси... Добавил туда строку отправки http хидера, прошу подмогнуть, как сделать так, чтобы значение этого хидера бралось из текстового файлика при каждом новом коннекте с сервером... сам уже две недели бьюсь и никак не разберусь, заранее большое спасибо всем, кто поможет...

Код


use HTTP::Daemon;
use LWP::UserAgent;
use Compress::Zlib;
use CGI::Carp qw(fatalsToBrowser);

my @ext = qw(x-gtar x-gzip x-tar zip image zip z gz tz taz tgz lzh arj arc tar cab wmz yfs wsz exe uu xxe bhx b64 hqx mim);

my $port = 8080;

$SIG{PIPE} = 'IGNORE';

my $server = HTTP::Daemon->new( LocalPort => $port ) or
die "Can't start server ($@)" unless defined $server;

my $ua = LWP::UserAgent->new;
$ua->default_header('My header' => "value") # вот тут я сломал голову

while (my $conn = $server->accept) {
    while (my $request = $conn->get_request) {
           $conn->autoflush;
                $request -> remove_header('Proxy-Connection');
        $request -> remove_header('Keep-Alive');
        $request -> header(Connection=>'close');
           my $resp = $ua->simple_request($request);
           my $c_cont = $resp->content;
        if ( $resp->content_encoding || (grep { $_ =~ /$resp->content_type/g } @ext) || length($c_cont) < 3000 ) {
        $conn->send_response($resp);
        }
        else {
             $c_cont_zip = Compress::Zlib::memGzip($c_cont);
             $resp->content($c_cont_zip);
             $resp->content_encoding('gzip');
             $conn->send_response($resp);
             }
     }
    print STDERR "Close: ", $conn->reason, "\n";
    $conn->close;
    undef $conn;
}

Попутно вопрос знатокам перла, есть ли в перле модуль, для обработки JavaScript наподобие браузера?

sir_nuf_nuf

Дата 4.2.2010, 10:16 (ссылка)

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

Загрузка ...

Опытный

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

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

как то так

Код


while (my $conn = $server->accept) {
    my $ua = LWP::UserAgent->new;
    my $str = do {my $fh = open "<filename.txt"; local $/ = undef; <$fh>};
    chomp $str;
    $ua->default_header('My header' => $str)
    .................
}

Это сообщение отредактировал(а) sir_nuf_nuf - 4.2.2010, 10:16

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

mkth

Дата 4.2.2010, 22:30 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата(sir_nuf_nuf @ 4.2.2010, 10:16)

как то так

Код


while (my $conn = $server->accept) {
    my $ua = LWP::UserAgent->new;
    my $str = do {my $fh = open "<filename.txt"; local $/ = undef; <$fh>};
    chomp $str;
    $ua->default_header('My header' => $str)
    .................
}

Спасибо, только чет прокс не пашет... smile

sir_nuf_nuf

Дата 5.2.2010, 09:52 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(mkth @ 4.2.2010, 22:30

)

Спасибо, только чет прокс не пашет...

а по подробнее ?

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

mkth

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

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

Загрузка ...

Новичок

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

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

Цитата(sir_nuf_nuf @ 5.2.2010, 09:52)

Цитата(mkth @ 4.2.2010, 22:30

)

Спасибо, только чет прокс не пашет...

а по подробнее ?

Код


#!/usr/bin/perl

use HTTP::Daemon;
use LWP::UserAgent;
use Compress::Zlib;
use CGI::Carp qw(fatalsToBrowser);
use strict;
use warnings;

my @ext = qw(x-gtar x-gzip x-tar zip image zip z gz tz taz tgz lzh arj arc tar cab wmz yfs wsz exe uu xxe bhx b64 hqx mim);

my $port = 8080;

$SIG{PIPE} = 'IGNORE';

my $server = HTTP::Daemon->new( LocalPort => $port ) or
die "Can't start server ($@)" unless defined $server;

while (my $conn = $server->accept) {
    my $ua = LWP::UserAgent->new;
    my $str = do {my $fh = open "<filename.txt"; local $/ = undef; <$fh>};
    chomp $str;
    $ua->default_header('My header' => $str);
}

while (my $conn = $server->accept) {
    while (my $request = $conn->get_request) {
           $conn->autoflush;
                $request -> remove_header('Proxy-Connection');
        $request -> remove_header('Keep-Alive');
        $request -> header(Connection=>'close');
           my $resp = $ua->simple_request($request);
           my $c_cont = $resp->content;
        if ( $resp->content_encoding || (grep { $_ =~ /$resp->content_type/g } @ext) || length($c_cont) < 3000 ) {
        $conn->send_response($resp);
        }
        else {
             $c_cont_zip = Compress::Zlib::memGzip($c_cont);
             $resp->content($c_cont_zip);
             $resp->content_encoding('gzip');
             $conn->send_response($resp);
             }
     }
    print STDERR "Close: ", $conn->reason, "\n";
    $conn->close;
    undef $conn;
}

Не работает сам прокси сервер, т.е., браузер не может с ним соединиться...

chorny

Дата 11.2.2010, 22:12 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата(mkth @ 4.2.2010, 03:14

)

есть ли в перле модуль, для обработки JavaScript наподобие браузера?

Несколько. JavaScript, JavaScript::SpiderMonkey, JavaScript::Engine

Pollucs

Дата 14.2.2011, 00:45 (ссылка)

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

Загрузка ...

Новичок

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

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

Доброго времени суток! Нужна помощь! Совсем недавно изучаю Perl, учусь с ЕШКО, материал у них хромает, в скриптах много ошибок. Вот часть скрипта, точнее процедура, отвечающая за поиск товара в интернет-магазине:

Код


sub Find {
    local (%data) = @_;
    local (@patterns, $pattern, $itmes, $found, $s, $keys, $brutto, $ref, $id, $section, $name, $price, $vat, $jm, $infoFile, $infoID, $photo);

    &HTML_Header("$cfg{name} - Результат просмотра каталога");
    &HTML_Background("$cfg{background}");
    print "<SPAN class=\"ver14\">Результат просмотра каталога</SPAN>\n";
    print "<BR><BR>\n";
    print "<TABLE border=\"0\" cellspasing=\"10\" cellpadding=\"1\">";

    if ($data{'search_str'} ne "") {
       $searchStr = $data{'search_str'};
       @patterns = split(/ /, $searchStr);
       $items = 0;
        open(OFFER, "$cfg{base_path}$cfg{dat_path}$cfg{offer_file}") ||
             die "Content-type: text/html\n\n Невозможно открыть файл данных!";
        while (<OFFER>) {
                chop;
                ($ref, $id, $section, $name, $price, $vat, $jm, infoFile, $infoID, $photo) = split(/::/, $_);
                $id =~ tr/[a-zf-я]/[A-ZА-Я]/;
                $price -= tr/,/./;
                $s = $section.$name;
                $found = 0;
                foreach $pattern (@patterns) {
                        if ($s =~ m/.*$pattern.*/i) {
                           $found++;
                        }
                }
                if ($found > 0) {
                   $items++;
                   print "<TR VALIGN=\"top\">\n";
                   print "<FORM ACTION=\"$cfg{script}\"METHOD=\"post\">\n";
                   print "<TD ALIGN=\"Right\">\n";
                         if ($section ne "") {
                            print "$section - ";
                         }
                         print "$name\n </TD>";
                         print "<TD ALIGN=\"CENTER\">\n";
                         if ($infoFile ne "") {
                            print "<A HREF=\"$cfg{home}$cfg{html_path}$infoFile";
                            if ($infoID ne "") {
                               print "$infoID";
                            }
   
                            print \"onMouseOver=\"window.status='Информация о товаре';
                             return true\"><IMG SRC=\"$cfg{home}$cfg{graph_path}$cfg{info_button}\" alt=\"ДОПОЛНИТЕЛЬНАЯ ИНФОРМАЦИЯ\" border=\"0\"></a>\n;
                         }
                         if ($photo ne "") {
                            print "<a href=\"$cfg{script}?action=photo&photo=$photo\" onMouseOver=\"window.status='Осмотрите товар';
                         return true\" onMouseOut=\"window.status=' ';
                         return true\"><img src=\"$cfg{home}$cfg{graph_path}$cfg{photo_button}\" alt=\"FOTO\" border=\"0\"><a>\n;
                         }
                         print "</TD>\n";

                         $brutto=&Cash($price*(1 + $vat / 100));
                         $price=&Cash($price);
                         print "<TD NOWRAP ALIGN=\"RIGHT\"><SPAN class=\"priceN\">$price /jm</SPAN>
                         <SPAN class=\"priceB\">($brutto VAT)</SPAN></TD>";
                   print "<TD NOWRAP width=\"$cfg{to basket_width}\" align=\"center\">";
                   print "<INPUT TYPE=\"hidden\" name=\"product\" value=\"$id\">\n";
                   print "<INPUT TYPE=\"hidden\" name=\"basket\" value=\"$data{basket}\">\n";
                   print "<INPUT TYPE=\"hidden\" name=\"form\" value=\"search\">\n";
                   print "<INPUT TYPE=\"hidden\" name=\"search_str\" value=\"$data{search_str}\">\n";
                   print "<SPAN class=\"ver10\">\n";
                   print "<INPUT TYPE=\"text\" name=\"count\" value=\"0\" size=\"1\">\n";
                   print "<INPUT TYPE=\"submit\" name=\"action\" value=\"В корзину\">\n";
                   print "</SPAN>\n";
                   print "</TD>\n";
                   print "</FORM>\n";
                   print "</TR>\n";
                }
              }
                   close(OFFER);
                   if ($items == 0) {
                      print "<TR>\n";
                      print "<TD align=\"center\">\n";
                      print "<SPAN class=\"ver14\">Не найдено ни одной позиции, соответствующей образцу</SPAN>";
                      print "</TD>\n";
                      print "</TR>\n";
                   }
              }
              else {
                   print "<TR>\n";
                   print "<TD align=\"center\">\n";
                   print "<SPAN class=\"ver14\">Образец поиска не определен!</SPAN>";
                   print "</TR>\n";
                   print "</TABLE>\n";
                   print "</CENTER>\n";
                   &HTML_Foot;
              }
    }

Ошибка, как мне кажется, где-то здесь:

Код


  if ($infoFile ne "") {
                            print "<A HREF=\"$cfg{home}$cfg{html_path}$infoFile";
                            if ($infoID ne "") {
                               print "$infoID";
                            }
  
                            print \"onMouseOver=\"window.status='Информация о товаре';
                             return true\"><IMG SRC=\"$cfg{home}$cfg{graph_path}$cfg{info_button}\" alt=\"ДОПОЛНИТЕЛЬНАЯ ИНФОРМАЦИЯ\" border=\"0\"></a>\n;
                         }
                         if ($photo ne "") {
                            print "<a href=\"$cfg{script}?action=photo&photo=$photo\" onMouseOver=\"window.status='Осмотрите товар';
                         return true\" onMouseOut=\"window.status=' ';
                         return true\"><img src=\"$cfg{home}$cfg{graph_path}$cfg{photo_button}\" alt=\"FOTO\" border=\"0\"><a>\n;
                         }
                         print "</TD>\n";

Как правильно описывать в Perl гиперссылки? Что-то в литературе нигде не нахожу. Пожалуйста, не ругайте сильно, я лишь начинаю smile

Заранее спасибо!

sir_nuf_nuf

Дата 14.2.2011, 11:10 (ссылка)

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

Загрузка ...

Опытный

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

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

у.... жесть какая..
Вы лучше возьмите нормальную книжку по Perl.
Кемелбук - хотя это и круто для начала.
Можно самоучитель Матросова.

И выкиньте из головы CGI скрипты и WWW, иначе вы выучите не perl, а PHP =)

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

Pollucs

Дата 14.2.2011, 12:43 (ссылка)

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

Загрузка ...

Новичок

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

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

sir_nuf_nuf понимаю, что жесть, но всё же хотелось бы курсы закончить, от препода помощи добиться трудно, хочу сначала с этим материалом разобраться, потом уже как все нормально учить (изучение PHP кстати тоже в планах smile

)
И всё-таки может подскажете в чём проблема?.. очень нужно..

sir_nuf_nuf

Дата 14.2.2011, 13:02 (ссылка)

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

Загрузка ...

Опытный

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

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

У вас кавычки (") расставлены как попало. Ясно, что ничего не работает. Возможно это из за копипаста.
Если вам нужно вывести большой кусок HTML, в котором много разных кавычек лучше использовать оператор квотирования

Код


print   q[  <a href="?ogog=egege" onclick="return 'yes'">Eh</a>   ];

квотирования с интерполяцией

Код


print   qq[  <a href="?id=$my_id_var" onclick="return '$my_var'">OO</a> ];

или DOC-here

Код


print <<END_OF_HTML;
 <a href="?ogog=egege" onclick="return 'yes'">Eh</a>
 <a href="?ogog=egege" onclick="return 'yes'">Eh</a>
END_OF_HTML

или DOC-here с интерполяцией

Код


print <<"END_OF_HTML";
 <a href="?id=$my_id_var" onclick="return '$my_var'">OO</a>
 <a href="?id=$my_id_var" onclick="return '$my_var'">OO</a>
END_OF_HTML

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

Pollucs

Дата 14.2.2011, 13:59 (ссылка)

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

Загрузка ...

Новичок

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

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

sir_nuf_nuf спасибо огромное, использовал квотирования с интерполяцией - помогло, однако, следуя принципу "не знать не стыдно, стыдно не спросить", Ваш ответ явил ещё несколько вопросов:
что значит "Возможно это из за копипаста"? (я ведь только начинающий программист, даже не могу пока им называться smile

),
по поводу DOC-here и DOC-here с интерполяцией, что это и с чем его едят, если можно, дайте ссылочку с информацией, сам пока не могу найти. Спасибо!

sir_nuf_nuf

Дата 14.2.2011, 14:08 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(Pollucs @ 14.2.2011, 13:59

)

что значит "Возможно это из за копипаста"?

=) это значит: "Возможно кавычки потерялись в процессе копирования (copy) - вставки (paste) кода в браузер"
copypaste - копипаст.

Почитайте этот кусок руководства. Там и про квотирование и про here-doc:

http://perldoc.perl.org/perlop.html#Quote-...-like-Operators

ищите слово "here-document"

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

Это сообщение отредактировал(а) sir_nuf_nuf - 14.2.2011, 14:12

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

Pollucs

Дата 14.2.2011, 19:21 (ссылка)

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

Загрузка ...

Новичок

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

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

sir_nuf_nuf Спасибо огромное, буду разбираться! smile

Pollucs

Дата 17.2.2011, 14:23 (ссылка)

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

Загрузка ...

Новичок

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

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

Продолжаю мучать свой скрипт, вновь ошибка, не могу понять в чём:

Код


#!/usr/bin/perl -w
use CGI qw/:standard/;
use CGI::Carp 'fatalsToBrowser';
print "Content-type: text/html\n\n";
$cfg{config_file}= "C:/WebServers/home/perlbook.ru/cgi-bin/shop/myshop.pl";
&ChtenConfig;
%dan_vybran = &ChtenDan;
&BezSSI(%dan_vybran);
$ENV{'REQUEST_METHOD'} eq "POST" ? &ObslugPOST(%dan_vybran);
 &ActGET(%dan_vybran);

 #Далее идёт перечень процедур, они вроде в порядке

Хотелось бы устранить ошибку в 9-й строке. Подскажите пожалуйста, что не так? Спасибо!

sir_nuf_nuf

Дата 17.2.2011, 15:37 (ссылка)

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

Загрузка ...

Опытный

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

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

Цитата(Pollucs @ 17.2.2011, 14:23

)

$ENV{'REQUEST_METHOD'} eq "POST" ? &ObslugPOST(%dan_vybran);

У вас не законченная структура.
Тренарный оператор выглядит так:

Код


$ENV{'REQUEST_METHOD'} eq "POST" ? &ObslugPOST(%dan_vybran) : &DoSomethingElse();

Кстати в вашем случае он нафиг не нужен. Нужен - обычный if

Код


if ($ENV{'REQUEST_METHOD'} eq "POST") {
    ObslugPOST(%dan_vybran);
}

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

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

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