Ключевые слова:perl, gcc, cpp, module, (найти похожие документы)
From: Vadim Likhota <vadiml@jabber.ru.>
Date: Mon, 15 Nov 2008 17:02:14 +0000 (UTC)
Subject: Использование С++ классов в Perl скриптах
Оригинал: http://vadiml.livejournal.com/1582.html
Журнальный вариант этой статьи опубликован в LinuxFormat 2007, N 11 (98)
Здесь она представлена в переработанном и дополненном виде
Описаний, как импортировать функции из С, достаточно много, а вот как использовать С++
классы, я увидел в виде кратких описаний только в XS Cookbook [1, 2] и небольшой статье
Gluing C++ And Perl Together . Пример использования С++ класса в Perl'е из XS Cookbook в
сокращенном варианте перекочевал в perlxstut. Кроме того, на CPAN можно найти модули,
импортирующие С++ классы и имеющие файлы импорта, которые можно использовать в качестве
примера, такие, как Boost-Graph, Lucene, Search-Xapian, Однако они не покрывают многих
вариантов подключения классов.
Чтобы не умножать сущности без надобности, т.е. не писать новых классов, которые потом
нигде не пригодятся, воспользуемся уже готовой библиотекой QtCore из Qt4. Для удобства
будут приведены части заголовочных файлов этой библиотеки, но все примеры будут
работоспособны при подключении реальной библиотеки. Кроме того, использование файла
perlobject.map [3] позволяет не писать заново описание объектов.
Начальные данные для любого модуля
Начальные данные для любого модуля можно найти в уже упомянутой статье , однако они
столь ценны и необходимы для раскрытия темы, что заслуживают отдельного рассмотрения.
Скелет любого модуля можно написать вручную, но легче и быстрее это сделать командой h2xs
-An имя_модуля. В результате будет создан каталог для модуля с необходимыми файлами,
содержимое которых детально описано в "Программировании на Perl" . Дав команду h2xs -An
QtCore, получим скелет модуля. В полученный каталог QtCore необходимо скопировать
perobject.map (названия всех файлов приводятся отностительно каталога QtCore). Созданный
файл Makefile.PL надо привести к следующему виду:
use 5.008;
use ExtUtils::MakeMaker;
$CC = 'g++';
WriteMakefile(
NAME => 'QtCore',
VERSION_FROM => 'lib/QtCore.pm',
PREREQ_PM => {}, # e.g., Module::Name => 1.1
($] >= 5.005 ?
(ABSTRACT_FROM => 'lib/QtCore.pm',
AUTHOR => 'A. U. Thor <author@localdomain.>') : ()),
LIBS => [''],
DEFINE => '',
CC => $CC,
LD => '$(CC)',
INC => '',
# OBJECT => '$(O_FILES)',
XSOPT => '-C++',
TYPEMAPS => ['perlobject.map'],
);
Выделенные жирным строки надо добавить именно для того, чтобы Perl заработал с С++.
Кроме того, важно исправить файл QtCore.xs, который будет содержать импортируемые в Perl
функции:
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif
Для наглядного примера создадим в этом файле класс, который будет хранить, допустим, версию
программы. Для этого добавим класс после подключенных заголовочных файлов перед строкой
"MODULE = QtCore PACKAGE = QtCore":
class QtCore {
public:
QtCore(){ vers = 0.001; };
~QtCore(){};
double ver(){ return vers; };
void setVer(double v){ vers = v; };
private:
double vers;
};
Работа с обычными функциями, конструктором и деструктором уже предусмотрена в Perl XS,
поэтому после объявления модуля и пакета можно использовать краткие объявления функций
(также возможны комментарии в perl-стиле, которые мы и будет использовать):
MODULE = QtCore PACKAGE = QtCore
=comment
# явное указание использовать прототипы функций позволяет избежать некоторых
# ошибок при передаче параметров в функции, но в тоже время не дает упростить
# использование этих функций. Например, если функция получает 2 параметра,
# а ваши данные для нее хранятся в массиве @aa,
# то ее необходимо вызывать как my_func($aa[0], $aa[1]).
# Тогда как при указании "PROTOTYPES: DISABLE" можно эту функцию вызвать как my_func(@aa).
=cut
PROTOTYPES: ENABLE
=comment
# XS распознает только 1 конструктор -- "new". Если их
# будет больше, то каждый будет нуждаться в подробном описании.
=cut
QtCore *
QtCore::new()
=comment
# методы класса
=cut
double
QtCore::ver()
void
QtCore::setVer(v)
double v
=comment
# В подавляющем большинстве случаев такого вызова деструктора хватает.
# Однако если вы хотите явно освободить память, уничтожить зависимые объекты и т.п.,
# то пример вызова деструктора найдете в XS Cookbook [2, см. ArrayOfStruct].
=cut
void
QtCore::DESTROY()
Кроме того, для вызова класса следует указать Perl'у, чем является класс QtCore, т.е. как
работать с этим типом данных, для чего создадим файл typemap со следующим содержимым:
TYPEMAP
QtCore * O_OBJECT
Описания встроенных типов данных можно посмотреть в typemap.xs , а описание O_OBJECT
находится в файле perlobject.map. Если не добавлять этот файл, то придется все
дополнительные типы данных полностью описывать самим в файле typemap (пример полного
описания приводится ниже). После этого остается внести изменения в файл lib/QtCore.pm,
который и будет подключаться в конечных скриптах. Поскольку QtCore.pm будет объектом и
ничего экспортироваться из него не будет, то следует из этого файла убрать всё относящееся
к модулю Exporter. Для импорта внешних функций можно использовать как XSLoader, так и более
старый DynaLoader (здесь используется второй, т.к. к нему чаще обращаются).
package QtCore;
use 5.008;
use strict;
use warnings;
require DynaLoader;
our @ISA = qw(DynaLoader);
our $VERSION = '0.01';
bootstrap QtCore $VERSION;
1;
Чтобы собрать полученный модуль, выполним команды perl Makefile.PL && make.
Всё сделанное необходимо протестировать. В модуле уже есть каталог t/ для тестовых
скриптов, которые, однако, расчитаны только на то, чтоб по команде make test вывести
"имя_скрипта.....ok". Этого явно недостаточно, чтобы подробно просмотреть работоспособность
написанного модуля. Поэтому создадим каталог test/ со скриптом qtcore.pl и следующим
содержимым:
#!/usr/bin/perl -w
use blib;
use QtCore;
my $q = new QtCore;
$q->setVer(4.001);
print $q->ver(), "\n";
В результате запуска скрипта должна появиться указанная нами версия 4.001.
Импортирование нескольких классов
Редко можно найти библиотеку, состоящую только из одного класса. Когда классов не много, их
можно описать в одном xs-файле. Или последовать примеру модуля Search-Xapian, в котором
один большой файл разбит на несколько, импортируемых в один командой
INCLUDE: подключаемый_файл.xs
Однако главным недостатком такого подхода является необходимость подключения в одном месте
всех заголовочных файлов, содержимое которых будет находиться в одной области видимости.
Третий вариант, особенно удобный для такой большой библиотеки, как QtCore, заключается в
том, чтобы каждый xs-файл сделать относительно независимым и в каждом подключать только тот
заголовочный файл, который описывает нам нужный класс. Это обычно делается двумя способами.
Первый способ состоит в том, чтобы в главном xs-файле прописать импорт boot-функций всех
файлов и вызвать их в boot-функции основного xs-файла, вызываемого функцией bootstrap.
Примеры реализации данного способа можно увидеть в библиотеках perl-Glib/Gtk2, Perl-RPM (в
каждой немного по-своему). Другой способ заключается в том, чтобы все вызовы сделать из
главного модуля, но уже на Perl'e. Данный вариант реализован в Win32::Gui. На мой взгляд,
он более удобен и обладает большей переносимостью.
Опишем последний вариант подробнее. Прежде всего следует удалить оставшиеся файлы
предыдущей сборки, а именно: каталог blib и файлы Makefile, pm_to_blib, QtCore.bs, *.c,
*.o.
Далее укажем обрабатывать несколько xs-файлов, для чего в Makefile.PL раскомментируем
строку
OBJECT => '$(O_FILES)'
Вследствие этого будут отрабатываться все xs-файлы, найденные в каталоге модуля (во
вложенных каталогах поиск не ведётся). Подключим библиотеку QtCore.so, для чего в строку
LIBS => [''],
пропишем её:
LIBS => ['-L/usr/lib -lQtCore '],
Для примера импортирования нескольких классов выберем небольшой класс QSize (здесь часть
файла с функциями, которые будут использованы ниже):
class Q_CORE_EXPORT QSize
{
public:
QSize();
QSize(int w, int h);
bool isEmpty() const;
int width() const;
int height() const;
void setWidth(int w);
void setHeight(int h);
void transpose();
void scale(int w, int h, Qt::AspectRatioMode mode);
void scale(const QSize &s, Qt::AspectRatioMode mode);
QSize &operator+=(const QSize &);
friend inline const QSize operator+(const QSize &, const QSize &);
private:
int wd;
int ht;
};
Создадим файл QSize.xs (оставив на потом некоторые функции):
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif
#include <QtCore/qsize.h>
MODULE = QtCore::QSize PACKAGE = QtCore::QSize
=comment
# QSize входит в состав QtCore
=cut
PROTOTYPES: ENABLE
QSize *
QSize::new()
bool
QSize::isEmpty()
int
QSize::width()
int
QSize::height()
void
QSize::setWidth(w)
int w
void
QSize::setHeight(h)
int h
void
QSize::DESTROY()
Далее создаем для класса QSize свой pm-файл lib/QtCore/QSize.pm
package QtCore::QSize;
use 5.008;
use strict;
use warnings;
use QtCore; # необходимо для вызова bootstrap, находящегося в файле QtCore
QtCore::bootstrap_subpackage 'QSize';
1;
В дальнейшем файлы QtCore.xs и lib/QtCore.pm будут нужны только для вызова bootstrap модуля
QtCore.pm. Заметим, что класс в QtCore.xs можно удалить, но тогда придется добавить хотя бы
одну внешнюю функцию, иначе в файле QtCore.c, который создается на основе QtCore.xs, не
будет всех нужных объявлений. Вообще все boot-функции и объявления в них можно прописать и
вручную, но вряд ли это целесообразно, если компилятор XS делает всё сам. Теперь следует
добавить в lib/QtCore.pm функцию, которая будет выполнять роль bootstrap для остальных
модулей:
sub bootstrap_subpackage {
my($package) = @_;
$package = 'QtCore::'.$package;
my $symbol = $package;
$symbol =~ s/\W/_/g;
no strict 'refs';
DynaLoader::dl_install_xsub(
"${package}::bootstrap",
DynaLoader::dl_find_symbol_anywhere("boot_$symbol")
);
&{ "${package}::bootstrap" };
}
Остался последний шаг в нашем примере импортирования нескольких классов. Класс следует
описать в файле typemap, добавив в конце:
QSize * O_OBJECT
Вот теперь уже можно запустить perl Makefile.PL && make и потестировать, что получилось.
Создадим файл test/qsize.pl для теста:
#!/usr/bin/perl -w
use blib;
use QtCore::QSize;
use Carp 'croak';
my $q = new QtCore::QSize; # создать класс
print "q is empty\n" if $q->isEmpty();
$q->setWidth(2); # присвоить параметр
print $q->width(), "\n"; # проверить
$q->setHeight(3);
print "q isn't empty\n" unless $q->isEmpty();
Использование нескольких конструкторов
Класс QSize содержит два конструктора, а компилятор XS знает только про new. Поэтому второй
конструктор реализуем сами. Чтобы увидеть, что для этого надо, достаточно посмотреть в файл
QSize.c, автоматически сгенерированный компилятором XS из файла QSize.xs:
char * CLASS = (char *)SvPV_nolen(ST(0));
QSize * RETVAL;
RETVAL = new QSize();
ST(0) = sv_newmortal();
sv_setref_pv( ST(0), CLASS, (void*)RETVAL );
Иными словами, благодаря "QSize::", расположенному перед конструктором "new", в функцию
передается строковый параметр CLASS с наименованием класса, после чего создается класс и
используется bless для полученной ссылки. Для примера импорта конструктора в QSize.xs
создадим конструктор "new1" с явным указанием компилятору на код и возвращаемый параметр:
QSize *
new1(CLASS)
char * CLASS
CODE:
RETVAL = new QSize();
OUTPUT:
RETVAL
Теперь запустим make. Получный в QSize.c код для "new1" будет идентичен автоматически
созданному коду для конструктора "new". Однако появятся две пометки о том, что код взят из
QSize.xs. Аналогично создадим второй конструктор, но уже с параметрами инициализации:
QSize *
new2(CLASS, w, h);
int w
int h
char * CLASS
CODE:
RETVAL = new QSize(w, h);
OUTPUT:
RETVAL
Заметим, что в Perl'е удобнее было бы использовать индификатор "new" для вызова любого
конструктора, не запоминая их номера. Для реализации этого удалим из QSize.xs вызов
QSize::new(), после чего добавим в lib/QtCore/QSize.pm функцию с таким же названием. Данная
функция в зависимости от содержимого сама будет выбирать, что ей вызвать. При неверном
количестве параметров функция выведет сообщение об ошибке:
sub new {
return new1($_[0]) if ( scalar(@_) == 1 );
return new2($_[0], $_[1], $_[2]) if ( scalar(@_) == 3 );
croak("ожидалось 0 или 2 параметра\n");
}
Далее даем команду make и проверяем, как всё работает, для чего добавим в test/qsize.pl
строку
my $w = QtCore::QSize->new(5,6);
Сложение классов ( operator+ )
Если в исходном классе, написанном на С++, содержатся операторы "арифметических" и
"логических" действий c классами, то данные функции желательно тоже импортировать в Perl.
Сначала рассмотрим, что добавить в QSize.xs для
QSize &operator+=(const QSize &);
Оператор возвращает тот же класс, к которому осуществляется прибавление, поэтому возвратить
QSize можно и в функции на Perl'e. Поскольку Perl внутри работает только с указателями, то
перед передачей функции прибавляемого класса otherSize его (указатель) следует
разыменовать:
void
QSize::operator_plus_eq(otherSize)
QSize * otherSize
CODE:
THIS->operator+= (*otherSize);
Или, например, другой оператор:
friend inline const QSize operator+(const QSize &, const QSize &);
Несмотря на то что фунция operator+ не является внутренней для класса, это не мешает
получить указатель на первый класс предыдущим способом. В то же время operator+ возвращает
новый объект QSize, который будет жить только в пределах С-функции. Нам же необходимо
вернуть указатель на новый объект QSize. Поэтому создадим новый экземпляр класса QSize и
ему приравняем возвращенный класс. Класс QSize простой, поэтому конструктор копий создается
компилятором автоматически.
QSize *
QSize::operator_plus(qsize2)
QSize * qsize2
PREINIT:
char * CLASS = "QtCore::QSize";
CODE:
RETVAL = new QSize();
*RETVAL = (operator+ ( *THIS, *qsize2 ));
OUTPUT:
RETVAL
В файле lib/QtCore/QSize.pm следует сделать для данных функций оболочку, используя overload
(подробности использования overload смотрите в perldoc или "Программировании на Perl" [5,
стр 397]):
use overload
'+' => \&_plus,
'+=' => \&_plus_eq,
'""' => sub { $_[0] };
sub _plus_eq {
unless ( ref($_) ) {
croak("need QSize += QSize\n");
return;
}
operator_plus_eq($_[0], $_[1]);
return $_[0]; # возвращается указатель на тот же экземпляр класса
}
sub _plus {
if ( ref($_[0]) and ref($_[1]) ) {
return operator_plus($_[0], $_[1]);
}
croak("Need QSize1 = QSize2 + QSize3\n");
}
В заключение осталось проверить работоспособность операторов. Добавим в test/qsize.pl такие
строки:
$w += $q;
print "w (h, w) == ", $w->height(), " ", $w->width(), "\n";
my $e = $w + $q;
print "e (h, w) == ", $e->height(), " ", $e->width(), "\n";
И, запустив, увидим как это работает.
Особенности использования enum
Работа с enum предусмотрена в Perl XS, однако с C++ появляется одна неприятность. Во время
обработки xs-файла компилятором XS обращения в другие классы за определёнными в них enum,
как, например, Qt::AspectRatioMode, в с-файле Qt::AspectRatioMode превращается в
Qt__AspectRatioMode. И выдается ошибка компилятора о том, что не найден тип
Qt__AspectRatioMode. К сожалению, нет никакой возможности избежать этого преобразования,
ибо таким способом создаются все функции с целью не допустить дублирования названий функций
с другими классами. Чтобы компилятор правильно увидел используемый нами enum, переопределим
его в исходный облик. В C-части xs-файла после подключения qsize.h добавим:
#define Qt__AspectRatioMode Qt::AspectRatioMode
Теперь можно функцию с этим типом данных:
void
QSize::scale(w, h, mode)
int w
int h
Qt::AspectRatioMode mode
CODE:
THIS->scale(w, h, mode);
Обратите внимание, что важно не забыть добавить в typemap новый тип данных:
Qt::AspectRatioMode T_ENUM
Для того чтобы не запоминать числовые значения всех enum-параметров, добавим модуль
lib/Qt.pm со всеми значениями AspectRatioMode:
package Qt;
# enum AspectRatioMode
use constant IgnoreAspectRatio => 0;
use constant KeepAspectRatio => 1;
use constant KeepAspectRatioByExpanding => 2;
1;
После добавления или удаления любого файла, следует полностью очитить библиотеку, удалив
каталог blib, файлы *.c, *.o & Co. После данных манипуляций и выполнения команд perl
Makefile.PL && make можно тестировать программу. Для этого после use blib в файле qsize.pl
следует добавить
use Qt;
а также добавить новую функцию в конце этого файла:
$e->scale(20, 20, Qt::IgnoreAspectRatio);
print "scale e (h, w) == ", $e->height(), " ", $e->width(), "\n";
Взаимодействие с STL или её аналогами
В Perl'e STL практически не нужна, поскольку большинство возможностей STL уже
поддерживаются массивами и хешами Perl'a. Поэтому рассмотрим только передачу данных из
шаблона list в массив Perl'a и обратно. Библиотека Qt4 инкапсулирует в себя STL, добавляя
некоторые возможности. Мы подробно рассмотрим работу с шаблоном QList, ибо методы некоторых
классов возвращают списки классов, используя именно его. Для получения массива обратимся к
классу QByteArray, в нём есть такой конструктор:
QList <QByteArray> split(char sep) const;
В файле QByteArray.xs перед использованием шаблонов STL необходимо убрать определения
do_open и do_close, иначе они начнут конфликтовать с аналогичными из Perl'a.
#undef do_open
#undef do_close
#include <QtCore/qlist.h>
#include <QtCore/qbytearray.h>
AV *
QByteArray::_split(c)
char c
CODE:
RETVAL = newAV();
QList <QByteArray> lba = THIS->split(c);
for ( int i = 0 ; i < lba.size() ; ++i ) {
QByteArray * ba = new QByteArray();
*ba = lba.at(i);
SV * rv = newSV(0);
sv_setref_pv( rv, "QtCore::QByteArray", (void *)ba );
av_push(RETVAL, rv);
};
OUTPUT:
RETVAL
CLEANUP:
SvREFCNT_dec( RETVAL );
Иными словами, в описании _split создается анонимный массив, указатель на который будет
передан в программу. Затем вызывается функция split класса на C++, которая возвращает
список классов QByteArray. Этот список обходится в цикле, в котором по одному указателю на
класс заносится в массив RETVAL. Поскольку массив принимает только тип данных SV*, то на
каждой итерации цикла создается новая переменная. Затем в нее копируется ссылка на класс из
списка, приведенная к типу данных Perl функцией sv_setref_pv. Подробно работа с массивами в
Perl XS описана в perlguts, а примеры использования массива со строками можно посмотреть в
"XS Cookbook" .
Следующий шаг состоит в добавлении в typemap нового класса
QByteArray * O_OBJECT
и создании для этого класса модуля lib/QtCore/QByteArray.pm. Функция _split возвращает
указатель на массив, однако в программе удобнее пользоваться обычным массивом. С этой целью
напишем простейшую оболочку для этой функции. Кроме того, в Perl'e есть своя функция split,
поэтому ее надо в пакете переопределить, используя use subs.
package QtCore::QByteArray;
use 5.008;
use strict;
use warnings;
use Carp qw/carp croak/;
use QtCore; # bootstraps QtCore.xs
QtCore::bootstrap_subpackage 'QByteArray';
use subs qw(split);
sub split {
croak("split: нет разделителя\n") unless $_;
return @{ _split($_[0], $_[1]) };
}
1;
Пересобираем пакет и тестируем (файл test/qbytearray.pl):
#!/usr/bin/perl -w
use blib;
use QtCore::QByteArray;
my $q = new QtCore::QByteArray("aaa bbb ccc");
print "q = ", $q->data(), "\n";
my @w = $q->split(' ');
for (my $i = 0 ; $w[$i] ; $i++ ) {
print "$i = ", $w[$i]->data(), "\n";
}
Аналогичным способом массив превращается в шаблон QList. Для примера приведём конструктор
класса QStringList, получающий для инициализации массив классов QString. В файле
QtCore/qstrinlist.h конструктор объявлен как
inline QStringList(const QStringList &l) : QList <QString> (l) { }
В xs-файле для него необходимо создать класс QList <QString> и заполнить его классами
QString, полученными из массива. av является указателем на копию этого массива. Копия
используется, поскольку функция av_pop(), которой мы здесь воспользуемся, удаляет считанные
элементы из массива.
QStringList *
new3(CLASS, av)
char * CLASS
AV * av
CODE:
QList <QString> qls;
while ( av_len(av) > -1 ) {
SV * rv = av_pop(av);
QString * str = (QString *)SvIV((SV*)SvRV( rv ));
qls << *str;
}
RETVAL = new QStringList(qls);
OUTPUT:
RETVAL
Описание типа данных, отсутствующего в typemap.xs и perlobject.map
В том случае, если нужно добавить новый тип данных, необходимо описать, как компилятору с
ним работать, т.е. читать из него данные и записывать. Данная тема описана в документации
Perl, но для полноты картины приведём пример, иллюстрирующий работу с отсутствующим в С
типом string. Для этого типа в typemap следует добавить:
string STRING
Ниже в разделах INPUT и OUTPUT необходимо описать, как перевести string из
внутреннего типа данных Perl'а (переменная $arg) в C++ (переменная $var) и обратно.
INPUT
STRING
{
STRLEN len;
const char * tmp = SvPV($arg, len);
$var.assign(tmp, len);
}
OUTPUT
STRING
sv_setpvn((SV*)$arg, (char *) ($var.data()), ($var.size()));
Приведение классов к привычному для Perl'a виду
В вышеприведенных способах создания объектов используется указатель на скаляр, в то время
как наиболее привычным указателем для создания классов является указатель на хеш, в котором
можно будет хранить переменные класса, если мы захотим что-то дописать на Perl'e:
$obj = {};
bless($obj);
Для того чтобы привести класс к привычному для Perl'a виду, создадим хеш в XS-файле, а
скаляр, который является указателем на С++ класс, сохраним в этом же хеше. Бывают случаи,
что класс создаётся не в XS файле, а функция получает указатель на него, и/или конструктор
копии этого класса находится в секции private. Тогда при уничтожении Perl-объекта С++ класс
удаляться не должен. Чтобы класс не удалился, нужно сделать пометку в хеше. Помимо этого,
необходимо осуществить и обратную операцию получить указатель на класс из хеша для работы с
вызываемыми функциями.
Поскольку описанные выше операции придётся делать для большинства функций, то удобнее
вынести этот код наружу во внешний подключаемый файл, который назовём common.xs. Обратите
внимание, что не cpp, а xs. Данное расширение используется, чтобы XS-компилятор сам
подхватил common.xs файл.
// преобразование С++ класса в Perl-объект
SV *
class2pobj(IV iv, const char *class_name, int no_ptr)
{
HV *hv = newHV(); // создание хеша
SV *retval = newSV(0); // переменная, в которую помещается указатель на класс
sv_setiv(retval, iv); // почти retval = (SV*)iv;
hv_store(hv, "_ptr", 4, retval, 0); // копирование переменной в $хеш{_ptr}
hv_store(hv, "_del", 4, newSViv(no_ptr), 0); // пометка-разрешение на вызов деструктора
return sv_bless(newRV_noinc((SV*)hv), gv_stashpv(class_name, 0)); // вызов bless и возврат уже готового Perl-объекта
}
// преобразование Perl-объекта в C++ класс
IV
pobj2class(SV *sv, const char *class_name, const char *func, const char *var)
{
char pclass_name[512];
char fn_warn[512];
char ptr_warn[512];
snprintf(pclass_name, 512, "Qt::%s", class_name); // воссоздание имени класса
snprintf(fn_warn, 512, "%s() -- %s is not blessed Qt::%s", func, var, class_name);
snprintf(ptr_warn, 512, "%s() -- %s->{_ptr} is NULL", func, var);
if( sv_derived_from(sv, pclass_name) && (SvTYPE(SvRV(sv)) == SVt_PVHV) ) { // если это искомый класс и тип данных является указателем на хеш, то
HV *hv = (HV*)SvRV( sv ); // получаем хеш из указателя
SV **ssv = hv_fetch(hv, "_ptr", 4, 0); // получаем реальный указатель
if ( ssv != NULL ) // если указатель не пустой
return SvIV(*ssv); // возвращаем его
warn( ptr_warn );
return (IV)NULL; // иначе возвращаем 'ничего'
}
warn( fn_warn );
return (IV)NULL;
}
Для подключения common.xs нужен заголовочный файл common.h:
#ifndef PQT4_COMMON_H
#define PQT4_COMMON_H
SV * class2pobj(IV iv, const char *class_name, int no_ptr);
IV pobj2class(SV *, const char *class_name, const char *func, const char *var);
#endif
Теперь посмотрим, какими станут конструктор и деструктор в XS-файле:
SV *
new()
CODE:
QSize * out_data;
out_data = new QSize( );
RETVAL = class2pobj(PTR2IV(out_data), "Qt::QSize", 1);
OUTPUT:
RETVAL
void
QSize::DESTROY()
CODE:
// предварительно проверяем можно ли удалять класс
SV **ssv = hv_fetch((HV*)SvRV(ST(0)), "_del", 4, 0);
if ( SvIV(*ssv) )
delete THIS;
Поскольку вызовы объекта были изменены, то теперь необходимо указать Perl'у, как работать с
новыми типами данных, т. е. поменять описание O_OBJECT в файле perlobject.map:
INPUT
O_OBJECT
$var = INT2PTR($type, pobj2class($arg, \"${(my $ttt = $type) =~ s/^(?:Perl)?([0-9A-Za-z_]+)\*/$1/;\$ttt}\", \"${Package}::$func_name\", \"$var\"));
if ( $var == NULL )
XSRETURN_UNDEF;
OUTPUT
O_OBJECT
$arg = class2pobj(PTR2IV($var), \"Qt::${(my $ttt = $type) =~ s/^([0-9A-Za-z_]+) \*/$1/;\$ttt}\", 1);
Обратите внимание, что в коде уже учтено использование библиотеки Qt. Для использования
кода с другой библиотекой его необходимо исправить.
Post Scriptum
В начале этой статьи мы писали проверку на количество параметров для перегруженных функций
в Perl-коде. Однако параметры могут различаться и по типу переменных, чего на уровне
Perl-кода не проверишь, а вот на уровне Perl XS можно проверить, в каком контексте
последний раз использовалась переменная. Воспользуемся этим и заодно перенесём на уровень
Perl XS обработку перегруженных функций. В результате получаем конструктор такого вида:
// перегруженные функции имеют переменное количество параметров, поэтому
PROTOTYPES: DISABLE
SV *
new(...)
// вызов без параметров
CASE: items == 0
CODE:
QSize * out_data;
out_data = new QSize( );
RETVAL = class2pobj(PTR2IV(out_data), "Qt::QSize", 1);
OUTPUT:
RETVAL
// вызов с двумя параметрами, и оба должны быть целыми числами
CASE: items == 2 && SvIOK(ST(0)) && SvIOK(ST(1))
PREINIT:
int w = (int)SvIV(ST(0));
int h = (int)SvIV(ST(1));
CODE:
QSize * out_data;
out_data = new QSize( w, h );
RETVAL = class2pobj(PTR2IV(out_data), "Qt::QSize", 1);
OUTPUT:
RETVAL
// если ни одно из условий не подошло, то возвращаем ошибку
CASE:
CODE:
warn( "Qt::QSize::QSize() -- Error in parameters" );
XSRETURN_UNDEF;
// такие комментарии в реальном коде следует убрать, т. к. они могут быть неверно интерпретированы
Подобным образом можно сделать разбор и других перегруженных функций, а не только
конструкторов.
Таким образом, в данной статье были рассмотрены все основные варианты использования C++ и
Perl XS. За пределами рассмотрения остались только прямое использование шаблонных классов
(но, как было указано выше, использовать их нецелесообразно, т. к. STL покрывается
возможностями самого Perl'a) и использование lvalue-функций из классов С++ в Perl'e (когда
разрабатывался Perl XS для 5-ой версии, lvalue изначально не был выписан и в самом Perl5, а
более поздних описаний расширений Perl XS на данный момент, по моим сведениям, не
существует).
Литература:
0.Документация Perl (perlxs, perlxstut, perlguts)
1. Dean's Extension-Building Cookbook in two parts:
Part A: http://www.cpan.org/authors/Dean_Roehrich/CookBookA-19960430.tar.gz
2. Dean's Extension-Building Cookbook in two parts:
Part B: http://www.cpan.org/authors/Dean_Roehrich/CookBookB-19960430.tar.gz
3. http://www.cpan.org/authors/Dean_Roehrich/perlobject.map-19960302.gz
4. John Keiser. Gluing C++ And Perl Together. 2001.
http://www.johnkeiser.com/perl-xs-c++.html
5. Уолл Л., Кристиансен Т., Орвант Д. Программирование на Perl. СПб.: Символ-плюс, 2005. 1152 с.
6. http://search.cpan.org/~nwclark/perl-5.8.8/ext/XS/Typemap/Typemap.xs
- Рассмотренные в конце статьи файлы common.xs и perlobject.map могут быть взяты на CPAN'е
из http://search.cpan.org/CPAN/authors/id/V/VA/VADIML/QtCore-4.004.tar.gz
- Копировать можно без ограничений, но прошу оставлять ссылку на оригинал.
я извиняюсь, а нельзя написать чтобы оно было так как GTK или QT3 на perl сразу, чтобы собрат ьвсе модули сразу, а то велосипеды писать, только время тратить...
