К списку статей
Автор: Цуканов Андрей
Обложка статьи

3-tier своими руками

    Как-то давным-давно случилось страшное. Наша фирма начала расширяться и открыла филиал. В другом городе. Раньше все работали в одном офисе, в котором была проложена локальная сеть и старенький SQL сервер как-то справлялся с нагрузкой. Здесь и склад и торговля и руководство.
    Проблемы конечно были всегда, но тут они стали быстро переходить в разряд неразрешимых. Как привязать новый офис к информационной структуре фирмы, тем более что руководству хочется видеть что происходит в филиале. И выручку, и складские остатки, и кто кому и сколько должен. Набирать штат программистов в филиал никто особенно не хотел. Устанавливать там сервер и постоянно его обслуживать не хотелось уже нам. Тем более непонятно было как сводить два одновременно работающих предприятия в одно. Выставить наш SQL сервер в интернет мы тоже как-то не решились.
    Вначале подумали создать какое-нибудь WEB приложение и заставить филиал работать с ним через браузер,  тем более что Apache сервер у нас уже был, и какой-никакой опыт работы с html имелся. Но тут выяснилось, что к браузеру придется привязать сканеры, кассы и весы. Как это делать и во что это выльется мы представить себе не могли.
    Немного подумав, решили что если браузер не может работать с периферией, то нужно написать что-то свое. В таком случае отпадает необходимость создавать сложные и громоздкие web странички, несущие в себе как данные так и кучу разметочной информации с кодом на java-script и можно ограничиться простейшим протоколом связи web-server'а с нашим клиентом. А весь функционал, отображение и взаимодействие компонентов возложить на клиентское приложение. К тому же по возможностям любой нормальный язык гораздо гибче чем java-script. В таком случае нужно создать надстройку над web сервером, реализующую какой-нибудь язык программирования и чтобы разгрузить SQL server, возложить на эту настройку отработку всех алгоритмов и бизнес-правил, а SQL серверу оставить роль которая ему и предназначена изначально - хранение и выборка данных. Тем более что количество stored-procedures росло лавинообразно да и убогенький полуязык на котором они писались затруднял решение некоторых задач.
    После некоторых раздумий для сервера приложений был выбран mod_perl,  благодаря в основном хорошим отзывам в инете и огромной библиотеке бесплатных модулей. Программу-клиент решили реализовать на Delphi, сказался наш многолетний опыт работы и имеющиеся наработки. Руководство спешило, поэтому раздумывать времени не было.
     В этой статье будут описаны наши первые шаги по созданию распределенной системы. Все примеры сопровождаются полным набором исходников, так что вы сможете либо повторить наш путь, или пойти своим.. Кроме этих примеров скоро будет выложена для свободного скачивания в исходных кодах небольшая складская система. В будущем, если будет время, мы собираемя добавить информацию по шифрации и сжатию передаваемых данных, аутентификации, развитию протоколов связи и т.д..

Установка Web сервера Apache и mod_perl.

Вначале скачайте исходники для apache версии 1.3.xx у производителя http://apache.rinet.ru/dist/httpd/apache_1.3.31.tar.gz. Также вам понадобятся исходники mod_perl версии 1.2x - их можно взять с сайта разработчиков
Начинаем работу: разархивируем файлы, производим конфигурацию, сборку, тестирование и установку дистрибутивов:
root> tar -zxvf ./apache_1.3.31.tzr.gz
root> tar -zxvf ./mod_perl-1.0-current.tar.gz
root> cd ./mod_perl-1.29
root> perl Makefile.PL APACHE_PREFIX=/usr/local/apache \
> APACHE_SRC=../apache-1.3.31/src \
> DO_HTTPD=1 \
> USE_APACI=1 \
> EVERYTHING=1

root> make
root> make test
root> make install

    Не обращайте внимание на сообщение Must skip important tests without LWP. Для успешного прохождения этих тестов пришлось бы установить еще несколько пакетов, которые нам сейчас не нужны. Посмотрите размер файла httpd в директории /usr/local/apache/bin/  - он должен составить примерно 600 или более килобайт. Точное значение для конкретного компилятора, платформы и библиотек нельзя предугадать, однако если размер значительно меньше этой величины, то скорее всего что-то прошло неправильно. Чтобы запустить WEB сервер необходимо перейти в каталог указанный в опции APACHE_PEFIX и выполнить команду ./bin/apachectl start.

root> cd /usr/local/apache
root> ./bin/apachectl start
    Теперь запустите свой любимый браузер и наберите http://localhost. Если все произошло без ошибок, вы должны увидеть стартовую страницу вашего сервера.
Кроме этого нам понадобится библиотека, поддерживающая объект Request, который позволяет облегчить разбор html заголовков.
    Ее можно скачать с сайта CPAN или у нас. Разархивируем, конфигурируем, устанавливаем:
root> tar -zxvf ./libapreq-1.3.tar.gz
root> cd ./libapreq_1.3
root> perl ./Makefile.PL
root> make
root> make install


Настройка httpd.conf

    Для продолжения экспериментов нам необходимо настроить файл конфигурации Apache httpd.conf. Обычно он находится в каталоге  /usr/local/apche/conf.  Откройте его с помощью редактора (предварительно создав копию). В первую очередь поместите в него строку:
PerlFreshRestart On
    Apache + mod_perl очень любит кэшировать откомпилированные программы, поэтому даже после перезапуска Apache, изменения, внесенные в текст модулей могут не обновиться в кеше и придется делать перезапуск  ОС. Эта строка как раз и заставляет Apache обновлять модули при каждом рестарте. Вообще говоря обновление кеша после изменения текста модулей достаточно неприятная проблема, т.к. нужно не забывать давать команду apachectl restart после каждого изменения. Как частичное решение можно предложить использование специальных модулей вроде Apache::Reload (исходники и документация), или применять require вместо use на время отладки, однако и это не спасает при изменении первичных модулей-обработчиков. Так что отдельная открытая  консоль с командой apachectl reload  в буфере - самое простое и надежное решение.
    Существует несколько способов использования mod_perl - например в режиме эмуляции CGI-вызовов, для чего служат модули Apache::Registry или Apache::Run. Однако они только эмулируют CGI и при этом теряются многие преимущества mod-perl. Для уменьшения времени реакции системы и повышения быстродействия авторами mod_perl рекомендуется создание специальных модулей-обработчиков.

    Теперь немного теории. Для того чтобы сервер выполнил ваш модуль необходимо чтобы:
  • он был правильно зарегистрирован в конфигурационном файле,
  • был расположен в соответствующем каталоге файловой системы,
  • имел права на чтение и исполнение для пользователя под которым работает сервер,
  • а также должен быть доступным для адресации в системе каталогов Perl.

    Предположим,  что основным каталогом, относительно которого будет происходить поиск исполняемых модулей будет стандартная директория Apache /usr/local/apache/cgi-bin. Создадим в ней еще один каталог ./ThreeTier в котором и будем создавать файлы модулей. Для этого выполним следующие команды:

root> cd /usr/local/apache/cgi-bin
root> mkdir ./ThreeTier

    Теперь нам необходимо передать серверу информацию об этом каталоге. Точнее эта информация нужна не серверу, а Perl, который в момент старта сервера должен добавить в хеш %INC информацию о каталогах в которых нужно искать исполняемые файлы. Например, если серверу потребуется найти мoдуль ThreeTier::ExampleOne.pm, он должен начать поиск с /cgi-bin, найти в нем каталог ThreeTier и, уже там считать и выполнить файл ExampleOne.pm. Для решения этого вопроса нужно использовать опцию  PerlRequire  в httpd.conf. Аргументом этой опции служит абсолютный путь к программе Perl, которая запускается один раз при старте сервера. Поскольку указывается абсолютный путь, то не имеет особого значения где расположен и как называется файл программы. В этом примере мы назовем его PerlRequire.pl поместим в каталог cgi-bin/ThreeTier вместе с модулями. В самом же файле вызовем директиву use lib для указания начального каталога поиска модулей. Кроме назначения начального каталога этот файл может служить для предзагрузки некоторых модулей Perl, стандартных, или созданных программистом. Например для работы с базами данных, или взаимодействия с Apache.
    Итак создаем файл /usr/local/apache/cgi-bin/ThreeTier/PerlRequire.pl.


#!/usr/bin/perl
use Apache                          # Предзагрузка модуля из стандартных путей Perl
use lib '/usr/local/apache/cgi-bin  # Добавление дополнительного пути поиска

1;                                  # Стандартный код возврата


    Назначаем права доступа для этого файла. Владелец - пользователь от имени которого запускается Web сервер, в данном случае nobody. Права для пользователя - только чтение и исполнение.

root> cd /usr/local/apache/cgi-bin/ThreeTier
root> chown nobody ./PerlRequire.pl
root> chmod 500 ./PerlRequire.pl
    Можно конечно принять и другую политику безопасности, тем более для примера, главное чтобы посторонний пользователь не смог изменить этот файл.

    Теперь добавляем следующую строку в httpd.conf:

PerlRequire /usr/local/apache/cgi-bin/ThreeTier/PerlRequire.pl
    После перезапуска Apache (apachectl restart) любой поиск модулей будет происходить в том числе и относительно .../cgi-bin. Кроме того уже на этапе старта будет загружен и откомпилирован модуль Apache и все связанные с ним модули, расположенные в стандартных путях поиска.
    Наш сервер готов к тому чтобы мы написали и зарегистрировали наш первый пример.


Пример №1

Сервер

    В качестве первого примера  попробуем создать простейший эхо сервер. Он будет принимать произвольную строку по команде POST  и возвращать ее клиенту. Везде далее будет использоваться только метод POST. Метод GET весьма ограничен как по длине передаваемой строки, так и по набору символов, которые он в состоянии принять. 
    Создаем в каталоге ThreeTier файл ExampleOne.pm. Для того чтобы сервер знал когда и как его нужно выполнять редактируем файл httpd.conf, добавляем в него следующие строки:

   SetHandler perl-script
   PerlHandler ThreeTier::ExampleOne

    Теперь при обращении по адресу http://your_server/exampleone Apache заставит mod_perl найти файл находящийся по относительному пути ThreeTier с именем ExampleOne и предопределенным типом .pm (стандартное расширение для модулей Perl). После этого он попытается исполнить находящуюся в этом модуле функцию handler. Отредактируем ExampleOne.pm следующим образом:
package ThreeTier::ExampleOne;
use strict;
use warnings;

sub handler
{
     my $r = shift;
     Apache->request( $r );
     $r->send_http_header('text/plain');
     if( $r->method ne 'POST')
     {
           print "Неверный метод вызова";
           return 0;
     }
      my $req = ;
      print $req;
}

1;
    Разберем этот файл построчно. Определение модуля package ThreeTier::ExampleOne должно соответствовать имени файла и каталогов по относительному пути поиска, только разделители каталогов заменяются на ::, а в конце не учитывается расширение. use strict заставляет Perl более тщательно проверять файл при компиляции - например запрещает использование необъявленных предварительно переменных, use warnings - генерирует большее чем обычно количество сообщений при выполнении программы. Эти две директивы помогут с отладкой и предостерегут в некоторых случаях от грубых ошибок в программе. Далее следует объявление процедуры sub handler. По умолчанию это точка входа mod_perl, куда он передает управление после получение запроса к ExampleOne.pm. Дальше уже следует полностью подконтрольный нам текст программы.
    В качестве аргумента handler получает объект типа Apache::Request, вначале мы сохраняем его в локальной переменной $r, а в следующей строке приводим к необходимому типу. Отсылаем клиенту заголовок ответа с типом контента -  в данном случае - простой текст (можно применить text/html или еще что-нибудь - это может зависеть от файрволов и прокси-серверов, которые вы применяете, например некоторые файрволы проверяют документ на соответствие его содержания объявленному типу). Далее анализируем передан ли поступивший запрос по методу POST? Для этого служит свойство method объекта Apache::Request. Если метод не является POST - мы выходим из обработчика с признаком ошибки return 0 (нулевое значение возвращаемое функцией обычно служит для обозначения ошибки в mod_perl) и пересылаем клиенту строку с текстом предупреждения о неверном вызове. В случае если метод равен POST, то считываем текст присланного от клиента сообщения в локальную переменную $req (mod_perl переопределяет файл стандартного ввода на прием POST сообщений, а стандартный вывод - на ответ сервера), после чего отсылаем  ее обратно клиенту. На этом работа сервера завершается и он начинает ожидать следующий запрос.

Клиент

    Для создания клиента воспользуемся DELPHI, примеры написаны под версию 6, однако можно воспользоваться любой версией (от 4 до 7-й), которая поддерживает следующие  свободно распространяемые компонеты: RxLib для создания некоторых элементов интерфейса и временных таблиц в памяти и Indy (Internet direct) для поддержки http (https) протокола (обычно поставляется вместе с версиями 6 и 7). Установка этих компонентов обычно не вызывают никаких трудностей.
    Создаем новое приложение средствами DELPHI. Объявляем переменную HTTP типа TIdHTTP, при обработке создания главной формы вызываем конструктор для этого объекта, при закрытии - соответственно деструктор.
use  ....... IdHTTP;
......
private
    HTTP : TIdHTTP;
.......
procedure TfExample01.FormCreate(Sender: TObject);
begin
  HTTP := TIdHttp.Create(Self);
end;
........
procedure TfExample01.FormDestroy(Sender: TObject);
begin
  HTTP.Free;
end;
    Добавляем два мемо поля, называем их memPost и memReceive в первое будем записывать передаваемое сообщение, а во втором увидим возвращаемое значение (или текст ошибки). Создаем кнопку и по нажатию на нее пишем следующий обработчик:
procedure TfExample01.BitBtn1Click(Sender: TObject);
var
  tmpStream : TStringStream;
begin
  tmpStream := TStringStream.Create('');
  memReceive.Text := '';
  try
    HTTP.Post('http://your_server/exampleone', memPost.Lines, tmpStream);
    memReceive.Text := tmpStream.DataString;
  except
  on E : Exception do memReceive.Text := E.Message;
  end;
  tmpStream.Free;
end;
    HTTP.Post имеет три аргумента -
  • URL вашего сервера,
  • объект типа TStrings содержащий текст сообщения и 
  • поток, возвращаемый сервером.
    В случае ошибки генерируется исключение - причем ошибка может возникнуть как из-за потери связи или отсутствия сервера в сети (если заменить your_server на your_server1 то появится ошибка Socket Error # 11001), так и от ошибки, возвращаемой сервером (например если мы заменим /exampleone на /exampleone1 то появится сообщение 404 Not found). Если все пройдет нормально, то в поле memReceive вы увидите копию текста memPost, если нет - то текст ошибки.

    Если у вас произошла ошибка то посмотрите файлы /usr/local/apache/logs/access_log и /usr/local/apache/error_log. Они обычно помогают диагностировать ее причину. И не забывайте перезапускать сервер после каждого обновления текстов модулей и изменений в конфигурации!
Таким образом мы смогли передать сообщение на сервер и принять ответ от него. Конечно, практической пользы от этого примера немного - это своеобразный тест для диагностики работы сервера  и правильной установки всех компонентов.

Пример №2

    Итак мы получили весьма бесполезную программу. Попробуем немного преобразовать ее, чтобы она могла очень много, буквально все что можно.

Сервер

    Для этого нужно совсем ничего, копируем файл ExampleOne.pm в ExampleTwo.pm :
root> cd /usr/local/apache/cgi-bin/ThreeTier
root> cp ./ExampleOne.pm ./ExampleTwo.pm
    Вносим в ExampleTwo.pm небольшие изменения (выделены цветом):
package ThreeTier::ExampleTwo;
use strict;
use warnings;

sub handler
{
     my $r = shift;
     Apache->request( $r );
     $r->send_http_header('text/plain');
     if( $r->method ne 'POST')
     {
           print "Неверный метод вызова";
           return 0;
     }
      my $req = ;
      print eval( $req );
}

1;
    В первой строке меняем имя пакета на ThreeTier::ExampleTwo так как поменялось имя файла, а в последней строчке процедуры handler  выводим не строку запроса POST, а результат выполнения строки запроса как выражения Perl. Чтобы сервер смог увидеть этот модуль добавляем несколько строк в httpd.conf:

   SetHandler perl-script
   PerlHandler ThreeTier::ExampleTwo


Клиент

    Теперь делаем минимальные изменения в программе - клиенте:
procedure TfExample01.BitBtn1Click(Sender: TObject);
var
  tmpStream : TStringStream;
begin
  tmpStream := TStringStream.Create('');
  memReceive.Text := '';
  try
    HTTP.Post('http://your_server/exampletwo', memPost.Lines, tmpStream);
    memReceive.Text := tmpStream.DataString;
  except
  on E : Exception do memReceive.Text := E.Message;
  end;
  tmpStream.Free;
end;
    И все готово, осталось только перезапустить сервер командой /usr/local/apache/bin/apachectl restart. Но по причинам о которых чуть ниже - категорически и настоятельно рекомендуем перед этой командой вытащить из сервера все сетевые кабели  (а заодно и шнур питания). Но предположим что мы люди отважные до безрассудства и все же перезапустились. Теперь если в верхнем мемо поле написать 2+2 то после нажатия на кнопку Request мы получим ответ 4. Это уже какая никакая польза от программы - как никак удаленные вычисления!
    Итак мы увидели что несмотря на практически безграничные возможности, этот модуль открыл огромную дыру в защите нашей системы. Такую же как например telnet без пароля. Любой шалунишка, способный ронять сервера только со стола на пол, в состоянии причинить нам массу неприятностей. Вся следующая писанина будет посвящена только тому, как найти компромисс между примером №1 и примером №2, между полной бесполезностью, но защищенностью, и полным подчинением сервера клиенту.
    Никаких скомпилированных примеров под наш сервер по понятным причинам тут нету, а файл конфигурации естественно не содержит код для доступа к exampletwo. Так что не пытайтесь...

Пример №3

    Прежде чем начинать создание новой программки, подумаем насчет структуризации предаваемой и получаемой информации. Ясно что к серверу должна приходить не просто какой-то массив байт, а структурированный запрос, который сервер мог бы разбить на элементы, а затем после некоторой интерпретации выполнить только ту работу, на которую мы рассчитываем. Ни в коем случае не больше, но и не меньше. Кроме того и возвращаемые данные должны быть как-то разделены друг от друга. В этом примере мы пока поразбираемся и предложим простейшую модель синтеза на стороне клиента и парсинга на стороне сервера  некоторого, наперед неограниченного количества именованных аргументов.     Существует множество способов передать информацию вида ключ-значение.  От простейших разделителей, ограничителей,  системы кодирования запросов в http-протоколе и заканчивая всеобъемлющим и модным сейчас XML (добавим от себя и крайне громоздким). Мы пойдем по пути простейших ограничителей  (усложнить вы сможете и сами), где каждая посылка будет представлена в виде: 
arg1=vol1,arg2=vol2,arg3=vol3, ....,argX=volX,......,argN=volN,
здесь "=" и "," являются символами-разделителями, соответственно "," разделяет пары друг от друга, а "=" имя аргумента от его значения. Из этого следует что ни в строках - именах аргументов ("argX"), ни в строках - значениях ("volX") эти символы встречаться не должны. Для этого требуется некоторая трансляция символов в именах и значениях. Можно применить Base64 для каждой строки, а разделители выбрать так чтобы они  попали в запрещенный для этой кодировки набор (например # и $). В этих и последующих примерах мы поступим проще, чтобы не загромождать тексты программ - просто выберем в качестве разделителей редко используемы символы из ASCII таблицы. В дальнейшем, чтобы случайно не передать разделители на сервер просто заменим их, если они встретятся в именах или значениях на пробелы (или сформируем исключение в момент формирования строки запроса).
    A в этом примере оставим знак "," разделителем пар, а знак "=" - разделителем имен аргументов от их значений.

Клиент

    Начнем на этот раз с программы-клиента. Объявим символы-разделители как константы:
const
    d_fld = '=';
    d_rec = ',';
    Перед отправкой строки из мемо-поля объединим их в форматированную строку следующим образом:
for i:= 0 to memPost.Lines.Count -  1 do
begin
   s := s + 'args' + IntToStr(i) + d_fld + memPost.Lines[i] + d_rec;
end;
    Если мы заполним  мемо-поле произвольным набором цифр то результирующая строка будет выглядеть как:
args0=234,args1=546,args2=66,args3=67,args4=324,
    Дальнейшая отправка запроса и получение ответа ничем не отличается от предыдущих примеров. За исключением того что URL в HTTP.Post будет выглядеть как
'http://11.0.0.1/examplethree'


Сервер

    Копируем файл ExampleTwo.pm в ExampleThree.pm, вносим дополнения в httpd.conf:

   SetHandler perl-script
   PerlHandler ThreeTier::ExampleThree
    Редактируем файл ExampleThree.pm, вначале поменяем имя пакета:
package ThreeTier::ExampleThree;
    Объявляем переменные-разделители (при использовании use strict все переменные, не помеченные через my или local необходимо объявлять в программе, иначе использование необъявленной переменной вызовет ошибку компиляции, и сервер вернет вам 500-ю ошибку).
use vars qw ($d_fld $d_rec);
    Теперь присваиваем этим переменным те же значения что и у клиента:
$d_fld = "=";
$d_rec = ",";
    Создаем небольшую функцию разбора пришедшей строки. В качестве аргумента она получает строку с разделителями, а результатом является ссылка на хеш (массив, адресуемы не целым, а строковым индексом):
sub requestParser
{
    my @params = split /$d_rec/, shift;
    my %args;
    grep {my @param = split /$d_fld/; $args{$param[0]} = $param[1]; } @params;
    return \%args;
}
    В первой строчке полученная через shift строка разбивается на массив строк с помощью встроенной функции split и присваивается локальной переменной @params. В результате элементы массива @params будут содержать примерно такие данные:
$params[0] = "args0=234";
$params[1] = "args1=546";
и т.д.
    Затем объявляем хеш %args. Встроенная в Perl функция grep примененная к массиву @params выполняет заключенный в блок {} набор операторов для каждого элемента массива. Она сначала разбивает строку на две, по символу-разделителю $d_fld ("=" в этом примере) и присваивает имя аргумента нулевому элементу массива @param, а значение - первому элементу. А затем создает новый элемент хеша %args с ключом равным элементу 0 массива @param и значением, равным элементу номер один. Если вдруг имена ключей совпадут, то произойдет замена старого значения на новое, об этом следует помнить при выборе имен для аргументов! В результате мы получим хеш со следующими значениями:
$args{'args0'}='234';
$args{'args1'}='546';
и т.д.
    После этого ссылка на хеш возвращается в вызвавшую программу:
return \%args;
    Поступившая от requestParser ссылка на хеш обрабатывается следующим образом:
my $args = requestParser($req);
my $tmpSum = 0;
my $tmpStr = '';
foreach my $par (sort keys(%$args))
{
  $tmpStr .= "$par=$args->{$par}\r\n";
  $tmpSum += $args->{$par};
}
print "Сумма аргументов:\r\n$tmpStrРавна : $tmpSum";
    Значение ссылки присваивается локальной для handler переменной $args, объявляются две переменные, инициализируемые нолем и пустой строкой, используемые затем для формирования ответа сервера и программа входит в цикл. Для каждого ключа, отсортированного по возрастанию выполняются следующие операции: к $tmpStr прибавляются значения "имя ключа"="значение ключа" (т.е. практически повторяется операция, примененная на клиенте) плюс возврат каретки и перевод строки (своего рода разделители, служащие для форматирования вывода в окне клиента) . А в $tmpSum накапливается сумма всех значений параметров запроса. Оператор print отправляет результат клиенту. Перезапускаем сервер (apachectl restart) и смотрим на результат:
    Конечно, этот пример имеет массу недостатков -  отсутствие проверки на соответствие аргументов числовым значениям, неформатированный вывод (вряд ли "\r\n" можно назвать форматированием), что не дает возможность вернуть массив или таблицу со значениями, да и хотелось бы заставить сервер выполнять несколько функций. Со всеми этими недостатками мы и поборемся в следующих примерах.


Пример №4


    В этом разделе мы заставим сервер выполнять несколько функций из разных модулей. В сложных программах, когда количество функций и процедур насчитывает сотни и тысячи, хотелось бы группировать их в отдельных модулях, и вызывать не только по имени, но и по имени файла в которых они находятся. Для решения этой проблемы мы поступим довольно просто, введем дополнительные параметры с предопределенными именами в строку вызова. Сервер должен будет их опознать, после чего сначала попытаться найти и загрузить исполняемый файл с именем модуля, а затем вызвать функцию по ее имени и передать этой функции оставшиеся параметры. Мы совершенно свободны в выборе имен для параметров, назначим для модуля имя параметра _mod, а для функции - _func. Подчеркивания мы ввели только для того чтобы показать, что это служебные параметры и они не будут считаться аргументами для вызываемых функций, с другой стороны их проще искать отладчиком в строке вызова, если возникнут какие-то проблемы.

Клиент

    Возьмем исходник из примера 3, и добавим к нему два новых элемента - выпадающие списки cbFunc и cbMod. C их помощью мы сможем указать какой модуль мы используем и какую функцию в нем мы вызываем. cbMod будет содержать три строки:
  • ExampleFourMath
  • ExampleFourString
  • undefined
    Соответственно для математических и строковых операций. Строка undefined добавлена для того, чтобы посмотреть что случится, если клиент вызвал несуществующий модуль.
    cbFunc, в свою очередь, будет заполнен именами функций:
  • min
  • max
  • average
  • sum
  • undefined
    Некоторые из этих функций будут использоваться обоими модулями, но в разных контекстах. Например в случае выбора функции sum и модуля ExampleFourMath, должна вернуться сумма аргументов, а в случае с модулем ExampleFourString - конкатенация этих аргументов как строк.
    Теперь после цикла с созданием строки запросов добавим следующие операторы и изменения (выделены цветом):
for i:= 0 to memPost.Lines.Count -  1 do
begin
  s := s + 'args' + IntToStr(i) + d_fld + memPost.Lines[i] + d_rec;
end;

s := s + '_func' + d_fld + cbFunc.Text + d_rec;
s := s + '_mod' + d_fld + cbMod.Text + d_rec;
reqStream := TStringStream.Create(s);

HTTP.Post('http://11.0.0.1/examplefour',
     reqStream,
     tmpStream);
    Другими словами, мы добавляем к строке запроса строчку вроде "_func=min,_mod=ExampleFourMath". Ну и меняем URL как обычно для нового примера. Больше ничего в клиенте менять не будем.

Сервер


    Как обычно копируем ExampleThree.pm  в ExampleFour.pm и добавляем несколько строк в httpd.conf:

   SetHandler perl-script
   PerlHandler ThreeTier::ExampleFour

    Делаем несколько небольших, но важных изменений в ExampleFour.pm:
my $args = requestParser($req);
my $func = $args->{_func};
delete($args->{_func});
my $mod = $args->{_mod};
delete($args->{_mod});
unless( eval "require ThreeTier::$mod")
{
   print "Неизвестный модуль $mod";
   Apache::exit();
}
no strict 'refs';
my $f;
$f = ("ThreeTier::" . $mod . "::" . $func);
if(defined(&$f))
{   
   $f->($args);
}
else
{
   print "Неопределенная функция $func в модуле ThreeTier::$mod";
   Apache::exit();
}
use strict 'refs';
return 1;
    В первой строке изменений мы присваиваем переменной $func значение из хеша с ключом '_func', а затем удаляем этот элемент из массива, чтобы он не смешивался с аргументами для функций. Тоже самое мы проделаем и с переменной $mod и с элементом, определенным ключом '_mod'. Конечно модно добавить проверки, есть ли такие ключи в хеше, сделать небольшую процедуру по стиранию их из хеша по образцу, но не будем загромождать пример.
    Теперь вызываем интерпретацию (eval) строки вида "require ThreeTier::ExampleFourMath", тем самым mod_perl пытается откомпилировать и загрузить в свое пространство имен файл ExampleFourMath.pm из каталога  ThreeTier находящегося в свою очередь в одном из каталогов, указанных для Perl как по умолчанию так и директивами use lib из PerlRequire.pl. Если файл существует, и может быть откомпилирован, eval возвращает ненулевой результат и программа продолжается. В противном случае возвращается сообщение об ошибке и handler прерывает свою работу (Apache::exit()). Заметим, что просто выйти из mod_perl, используя например, halt, нельзя, это может привести к краху системы. Рекомендуется return 1, если это главный handler, или Apache::exit - в любом месте программы или вложенной функции.
    Дальше используется директива no strict 'refs'. Она необходима чтобы снять ограничение на вызов функции по имени. Так как у нас вначале модуля указано use strict - то выполнение такого вызова приведет к ошибке. И это правильно практически всегда, но только не здесь. Объявляем переменную $f которая будет хранить ссылку на функцию, определяемую строкой вида "ThreeTier::ExampleFourMath::max".  Для получения ссылки на функцию по строке применяются круглые скобки (). Ну такой уж синтаксис в Perl ! Ужас конечно, а есть еще регулярные выражения... Но как ни странно он живет и процветает последние 20 лет.
    Проверяем создалась ли ссылка if(defined(&$f)) (тоже перл !!!) и если да - то вызываем эту функцию по ссылке, передавая ссылку на хеш с аргументами $f->($args) (и тут не лучше...). А если нет, печатаем сообщение что забыли мы эту функцию создать, или не оттуда вызываем, после чего выходим из обработки. После вызова функции возвращаем на место  директиву use strict и тоже выходим.
Теперь нам надо создать файлы-модули содержащие реализацию наших функций. Файлов будет два - один ExampleFourMath.pm и второй ExampleFourString.pm. Оба они будут находиться в каталоге ..../ThreeTier. Вообще-то их можно запрятать куда-нибудь подальше от любопытных глаз в файловую систему, в том числе и не в дерево файлов Apache, но для этого придется поменять как PerlRequire.pl (добавив use lib) так, возможно и префиксы пакетов как в handler, так и в самих объявлениях пакетов. Но оставим все как есть, у нас тут все-таки примеры, а не корпоративный кластерный сервер.
    Итак фрагмент файла ExampleFourMath.pm:
package ThreeTier::ExampleFourMath;
use strict;
use warnings;

sub sum
{
  my $args = shift;
  my $tmpVal = 0;
  my $tmpStr = '';
  foreach my $par (sort keys(%$args))
  {
    $tmpVal += $args->{$par};
    $tmpStr .= "$par = $args->{$par}\r\n";
  }
  print "Сумма параметров :\r\n$tmpStrРавна: $tmpVal";
  Apache::exit();
}

sub average
{
  my $args = shift;
  my @pars = sort keys(%$args);
  my $tmpVal = 0;
  my $count = $#pars + 1;   
  my $tmpStr = '';
  foreach my $par (@pars)
  {
    $tmpVal += $args->{$par};
    $tmpStr .= "$par = $args->{$par}\r\n";
  }
  $tmpVal /= $count;
  print "Среднее значение параметров :\r\n$tmpStrРавно: $tmpVal";
  Apache::exit();
}

............
    Первая строка объявляет файл пакетом с именем ThreeTier::ExampleFourMath, затем следуют обычные директивы хорошо известные по предыдущим примерам, а затем реализации набора функций. Функция sum мало чем отличается от подобного алгоритма в третьем примере. Просто суммирует все значения хеша а потом выводит их список и результат. Average работает почти также, но делит сумму на количество параметров. Реализация остальных функций - тоже совершенно тривиальна (min естественно возвращает минимальное значение, а max - максимальное).
    Теперь посмотрим на ExampleFourString.pm:
package ThreeTier::ExampleFourString;
use strict;
use warnings;

sub sum
{
  my $args = shift;
  my $tmpVal = '';
  my $tmpStr = '';
  foreach my $par (sort keys(%$args))
  {
    $tmpVal .= $args->{$par};
    $tmpStr .= "$par = $args->{$par}\r\n";
  }
  print "Конкатенация параметров :\r\n$tmpStrРавна: $tmpVal";
  Apache::exit();
}
    В общем тоже самое, назначено новое имя пакета в первой строке, а sum вместо суммы выводит конкатенацию строк. Примерно также работает max (ищет самую длинную строку) и min (соответственно самую короткую). Целиком их коды не приводятся - если интересно, то можно скачать исходники примеров и посмотреть там. Перезапускаем Apache и смотрим результаты.
    Осталось еще много проблем, которые надо решить, например типизация, форматированный вывод и парсинг результатов, но мы все ближе к цели.

Пример №5

    В предыдущих примерах мы получали от сервера неформатированную строку. Попробуем упорядочить вывод результатов. Применим тот же метод что и при отправке аргументов в запросе - то есть разделители.  Предположим что наш сервер должен возвращать набор нескольких таблиц за один раз. Это довольно распространенный случай - например для накладной нужно вернуть ее заголовок из нескольких полей (массив, или таблица из одной строки) и табличную часть. Поэтому будем использовать три различных разделителя:
  • разделитель полей в записи (скаляров в одномерном массиве)
  • разделитель  записей в двумерном массиве
  • разделитель таблиц в возвращаемом наборе данных
    Мы можем, как и в случае с запросом, использовать редкие символы ASCII,  "защитить"  случайно встречающиеся символы разделителей в строке с помощью  другого спец-символа (наподобие строки в С), преобразовывать строки в набор Base64 (или подобный ему) и использовать в качестве разделителей запрещенные в этом наборе символы или применить какой-нибудь стандартный XML формат и т.п. В общем случае Base64 позволил бы передавать не только строковые значения, но и двоичные данные, например изображения. Но опять же для простоты примера применим первый способ. В примере, который вы сможете скачать в качестве разделителей используются ASCII символы 18, 19 и 20 (десятичные значения). Для наглядности в этом тексте будут использоваться соответственно
  • '='  - разделитель полей
  • ','  - разделитель
  • '!'  - разделитель таблиц

Сервер


    Создаем файл ExampleFive.pm по образцу ExampleFour.pm и, дополнительно, ExamleFiveGlobal.pm - в который мы вынесем все константы и функции из ExampleFive.pm, оставив там только handler. Функции из ExampleFiveGlobal будут интенсивно использоваться другими модулями, формирующими ответ сервера.
    Файл ExampleFive.pm:
package ThreeTier::ExampleFive;
use strict;
use warnings;
use ThreeTier::ExampleFiveGlobal;

sub handler
{
    my $r = shift;
    Apache->request($r);
 
    $r->send_http_header('text/plain');

    if($r->method ne 'POST')
    {
        print "
Bad method request
";
        return 0;
    }
   
    my $req = ;
   
    my $args = requestParser($req);
    $strRespond = '';
    callUserFunction($args);
    sendOK();
    return 1;
}

    В четвертой строке мы импортируем функции и константы из ExampleFiveGlobal.pm:
requestParser($req) - создает хеш аргументов запроса так же как и в предыдущих примерах:
sub requestParser
{
    my @params = split /$d_rec/, shift;
    my %args;
    grep {my @param = split /$d_fld/; $args{$param[0]} = $param[1]; } @params;
    return \%args;
}
    А callUserFunction($args) выполняет заданную клиентом функцию:
sub callUserFunction
{
    my $args = shift;
    my $parentPackage = 'ThreeTier::';
    my $strFunc = $args->{_func};
    my $strMod = $parentPackage . $args->{_mod};
   
    unless( eval "require $strMod")
    {
        sendError("Неизвестный модуль $strMod");
    }
    no strict 'refs';
    my $func = ($strMod . "::" . $strFunc);
   
    unless(defined(&$func))
    {   
        sendError("Неопределенная функция $strFunc в модуле $strMod");
    }
    $func->($args);
    use strict 'refs';
}
    Оставшиеся пока неопределенными sendOK и sendError рассмотрим чуть позже.
    Заголовок ExampleFiveGlobal.pm:
package ThreeTier::ExampleFiveGlobal;
use strict;
use warnings;
use Exporter;

use vars qw(@ISA @EXPORT $d_fld $d_rec $d_set $strRespond);

@ISA = qw(Exporter);
@EXPORT = qw($d_fld $d_rec $d_set $strRespond &callUserFunction &requestParser
             &addEmptySet &addField &addRecord &addSet &sendError &sendOK
             &isDecimal &isInt);

$d_fld = chr(20);
$d_rec = chr(19);
$d_set = chr(18);
$strRespond = '';
    Вначале объявляется имя модуля package ThreeTier::ExampleFiveGlobal;, потом следуют две стандартные директивы use strict и use warnings, рассмотренные в предыдущих примерах. Следующая директива, use Exporter, служит для подключения встроенного модуля Exporter, чтобы мы могли реализовать экспорт имен в другие модули стандартными средствами. use vars объявляет глобальные переменные этого модуля : @ISA и @EXPORT служат для реализации стандартных механизмов экспорта, $d_fld,$d_rec и $d_set - переменные, содержащие разделители полей, записей и таблиц. $strRespond  - глобальная переменная-накопитель в которой хранится ответ сервера.
    @ISA = qw(Exporter) - опять же служит для удовлетворения стандартов экспорта в Perl. Массиву @EXPORT присваивается список всех функций и переменных, которые будут экспортированы из этого модуля. Если вы упустите какую-нибудь из них в этом списке, то внешние модули не смогут к  ним обратиться. Естественно, что внутренние функции и служебные переменные модуля в этом списке присутствовать не должны. Далее следует инициализация глобальных переменных.
    Теперь создадим функции, которые будут принимать скаляры, массивы и массивы массивов и преобразования в строку ответа. Ниже приводится описание функции addSet, которая получает в качестве аргумента ссылку на массив ссылок на массив (в нормальном языке - двумерный массив), преобразует ее в строку и прибавляет результат к глобальной переменной $strRespond:
sub addSet
{
  my ($prs) = shift;
  foreach my $pr (@$prs)
  {   
     $strRespond .= join($d_fld , @$pr) . $d_fld . $d_rec;
  }
  $strRespond .= $d_set;
}
    Вначале мы получаем через shift передаваемый аргумент, а затем для каждой записи (ссылка на массив) выполняем процедуру join, которая берет строковое значение каждого поля (элемента массива) и объединяет их в одну строку используя указанный нами разделитель. Поскольку мы используем ограничители, а не разделители (так удобнее будет разбивать строки на массивы данных на стороне клиента), то добавляем в конце ограничитель для последнего поля и ограничитель записи для одномерного массива. В конце прибавляем к результирующей строке ограничитель таблицы. Пример работы этой функции - если мы передадим указатель на массив:
 1  2  3
 4  5  6
 7  8  9
11 12 13
то получим результат:
1=2=3=,4=5=6=,7=8=9=,11=12=13=,!
    Иногда вместо двумерного массива надо передать одномерный (или запись). Для этого служит функция addRecord, она принимает ссылку на массив и выдает строку, содержащую таблицу с одной строкой:
sub addRecord
{
    my $pr = shift;       
    $strRespond .= join($d_fld , @$pr) . $d_fld . $d_rec . $d_set;
}
    Аргумент:
1 2 3 4 5 6 7
Результат:
1=2=3=4=5=6=7=,!
    Для передачи скаляра используется add Field:
sub addField
{
    $strRespond .= shift() . $d_fld . $d_rec . $d_set;
}
    Аргумент:
1
    Результат:
1=,!
    Для передачи пустой таблицы служит addEmptySet, которая просто прибавляет к $strResond строку - "=,!".
    Теперь, вызывая эти функции несколько раз, мы можем сформировать довольно сложный по структуре ответ сервера клиенту.
Но осталась еще одно небольшое дело - обработка ошибок на сервере. До этого мы отсылали простую неформатированную строку и в общем случае невозможно было определить нормальный это ответ, или произошел какой-то сбой. Теперь мы можем условиться, что первая таблица будет содержать код статуса со строкой ошибки. Например, если сервер отработал корректно, то в первом поле первой записи содержится строка "OK", а если нет - то в ней находится строка "Error", а в следующем поле - строковое описание ошибки. Все остальные наборы будут следовать за первой таблицей. Создадим функцию sendOK:
sub sendOK
{
    print 'OK' . $d_fld . $d_rec . $d_set . $strRespond;
}
    Которая прибавляет в начало строки ответа "OK=,!" и отправляет ответ клиенту.
    И функцию sendError которая принимает любую строку:
sub sendError
{
    $strRespond = '';
    print 'Error' . $d_fld . shift() . $d_fld . $d_rec . $d_set;
    Apache::exit();
}
      Она обнуляет результирующую строку, отправляет клиенту сообщение типа "Error=Строка ошибки=,!", и выходит из обработчика.
    Добавим в ExampleFiveGlobal пару полезных функций isInt и isDecimal  которые позволяют определить является ли значение некоторой переменной соответственно целым или дробным числом (они будут полезны для генерации ошибок, если мы передадим серверу неверные аргументы):
sub isDecimal
{
    return ($_[0] =~ m/^\s*[-+]?\d+\.?\d*\s*$/);
}

sub isInt
{
    return ($_[0] =~ m/^\s*[-+]?\d+\s*$/);
}
    Теперь можно перейти к созданию функций,  которые будут обрабатывать наши данные. В этом примере будут добавлены еще 3 модуля  - ExampleFiveField.pm, ExampleFiveRecord.pm и ExampleFiveSet.pm. Первый из них содержит функции возвращающие скаляр, второй - одномерный массив произвольного размера и третий - таблицу с произвольным количеством строк и столбцов.
    Начнем с ExampleFiveField:
package ThreeTier::ExampleFiveField;
use strict;
use warnings;
use ThreeTier::ExampleFiveGlobal;

sub sum
{
  my $args = shift;
  sendError('Первое слагаемое не является цифрой !') unless(isDecimal($args->{add_1}));
  sendError('Второе слагаемое не является цифрой !') unless(isDecimal($args->{add_2}));
  addField($args->{add_1} + $args->{add_2});       
}
.........................................
    Заголовок файла обычный, только добавлен импорт нашего глобального модуля use ThreeTier::ExampleFiveGlobal.  Разберем функция sum, которая должна либо вернуть нам сумму двух аргументов, либо строку ошибки. Вначале проверяется являются ли переданные функции аргументы цифровыми (isDecimal), а  если нет, то возвращается строка ошибки через sendError. В случае успеха проверок, клиенту отсылается значение суммы аргументов. Оно содержится в первом поле первой записи второй таблицы, так как в первой таблице передается значение статуса через вызов sendOK в handler. Остальные функции этого модуля max, min и average действуют аналогично.
    Попробуем вернуть одномерный массив.
package ThreeTier::ExampleFiveRecord;
use strict;
use warnings;
use ThreeTier::ExampleFiveGlobal;

sub arProgress
{
  my $args = shift;
  sendError('Начальное значение не является цифрой !') unless(isDecimal($args->{add_1}));
  sendError('Шаг итерации не является цифрой !') unless(isDecimal($args->{add_2}));
  sendError('Количество итераций не является цифрой !') unless(isDecimal($args->{add_3}));
  sendError('Количество итераций должно быть больше 0 !') if($args->{add_3} < 1);
  sendError('Количество итераций должно быть целым !') unless(isInt($args->{add_3}));
  sendError('Количество итераций должно быть меньше 1000 !') if($args->{add_3} >= 1000);
  my @res = ();
 
  for( my $i = 0; $i < $args->{add_3}; $i++ )
  {
    push @res, $args->{add_1} + $i * $args->{add_2};
  }  
  addRecord(\@res);
}
.........................................
    Файл ExampleFiveRecord содержит 3 функции - arProgress - которая вычисляет по начальному значению, шагу и количеству итераций элементы арифметической прогрессии, geoProgress - геометрическую прогрессию, а fibonacci - числа ряда Фибоначчи. Разберем только первую из них - arProgress - остальные в общем аналогичны ей. Вначале через shift получаем ссылку на хеш аргументов. Затем проверяем являются ли они числами, проверяем заданное количество итераций ($args->{add_3})- оно должно быть > 0 и меньше например 1000, чтобы не загружать сервер и, кроме того, быть целым. Количество итераций нужно проверять очень внимательно, т.к. можно попасть в очень большой цикл и в результате строка ответа займет огромное количество памяти сервера. Объявляем пустой массив @res, и в цикле добавляем в него полученные значения (push). addRecord(\@res) добавляет к результирующей строке таблицу с одной записью, полученную из ссылки на массив, после чего sendOK из ExampleFive::handler отсылает результат и статус  клиенту.
    Функции последнего модуля ExampleFiveSet.pm возвращают таблицы:
package ThreeTier::ExampleFiveSet;
use strict;
use warnings;
use ThreeTier::ExampleFiveGlobal;

sub arTable
{
  my $args = shift;
  sendError('Кол-во по горизонтали не является целым числом !') unless(isInt($args->{add_1}));
  sendError('Кол-во по вертикали не является целым числом !') unless(isDecimal($args->{add_2}));
  sendError('Количество горизонтали должно быть меньше 50 но больше 1!')
           if(($args->{add_1} >= 50) || ($args->{add_1} <= 0));
  sendError('Количество вертикали должно быть меньше 50 но больше 1!')
           if(($args->{add_2} >= 50) || ($args->{add_2} <= 0));
          
  my @res = ();
 
  my @rec = ();
  push @rec, '';
  for( my $i = 1; $i <= ($args->{add_1}); $i++ )
  {
        push @rec, $i ;
  }
  push @res, \@rec;
 
 
  for( my $j = 1; $j <= ($args->{add_2}); $j++ )
  {
    my @rec = ();
    push @rec , $j;
    for(my $i = 1; $i <= ($args->{add_1}); $i++ )
    {
        push @rec, $i + $j;    
    }
    push @res, \@rec;
  }  
  addSet(\@res);
}
.........................................
    Он содержит 2 функции - arTable и geoTable. Каждая из этих функций принимает 2 аргумента - размер по вертикали и размер по горизонтали. В результате работы первой из них возвращается таблица сложения, а второй - таблица умножения. Мы рассмотрим только arTable так как geoTable практически полностью подобна ей. Заголовок обычный для наших примеров. Проверки на целое и интервал значений тоже достаточно просты. Создаем пустой массив @res в котором будут сохраняться ссылки на массивы рядов. На стороне клиента, мы будем отображать результат в стандартном объекте TStringGrid, поэтому вместе со значениями, хотелось бы вернуть и строки для подписи заголовков рядов и колонок. Для этого создаем еще один пустой массив @rec и заполняем его значениями от 1 до $args->{add_1}, после чего добавляем ссылку на  него к результирующему массиву @res. Затем формируем двойной цикл от 1 до $args->{add_1} и $args->{add_2}. Во внешнем цикле формируем пустой массив, заполняем его значениями сумм счетчиков, и затем ссылку на заполненный массив добавляем к результирующему массиву. Кроме того для нумерации рядов первым элементом пустого массива становится значение счетчика  внешнего цикла (push @rec, j;). Вызов addSet  преобразует ссылку на результирующий массив в строку. После чего handler отсылает ответ клиенту.
    Добавляем в конец httpd.conf строки:

   SetHandler perl-script
   PerlHandler ThreeTier::ExampleFive

    Перезапускаем сервер:
root> /usr/local/apache/bin/apachectl restart

Клиент

    Настала пора переделать клиент - в этом примере мы добавим модуль парсинга, и вынесем весь код, отвечающий за связь сервером в отдельные модули. Для начала создадим модуль uConnetor.pas, в котором будет содержаться класс TConnector.
TConnector = class
  private
    HTTP : TIdHTTP;
    Composer : TRequestComposer;
    Parser : TRespondParser;
....................................
    Этот класс в свою очередь будет содержать три private объекта :  HTTP типа  TIdHTTP - хорошо знакомый объект Indy для связи с WEB серверами,  Composer типа TRequestComposer - этот класс мы создадим чуть позже - он служит для создания строки запроса и  Parser типа TRespondParser - тоже наш класс для преобразования ответа сервера в структуры данных Delphi.
Определим константы для символов - ограничителей:
const
  d_fld = Chr(20);
  d_rec = Chr(19);
  d_set = Chr(18);
    Теперь создадим класс TRequestComposer - в основном он будет работать также как и процедуры формирования строки запроса в прошлых примерах, но мы добавим некоторые проверки на допустимость имен модулей, функций и параметров. Кроме того, если в значениях параметров будут встречаться символы-разделители, то мы просто будем заменять их пробелом в функции StringToServer. Одним из внутренних полей этого класса будет paramList типа TStringList в который мы сможем добавлять пары "имя-параметра" = "значение-параметра" с помощью процедуры AddParam:
procedure TRequestComposer.AddParam(AName,AValue : String);
begin
 CheckParam(AName);
 paramList.Add(AName + d_fld + StringToServer(AValue));
end;
    CheckParam - проверяет строку имени на допустимость некоторым критериям - например чтобы в ней содержались только латинские буквы и цифры (могут проблемы с ключами в хеше на сервере), чтобы она не начиналась с "_" - так как такие имена мы зарезервировали для специальных параметров (имени модуля и функции).
    Кроме того, определены два свойства Module и Func - для хранения имени модуля и функции. При установке хоть одного из них происходит очистка paramList - незачем хранить параметры, если функция или модуль изменились.
    После установки всех параметров вызывается свойство RequestString через внутреннюю функцию  FGetRequestStrng:
function TRequestComposer.FGetRequestString : String;
var
 res : String;
 i : Integer;
begin
 if Length(_module) = 0 then raise Exception.Create('Имя модуля не может быть пустым !');
 if Length(_func) = 0 then raise Exception.Create('Имя функции не может быть пустым !');
 res := '_mod' + d_fld + _module + d_rec
      + '_func' + d_fld + _func + d_rec;
 for i := 0 to paramList.Count - 1 do
    res := res + paramList[i] + d_rec;
 FGetRequestString := res;
end;
    Сначала проверяются имя и функция на нулевую длину, затем для них формируются специальные параметры _mod и _func, после чего в цикле добавляются все параметры из paramList.
    Некоторые из этих свойств и функций через переопределения в TConnector доступны программисту для прямого использования. Обычный метод применения модуля TConnector для отправки запроса на сервер выглядит следующим образом:
try
  Connector.Module := 'ExampleFiveField';
  Connector.Func := 'sum';
  Connector.AddParam('add_1', '3');
  Connector.AddParam('add_2', '4');
  Connector.Execute;
  ......................
  //Обработка ответа
  ......................
except
   on E: Exception do Memo1.Text := E.Message;
end;
    Здесь мы устанавливаем имя модуля и имя функции, добавляем несколько параметров и вызываем Connector.Execute, который обращается внутри класса к Composer.RequestString и передает ее через HTTP на сервер:
try
  reqStream := TStringStream.Create(Composer.RequestString);
  resStream := TStringStream.Create('');
  HTTP.Post(_URL,reqStream,resStream);
  Parser.Parse(resStream);
except
  on  E : Exception do
  begin
    reqStream.Free;
    resStream.Free;
    raise Exception.Create(E.Message);
  end;
end;
    Конструкция знакома из прошлых примеров. Осталось разобрать парсинг и преобразования возвращаемой строки. Класс создадим в файле uRespondParser и назовем TRespondParser. Основной процедурой этого класса будет TRespondParser.ParseToList, которая позволяет разбить строку на подстроки в соответствии с символом-ограничителем и заполнить этими подстроками TStringList:
procedure TRespondParser.ParseToList(AInputString : PChar; chrDvd : Char; AOutputList : TStringList);
var
 pBeg,pPos,pEnd : PChar;
 fullLen,iLen, i : Integer;
 PTemp : PChar;
 tmp : real;
begin
 AOutputList.Clear;
 pBeg := AInputString;
 pPos := nil;
 pEnd := StrEnd(AInputString);
 fullLen := Length(AInputString);

 pPos := FastStrScan(pBeg, chrDvd, pEnd - pBeg);
 while (pPos <> nil) and (pBeg < pEnd) do
 begin
   iLen := pPos - pBeg;
   PTemp := AllocMem(iLen + 1);
   strMove(PTemp,pBeg,iLen);
   AOutputList.Add(PTemp);
   FreeMem(PTemp);
   pBeg := pPos + 1;
   pPos := FastStrScan(pBeg, chrDvd, pEnd - pBeg);
 end;
end;
    Она принимает три параметра - строку для разбивки, символ-разделитель и коллекцию строк AOutputList, а возвращает количество элементов добавленных в AOutputList.  С ее помощью мы можем разделить строку ответа вначале на таблицы, потом таблицы на записи, а записи на поля. Примененная в последней строке фукция FastStrScan  является заменой стандартной в Delphi StrScan, но работает несколько быстрее, поскольку не определяет при каждом вызове длину строки. Это может быть существенно при длине ответа начиная с нескольких сотен килобайт.
function TRespondParser.FastStrScan(const Str: PChar; Chr: Char; Length : Integer): PChar; assembler;
asm
        PUSH    EDI
        MOV     EDI,Str
        MOV     AL,Chr
        MOV     ECX,Length

        REPNE   SCASB
        MOV     EAX,0
        JNE     @@1
        MOV     EAX,EDI
        DEC     EAX
@@1:    POP     EDI
end;
    Она просто находит первый заданный в аргументе Chr байт с начала строки Str и возвращает либо адрес позиции, либо nil.
    Символы, расположенные от начала строки до найденной  позиции копируются в TStringList. В классе TRespondParser содержатся три списка строк :
  •     SetList : TStringList; - сохраняет строки-таблицы
  •     RecList : TStringList; - строки-записи для одной из таблиц в SetList
  •     FldList : TStringList; - строки, соответствующие полям одной из записей в RecList
    Рассмотрим прием потока от HTTP-сокета, разбиение его на таблицы и обработку ошибок в TRespondParser.Parse(strm:TStringStream):Integer;
function TRespondParser.Parse(strm : TStringStream) : Integer;
var
  s : String;
begin
  strm.Position := 0;
  s := strm.DataString;
  SetList.Clear;
  ParseToList(PChar(s), d_set , SetList);
  if SetList.Count < 1 then raise Exception.Create('Ответ сервера не содержит таблиц!');
  if ParseToList(PChar(SetList[0]), d_rec, RecList) <> 1 then
         raise Exception.Create('Ответ сервера не содержит таблицу статуса!');
  if ParseToList(PChar(RecList[0]), d_fld, FldList) < 1 then
         raise Exception.Create('Ответ сервера не содержит код статуса!');
  if FldList[0] <> 'OK' then
     if FldList.Count < 2 then raise Exception.Create('Ответ сервера не содержит поле ошибки!')
     else raise Exception.Create('Ошибка сервера: ' + FldList[1]);
  SetList.Delete(0);
  Parse := SetList.Count;
end;
    Устанавливаем указатель потока в начало и преобразуем поток в строку. Очищаем список строк SetList и заполняем его, используя разделитель таблиц. Теперь каждый элемент в SetList содержит строку-таблицу. Если после разбивки SetList не содержит элементов - значит произошел какой-то сбой и сервер не вернул структуру статуса. Поэтому мы генерируем ошибку об отсутствии таблиц в ответе. Затем первая таблица в SetList, содержащая таблицу статуса разбивается на записи в RecList и снова анализируется, в ней должна быть ровно 1 запись, если это не так - генерируем ошибку. Далее первая запись из RecList разбивается на поля в FldList, если  полей  нет - снова сообщение об ошибке. Теперь анализируется строка в первом поле FldList[0], если она не равна "OK", то ищется втрое поле, содержащее строку ошибки. Если оно есть - то возникает ошибка, со строкой возвращенной сервером, если нет - то неопределенная ошибка сообщающая о нарушении формата данных. Затем мы удаляем таблицу статуса сервера из списка таблиц и возвращаем количество элементов оставшихся в SetList.
    Для удобства дальнейшего использования этого класса, создадим несколько служебных функций -
  • TRespondParser.DoRecList(ASetNumber : Integer = 0) : Integer;
  • TRespondParser.DoFldList(ARecNumber : Integer = 0) : Integer;
    Первая из них берет строку-таблицу из SetList[ASetNumber], и разбивает ее на поля-записи в RecList, возвращая количество записей. Вторая же разбирает строку-запись RecList[ARecNumber] в список полей FldList и возвращает количество элементов в нем.
    Еще одна функция одна служебная функция GetField нужна  для доступа к полям по индексу:
function TRespondParser.GetField(AFldNumber : Integer = 0) : String;
begin
  if FldList.Count <= AFldNumber then
    raise Exception.Create('Номер поля слишком велик!');
  GetField := FldList[AFldNumber];
end;
    Она возвращает строку под номером AFldNumber из списка FldList или генерирует исключение если индекс слишком велик.

    Теперь можно перейти к примерам. Попробуем вызвать на сервере функцию sum из ExampleFiveFiled - она, как вы помните, должна вернуть только одно значение:
  Memo1.Text := '';
  Edit3.Text := '';
  try
    Connector.Module := 'ExampleFiveField';
    Connector.Func := 'sum';
    Connector.AddParam('add_1', '2');
    Connector.AddParam('add_2', '3');

    Connector.Execute;
    Connector.DoRecList(0);
    Connector.DoFieldList(0);
    Edit3.Text := Connector.GetField(0);
  except
    on E: Exception do Memo1.Text := E.Message;
  end;
    Очищаем Memo1 которое будет выводить текст ошибки и Edit3 - поле результата. Задаем имена модуля и функции - ExampleFiveFiled и sum. Добавляем два параметра и вызываем исполнение на сервере через Execute. При этом создастся строка запроса (GetRequestString), она будет отправлена на сервер (HTTP.Post), потом полученный от сервера ответ будет проанализирован на наличие ошибок и  сохранится в виде строк-таблиц в SetList (Parse). DoRecList(0) выбирает первую строку-таблицу и заносит ее строки-записи в RecList. DoFieldList(0) забирает первую запись из RecList и сохраняет значения полей в FldList. GetField(0) выбирает первую строку из списка полей и записывает в Edit3 как результат работы примера. Если по какой-то причине возникла ошибка, то ее строковое значение попадет в Memo1. Например если add_1 не является числовым, то в Memo1 будет строка  'Ошибка сервера: Первое слагаемое не является цифрой !'.

    Теперь вызовем arProgress из ExampleFiveRecord чтобы получить и обработать одномерный массив.
  Memo2.Text := '';
  lbRes.Items.Clear;
  try
    Connector.Module := 'ExampleFiveRecord';
    Connector.Func := 'arProgress';
    Connector.AddParam('add_1', '10');
    Connector.AddParam('add_2', '3');
    Connector.AddParam('add_3', '5');

    Connector.Execute;
    Connector.DoRecList;
    Connector.DoFieldList;
    for i := 0 to Connector.FieldCount - 1 do
       lbRes.Items.Add(Connector.GetField(i));
  except
    on E: Exception do Memo2.Text := E.Message;
  end;
    Для отображения этого массива воспользуемся списком TListBox lbRes. Пример не слишком отличается от предыдущего, за исключением того, что мы в цикле выбираем значения из FldList и заносим их в список на экране. Количество полученных элементов может быть любым (в пределах разумного). Как результат мы получим последовательность чисел 10,13,16,19,22.

    И последний пример - возврат таблицы. Для этого нужно вызвать arTable из ExampleFiveSet:
  Memo3.Text := '';
  grid.RowCount :=  2;
  grid.ColCount :=  2;
  try
    Connector.Module := 'ExampleFiveSet';
    Connector.Func := 'arTable';
    Connector.AddParam('add_1', '5');
    Connector.AddParam('add_2', '6');

    Connector.Execute;
    Connector.DoRecList;
    grid.RowCount := Connector.RecCount ;
    Connector.DoFieldList;
    grid.ColCount := Connector.FieldCount ;
    for j := 0 to Connector.RecCount - 1 do
    begin
        Connector.DoFieldList(j);
        for i := 0 to Connector.FieldCount - 1 do
        begin
            grid.Cells[i , j ] := Connector.GetField(i);
        end;
    end;
  except
    on E: Exception do Memo3.Text := E.Message;
  end;
    Данные будут отображаться в стандартном объекте Delphi типа TStringGrid. В первой, из выделенных цветом строк, определяется количество рядов в пришедшей таблице через количество элементов в RecList (обертка - свойство Connector.RecCount) . Потом происходит парсинг первой записи,  и определяется количество столбцов. В двойном цикле поочередно  обрабатываются все строки-записи и все поля в них.  Значение каждого поля записывается в соответствующую ячейку TStringGrid.


Пример №6


    В этом примере мы рассмотрим доступ к базе данных MySQL. Для этого нам понадобятся следующие программные компоненты.
для сервера:
  • Сервер MySQL - можно взять с сайта производителя www.mysql.com или у нас
  • DBI - универсальный коннектор баз данных для PERL. Можно взять с нашего сайта или найти на CPAN.
  • Msql-Mysql-module - драйвер для доступа из DBI к Msql и Mysql серверам. Находится у нас или на CPAN.
для клиента:
  • RXLib - хорошо известная библиотека для Delphi. В этом примере мы используем из нее только TRxMemoryData - таблицу, хранимую в памяти. Можно взять c http://sourceforge.net/projects/rxlib.


Установка компонентов на сервере

Установка MySQL хорошо описана во многих статьях. Но если вам не хочется изучать всю документацию мы приведем пример быстрой установки.
    Для начала создадим пользователя и группу от имени которых будет работать демон сервера MySQL:
root> groupadd mysql
root> useradd -g mysql mysql
Скачиваем бинарный дистрибутив в какой-нибудь каталог, разархивируем его в /usr/local:
root> cd /usr/local
root> tar -zxvf /your/path/to/file/mysql-standard-4.0.17-pc-linux-i686.tar.gz
В результате мы получаем  каталог /usr/local/mysql-standard-4.0.17-pc-linux-i686 с файлами дистрибутива. Для удобства дальнейшей работы создаем символьную ссылку mysql на этот каталог:
root> ln -s ./mysql-standard-4.0.17-pc-linux-i686 ./mysql
и переходим в него:
root> cd ./mysql
выполняем скрипт для инициализации системных и тестовых баз данных:
root> ./scripts/mysql_install_db --user=mysql
устанавливаем права доступа для каталогов:
root> chown -R root .
root> chown -R mysql data
root> chgrp -R mysql .
запустим сервер с учетом кодировки клиента (если вы пользуетесь какой-нибудь оболочкой, например Midnight Commander, то перед запуском из нее нужно выйти в чистую консоль):
root> ./bin/mysqld_safe --user=mysql --default-character-set=cp1251  &
К созданию рабочей базы для мы вернемся чуть позже, а пока установим модули для Perl.

    Установка DBI. Разархивируем дистрибутивный файл и войдем в каталог:
root> tar -zxvf ./DBI-1.42.tar.gz
root> cd ./DBI-1.42
Конфигурируем, компилируем, тестируем и устанавливаем модуль:
root> perl ./Makefile.PL
root> make
root> make test
root> make install
На сообщения вроде Warning: prerequisite Test::More failed to load: Can't locate Test/More.pm можно не обращать внимания - мы не будем устанавливать модули детального тестирования.

    Установка Msql-Mysql-module. Аналогично DBI разархивируем и входим в каталог с исходниками:
root> tar -zxvf ./Msql-Mysql-modules-1.2219.tar.gz
root> cd ./Msql-Mysql-modules-1.2219
Конфигурируем, компилируем, тестируем и устанавливаем:
root> perl ./Makefile.PL
Enter the appropriate number:  [3] 1
Do you want to install the MysqlPerl emulation? You might keep your old
Mysql module (to be distinguished from DBD::mysql!) if you are concerned
about compatibility to existing applications! [n] n
Where is your MySQL installed? Please tell me the directory that
contains the subdir 'include'. [/usr/local/mysql] /usr/local/mysql
Which database should I use for testing the MySQL drivers? [test] test
On which host is database test running (hostname, ip address
or host:port) [localhost] localhost
User name for connecting to database test? [undef] root
Password for connecting to database test? [undef]
root> make
root> make test
root> make install
Появляющиеся иногда сообщения наподобие Warning: prerequisite Data::ShowTable failed to load: Can't locate Data/ShowTable.pm in @INC можно игнорировать.

Создадим базу данных и одну таблицу для наших экспериментов:
Открываем новую базу и заходим в нее:
root> /usr/local/mysql/bin/mysql
mysql> create database example;
Query OK, 1 row affected (0.00 sec)
mysql> use example;
Database changed
Теперь вы можете или сами создать таблицу tovar:
mysql> CREATE TABLE tovar(                                          
    -> tv_id int(8) NOT NULL auto_increment,                        
    -> tv_kod varchar(10) NOT NULL default '',                                                       
    -> tv_name varchar(150) NOT NULL default '',                    
    -> tv_cena decimal(12,2) NOT NULL default '0.00',                    
    -> PRIMARY KEY (tv_id),               
    -> FULLTEXT KEY tv_name_idx (tv_name));
Query OK, 0 rows affected (0.02 sec)
или взять нашу, уже заполненную данными , и скопировать ее в базу example:
mysql> \. ~/tovar.sql
Query OK, 430 rows affected (0.05 sec)
Records: 430  Duplicates: 0  Warnings: 0
    Чтобы не обращаться к серверу SQL из скрипта под именем root - тем более что пароль в тексте задается в открытом виде, откроем специального пользователя для наших экспериментов:
mysql> GRANT SELECT,INSERT,UPDATE,DELETE
    -> ON example.*
    -> TO example_user@localhost
    -> IDENTIFIED BY 'example_password';
Query OK, 0 rows affected (0.01 sec)
mysql> FLUSH PRIVILEGES;
Query OK, 0 rows affected (0.01 sec)
    В дальнейшем, когда мы будем обращаться к серверу, то будем использовать аккаунт пользователя с именем example_user, имеющего пароль example_password, которому разрешены выборка, добавление, изменение и удаление записей в любой таблице базы example. Последняя строка вводит в силу все изменения, произведенные с аккаунтами MySQL сервера.

Сервер

Копируем файл ExampleFive.pm в ExampleSix.pm. ExampleSix практически не изменится, необходимо только поменять в заголовке имя пакета  и вызов use:
package ThreeTier::ExampleSix;
use strict;
use warnings;
use ThreeTier::ExampleSixGlobal;
    Копируем ExampleFiveGlobal.pm в ExampleSixGlobal.pm и делаем в нем некоторые дополнения:
package ThreeTier::ExampleSixGlobal;
use strict;
use warnings;
use DBI;
use Exporter;
..................................
@EXPORT = qw($d_fld $d_rec $d_set $strRespond &callUserFunction &requestParser
             &addEmptySet &addField &addRecord &addSet &sendError &sendOK
             &isDecimal &isInt &getSQLResult);
    В заголовке мы не только меняем имя пакета, но импортируем модуль для связи с базами данных DBI, а в массив экспорта добавляем новую функцию - getSQLResult. Эта функция будет единственной существенной модификацией в ExampleSixGlobal.pm.
sub getSQLResult

    my $sql = shift;
    my $dbh;

    unless(
        eval
        {
            $dbh = DBI->connect("DBI:mysql:example:localhost",
                'example_user','example_password', {PrintError=>0, RaiseError=>0 })
            or sendError("Ошибка соединения с БД: ".$DBI::errstr);
        }
    )
    {
        sendError("Ошибка соединения с БД : $@");
    };
    
    my $sth = $dbh->prepare($sql) or sendError('Ошибка при подготовке запроса:' . $DBI::errstr);
    $sth->execute or sendError('Ошибка SQL сервера : ' . $DBI::errstr);
    my $res = $sth->fetchall_arrayref;
    $sth->finish;
    return $res;   
}
    Эта функция принимает в качестве аргумента строку SQL запроса, а возвращает ссылку на массив, каждый элемент которого содержит ссылку на массив полей результирующей таблицы. Вначале мы получаем строку через shift и объявляем внутреннюю переменную - указатель на объект базы данных. Потом с помощью функции eval (единственный способ поймать ошибку при подключении) и DBI->connect присоединяемся к нужной нам базе. В первом аргументе находится тип драйвера, который используется для подключения - DBI:mysql, имя базы example и имя хоста localhost на котором эта база присутствует. В качестве имени хоста может использоваться IP адрес или URL. Если вам захочется подключиться к базе другого типа (не MySQL), то будет достаточно установить соответствующий драйвер и указать его имя после строки DBI:. Затем следуют имя пользователя 'example_user' и пароль 'example'. Будьте осторожны с этим файлом - так как пароль указывается в незашифрованном виде, то этот файл должен быть доступен на чтение только для сервера Apache и для вас. После присоединения к базе мы можем выполнить SQL запрос. В результате его выполнения мы получаем ссылку на массив ссылок на массивы полей ($sth->fetchall_arrayref). Закрываем запрос ($sth->finish) и возвращаем результат вызывающей программе. Соединение закрывать не следует, так как mod-perl сам поддерживает кеш соединений, и при следующем обращении к базе постарается вместо открытия нового использовать старое - это гораздо быстрее.
    Теперь все готово для того чтобы написать небольшую функцию, для выборки информации из таблицы по критерию, заданному клиентом. Создадим еще один файл ExampleSixTable.pm и определим в нем единственную функцию getTovar:
package ThreeTier::ExampleSixTable;
use strict;
use warnings;
use ThreeTier::ExampleSixGlobal;

sub getTovar
{
    my $args = shift;
    my $table = getSQLResult(qq[SELECT tv_id,tv_kod,tv_name,tv_cena
                               FROM tovar WHERE tv_name LIKE '%$args->{pattern}%'
                               ORDER BY tv_name]);
    addSet($table);
    return 1;
}

1;
    Функция выполняет SQL запрос (getSQLResult), который ищет в таблице tovar все записи, в которых поле tv_name содержит в любом месте подстроку, задаваемую $args->{pattern} . А результат - указатель на массив указателей на поля преобразует в строку через addSet. После чего handler отправляет результат клиенту.
    Добавляем в конец httpd.conf строки:

   SetHandler perl-script
   PerlHandler ThreeTier::ExampleSix

    Перезапускаем сервер:
root> /usr/local/apache/bin/apachectl restart


Клиент

        Установка RxLib хорошо описана в поставляемом с пакетом файле документации и обычно не вызывает затруднений.
        Начнем модификацию объекта TConnector так, чтобы он мог преобразовывать принимаемые от сервера поля в различные типы данных. Создадим несколько дополнительных функций, ядром которых останется описанная в предыдущем примере GetField:
  •     GetFieldAsString - возвращает поле как строку
  •     GetFieldAsInteger - возвращает целое
  •     GetFieldAsDouble - возвращает число с плавающей запятой
    Можно придумать еще множество подобных функций для остальных типов данных Delphi. Но для нашего примера этого списка вполне достаточно. GetFieldAsString вводится только для совместимости по именам на самом же деле она просто вызывает Connector.GetField:
function TConnector.GetFieldAsString(FieldNumber : Integer = 0) : String;
begin
  GetFieldAsString := GetField(FieldNumber);
end;
    Функция GetFieldAsInteger преобразует строку в целое (к счастью представления целых в MySQL и Delphi обычно совпадают, если конечно не использовать экзотические кодировки):
function TConnector.GetFieldAsInteger(FieldNumber : Integer = 0) : Integer;
begin
  GetFieldAsString := StrToInt(GetField(FieldNumber));
end;
    GetFieldAsDouble немного посложнее, так как приходится учитывать, что могут не совпадать десятичные разделители. Если сервер в наших руках и обычно использует для этих целей точку '.', то клиент может установить у себя все что угодно:
function TConnector.GetFieldAsDouble(FieldNumber : Integer = 0) : Double;
var
  s,tmpStr:String;
begin
  s := GetField(FieldNumber);
  if (DecimalSeparator <> '.') and (Pos('.',s) <> 0) then
     tmpStr:=StringReplace(s,'.',DecimalSeparator,[rfReplaceAll])
  else
     tmpStr:=s;
  GetFieldAsDouble := StrToFloat(tmpStr);
end;
Добавим еще одну функцию, которая бы позволила автоматически заполнять любую таблицу на клиенте:
procedure TConnector.ParseToDataSet(ADataSet : TDataSet; SetNumber : Integer = 0);
var
 i,j, RecNum, FieldNum : integer;
begin
  ADataSet.First;
  while not ADataSet.Eof do ADataSet.Delete;

  RecNum := DoRecList(SetNumber);
  for i := 0 to RecNum - 1 do
  begin
    DoFieldList(i);
    AddRecordToTable(ADataSet);
  end;
  ADataSet.First;
end;
Вначале происходит удаление всех записей из DataSet, затем заданная строка-таблица преобразуется в список строк-записей DoRecList(SetNumber). Каждая запись обрабатывается в цикле и преобразуется в начале список полей, после чего вызывается AddRecordToTable:
procedure TConnector.AddRecordToTable(ATable : TDataSet);
var
 i : integer;
begin
 ATable.Append;
 for i := 0  to ATable.Fields.Count - 1 do
 begin
   if ATable.Fields[i].Calculated then continue;
   if ATable.Fields[i].DataType = ftString then
   begin
     ATable.Fields[i].AsString := GetFieldAsString(i);
     continue;
   end;
   if ATable.Fields[i].DataType = ftInteger then
   begin
     ATable.Fields[i].AsInteger := GetFieldAsInteger(i);
     continue;
   end;
   if ATable.Fields[i].DataType = ftFloat then
   begin
     ATable.Fields[i].AsFloat := GetFieldAsDouble(i);
     continue;
   end;
end;
 ATable.Post;
end;
В первой строке к DataSet прибавляется очередная запись, после чего она начинается заполняться данными. Для этого в цикле анализируется структура таблицы. При этом сравниваются несколько стандартных типов с типом текущего поля DataSet, и если типы совпадают, то вызывается определенная для этого типа функция преобразования и полю в таблице присваивается значение поля из списка коннектора.

    Во первых создадим временную таблицу в памяти:
tv_table: TRxMemoryData;
.........................................
tv_table := TRxMemoryData.Create(Self);
    Добавим в нее несколько полей, соответствующих по типам возвращаемым сервером значениям:
tv_table.FieldDefs.Add('tv_id', ftInteger);
tv_table.FieldDefs.Add('tv_kod', ftString, 10);
tv_table.FieldDefs.Add('tv_name', ftString, 150);
tv_table.FieldDefs.Add('tv_cena', ftFloat);
    Не забудем ее активизировать:
tv_table.Active := true;
    Откроем стандартный TDataSource и привяжем его к созданной таблице:
tv_DS: TDataSource;
........................................
tv_DS := TDataSource.Create(Self);
tv_DS.DataSet := tv_table;
    Создадим TDBDataGrid, определим в ней поля и установим источник данных от предыдущего TDataSource:
tv_grid: TDBGrid;
........................................
var
  tmpColumn : TColumn;
........................................
tv_grid := TDBGrid.Create(Self);
tv_grid.Top := 90;
tv_grid.Left := 10;
tv_grid.Height := 200;
tv_grid.Width := 700;

tmpColumn := tv_grid.Columns.Add;
tmpColumn.FieldName := 'tv_id';
tmpColumn.Width := 50;
tmpColumn := tv_grid.Columns.Add;
tmpColumn.FieldName := 'tv_kod';
tmpColumn.Width := 50;
tmpColumn := tv_grid.Columns.Add;
tmpColumn.FieldName := 'tv_name';
tmpColumn.Width := 500;
tmpColumn := tv_grid.Columns.Add;
tmpColumn.FieldName := 'tv_cena';
tmpColumn.Width := 60;

tv_grid.DataSource := tv_DS;

tv_grid.Parent := Self;
    Для того чтобы пример заработал нужно написать еще несколько строк:
  Memo1.Text := '';
  try
    Connector.Module := 'ExampleSixTable';
    Connector.Func := 'getTable';
    Connector.AddParam('pattern', '7200');
    tmpCursor := Screen.Cursor;
    Screen.Cursor :=  crHourGlass;
    Connector.Execute;
    Connector.ParseToDataSource(tv_DS);
  except
    on E: Exception do Memo1.Text := E.Message;
  end;
  Screen.Cursor := tmpCursor;
    Очищаем Memo1 - где в случае ошибки будет сохранено ее значение. Задаем имя модуля и функции. Добавляем параметр поиска. Чтобы показать что началась обработка данных, устанавливаем курсор-часы. Отправляем данные на сервер с помощью Connector.Execute. Полученные данные заносятся в локальную таблицу Connector.ParseToDataSource(tv_DS).


Пример №7


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

Сервер
    Скопируем ExampleSix.pm в ExampleSeven.pm и сделаем у него в заголовке небольшие изменения:
package ThreeTier::ExampleSeven;
use strict;
use warnings;
use ThreeTier::ExampleSevenGlobal;
    Копируем ExampleSixGlobal.pm в ExampleSevenGlobal.pm и вносим изменения :
package ThreeTier::ExampleSevenGlobal;
use strict;
use warnings;
use DBI;
use Exporter;

use vars qw(@ISA @EXPORT $d_fld $d_rec $d_set $strRespond $dbh);

@ISA = qw(Exporter);
@EXPORT = qw($d_fld $d_rec $d_set $strRespond &callUserFunction &requestParser
             &addEmptySet &addField &addRecord &addSet &sendError &sendOK
             &isDecimal &isInt &getSQLResult &execSQL);
    Так как нам придется исполнять несколько SQL запросов за один сеанс, мы объявили переменную сеанса $dbh как глобальную для модуля ExampleSevenGlobal. По этой же причине, чтобы не создавать подключение при выполнении каждого SQL запроса, перенесем блок подсоединения из getSQLResult в callUserFunction. Как видно из листинга мы добавили новую функцию execSQL - она служит для выполнения управляющих запросов, то есть таких, которые не возвращают результат в виде таблицы (INSERT, UPDATE, DELETE и т.п.):
sub execSQL
{
    my $sql = shift;
    $dbh->do($sql) or sendError($DBI::errstr . $sql);
}
    Здесь все просто, пользуясь переменной соединения $dbh как глобальной, выполняется строка запроса, переданная в качестве параметра. В случае ошибки - сервер возвращает клиенту ее строковое значение и выходит из обработки.
    Скопируем ExampleSixTable.pm в ExampleSevenTable.pm и как обычно изменим имя пакета и директиву use:
package ThreeTier::ExampleSevenTable;
use strict;
use warnings;
use ThreeTier::ExampleSevenGlobal;
    Немного изменим getTovar, чтобы она всегда возвращала весь список товаров, безо всяких ограничений по образцу:
sub getTovar
{
    my $args = shift;
    my $table = getSQLResult(qq[SELECT tv_id,tv_kod,tv_name,tv_cena
                               FROM tovar ORDER BY tv_name]);
    addSet($table);
    return 1;
}
    Добавим еще 3 функции для добавления, изменения и удаления записей в таблице:
  • addTovar
  • editTovar
  • delTovar
    Рассмотрим листинг функции addTovar для добавления товара в таблицу:
sub addTovar
{
  my $args = shift;
  my $sql = qq[INSERT INTO tovar (tv_kod,tv_name,tv_cena)
               VALUES ('$args->{kod}','$args->{name}','$args->{cena}')];       
  execSQL($sql);
  my $ident = getSQLResult("SELECT LAST_INSERT_ID()")->[0]->[0];   
  getTovar($args);
  addField($ident);   
}
     Вначале мы получаем ссылку на хеш аргументов $args, затем с их помощью формируем строку запроса $sql, которая в результате подстановки будет выглядеть наподобие:  
INSERT INTO tovar (tv_kod,tv_name,tv_cena) VALUES('56-76','Новый товар','12.50')
После этого мы выполняем эту строку как команду через execSQL. Потом формируем следующий SQL запрос, чтобы определить значение  автоматически сгенерированного MySQL ключевого поля типа autoincrement. Поскольку этот запрос уже должен вернуть результат выборки, применяется функция getSQLResult. Из возвращаемого массива массивов мы выбираем первый элемент первого массива и сохраняем его в локальной переменной $ident. Затем вызывается функция getTovar которая заполняет первую строку-таблицу списком товаров, а addField добавляет в ответ еще одну таблицу, правда состоящую всего из одного поля в единственной записи, со значением индекса для нового товара. Тем самым клиент может обновить данные в своей локальной базе, а потом, найти по индексу из второй строки-таблицы, только что добавленный товар.
    Функция editTovar позволяет менять все поля в таблице tovar кроме индексного:
sub editTovar
{
  my $args = shift;
  my $sql = qq[UPDATE tovar SET tv_kod = '$args->{kod}', tv_name = '$args->{name}',
                                tv_cena = '$args->{cena}'
                                WHERE tv_id = '$args->{id}'];       
  execSQL($sql);
  getTovar($args);
}
Она создает с помощью хеша аргументов командную строку UPDATE, выполняет ее при помощи execSQL, а потом через getTovar, передает клиенту измененную таблицу.
    Функция delTovar удаляет строку из таблицы по индексному полю:
sub delTovar
{
  my $args = shift;
  my $sql = qq[DELETE FROM tovar WHERE tv_id = '$args->{id}'];       
  execSQL($sql);
  getTovar($args);
}
Эта функция выполняет на сервере команду DELETE уничтожая запись, и возвращает клиенту модифицированную таблицу.
    Добавляем в httpd.conf строки:

   SetHandler perl-script
   PerlHandler ThreeTier::ExampleSeven

    Перезапускаем сервер:
root> /usr/local/apache/bin/apachectl restart

Клиент

    Создадим сервисные процедуры для того чтобы не приходилось каждый раз преобразовывать различные типы в строку при формировании запросов к серверу (конечно в реальной программе их должно быть больше, например для даты/времени, логического значения и т.д.):
  • procedure AddParam(AName,AValue : String); overload;
  • procedure AddParam(AName : String; AValue : Integer); overload;
  • procedure AddParam(AName : String; AValue : Double); overload;
    Функция AddParam(String,String) остается такой же как и в предыдущем примере, только объявляется перегруженной.  
    Функция AddParam(String,Integer):
procedure TConnector.AddParam(AName : String;AValue : Integer);
var
 s : String;
begin
  Str(AValue, s);
  AddParam(AName,s);
end;
Она преобразует целое значение параметра в его строковое представление и вызывает AddParam(String,String).
    Функция AddParam(String,Double) чуть посложнее:
procedure TConnector.AddParam(AName : String;AValue : Double);
var
 s : String;
begin
  s := FloatToStr(AValue);
  if DecimalSeparator<> '.' then
     AddParam(AName,StringReplace(s,DecimalSeparator,'.',[rfReplaceAll]);
  else
     AddParam(AName,s);
end;
Кроме преобразования вещественного числа в строку, надо еще учесть какой символ является обозначением десятичной точки у клиента. Если сервер нам подконтролен и настроен воспринимать в качестве разделителя точку '.', то у клиента может быть установлено любое значение. Поэтому необходимо сделать замену в строке через стандартную функцию StringReplace и, только после этого, выполнить процедуру добавления строкового параметра AddParam(String,String).
    Рассмотрим добавление записи в нашу таблицу на стороне клиента:
  Memo1.Text := '';
  try
    Connector.Module := 'ExampleSevenTable';
    Connector.Func := 'addTovar';
    Connector.AddParam('kod', '56-76');
    Connector.AddParam('name', 'Новый товар');
    Connector.AddParam('cena', 12.50);
    tmpCursor := Screen.Cursor;
    Screen.Cursor :=  crHourGlass;
    Connector.Execute;
    Connector.ParseToDataSet(tv_table);
    Connector.DoRecList(1);
    Connector.DoFieldList(0);
    id := Connector.GetFieldAsInteger(0);
    tv_table.Locate('tv_id', id, []);

  except
    on E: Exception do Memo1.Text := E.Message;
  end;
  Screen.Cursor := tmpCursor;
Очищаем Memo1, в котором в случае неудачи будет содержаться код ошибки, задаем новые значения для модуля и функции, заполняем значения параметров. В параметре с именем 'cena' мы теперь можем сразу задать значение с плавающей точкой. Для удобства устанавливаем курсор-песочный часы. Выполняем запрос на сервере Connector.Execute и заполняем первой строкой-таблицей нашу локальную таблицу в памяти Connector.ParseToDataSet(tv_table). После этого наш TDBGrid покажет все записи таблицы в том числе и только что записанную в базу. Теперь мы создаем список записей второй таблицы (в ней содержится ключевое значение нового товара), затем разбиваем первую ее запись на список полей и присваиваем переменной id значение первого поля. Ищем этот индекс в локальной таблице и устанавливаем указатель на найденное значение. Таким образом мы добавили новое значение товара, отобразили всю модифицированную таблицу и обозначили вставленное значение. В случае, если произойдет какая-то ошибка, то ее текст отобразится в Memo1.
    Операция модификации несколько проще:
  Memo1.Text := '';
  try 
    Connector.Module := 'ExampleSevenTable';
    Connector.Func := 'editTovar';
    Connector.AddParam('kod', '56-77');
    Connector.AddParam('name', 'Старый товар');
    Connector.AddParam('cena', 12.70);
    Connector.AddParam('id', 7777456);
    tmpCursor := Screen.Cursor;
    Screen.Cursor :=  crHourGlass;
    Connector.Execute;
    Connector.ParseToDataSource(tv_DS);
    tv_table.Locate('tv_id', 7777456, []);

  except
    on E: Exception do Memo1.Text := E.Message;
  end;
  Screen.Cursor := tmpCursor;
Здесь добавляется целочисленный параметр id, обозначающий уникальный  индекс товара. Поскольку индекс нам уже известен, то нет смысла передавать его с сервера. После обновления таблицы мы просто ищем старое значение - это имеет смысл делать, так как наша таблица упорядочена по именам, и положение товара в списке может сильно измениться.
     Удаление тоже не представляет сложностей:
 Memo1.Text := '';
  try
    Connector.Module := 'ExampleSevenTable';
    Connector.Func := 'delTovar';
    Connector.AddParam('id', 7777456);
    tmpCursor := Screen.Cursor;
    Screen.Cursor :=  crHourGlass;
    Connector.Execute;
    Connector.ParseToDataSource(tv_DS);
    if tv_table.RecordCount < (oldPos) then
       tv_table.RecNo := tv_table.RecordCount
    else
       tv_table.RecNo := oldPos ;
  except
    on E: Exception do Memo1.Text := E.Message;
  end;
   Screen.Cursor := tmpCursor;
В качестве параметра передается единственное ключевое значение товара. Таблица обновляется, а текущая запись в DataSource устанавливается на ближайшую по отношению к удаленной.


Заключение

    Эта статья показала как можно использовать Apache не только как WEB сервер, но и как сервер приложений. Можно сказать что подобные результаты можно получить с любым WEB сервером, поддерживающим языковые расширения. С Apache можно использовать Java или PHP, mod_python или mod_mono, CGI или FastSGI. Клиентские средства тоже могут быть какими угодно - главное чтобы они могли поддерживать сокет IP.
    Осталось еще множество нерешенных вопросов и проблем - например сжатие передаваемой информации, ее шифрация и защита, аутентификация, разделение прав доступа. Конечно эти проблемы можно частично решить используя протокол https, но это сразу приведет к существенному падению быстродействия. Используемый в этих примерах компонент IdHTTP также далек от идеала с точки зрения минимизации количества пересылаемых пакетов - например вместо стандартных 8 пакетов без KeepAlive и 4 с KeepAlive он пересылает соответственно 24 и 14. На медленных или спутниковых каналах это приводит к значительным задержкам. Потому стоит поэкспериментировать с другими свободными или платными продуктами.
  Хотелось бы ввести полную автоматическую сериализацию и десериализацию передаваемых данных, но это снова приводит к  увеличению трафика. Так что до совершенства еще очень далеко.

P.S. Если вы найдете какие-нибудь ошибки, неточности, или у вас появятся вопросы или предложения - пишите на почту  info@bizonlie.ru 
  • Обложка статьи FreeBSD. Настраиваем файловые системы

    FreeBSD. Настраиваем файловые системы

    FreeBSD. Свободные записки о свободной системе. В качестве объекта для изучения был избран однодисковый вариант FreeBSD стабильной версии - 4.2

    Читать далее
  • Обложка статьи Поддерживаю РФ: Кириллические домены должны поддерживаться в российском ПО и сервисах

    Поддерживаю РФ: Кириллические домены должны поддерживаться в российском ПО и сервисах

    Поддержка российским ПО и отечественными сервисами кириллических доменов и адресов электронной почты станет ключевой задачей проекта Поддерживаю.РФ в 2021 году. По словам директора Координационного центра доменов .RU/.РФ Андрея Воробьева, национальный дом

    Читать далее
  • Обложка статьи Защищаем Apache 2. Шаг за шагом

    Защищаем Apache 2. Шаг за шагом

    В этой статье мы расскажем о пошаговой установке и конфигурировании Apache 2.0, чтобы снизить риск неавторизованного доступа или успешного взлома в случае применения новой уязвимости, обнаруженной в Apache Web сервере. В результате, можно будет пользовать

    Читать далее
  • Обложка статьи Защита ваших данных. PGP & Linux

    Защита ваших данных. PGP & Linux

    Эта статья написана для тех, кому необходимо сохранить некоторую информацию в секрете и кто пока не решил как это сделать....

    Читать далее
  • Обложка статьи DragonFlyBSD: загрузка и инициализация

    DragonFlyBSD: загрузка и инициализация

    В этом цикле статей я хочу рассказать об операционной системе, родившейся прямо на наших глазах - летом 2004 года. Имя ей - DragonFlyBSD, и являет она собой представителя славного племени BSD-систем. В сущности, исходно это fork (порождение) FreeBSD 4-й в

    Читать далее

Специальные предложения
интернет-магазина

  • Чехол для переноски Portable Hard Shell для Oculus Quest 2 VR
    3300 руб

    Чехол для переноски Portable Hard Shell для Oculus Quest 2 VR

  • Книга: Дронов В.А. "Laravel 9. Быстрая разработка веб-сайтов на PHP"
    1550 руб

    Книга: Дронов В.А. "Laravel 9. Быстрая разработка веб-сайтов на PHP"

  • №18 Патрон с впаянной лампой 2,5 V/ 0,3A
    212 руб

    №18 Патрон с впаянной лампой 2,5 V/ 0,3A

  • Книга: Аль-Халили Джим "Мир физики и физика мира. Простые законы мироздания"
    1000 руб

    Книга: Аль-Халили Джим "Мир физики и физика мира. Простые законы мироздания"

  • Набор выводных резисторов 0.25W (100 Ом—910 Ом), 24 номинала по 10 шт.
    275 руб

    Набор выводных резисторов 0.25W (100 Ом—910 Ом), 24 номинала по 10 шт.