Разработка модулей для Perl (XS, XSUB, perlxs)

XS - это интерфейс взаимодействия кода C/C++ с кодом perl. Если вам требуется получить доступк к каким-либо специфическим функциям операционной системы или вы хотите управлять ресурсоемкими процессами их perl, то эта статья для вас. Здесь вы найдете несколько примеров, возможно даже небесполезных, для Windows и Linux.

• Мониторинг файловой системы для Windows
• Модуль подсчета траффика, пример сниффера для Linux
• Работаем с окнами в Windows

• В поисках решения
• Соединяем с perl
• Модуль WCN.pm
• Скачать WCN-0.1-win.zip

Эффективный мониторинг можно организовать только на уровне системы. Как следствие, необходимость взаимодействовать с API через специфическое расширение, а это - отдельная тема. Придется потрудиться как над алгоритмом, так и над способом его запихивания в perl.

В поисках решения

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

Функция ReadDirectoryChangesW имеет следующий прототип:

BOOL ReadDirectoryChangesW(
    HANDLE hDirectory,
    LPVOID lpBuffer,
    DWORD nBufferLength,
    BOOL bWatchSubtree,
    DWORD dwNotifyFilter,
    LPDWORD lpBytesReturned,
    LPOVERLAPPED lpOverlapped,
    LPOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine
   );

• hDirectory - дескриптор каталога за которым мы должны следить. Получить дескриптор можно с помощью WinAPI функции OpenFile (см. ниже).
• lpBuffer - указатель на буфер, в который будет помещена информация о произошедших изменениях в каталоге.
• nBufferLength - длина буфера. С расчетом этой величины у меня были некоторые проблемы, по этому мы остановимся на буфере чуть позже.
• bWatchSubtree - булево значение, указывающее на необходимость слежения за вложенными каталогами.
• dwNotifyFilter - набор флагов, который определяет характер изменений, которые нас интересуют.
• lpBytesReturned - указатель на переменную, в которую функция ReadDirectoryChangesW() запишет значимую длину данных в буффере lpBuffer.
• Аргументы lpOverlapped и lpCompletionRoutine нас, в данном случае, не интересуют.

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

HANDLE hDir = CreateFile(szDirPath,FILE_LIST_DIRECTORY,
	FILE_SHARE_READ|FILE_SHARE_DELETE,NULL,
	OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,NULL);

С буфером дело обстоит сложнее. По сути, буффер имеет вид массива из экземпляров структуры типа FILE_NOTIFY_INFORMATION. Каждый экземпляр описывает некое событие, которое имело место в пределах каталога. Дело осложняется еще и за счет того, что одно событие не ограничивается FILE_NOTIFY_INFORMATION, а требует еще и выделения памяти под имя файла. Если кто не догоняет, ниже я привел прототип структуры FILE_NOTIFY_INFORMATION

typedef struct _FILE_NOTIFY_INFORMATION {
   DWORD NextEntryOffset;
   DWORD Action;
   DWORD FileNameLength;
   WCHAR FileName[1];
} FILE_NOTIFY_INFORMATION;

sizeof(FILE_NOTIFY_INFORMATION) + MAX_PATH * 2

Но не думайте, что все так просто. У нас еще не определено количество таких объемов, необходимое для представления нескольких событий. Вообще, результат работы функции ReadDirectoryChangesW определяется кодом возврата и значением переменной lpBytesReturned (см. прототип функции выше). Если lpBytesReturned после успешного (определяется кодом возврата) выполнения функции равно нулю, то системе не хватило буффера для размещения информации о всех произошедших изменениях. Самое интересное, это ремарка в документации о том, что нужно делать в этом случае - ну, мол, не переживайте? перечитайте каталог и проверьте все сами. Класс! Это при условии вложенности каталогов! Да еще и для сравнения нужно предварительно собрать данные и где-то их сохранить. Таким макаром проще юзать Find*ChangeNotification - алгоритм нисколько не упрощается.

Но, настоящие хакеры не сдаются! Так как ничего полезного о расчете буфера в документации я не нашел и в инете никто не пособил, пришлось идти на таран. Методом научного тыка я пришел к выводу, что более 3-4 событий функция ReadDirectoryChangesW одновременно не обрабатывает. Да и то, 3-4 события это когда функция вызывается с фильтром по максимуму, то есть следит за изменениями атрибутов, сменой имен, созданием и прочими действами. Конечно, тут я могу и ошибаться, но как тут еще протестировать - для объективности необходимо выполнять изменения в каталоге с бешенной скоростью. Для пущей надежности мы будем резервировать место под 32 события (учитывая, что еще под имя файла отводится по максимуму, даже если будут иметь место более 32, то все равно вряд-ли загнемся от недостатка памяти).

Итак, подведем итог по буферу. Будем выделять столько, сколько необходимо для хранения информации о событии с именем файла по максимуму в 32-х экземплярах. Если при юзании кто нибудь определит, что этого недостаточно, пишите - исправим. И вообще, я буду очень рад, если кто-то знает нормальный способ расчета буффера для этой функции и поделится им.

Соединяем с perl

Механизм XSUB подразумевает собой некий стандарт, следуя которому можно соединить программу на C и perl. Большая часть усилий по сопряжению двух языков приходится на С-часть программы. То есть изучая механизм XSUB вы должны всегда понимать, что речь идет о коде на C. По большей части весь механизм заключается в правильной работе со стеком аргументов и приведении типов к типам perl (то есть скаляр, массив, хэш). Что бы не держать в голове все тонкости правил передачи аргументов и уменьшить количество ошибок, связанных с аргументацией, был разработан специальный макроязык описания интерфейсов функций XSUB. Этот язык содержит макросы, которые в процессе обработки преобразуют код программы в соответствии с требованиями XSUB. Часть этих макросов обрабатывается препроцессором С перед компиляцией, а часть специальной программой xsubpp, которая выполняет преобразование файла с кодом XSUB к полноценному С-коду. По сути, xsubpp представляет собой компилятор XSUB.

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

h2xs -A -n WCN

Итак, файл WCN.xs представляет собой гибрид С-кода и макроязыка XSUB. Именно в этом файле должен быть описан интерфейс модуля, то есть правила интерпретации входных и выходных значений для всех функций, через которые perl будет взаимодействовать с нашим модулем.

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#define _WIN32_WINNT 0x0400

MODULE = WCN		PACKAGE = WCN

HANDLE
Open(szDirPath)
LPCTSTR szDirPath;
	CODE:
RETVAL = CreateFile(szDirPath,FILE_LIST_DIRECTORY,
	FILE_SHARE_READ|FILE_SHARE_DELETE,NULL,
	OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,NULL);
	OUTPUT:
RETVAL


BOOL
Close(hDir)
HANDLE hDir;
	CODE:
RETVAL = CloseHandle(hDir);
	OUTPUT:
RETVAL

void
Read(hDir,bWatchSubtree,dwFilter)
HANDLE hDir;
BOOL bWatchSubtree;
DWORD dwFilter;

	INIT:
DWORD dwBytesReturned;
DWORD dwRecSize =
	sizeof(FILE_NOTIFY_INFORMATION) + MAX_PATH * 2;
DWORD dwCount = 32;
FILE_NOTIFY_INFORMATION *pCurrNI;
FILE_NOTIFY_INFORMATION *pNI;
BOOL bResult;
char buf[MAX_PATH];
AV* NotifyInfo;

	PPCODE:
pNI = (FILE_NOTIFY_INFORMATION*)
	malloc(dwRecSize * dwCount);
bResult = ReadDirectoryChangesW(
	hDir,pNI,dwRecSize * dwCount,bWatchSubtree,
	dwFilter,&dwBytesReturned,NULL,NULL);
if (bResult && dwBytesReturned){
	pCurrNI = pNI;
	while (1){
		memset(buf,0,sizeof(buf));
		WideCharToMultiByte(CP_ACP,0,pCurrNI->FileName,
			pCurrNI->FileNameLength,buf,sizeof(buf),
			NULL,NULL);

		NotifyInfo = (AV*)sv_2mortal((SV*)newAV());
		av_push(NotifyInfo,newSViv(pCurrNI->Action));
		av_push(NotifyInfo,newSVpv(buf,
			pCurrNI->FileNameLength / 2));
		XPUSHs(newRV_noinc((SV*)NotifyInfo));

		if (!pCurrNI->NextEntryOffset){
			break;
		}else{
			pCurrNI = (FILE_NOTIFY_INFORMATION*)
				((DWORD)pCurrNI + pCurrNI->NextEntryOffset);
		}
	}
}else{
	XPUSHs(Nullsv);
}
free(pNI);

BOOL		T_IV
HANDLE		T_UV
DWORD		T_UV
LPCTSTR		T_PV

perl Makefile.PL
...
nmake
...

Модуль WCN.pm

package WCN;

require 5.005_62;
use strict;
use warnings;

require Exporter;
require DynaLoader;

our @ISA = qw(Exporter DynaLoader);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

our @EXPORT = qw(
	&WCN_INVALID_HANDLE
	&WCN_FILE_NAME
	&WCN_DIR_NAME
	&WCN_ATTRIBUTES
	&WCN_SIZE
	&WCN_LAST_WRITE
	&WCN_LAST_ACCESS
	&WCN_SECURITY
	&WCN_ACTION_ADDED
	&WCN_ACTION_REMOVED
	&WCN_ACTION_MODIFIED
	&WCN_ACTION_RENAMED_OLD_NAME
	&WCN_ACTION_RENAMED_NEW_NAME
);
our $VERSION = '0.01';

bootstrap WCN $VERSION;

# Preloaded methods go here.

sub WCN_INVALID_HANDLE()	{0xFFFFFFFF}

sub WCN_FILE_NAME()		{0x00000001}
sub WCN_DIR_NAME()		{0x00000002}
sub WCN_ATTRIBUTES()		{0x00000004}
sub WCN_SIZE()			{0x00000008}
sub WCN_LAST_WRITE()		{0x00000010}
sub WCN_LAST_ACCESS()		{0x00000020}
sub WCN_SECURITY()		{0x00000100}

sub WCN_ACTION_ADDED()		{0x00000001}
sub WCN_ACTION_REMOVED()	{0x00000002}
sub WCN_ACTION_MODIFIED()	{0x00000003}
sub WCN_ACTION_RENAMED_OLD_NAME(){0x00000004}
sub WCN_ACTION_RENAMED_NEW_NAME(){0x00000005}

sub new{
	my $class = shift;
	$class= ref($class) || $class;
	my $self = {};
	bless $self,$class;
	return $self if $self->initialize(@_);
	return undef;
}

sub initialize{
	my ($self,$path,$tree,$filter) = @_;
	$path = '.' unless defined($path);
	$tree = 0 unless defined($tree);
	$filter = WCN_FILE_NAME unless defined($filter);
	$self->{path} = $path;
	$self->{tree} = $tree;
	$self->{filter} = $filter;
	Close($self->{handle}) if exists($self->{handle}) &&

		$self->{handle} != WCN_INVALID_HANDLE;
	$self->{handle} = Open($path);
	return undef if $self->{handle} == WCN_INVALID_HANDLE;
	return 1;
}

sub read_changes{
	my $self = shift;
	return undef if $self->{handle} == WCN_INVALID_HANDLE;
	return Read($self->{handle},$self->{tree},$self->{filter});
}

DESTROY{
	my $self = shift;
	Close($self->{handle}) if $self->{handle} != WCN_INVALID_HANDLE;
}

1;
__END__

На самом деле, константы, которые определены в модуле константными функциями (WCN_**) можно было импортировать из программы на C. Но после того, как я посмотрел на реализуцию кода С и распухания модуля WCN.pm при использовании стандартного механизма переноса констант, я решил что гораздо эффективнее объявить константы прямо в модуле. Не волнуйтесь, значения этих констант навряд-ли изменяются от версии к версии в Windows NT. Иначе очень многие программы написанные на С просто не работали после переноса.

Теперь давайтеразберемся, как же работает модуль. Прежде всего, конструктор создает экземпляр объекта и инициализирует его. В последствии, объект может быть переориентирован на мониторинг другого каталога. Это достигается путем вызова метода initialize() с соответствующими аргументами.

Вызов метода read_changes() приводит к блокировке программы до возникновения нового события. В качестве результата, метод read_changes возвращает результат работы функции Read() из С-модуля. При обращении к методу read_changes() модуль WCN.pm сам передает ранее сохраненные аргументы в функцию на C. Массив, возвращаемый С-функцией Read() представляет собой последовательность ссылок на анонимные массивы, каждый из которых в свою очередь описывает событие, имевшее место в каталоге. Первый элемент этого анониманого массива содержит код события. Символические константы WCN_ACTION_* облегчают процесс идентификации событий (необходимо заметить, что из модуля экспортируются только имена констант, но не методов и функций). Второй элемент массива представляет собой имя файла. Имя файла представляется путем к файлу, относительно каталога слежения. То есть, если изменения произошли в корне каталога, то имя файла представляет истинное имя файла, подвергшегося изменениям. Если же изменения произошли в одном из подкаталогов, то имя файла включает в себя имена всех каталогов, которые представляют путь к файлу относительно каталога слежения.

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

nmake test

my $watcher = new WCN('C:\\temp',1,WCN_ATTRIBUTES|WCN_SIZE)
	or die "Не могу поднять ногУ!\n";
while(1){
	my @changes = $watcher->read_changes();
	die "Облажались!\n" if ref($changes[0]) ne 'ARRAY';

	foreach my $ref (@changes){
		print "Событие: ${$ref}[0], Файл/Каталог: ${$ref}[1]\n";
	}
}

Наверх

Модуль подсчета траффика, пример сниффера для Linux

• Скачать CTT-0.1-lin.tar.gz
• Установка модуля
• Пример использования модуля
• Интерфейс класса CTT
  • new
  • Enable
  • Disable
  • Read
  • AddFilter
  • DelFilter
  • StopOn
  • IfName
  • GetCurrBytes
  • GetCurrPackets
  • ResetCounter
  • GetFilters
  • IsUsed
  • OnOverflow
• Планы

Платформы

• Linux

Описание

Модуль работает по принципу сниффера: соответствующий интерфейс переводится в режим PROMISCUOUS, после этого становятся доступными пакеты сегмента подсети, в который выведен интерфейс.

ВНИМАНИЕ!

• Учтите, что для перевода интерфейса в "разнородный" режим необходимо обладать правами привелегированного пользователя.
• С помощью модуля вы не сможете контролировать прохождение пакетов низкого уровня - только IP-протоколов.
• Модуль так же не обращает внимание на пакеты IP-версии отличной от 4.
• Будьте внимательны, если рядом свитч.

• Использовать интерфейсы стандарта Ethernet IEEE 802.3.
• Накапливать информацию о проходящих пакетах в 32-разрядных счетчиках (в пределах 4Gb).
• Устанавливать правила фильтрации пакетов по адресам источника и назначения, маскировать недейственные биты адреса, с возможностью отрицания условия (условная инверсия).
• Устанавливать для каждого фильтра объем трафика (входящего, исходящего или общего), после прохождения которого будет вызываться специальный обработчик. Код обработчика может быть произвольно переопределен.

Установка модуля

perl Makefile.PL

make

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

make install

ПРИМЕЧАНИЕ
По умолчанию модуль CTT предполагает использование не более 256 счетчиков. Однако вы можете перед сборкой модуля переопределить константу MAX_FILTER и, сопоставив ей требуемое значение, увеличить количество фильтров.

Пример использования модуля

use CTT;
$ctt = new CTT;
$ctt->Enable("eth0") or die "Ошибка установки разнородного режима";

$fi1 = $ctt->AddFilter("192.168.1.90","255.255.255.255",
  "!192.168.0.0","255.255.0.0");     # Фильтровать все с 192.168.1.90
                                     # отправленное за пределы сети
$ctt->StopOn($fi1,20000,20000,0);    # Сигнализировать по достижении
                                     # 20000 байт

$fi2 = $ctt->AddFilter("192.168.1.90","255.255.255.255",
  "!192.168.1.90","255.255.255.255");# Фильтровать все с 192.168.1.90
                                     # адресованное другим хостам
$ctt->StopOn($fi2,40000,40000,0);    # Сигнализировать по достижении
                                     # 40000 байт

while ($ctt->Read()){
      @filters = $ctt->GetFilters();
      unless (@fi){
            print "Нечего фильтровать.\n";
            last;
      }
}

sub CTT::OnOverflow{
      my ($self,$fi) = @_;
      print "Счетчик $fi переполнен. Текущее значение: ",
            scalar(self->GetCurrBytes($fi)),"\n";
      $self->DelFilter($fi);
}

Фильтр определяет условия отбора пакетов а так же сохраняет промежуточные значения счетчиков. Фильтры определяются по индексам, но различные экземпляры CTT никак не связаны между собой. Это значит, что одинаковые индексы фильтров для каждого экземпляра объекта CTT будут указывать на абсолютно несвязанные данные.

new

$ctt = new CTT;

$ctt->Enable("eth0");

while ($ctt->Read()){
      ...
}

$fi2 = $ctt->AddFilter("192.168.1.90","255.255.255.255",
                       "!192.168.0.0","255.255.0.0");

Обратите внимание на способ задания адреса назначения. Восклицательный знак перед адресом указывает на отрицание адреса. Это значит, что в отбор попадут все пакеты, один из адресов которых (источник или назначение) не совпадает с указанным, то есть не входит в сеть 192.168.0.0/16.

ВНИМАНИЕ!
На самом деле, не имеет значения какой из заданных адресов источник, а какой назначение. Условием отбора является совпадение (или несовпадение в случае указания "!") одного из указанных адресов с адресом источника, а другого с адресом назначения, определяемым по заголовку пакета. Но обязательно совпадать должны оба адреса. И если в процессе анализа пакета выяснилось, что источник и назначение попадают под указанное условие, но поменялись местами то выполняется инкремент счетчика полученных байт. В случае совпадения адресов в указанном порядке инкрементируется счетчик отправленных байт. Учтите, что вы имеете возможность задать такое условие отбора, при котором суммарный трафик превысит фактический в два раза. Например при сети 192.168.1.0

# Все адреса в сети попадают как под первое условие, так и под второе
$ctt->AddFilter("192.168.1.0","255.255.255.0",
                "192.168.0.0","255.255.0.0");

$fi = $ctt->AddFilter("192.168.1.0","255.255.255.0",
                "!192.168.0.0","255.255.0.0");
$ctt->DelFilter($fi);

$fi = $ctt->AddFilter("192.168.1.0","255.255.255.0",
                "!192.168.0.0","255.255.0.0");
$ctt->StopOn($fi,1000,2000,10*1024*1024); # Сигнализировать при
                                          # исходящем 1000B, входящем 2000B
                                          # и общем трафике более 10MB.
$ctt->StopOn($fi,0,0,10*1024*1024);       # Контролировать только общий трафик
                                          # при прежнем условии 10MB.

print $ctt->IfName();

$str = $ctt->GetCurrBytes($fi);
($sent,$recv) = $ctt->GetCurrBytes($fi);

while ($ctt->Read() && @fi = $ctt->GetFilters()){
      ...
}

if ($ctt->IsUsed(0)){
      ...
}

Наверх

Работаем с окнами в Windows

• Ближе к делу
• Регистрируем класс окна
• Создание экземпляра окна
• Привязываем perl-обработчик к дескриптору окна
• Функции для работы с окнами
• Обработка очереди сообщений
• Вызов обработчика на территории perl
• Поднимите мне веки или где наше окно?

Реализация perl под Windows не предоставляет возможности работать с окнами. Однако, perl так же и не страдает манией величия (под видом претендента на место языка с исчерпывающими возможностями) и позволяет добавлять отсутствующие механизмы с помощью модулей.

Ближе к делу

Что такое API все знают? Правильно, это программный интерфейс, который связывает разные части программы. Так вот, в операционных системах Windows доступ к различным механизмам системы обеспечивается посредством функций специального интерфейса - WinAPI. Так как система довольно сложна, различных механизмов в ней достаточно. В связи с этим, WinAPI может предстать перед программистом довольно пухлой программной прокладкой. Здесь уже без справочника не обойтись. Хорошо то, что как ни крути, WinAPI одно и для C, и для Delphi и для других языков. Если бы в perl можно было напрямую работать со стеком и вызывать функций по указателю, то нам не пришлось бы лезть в C. Однако, по вполне понятным причинам такого механизма в perl нет. И, во всяком случае, если вы знаете что такое стек и как с ним работать, то несколько строк на C вас нисколько не испугают. В общем решение здесь одно - создать модуль, через который программа на perl получит доступ к нужным функциям WinAPI.

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

Пора открывать справочник по функциям WinAPI и выявлять все необходимые функции. Ниже перечисляются функции которые нам понадобятся.

• RegisterClass() - регистрация класса окна
• CreateWindow() - создание экземпляра окна
• ShowWindow() - перерисовать окно
• UpdateWindow() - обновить окно
• SendMessage() - отправить окну сообщение и дождаться результата
• PostMessage() - отправить окну сообщение
• DestroyWindow() - уничтожить окно

Пока все. Эти функции представляют собой программный минимум для работы с окнами.

Теперь нужно подумать о схеме. Как мы будем реализовывать perl-интерфейс к этим функциям? Самый простой вариант - это с помощью XSUB написать функции преобразования параметров, передаваемых из perl, в доступный для WinAPI вид. Однако, лучшим решением будет реализация объектного интерфейса. При этом, нужно будет разделить этапы создания окна и процесс обработки очереди сообщений. Это может понадобиться в случае если мы захотим работать с несколькими окнами в одном приложении. Для этого, нам понадобятся дескрипторы всех окон. К тому же, обработка очереди сообщений для каждого из этих окон может быть вынесена в отдельный процесс.

Для большинства оконных функций требуется только дескриптор окна. Мы будем сохранять дескриптор окна в переменной объекта класса, код которого будет реализовываться моделум WinApp.pm. Таким образом, мы избавляемся от необходимости забивать голову ненужной заботой об объектном интерфейсе на уровне XSUB.

С помощью команды

h2xs -A -n WinApp

BOOL		T_IV
DWORD		T_UV
UINT		T_UV
HWND		T_UV

Далее, беремся за файл WinApp.xs, который будет содержать гибрид C-кода и XSUB-директив. Не забываем подключить заголовочный файл windows.h, в противном случае компилятор не увидит определений необходимых функций и ресурсов. Добавляем сразу в начало файла строку

#include 

Регистрируем класс окна

Функция RegisterClass() имеет следующий прототип

ATOM RegisterClass(CONST WNDCLASS *lpWndClass);

Ясно, что дело темное. Из этого прототипа мы не можем сделать каких либо полезных выводов. Лезем в справочник и выковыриваем оттуда описание структуры WNDCLASS

typedef struct _WNDCLASS {    // wc
    UINT    style;
    WNDPROC lpfnWndProc;
    int     cbClsExtra;
    int     cbWndExtra;
    HANDLE  hInstance;
    HICON   hIcon;
    HCURSOR hCursor;
    HBRUSH  hbrBackground;
    LPCTSTR lpszMenuName;
    LPCTSTR lpszClassName;
} WNDCLASS;

Мы не будем рассматривать все поля этой структуры. Для нас первостепенное значение представляют поля lpfnWndProc и lpszClassName. Поле style то же имеет значение, однако, мы обойдемся минимумом, определив значение с помощью констант CS_HREDRAW | CS_VREDRAW. Существуют еще несколько констант, описывающих возможные стили класса. Если сей факт представляет для вас интерес, загляните в документацию по WinAPI. Константы CS_HREDRAW и CS_VREDRAW говорят о том, что при изменении размеров клиентской части окна (например, пользователь выполнил захват ребра и выполняет перемещение курсора) необходимо перерисовывать окно.

Поле lpfnWndProc наиболее важно для класса, так как это поле содержит адрес функции, выполняющей обработку сообщений. Прототип этой функции жестко определен системой. Вместе с осознанием значения поля lpfnWndProc должно придти и понимание того, что просто так подсунуть перловую функцию не получится. Придется писать дополнительный код, который будет посредником между системой и обработчиком сообщений, реализованным на perl. При чем, делать это придется до того как приступить к реализации XSUB-версии RegisterClass(). Иначе толку от вызова RegisterClass() будет как от козла молока.

Вот так должна выглядеть функция обработки сообщений

LRESULT CALLBACK WindowProc(
    HWND hwnd,	// handle of window
    UINT uMsg,	// message identifier
    WPARAM wParam,	// first message parameter
    LPARAM lParam 	// second message parameter
   );

С помощью XSUB мы можем выполнить вызов функции, находящейся на территории perl, но для этого необходимо знать полное имя функции. А что толку знать имя функции на этапе регистрации окна? Мдяяя, замкнутый круг какой-то получается: что бы вызвать RegisterClass() нужно иметь функцию обработки сообщений. Ну ладно, мы решили, что напишем отдельную функцию на C и она, в свою очередь, будет форвардить масяги на территорию perl-кода. Но как этой самой С-функции передать имя нашей функции на perl?

Мы поступим хитро и немного изменим схему работы. Не задумываясь на тем, как идентифицировать callback-perl функцию на этапе регистрации окна мы укажем в качестве обработчика функцию, на которую возложим передачу сообщений в perl. А непосредственно идентификацию perl-функции обработки сообщений мы будем указывать во время создания экземпляра окна. Таким образом мы только увеличим гибкость, позволяя каждому окну сопоставлять персональный обработчик сообщений и это, заметьте, независимо от класса.

А сейчас давайте просто определим пустой обработчик сообщений, не задумываясь над реализацией связи с perl. Назовем функцию WndProc и разместим ее естественно в файле WinApp.xs но не после директив XSUB MODULE и PACKAGE, а до них (то есть между директивами препроцессора #include и первыми XSUB-директивами MODULE и PACKAGE).

LRESULT CALLBACK WindowProc(HWND hWnd,
	UINT uMsg,DWORD wParam,DWORD lParam)
{

	return DefWindowProc(hWnd,uMsg,wParam,lParam);
}

Обратите внимание, что типы предпоследнего и последнего параметров изменены. Мы поступаем так, потому что нам лень лезть в typemap и добавлять новые соответствия типов. В любом случае, оба аргумента представляются 32х-разрядными величинами. Однако, не стоит думать, что можно вот так наплевательски относиться к типам этих аргументов. Некоторые сообщения требуют своебразной интерпретации значений. Встречаются и указатели, и беззнаковые целые, и числа со знаком. Но эти проблемы мы выложим на плечи программиста, который будет использовать модуль. Во всяком случае, сейчас об этом думать рано.

Функция DefWindowProc() представляет собой дефолтный обработчик сообщений. Ее вызов связан с тем, что каждое сообщение должно быть обработано (иначе в очереди будет бардак). Так вот, если вы не определяете обработчик для какого нибудь сообщения, то будьте добры вызовите DefWindowProc() - уж она то со всеми разберется. На вышеописанное следует обратить удвоенное внимание, так как мы имеем дело с сопряжением двух языков. В процесе разработки общего подхода я наступил на грабли, связанные с различным представлением значений в perl и C. Удар этими граблями образовал на моей голове очаровательную (почти в сутки величиной) шишку, смысл которой заключался в категорическом отказе приложения перерисовывать окно. А все из-за такого пустяка, как игнорирование дефолтного обработчика.

Ну, хватить философствовать, подошло время для реализации XSUB RegisterClass(). Давайте вернемся к структуре WNDCLASS и определим, какие параметры нужно получить, что бы зарегистрировать класс. Функция обработчик (на стороне C) у нас уже есть. Остается всего один параметр - имя класса. У меня такое ощущение, что в скором времени нам будет мало вот такой реализации. В связи с этим, предлагаю не испытывать судьбу и на всякий случай вторым параметром потребовать передачи значения для поля style.

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

int
_RegisterClass(szClassName,dwStyle)
LPCTSTR szClassName;
DWORD dwStyle;

		INIT:

	WNDCLASS	wcl;
	wcl.style		= dwStyle;
	wcl.lpfnWndProc	= (WNDPROC)WindowProc;
	wcl.cbClsExtra	= 0;
	wcl.cbWndExtra	= 0;
	wcl.hInstance	= NULL;
	wcl.hIcon		= NULL;
	wcl.hCursor		= NULL;
	wcl.hbrBackground	= (HBRUSH)(COLOR_WINDOW+1);
	wcl.lpszMenuName	= NULL;
	wcl.lpszClassName	= szClassName;

		CODE:

	RETVAL = RegisterClass(&wcl);

		OUTPUT:

	RETVAL

Если попробовать собрать проект, xsubpp выдаст ошибку, мол, я не знаю кто такой LPCTSTR. И правильно сделает, ведь мы не добавили в файл typemap соответствующие определения. Отредактируйте typemap, что бы его содержимое было следующим

BOOL		T_IV
DWORD		T_UV
UINT		T_UV
HWND		T_UV
LPSTR		T_PV
LPCTSTR		T_PV

Вот теперь можно и попробовать собрать. Сразу будем тестировать каждую добавляемую функцию, что бы в последствии не заботиться об этом. Для этого, в файле test.pl напишем тест под номером 2

# Тестируем функцию регистрации класса
my $className = 'WinApp class';
my $style = 3; # CS_HREDRAW | CS_VREDRAW
my $atom = _RegisterClass($className,$style);
print $atom ? "" : "not ","ok 2\n";

Не забываем об экспорте имени функции в модуле WinApp.pm

our @EXPORT = qw(
	&_RegisterClass
);

Теперь можно проверить. Выполняем команду

nmake test

Результат должен быть следующим

1..1
ok 1
ok 2

Ага, забыли поправить количество тестов в конструкторе модуля test.pl. Исправляем, запускаем. Все должно быть верно

BEGIN { $| = 1; print "1..2\n"; }
END {print "not ok 1\n" unless $loaded;}
use WinApp;
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

# Тестируем функцию регистрации класса
my $className = 'WinApp class';
my $style = 3; # CS_HREDRAW | CS_VREDRAW
my $atom = _RegisterClass($className,$style);
print $atom ? "" : "not ","ok 2\n";

Для того, что бы определить значение логичесткого объединения констант CS_HREDRAW и CS_VREDRAW нам придется заглянуть в заголовочный файл winuser.h. CS_VREDRAW сопоставлено значение 1, а CS_HREDRAW, соответственно, 2. 1 or 2 = 3. Вот таким образом мы получаем знаечние для определения стиля класса.

Создание экземпляра окна

Функция WinAPI CreateWindow() позволяет создать новое окно на основе имени класса. Вот её прототип

HWND CreateWindow(
    LPCTSTR lpClassName,
    LPCTSTR lpWindowName,
    DWORD dwStyle,
    int x,
    int y,
    int nWidth,
    int nHeight,
    HWND hWndParent,
    HMENU hMenu,
    HANDLE hInstance,
    LPVOID lpParam
   );

Как видим, довольно много аргументов, хотя назначение каждого из них вполне ясно из названий. Первым аргументом необходимо передать имя класса окна, то самое, которое использовалось при регистрации. Параметр lpWindowName, проще говоря, заголовок окна. Далее следует параметр, определяющий стиль окна. Всевозможных констант, определяющих стиль окна, очень много. Эти константы определены в заголовочном файле winuser.h. Мы не будем рассматривать все возможные значения (для этого есть справочник WinAPI) а за основу возьмем наиболее часто встречающийся стиль.

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

XSUB реализация для этой функции у нас будет называться _CreateWindow(). В качестве аргументов мы будем передавать имя класса, заголовок окна, стиль, размеры и имя (заметьте, не указатель) функции обработчика на perl.

Теперь необходимо немного углубиться в порядок действий системы при создании нового окна. Прежде всего, мы знаем, что классу окна уже сопоставленн обработчик сообщений (в процессе регистрации класса). Это значит, что уже в момент вызова CreateWindow() система может вызывать обработчик сообщения, при том, что окна еще не существует. Фактом создания окна мы будем считать получение от функции CreateWindow() дескриптора созданного окна. Как вы понимаете, только после этого наше окно сможет, так сказать, приносить пользу. А без дескриптора нам не нужно никакое окно, ведь мы ему даже и сообщение послать не сможем.

Но, вернемся к функции обработки сообщений. Мы определили обработчик только для C-части расширения. То есть, если до создания окна будет вызван обработчик сообщения, то этот самый обработчик ничего полезного сделать не сможет, так как он понятия не имеет, какую функцию perl ему нужно вызывать. Однако, все не так уж плохо - выход есть. Если вникнуть в документацию, то можно обнаружить возможность передачи указателя на данные любого типа с помощью последнего аргумента функции CreateWindow().

Мы совершенно верно предположили, что обработчик сообщений может (и, как мы увидем далее, будет) вызываться до того, как фактически окно будет создано. Сразу скажу, что создание окна связано с обработкой сообщения WM_CREATE. В документации WinAPI сказано, что сообщение WM_CREATE посылается обработчику, когда поступает запрос на создание окна функциями CreateWindow() или CreateWindowEx(). При этом, lParam, передаваемый в качестве последнего аргумента обработчика, является указателем на экземпляр структуры типа CREATESTRUCT, которая содержит информацию о создаваемом окне. Для такого простого случая как наш, этот указатель можно было спокойно проигнорировать, если бы не возможность получения указателя, переданного функции CreateWindow() в качестве последнего аргумента. В нашем случае, это полное имя perl-функции обработчика сообщений.

Давайте проведем небольшой эксперимент, подтверждающий пригодность использования нашей схемы. В конец файла WinApp.xs добавляем следующий код

HWND
_CreateWindow(szClassName,szTitle,dwStyle,x,y,dwWidth,dwHeight,szCallbackName)
LPCTSTR szClassName;
LPCTSTR szTitle;
DWORD dwStyle;
int x;
int y;
DWORD dwWidth;
DWORD dwHeight;
LPCTSTR szCallbackName;

	CODE:

	RETVAL = CreateWindow(szClassName,szTitle,dwStyle,x,y,
		dwWidth,dwHeight,NULL,NULL,NULL,(LPVOID)szCallbackName);

	OUTPUT:

	RETVAL

А функцию обработки сообщений изменим следующим образом

LRESULT CALLBACK WindowProc(HWND hWnd,
	UINT uMsg,DWORD wParam,DWORD lParam)
{
	LPCREATESTRUCT cs;
	switch(uMsg){
		case	WM_NCCREATE:
			return TRUE;
		case	WM_CREATE:
			cs = (LPCREATESTRUCT)lParam;
			printf("WindowProc called: %s\n",cs->lpCreateParams);
			return 0;
		case	WM_DESTROY:
			PostQuitMessage(0);
			return 0;
	}

	return DefWindowProc(hWnd,uMsg,wParam,lParam);
}

Не забываем экспортировать имя функции в глобальное пространство имен. Теперь список экспорта, определяемый в модуле WinApp.pm должен выглядеть следующим образом

our @EXPORT = qw(
	&_RegisterClass
	&_CreateWindow
);

В файл test.pl добавим простой код тестирования функции _CreateWindow()

# Тестируем функцию создания окна
my $HWND = _CreateWindow($className,'WinApp sample test',
	0,100,100,200,200,'main::WndProc');
sleep(5);

Теперь можно скомпилировать проект и запустить тестовую программу с помощью команды

nmake test

Результат тестирования будет следующим

test.pl
1..2
ok 1
ok 2
WindowProc called: main::WndProc

Привязываем perl-обработчик к дескриптору окна

Каким образом передать имя perl-обработчика сообщений в функцию WindowProc() при создании окна мы выяснили. Но ведь по идее perl-обработчик должен вызываться каждый раз, когда окно получает сообщения. Как тут быть? Можно пойти на таран и завести на стороне C-кода глобальную переменную, которая будет хранить имя функции обработчика. Но в этом случае мы ограничиваем программу всего одним окном. Это не есть гут, скажете вы и будете правы.

Не отчаивайтесь, мы выкручивались из ситуаций и посложнее, чем сохранение какого-то там строкового параметра. Ковыряясь в справочнике WinAPI, можно наткнуться на такую пару функций - GetWindowLong() и SetWindowLong(). На первый взгляд вся полезность этих функций заключается в установке и получении каких либо параметров окна. Однако, обратите внимание не маленькое упоминание о некоторой величине, которая ассоциируется с константой GWL_USERDATA. Эта константа позволяет связать с любым окном произвольное 32-х разрядную величину. Это вполне может быть и указатель. А имея возможность ассоциировать с окном указатель на произвольные данные, мы тем самым приобретаем возможность привязать к окну вообще любые значения, так как указать можно и на произвольную структуру данных. В общем, вот таким нехитрым способом мы привяжем строковое значение имени perl-функции к конкретному окну. Модуль получится гибким, красивым и умным :)

В нашем случае, привязку имени обработчика к окну нужно свести до уровня рефлекса модуля. Это значит, что легче всего возложить эту задачу на обработчик сообщения WM_CREATE, который у нас уже есть. Если вернуться к прототипу обработчика сообщений, то мы обнаружим наличие всех необходимых для привязки данных. Дескриптор создаваемого окна, который так нетерпеливо ожидает вызывающая CreateWindow() функция, поступает в обработчик в качестве первого аргумента. Вся прелесть в том, что на момент прихода сообщения WM_CREATE, в обработчик посылается действительный дескриптор - тот самый, который будет возвращен из функции CreateWindow().

Вся работа по связи имени функции и дескриптора окна выполняется в функции WindowProc(). Теперь ее код выглядит так

LRESULT CALLBACK WindowProc(HWND hWnd,
	UINT uMsg,DWORD wParam,DWORD lParam)
{
	LPCREATESTRUCT cs;
	LPSTR szFuncName;
	int NameLength;
	switch(uMsg){
		case	WM_NCCREATE:
			return TRUE;
		case	WM_CREATE:
			cs = (LPCREATESTRUCT)lParam;
			NameLength = strlen(cs->lpCreateParams);
			if (NameLength <= 0) return -1;
			szFuncName = malloc(NameLength + 1);
			if (!szFuncName) return -1;
			strcpy(szFuncName,cs->lpCreateParams);
			SetWindowLong(hWnd,GWL_USERDATA,
				(DWORD)szFuncName);

			return 0;
		case	WM_DESTROY:

			szFuncName = (LPSTR)GetWindowLong(hWnd,GWL_USERDATA);
			if (szFuncName) free(szFuncName);
			PostQuitMessage(0);
			return 0;
	}

	return DefWindowProc(hWnd,uMsg,wParam,lParam);
}

Здесь код требует некоторых пояснений. Зачем - спросите вы - нам нужно создавать копию строки, ведь у нас уже есть строка? Дело в том, что указатель cs->lpCreateParams указывает на переменную с ограниченной областью видимости, иначе говоря - аналог переменной perl, объявленной с помощью my. Хорошо если в функцию _CreateWindow() передается значение глобальной переменной, но даже в этом случае, не зная всех тонкостей устройства perl, нельзя гарантировать что указатель будет верным после того, как функция _CreateWindow() завершит свою работу. Дабы не испытывать судьбу, мы динамически выделяем память для хранения имени. Как вы знаете, динамически-выделенная память существует до тех пор, пока её не освободят с помощью функции free() или же о ней позаботися (по крайней мере, должен) сборщик мусора при завершении программы. Таким образом, блок динамически выделенной памяти существует на всем протяжении жизни программы, что нас, в принципе, устраивает, так как время существования окна никогда не превышает время существования программы (логично, да? :)

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

Еще хочу обратить ваше внимание на вызов функции PostQuitMessage(). Эта функция должна вызываться обязательно, так как она сигнализирует ситеме о том, что поток прекращает обрабатывать очередь сообщений. Если своевременно не сделать этого вызова, то цикл трансляции сообщений, который мы рассмотрим чуть позже, не завершится и программа зависнет.

Функции для работы с окнами

Мы написали кучу кода, а толку от модуля пока еще не видно. Мы даже ни разу не видели, как выглядит наше окно. Для того, чтобы иметь возможность как то управлять нашим окном, нам понадобятся несколько API-функций, которые я перечислил ранее. Сразу приведу их код из файла WinApp.xs

BOOL
_ShowWindow(hWnd,nCmdShow)
HWND hWnd;
int nCmdShow;

	CODE:

	RETVAL = ShowWindow(hWnd,nCmdShow);

	OUTPUT:

	RETVAL


BOOL
_UpdateWindow(hWnd)
HWND hWnd;

	CODE:

	RETVAL = UpdateWindow(hWnd);

	OUTPUT:

	RETVAL


DWORD
_SendMessage(hWnd,uMsg,wParam,lParam)
HWND hWnd;
DWORD uMsg;
DWORD wParam;
DWORD lParam;

	CODE:

	RETVAL = SendMessage(hWnd,uMsg,wParam,lParam);

	OUTPUT:

	RETVAL


BOOL
_PostMessage(hWnd,uMsg,wParam,lParam)
HWND hWnd;
DWORD uMsg;
DWORD wParam;
DWORD lParam;

	CODE:

	RETVAL = PostMessage(hWnd,uMsg,wParam,lParam);

	OUTPUT:

	RETVAL


BOOL
_DestroyWindow(hWnd)
HWND hWnd;

	CODE:

	RETVAL = DestroyWindow(hWnd);

	OUTPUT:

	RETVAL

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

Обработка очереди сообщений

Однако, господа, и это еще не все. Для нормального функционирования окна нам не достает самого главного - кто-то должен обрабатывать очередь сообщений. В общем, цикл обработки очереди сообщений тривиален

	MSG msg;
	while (GetMessage(&msg, NULL, 0, 0))
	{
		TranslateMessage(&msg);
		DispatchMessage(&msg);
	}

Структура MSG имеет следующее определение

typedef struct tagMSG {     // msg
    HWND   hwnd;
    UINT   message;
    WPARAM wParam;
    LPARAM lParam;
    DWORD  time;
    POINT  pt;
} MSG;

Из всех мемберов этой структуры нам сейчас должны быть неизвестны только два: time и pt. Согласно документации, time определяет время посылки сообщения, а pt - представляет собой координаты курсора в момент отправки сообщения. Вот так все просто. Хотя нам, судя по коду цикла обработки, даже и не обязательно знать, что там в этой структуре.

Мы без проблем можем написать XSUB-аналоги этих API-функций. Однако, здесь есть одна тонкость. Дело в том, что этот цикл работает со структурой, а в perl отсутствует понятие указателя. Мы, конечно, можем повозиться с pack/unpack или еще как-то решить эту проблему (например, по аналогии с именем обработчика, создать структуру динамически), однако на кой черт нам все это нужно. Цикл обработки практически одинаков для каждого окна (на самом деле, есть ситуации, когда цикл отличается, но это тема отдельной статьи), так почему бы нам не определить отдельную функцию, вызывая которую мы будем заставлять модуль автоматически обрабатывать очередь сообщений для нашего окна. Давайте так и поступим. Функцию назовем ProcMQ(), что означает - обработка очереди сообщений. Вот ее код в файле WinApp.xs

DWORD
ProcMQ()

	INIT:

	MSG msg;

	CODE:

	while (GetMessage(&msg, NULL, 0, 0))
	{
		TranslateMessage(&msg);
		DispatchMessage(&msg);
	}

	RETVAL = msg.wParam;

	OUTPUT:

	RETVAL

Заметьте очень важную деталь, что в коде этой функции не фигурирует дескриптор окна. Это означает, что мы должны вызывать эту функцию всего один раз для программы. Правда, круто!? Cначала создаем произвольное количество окон, а потом, с помощью всего одного вызова, активизируем обработку очереди для всех и каждого окна нашего приложения. Вот так то.

Вызов обработчика на территории perl

Мы подошли к самому сложному моменту расширения - обеспечить вызов обработчика, реализованного на стороне perl. Тут уже не обойтись без документации к XSUB-API. Так как мы очень ленивые (Ларри говорит, что это хорошо :), мы не будем сильно вникать - что и по-чем. Мы воспользуемся очень оригинальной методикой программирования Copy&Paste из наиболее подходящего примера. Этот самый пример я выудил из perlcall. Сэмпл под названием "Returning a Scalar" исчерпывающе поясняет как вызвать функцию, принимающую список и возвращающую скаляр. Нам это и надо, посему делаем "копи-пасту" этого примера в файл WinApp.xs. Да, но копировать его нужно не в конец, а в начало файла (перед WindowProc(), иначе WindowProc() не увидит ее), так как по сути, это не будет функцией модуля WinApp, это просто вспомогательная функция для WindowProc().

После непродолжительны шаманских песнопений и пританцовываний вокруг этой функции с бубном, мы получаем примерно следующее:

static BOOL
PerlCallback(hWnd,uMsg,wParam,lParam)
HWND hWnd;
DWORD uMsg;
DWORD wParam;
DWORD lParam;
{
	int count;
	BOOL bResult;
	LPSTR szFuncName;

	dSP;

	szFuncName = (LPSTR)GetWindowLong(hWnd,GWL_USERDATA);
	if (!szFuncName) return FALSE;

	ENTER;
	SAVETMPS;
	PUSHMARK(SP);
	XPUSHs(sv_2mortal(newSVuv((UV)hWnd)));
	XPUSHs(sv_2mortal(newSVuv((UV)uMsg)));
	XPUSHs(sv_2mortal(newSVuv((UV)wParam)));
	XPUSHs(sv_2mortal(newSVuv((UV)lParam)));
	PUTBACK;
	count = call_pv(szFuncName,G_SCALAR);
	SPAGAIN;
	if (count != 1) croak("Big trouble\n") ;
	bResult = POPi;
	PUTBACK;
	FREETMPS;
	LEAVE;
	return bResult;
}

Первым делом эта функция получает указатель на строку с именем функции perl, которую нужно вызвать для обработки сообщений. Обращаю ваше внимание на проверку, после вызова GetWindowLong(). Дело в том, что WM_CREATE не обязательно является первым сообщением. Однако алгоритм сопоставляет имя perl-обработчика только тогда, когда приходит сообщение WM_CREATE. Это означает, что если до того, как обработчик сообщений получит WM_CREATE система пошлет нам какое-нибудь другое сообщение, то PerlCallback() не сможет получить корректный указатель на строку. И если не выполнять этой проверки, то система сгенерирует экспекшн, так как будет произведена попытка обращения к неизвестно какой области памяти. Таким образом мы игнорируем все сообщения, которые приходят до WM_CREATE (поверьте, это небольшая потеря).

Теперь, наша задача сводится к присобачиванию вызова этой функции к обработчику WindowProc. Вот как это выглядит на практике

LRESULT CALLBACK WindowProc(HWND hWnd,
	UINT uMsg,DWORD wParam,DWORD lParam)
{
	LPCREATESTRUCT cs;
	LPSTR szFuncName;
	int NameLength;
	switch(uMsg){
		case	WM_NCCREATE:
			return TRUE;
		case	WM_CREATE:
			cs = (LPCREATESTRUCT)lParam;
			NameLength = strlen(cs->lpCreateParams);
			if (NameLength <= 0) return -1;
			szFuncName = malloc(NameLength + 1);
			if (!szFuncName) return -1;
			strcpy(szFuncName,cs->lpCreateParams);
			SetWindowLong(hWnd,GWL_USERDATA,
				(DWORD)szFuncName);
			if (PerlCallback(hWnd,uMsg,wParam,lParam))
				return 0;
			free(szFuncName);
			return -1;
		case	WM_DESTROY:
			if (!PerlCallback(hWnd,uMsg,wParam,lParam))
				return 1;
			szFuncName = (LPSTR)GetWindowLong(hWnd,GWL_USERDATA);
			if (szFuncName) free(szFuncName);
			PostQuitMessage(0);
			return 0;
	}

	return PerlCallback(hWnd,uMsg,wParam,lParam) ? 0
		: DefWindowProc(hWnd,uMsg,wParam,lParam);
}

Мы определяем WM_CREATE в качестве отправной точки для обработки сообщений на стороне perl. Это следует из описания функции PerlCallback(). Границей, завершающей процесс обработки сообщений, у нас является WM_DESTROY. После поступления этого сообщения, обработка очереди безоговорочно завершается посредством вызова PostQuitMessage.

В случае, когда мы получаем какой либо другое сообщение, мы ориентируемся на код возврата perl-обработчика для того, что бы определить - было ли обработано сообщение и нужно ли вызывать DefWindowProc(). Как я говорил ранее, вызов DefWindowProc() очень важен для необработанных сообщений. Ответственность за своевременный вызов ложится не только на WindowProc(), но и на обработчик на стороне perl. Очень важно, что бы perl-обработчик возвращал 0, в случае когда сообщение не обработано.

Поднимите мне веки или где наше окно?

Пора бы уже и полюбоваться на плоды трудов своих. Программа тестирования (файл test.pl) у меня выглядит следующим образом

# Тестируем функцию регистрации класса
my $className = 'WinApp class';
my $style = 3; # CS_HREDRAW | CS_VREDRAW
my $atom = _RegisterClass($className,$style);
print $atom ? "" : "not ","ok 2\n";

# Тестируем функцию создания окна
my $HWND = _CreateWindow($className,'WinApp sample test',
	0,100,100,200,200,'main::WndProc');
_ShowWindow($HWND,1);
_UpdateWindow($HWND);
ProcMQ();

sub WndProc{
	my ($hWnd,$uMsg,$wParam,$lParam) = @_;
	if ($uMsg == 1){ # WM_CREATE
		print "Window creation\n";
		return 1;
	}elsif($uMsg == 2){ # WM_DESTROY
		print "Window destroying\n";
		return 1;
	}
	return 0; # Это ОЧЕНЬ ВАЖНО!!!
}

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

our @EXPORT = qw(
	&_RegisterClass
	&_CreateWindow
	&_ShowWindow
	&_UpdateWindow
	&_SendMessage
	&_PostMessage
	&_DestroyWindow
	&ProcMQ

);

После запуска программы, на экране появится самое обычное, ничем не примечательное окно. И ради этого мы столько пережили! - воскликнете вы. Ничего, дело за малым - определить константы и прочее, прочее. И.г. - навести марафет. А окно... Окно мы создавали вовсе не для того, что бы на него любоваться. Мы создавали его для того, что бы, как все нормальные программы, работать с системными сообщениями. Так сказать, альтернатива глюкавству сигналов в операционных системах Windows. Согласитесь, это ведь не очень удобно, когда из всех сигналов боль-менее пашет только INT, та и тот со своими заскоками. Так что, красота красотою, а правильно работать важнее.

Наверх