Дмитрий Репин aka cmapuk[0nline]

ЧАСТЬ 4.

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

"Крылья... Ноги... Главное - хост!
Во!..."
c2002 cmapuk[0nline]

Плетем гнезда. Стандартные инструменты Перл для работы с Сетью достаточно удобны и, в принципе, не нуждаются в надстройках. Исключение может составить разве что только модуль LWP. В этом разделе мы плавно пойдем от use Socket до use LWP; и таким образом попытаемся охватить все возможности сетевого Perl. Итак, стандартный модуль Socket.

Socket - это модуль функционального типа. Описание всех его функций имеется в perldoc. Мы же рассмотрим сами принципы организации сетевых подключений. Не забывайте, что команда perldoc -f function - расскажет много интересного.

use Socket; # Подключаем модуль
$|++;           # Отключаем буферизацию
$request=<<REQ; # Составляем запрос в переменную $request
GET /go.cgi?action=forum\&board=dummies HTTP/1.0
User-Agent:LLamzilla Platinum 3000
Referer:http://www.microsux.com
Cookie:Da kakie nafig kuki!
Accept:*/*
Accept-Language:en;ru
Accept-Charset:koi8-r

REQ
$protocol=getprotobyname(tcp);
# Эта функция возвращает числовое обозначение по имени
# протокола. Мы используем tcp протокол.
# На TCP основаны все прикладные протоколы, например
# HTTP, FTP, SMTP, POP3, и т.д.

socket(SOCK,PF_INET,SOCK_S-TREAM,$protocol);
# Открываем сокет с дескриптором SOCK(как файл в open).
# Вторым параметром мы определяем либо сокет юниксов, либо сетевой
# сокет. В данном случае - сетевой.
# Третий параметр - тип передачи данных.
# SOCK_STREAM-потоковый (для tcp), требующий подключения к удаленному
# хосту. SOCK_DGRAM - не требует подключения, используется для передачи
# данных отдельными пакетами(udp). Кстати, по большей части ICQ
# работает как раз на udp.

$iaddr=gethostbyname(perl.ru);
# Получаем адрес по имени

$port=80;
$packed_addr=sockaddr_in-($port,$iaddr);
# Упаковываем данные для подключения в
# специальный формат(для функции connect())

if(connect(SOCK,$packed_addr)){
         print SOCK $request;
         # Если подключение состоялось, посылаем запрос
         # и получаем ответ
         while(<SOCK>){
                 push(@response,$_);
         }
}else{
         print "Perl.ru в дауне =(";
}
close(SOCK);
# Теперь в массиве @response у нас лежит ответ(примерно так):
# 200 OK Found
# Заголовки
# ...
# ...
# Пустая строка
# HTML-страница http://www.perl.ru/go.cgi?action=forum&board=dummies

Для метода POST вся работа с сокетом аналогична. Изменяется только запрос.

$request=<<REQ;
POST /go.cgi HTTP/1.0
User-Agent:LLamzilla Platinum 3000
Referer:http://www.microsux.com
Cookie:Da kakie nafig kuki!
Accept:*/*
Accept-Language:en;ru
Accept-Charset:koi8-r
Content-type:application/www-form-urlencoded
Content-Length:26
action=forum\&board=dummies
REQ

Конечно, данный способ менее всего удобен, но он позволяет контролировать весь процесс на всех стадиях его действия. Рассмотрим теперь этот же пример, но с использованием модуля IO::Socket;

# Запрос тот же в $request
$sock = IO::Socket::INET->new(PeerAddr => www.perl.ru,
  PeerPort => 80,
  Proto => tcp
         Type => SOCK_STREAM);
# Или так
# $sock = IO::Socket::INET->new(PeerAddr => www.perl.ru:80);
# $sock = IO::Socket::INET->new("XXX.XXX.XXX.XXX:80");
# Параметры метода new() помогают ввести дополнительные опции
# подключения, например Timeout.

if($sock){
         print $sock $request;
         while(<$sock>){
                 push(@response,$_);
         }
}
close($sock);
# то же самое: if $sock значит, подключение состоялось
# и мы отправляем данные, а потом принимаем
# Для приема и отправки также существуют ф-ции send() и recv()

Не сложнее, чем работа с файлами, правда?

Стоит еще раз отметить: для UDP используется тип сокета SOCK_DGRAM и не требуется connect(), а для TCP - наоборот. В разделе "Чистая практика" мы еще вернемся к Socket и IO::Socket, а сейчас рассмотрим модуль LWP.

Этот модуль весьма популярен среди программистов. Он представляет собой удобный интерфейс к модулям Socket и IO::Socket. Cобственно, лучшего рассказа про LWP, чем perldoc lwpcook, найти сложно. Поэтому я просто возьму примеры оттуда и сделаю комментарии.

Метод GET при использовании LWP-Simple

use LWP::Simple;
$doc = get("http://www.perl.ru");
# Весь HTML в $doc
getprint("http://www.perl.ru");
# Вывод страницы сразу в STDOUT

Запуск с консоли

>perl -MLWP::Simple -e getprint "http://www.sn.no/libwww-perl/";

Распечатка в STDIN

>perl -MLWP::Simple -e getstore "ftp://ftp.sunet.se/pub/lang/perl/CPAN/src/latest.tar.gz";,"perl.tar.gz"

Скачать и сохранить файл как "perl.tar.gz"

######## В скрипте
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$ua->agent("Gruzilla/10.0 Platinum"); # Типа кул броузер )
$req = HTTP::Request->new(GET => http://www.perl.ru);

# Модуль HTTP::Request сделан для удобства создания запросов
$req->header(Accept => text/html);

# Теперь отправляем
$res = $ua->request($req);

# Проверим, все ли прошло ОК
if ($res->is_success) {
         print $res->content;
         # Распечатка принятых данных
} else {
         print "Error: " . $res->status_line . "\n";
}

При методе HEAD данные не отправляются и не принимаются.

Между клиентом и сервером идет обмен только заголовками.

Это полезно, например, для проверки существования файлов на сервере и т.п.

use LWP::Simple;
  if (@hdrs=head($url)) {
         # OK документ существует и доступен
         print join("\n",@hdrs);
         # Распечатаем заголовки
  }

use LWP::UserAgent;
$ua = LWP::UserAgent->new;
# Составление запроса
my $req = HTTP::Request->new(POST => http://www.someserver.com/script.cgi);
$req->content_type(application/x-www-form-urlencoded);
$req->content(param1=value1& param2=value2); # Это данные якобы формы
my $res = $ua->request($req); # Отправка
print $res->as_string; # Распечатка результата отправки

Еще вариант

use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
my $req = POST http://www.someserver.com/script.cgi,
[ param1 => value1, param2 => value ];
print $ua->request($req)->as_string;

Используем PROXY-сервер

use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$ua->env_proxy; # Взять прокси-настройки из окружения
# или вручную
$ua->proxy(ftp => http://proxy.myorg.com);
$ua->proxy(wais => http://proxy.myorg.com);
my $req = HTTP::Request->new(GET => wais://www.xxx.com/);
print $ua->request($req)->as_string;

Если прокся с паролем

use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$ua->proxy([http, ftp] => http://proxy.myorg.com);
$req = HTTP::Request->new(GET,"http://www.perl.com";);
$req->proxy_authorization_basic("proxy_user", "proxy_password");
$res = $ua->request($req);
print $res->content if $res->is_success;

Доступ к ресурсам, защищенным htaccess

use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$req = HTTP::Request->new(GET => http://www.linpro.no/secret/);
$req->authorization_basic(login, password);
print $ua->request($req)->as_string;

А Куки?

use LWP::UserAgent;
use HTTP::Cookies;
$ua = LWP::UserAgent->new;
$ua->cookie_jar(HTTP::Cookies->new(file => "lwpcookies.txt",
\t\t\t autosave => 1));
# Теперь куки будут читаться/писаться в lwpcookies.txt
# Далее уже запрос
$res = $ua->request(HTTP::Request->new(GET => "http://www.yahoo.no";));
print $res->status_line, "\n";

Секьюрный протокол HTTPS (SSL)

use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(GET => https://www.helsinki.fi/);
my $res = $ua->request($req);
if ($res->is_success) {
         print $res->as_string;
}else{
         print "Failed: ", $res->status_line, "\n";
}
# Код от обычного (для HTTP) мало чем отличается ;-)

use LWP::Simple;
%mirrors = (
  http://www.perl.ru/ => perl-ru.html,
  http://www.perl.com/ => perl-com.html,
  http://www.cpan.org =>cpan-org.html,
  gopher://gopher.sn.no/ => gopher.html,
); while (($url, $localfile) = each(%mirrors)) {
         mirror($url, $localfile);
}

Доставка больших документов

1-й вариант. Записываем данные в процессе скачивания в файл

use LWP::UserAgent;
$ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(GET => http://www.linpro.no/lwp/libwww-perl-5.46.tar.gz);
$res = $ua->request($req, "libwww-perl.tar.gz");
if ($res->is_success) {
         print "ok\n";
}else{
         print $res->status_line, "\n";
}

2-й вариант. Вставка контролирующей подпрограммы в качестве второго аргумента $ua->request(). В этом варианте можно записывать скачиваемый файл по кусочкам, чтобы в случае обрыва связи потом его докачать.

use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$URL = ftp://ftp.unit.no/pub/rfc/rfc-index.txt;
my $expected_length;
my $bytes_received = 0;
my $res =$ua->request(HTTP::Request->new(GET => $URL),
                 sub {
                         my($chunk, $res) = @_;
                         $bytes_received += length($chunk);
                         unless (defined $expected_length) {
                                 $expected_length = $res->content_length || 0;
                         }
                         if ($expected_length) {
                                 printf STDERR "%d%% - ",
                                 100 * $bytes_received / $expected_length;
                 }
                         print STDERR "$bytes_received bytes received\n";
                         # В $chunk - текущие данные
                         # print $chunk;
                 }
);
print $res->status_line, "\n";

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

Информация имеет силу, только когда ее можно сохранить.
Перефразированный Карнеги ;-)

Простые задачи. Perl, как и любой полноценный язык, предоставляет возможность сохранять/читать данные в/из различных источников, от файлов до SQL-образных баз данных. При таком многообразии главное - сделать правильный выбор. Для начала стоит определиться, с какими объемами данных будет работать программа, в какой форме эти данные и как часто будет использоваться программа. Для простейших задач подойдет и простой текстовый файл. Например, конфигурация программы.

# config.dat
# Коментарии
# к конфигу
DATADIR=/home/vasya/coolproga/datfiles
EXITCODE=666
MESSAGE=Hello, Master Pupkin!
...
# end of config.dat
В скрипте все это читаем:
open(F,"config.dat");
while($line=<F>){
         chomp $line;
         next if $line=~/^#/;
         # Пропустить строку комментариев
         ($var,$value)=split/=/,$line;
         $CONF{$var}=$value;
         # Конфиг собираем в хэш
}
close(F);

Часто более удобным способом хранения информации являются простые базы данных - DBM-файлы. В этих файлах хранятся пары ключ/значение, а работа с данными производится через хэш, ассоциированный с DBM-файлом. DBM-базы бывают различных типов, зависящих обычно от операционной системы. Таблицу совместимости можно найти тут же - perldoc AnyDBM_File . Каждому типу соответствует свой Perl-модуль(DB_File, NDBM_File, etc). Связать хэш с базой можно разными способами - с помощью функций dbmopen или tie.

use DB_File;
dbmopen(%DATA, $dbfile)
or die "Cant open $dbfile: $!";
# Работаем с данными
...
dbmclose(%DATA); # Завершаем работу с базой

use NDBM_File;
tie(%DATA, NDBM_File, $dbfile,O_CREAT|O_RDWR);
# Работаем с данными
...
untie(%DATA); # Завершаем работу с базой

О работе этих функций - perldoc -f dbmopen и perldoc -f tie.

Работа с хэшем DBM-базы не отличается от работы с обычным хэшем.

В принципе, этой информации о DBM-файлах достаточно.

Structured Query Language. Структурированный язык запросов, а попросту - SQL - это тема для отдельной статьи и только косвенно связана с Перл. Мы же рассмотрим способы взаимодействия с SQL-образными базами данных.

Самым удобным интерфейсом к БД является модуль DBI (нет в стандартной поставке Перл). DBI - это основной модуль интерфейса, к которому необходимо присовокупить (гусары, молчать!) драйвер для соответствующей базы данных. Не надо пугаться! Драйвер - это всего-лишь Perl-модуль. Для каждого типа БД модуль-драйвер будет иметь название DBD::basename: DBD::mysql, DBD::InterBase, DBD::mSQL и т.п.

Проще говоря, вам нужно просто установить два модуля: DBI и DBD::НазваниеБазы. Впоследствии, для других типов БД ставить DBI заново уже не требуется. Список имеющихся у вас драйверов можно получить так:

use DBI;
@driver_names = DBI->available_drivers;

Теперь о работе с DBI.

use DBI;
$db = DBI->connect("dbi:mysql:database=Users-;mysql_socket=/tmp/mysql_socket.sock","login","password") || die "Database Connection ERROR $DBI::errstr";
# Вот так мы подключимся к mysql-ной базе Users

$db = DBI->connect("dbi:InterBase:database=/home/db/data.gdb;ib_dialect=3;ib_charset=win1251","-login","pass")|| die "$DBI::errstr";
# А вот так - к базе формата InterBase
...
# Завершение
$db->disconnect();

Ошибки базы данных пишутся в DBI::errstr, откуда их можно запросто прочитать =).

Работа с данными после подключения происходит следующим образом.

$req=$db->do("CREATE TABLE USERS .......... "); # простые SQL-команды
$req=$db->do("DELETE FROM ORDERS"); # простые SQL- команды
$req=$db->do("DROP TABLE USERS"); # простые SQL- команды
# Более сложные команды типа SELECT, INSERT, и т.п.
# требуют другого подхода
$req=$db->prepare("SELECT NAMES FROM USERS");
$req->execute || die "$DBI::errstr";
$req->finish;

Метод finish вызывается для освобождения памяти, если ваш скрипт производит несколько запросов.

Для работы с данными в DBI имеется множество методов. Например:

$rv = $db->do($query);
# Просто запрос, результат которого окажется в $rv

Для получения данных после запроса (после prepare и execute) имееются различные методы.

@row = $req->fetchrow_array;
# Массив полей строки после SELECT

$req=$db->prepare("SELECT NAMES,LASTNAMES FROM USERS WHERE AGE>18");
$req->execute || die "$DBI::errstr";
while(@row=$req->fetchrow_array){
print "Имя: $row[0], Фамилия $row[1]\n";
}
$req->finish;
# Вот так, например, можно выбрать имена пользователей старше 18 лет.
$row_ref = $req->fetchrow_arrayref;
# Ссылка на массив полей строки после SELECT
# То же самое, но обращение к данным будет производится как $row_ref->[0], $row_ref->[1].
$hash_ref = $req->fetchrow_hashref;
# Ссылка на хэш полей строки после SELECT
# А вот так можно сложить выбранные строки в хэш, ссылкой на который будет
# $hash_ref.
# Если требуется выбрать одну строку, например случайного пользователя,
# то достаточно будет такого действия:
@row =$db->selectrow_array("SELECT NAME,LASTNAME FROM USERS ORDER BY RAND()");
# Здесь не требуется prepare, execute и т.п.
$row_ref = $db->selectrow_arrayref($query);
# То же, но в виде ссылки
$hash_ref = $db->selectrow_hashref($query);
# или хэш-ссылки

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

Для этого нужно воспользоваться методом bind_columns и связать данные со ссылками на соответствующие переменные.

$req=$db->prepare("SELECT NAMES,LASTNAMES FROM USERS WHERE AGE>18");
$req->execute || die "$DBI::errstr";
$req->bind_columns(\$Name, \$LastName);
while($req->fetch()){
         print "Имя: $Name, Фамилия: $LastName\n";
}
$req->finish;

Список всех методов подробно описан в документации к DBI (perldoc DBI). Описание модуля, содержащееся в комплекте поставки, занимает около 150 килобайт. Подробнее документацию вы вряд ли найдете. Также полную информацию можно найти здесь: dbi.perl.org. Стоит еще упомянуть о расширениях модуля DBI. Они носят названия вида DBIx::***. Найти их можно на search.cpan.org.

Кроме модуля DBI существует масса отдельных модулей для разных типов БД. Например, Mysql - для MySQL, IBPerl - для InterBase. Однако, по моему мнению, DBI является самым удобным интерфейсом, а главное - он присутствует практически на всех хостингах.

Почему я не стал рассказывать подробно о работе с базами данных? Дело в том, что большинство проблем, возникающих при программировании под БД, появляется вследствие незнания принципов работы с БД, различий между различными их видами, что выходит за рамки изучения Перл. Ликбез по этой теме требует написания отдельных статей с рассмотрением конкретных типов БД. Я же не ставил перед собой такую задачу. Все, что нужно для программирования Perl+DB, - это книга по языку SQL, документация к вашей БД и perldoc DBI.

Небольшой совет. Запросы к БД следует составлять в отдельной переменной, и эту переменную передавать пераметром в do(), prepare(). Таким образом можно легко разобраться, если произойдет ошибка.

$query="SELECT NAMES,LASTNAMES FROM USERS WHERE AGE>18";
$req=$db->prepare($query);
$req->execute || die "$DBI::errstr Запрос:$query";

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