| |
|
| Пользователей: | 25 |
| Новичок: | |
 BUM |
|
| Сейчас на сайте: | 10 |
| Сообщений: | 20 |
| Тем: | 18 |
| Разделов: | 41 |
| Статистика | |
| Новые темы: | |
| PerlQT4 (Использование.. С++ классов в Perl скриптах).. | |
| catalyst не видит путь | |
| Остальные | |
| Новые разделы: | |
| staynet.ru | |
| MVC Catalyst | |
| Остальные | |
| Новые сообщений: | |
| PerlQT4 (Использование.. С++ классов в Perl скриптах).. | |
| PerlQT4 (Использование.. С++ классов в Perl скриптах).. | |
| Остальные | |
| Рейтинг контента: | |
| CRUD Perl Web | |
| сравнение.. сложных структур данных в Perl | |
| Остальные | |
| Новые фотографии: | |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| Рейтинг фотографий | |
| Новые видео клипы: | |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| Рейтинг видео клипов | |
Просмотр темы |
||||||||||||
 Главная -->
Компьютеры -->
Интернет -->
Программирование -->
perl -->
|
||||||||||||
| « Предыдущий контент | ||||||||||||
На уровень выше
|
Посмотреть подразделы |
|||||||||||
|
|
||||||||||||
|
|
||||||||||||
| Тема: PerlQT4 (Использование С++ классов в Perl скриптах) (Просмотров: 1029) | ||||||||||||
 Дата: 1276570129 Новое: 1276570509 |
||||||||||||
Посмотреть комментарии этой темы
|
||||||||||||
|
|
||||||||||||
| | ||||||||||||
| HOWTO по работе с С++ классами из Perl'a | ||||||||||||
| | ||||||||||||
| Описаний, как импортировать функции из С, достаточно много, а вот как использовать С++ классы, я увидел в виде кратких описаний только в XS Cookbook [1, 2] и небольшой статье «Gluing C++ And Perl Together» [4]. Пример использования С++ класса в Perl'е из XS Cookbook в сокращенном варианте перекочевал в perlxstut. Кроме того, на CPAN можно найти модули, импортирующие С++ классы и имеющие файлы импорта, которые можно использовать в качестве примера, такие, как Boost-Graph, Lucene, Search-Xapian, Однако они не покрывают многих вариантов подключения классов. Чтобы не умножать сущности без надобности, т.е. не писать новых классов, которые потом нигде не пригодятся, воспользуемся уже готовой библиотекой QtCore из Qt4. Для удобства будут приведены части заголовочных файлов этой библиотеки, но все примеры будут работоспособны при подключении реальной библиотеки. Кроме того, использование файла perlobject.map [3] позволяет не писать заново описание объектов. Преимущества: 1) Быстрая скорость разработки, так как perl язык с динамической типизацией (dynamically typed), C++ и в какой-то мере Java — вы можете очень просто порождать ошибки, связанные со статическим типом переменной, в которую вы помещаете динамическое значение совместимого, но не идентичного типа. 2) Быстрая инициализация классов, загрузка кода на этапе компиляции (require), так же наследование (parent) и методов класса (SelfLoader и AutoLoader etc). 3) Кроссплатформенность программ, вероятность запуска на любой машине. 4) Самое большое количество модулей на cpan.org (16292 modules). 5) Автоматическая сборка мусора. Начальные данные для любого модуля Начальные данные для любого модуля можно найти в уже упомянутой статье [4], однако они столь ценны и необходимы для раскрытия темы, что заслуживают отдельного рассмотрения. Скелет любого модуля можно написать вручную, но легче и быстрее это сделать командой h2xs -An имя_модуля. В результате будет создан каталог для модуля с необходимыми файлами, содержимое которых детально описано в "Программировании на Perl" [5]. Дав команду h2xs -An QtCore, получим скелет модуля. В полученный каталог QtCore необходимо скопировать perobject.map (названия всех файлов приводятся отностительно каталога QtCore). Созданный файл Makefile.PL надо привести к следующему виду: Code: 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 функции: Code: #ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef __cplusplus } #endif Для наглядного примера создадим в этом файле класс, который будет хранить, допустим, версию программы. Для этого добавим класс после подключенных заголовочных файлов перед строкой "MODULE = QtCore PACKAGE = QtCore": Code: class QtCore { public: QtCore(){ vers = 0.001; }; ~QtCore(){}; double ver(){ return vers; }; void setVer(double v){ vers = v; }; private: double vers; }; Работа с обычными функциями, конструктором и деструктором уже предусмотрена в Perl XS, поэтому после объявления модуля и пакета можно использовать краткие объявления функций (также возможны комментарии в perl-стиле, которые мы и будет использовать): Code: 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 со следующим содержимым: Code: TYPEMAP QtCore * O_OBJECT Описания встроенных типов данных можно посмотреть в typemap.xs [6], а описание O_OBJECT находится в файле perlobject.map. Если не добавлять этот файл, то придется все дополнительные типы данных полностью описывать самим в файле typemap (пример полного описания приводится ниже). После этого остается внести изменения в файл lib/QtCore.pm, который и будет подключаться в конечных скриптах. Поскольку QtCore.pm будет объектом и ничего экспортироваться из него не будет, то следует из этого файла убрать всё относящееся к модулю Exporter. Для импорта внешних функций можно использовать как XSLoader, так и более старый DynaLoader (здесь используется второй, т.к. к нему чаще обращаются). Code: 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 и следующим содержимым: Code: #!/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, в котором один большой файл разбит на несколько, импортируемых в один командой Code: 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 раскомментируем строку Code: OBJECT => '$(O_FILES)' Вследствие этого будут отрабатываться все xs-файлы, найденные в каталоге модуля (во вложенных каталогах поиск не ведётся). Подключим библиотеку QtCore.so, для чего в строку Code: LIBS => [''], пропишем её: Code: LIBS => ['-L/usr/lib -lQtCore '], Для примера импортирования нескольких классов выберем небольшой класс QSize (здесь часть файла с функциями, которые будут использованы ниже): Code: 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 (оставив на потом некоторые функции): Code: #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 Code: 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 для остальных модулей: Code: 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, добавив в конце: Code: QSize * O_OBJECT Вот теперь уже можно запустить perl Makefile.PL && make и потестировать, что получилось. Создадим файл test/qsize.pl для теста: Code: #!/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: Code: 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" с явным указанием компилятору на код и возвращаемый параметр: Code: QSize * new1(CLASS) char * CLASS CODE: RETVAL = new QSize(); OUTPUT: RETVAL Теперь запустим make. Получный в QSize.c код для "new1" будет идентичен автоматически созданному коду для конструктора "new". Однако появятся две пометки о том, что код взят из QSize.xs. Аналогично создадим второй конструктор, но уже с параметрами инициализации: Code: 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 функцию с таким же названием. Данная функция в зависимости от содержимого сама будет выбирать, что ей вызвать. При неверном количестве параметров функция выведет сообщение об ошибке: Code: sub new { return new1($_[0]) if ( scalar(@_) == 1 ); return new2($_[0], $_[1], $_[2]) if ( scalar(@_) == 3 ); croak("ожидалось 0 или 2 параметра\n"); } Далее даем команду make и проверяем, как всё работает, для чего добавим в test/qsize.pl строку Code: my $w = QtCore::QSize->new(5,6); Сложение классов ( operator+ ) Если в исходном классе, написанном на С++, содержатся операторы "арифметических" и "логических" действий c классами, то данные функции желательно тоже импортировать в Perl. Сначала рассмотрим, что добавить в QSize.xs для Code: QSize &operator+=(const QSize &); Оператор возвращает тот же класс, к которому осуществляется прибавление, поэтому возвратить QSize можно и в функции на Perl'e. Поскольку Perl внутри работает только с указателями, то перед передачей функции прибавляемого класса otherSize его (указатель) следует разыменовать: Code: void QSize::operator_plus_eq(otherSize) QSize * otherSize CODE: THIS->operator+= (*otherSize); Или, например, другой оператор: Code: friend inline const QSize operator+(const QSize &, const QSize &); Несмотря на то что фунция operator+ не является внутренней для класса, это не мешает получить указатель на первый класс предыдущим способом. В то же время operator+ возвращает новый объект QSize, который будет жить только в пределах С-функции. Нам же необходимо вернуть указатель на новый объект QSize. Поэтому создадим новый экземпляр класса QSize и ему приравняем возвращенный класс. Класс QSize простой, поэтому конструктор копий создается компилятором автоматически. Code: 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]): Code: use overload '+' => \&_plus, '+=' => \&_plus_eq, '""' => sub { $_[0] }; sub _plus_eq { unless ( ref($_[1]) ) { 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 такие строки: Code: $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 добавим: Code: #define Qt__AspectRatioMode Qt::AspectRatioMode Теперь можно функцию с этим типом данных: Code: void QSize::scale(w, h, mode) int w int h Qt::AspectRatioMode mode CODE: THIS->scale(w, h, mode); Обратите внимание, что важно не забыть добавить в typemap новый тип данных: Code: Qt::AspectRatioMode T_ENUM Для того чтобы не запоминать числовые значения всех enum-параметров, добавим модуль lib/Qt.pm со всеми значениями AspectRatioMode: Code: 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 следует добавить Code: use Qt; а также добавить новую функцию в конце этого файла: Code: $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, в нём есть такой конструктор: Code: QList <QByteArray> split(char sep) const; В файле QByteArray.xs перед использованием шаблонов STL необходимо убрать определения do_open и do_close, иначе они начнут конфликтовать с аналогичными из Perl'a. Code: #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" [2]. Следующий шаг состоит в добавлении в typemap нового класса Code: QByteArray * O_OBJECT и создании для этого класса модуля lib/QtCore/QByteArray.pm. Функция _split возвращает указатель на массив, однако в программе удобнее пользоваться обычным массивом. С этой целью напишем простейшую оболочку для этой функции. Кроме того, в Perl'e есть своя функция split, поэтому ее надо в пакете переопределить, используя use subs. Code: 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 $_[1]; return @{ _split($_[0], $_[1]) }; } 1; Пересобираем пакет и тестируем (файл test/qbytearray.pl): Code: #!/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 конструктор объявлен как Code: inline QStringList(const QStringList &l) : QList <QString> (l) { } В xs-файле для него необходимо создать класс QList <QString> и заполнить его классами QString, полученными из массива. av является указателем на копию этого массива. Копия используется, поскольку функция av_pop(), которой мы здесь воспользуемся, удаляет считанные элементы из массива. Code: 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 следует добавить: Code: string STRING Ниже в разделах INPUT и OUTPUT необходимо описать, как перевести string из внутреннего типа данных Perl'а (переменная $arg) в C++ (переменная $var) и обратно. Code: 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: Code: $obj = {}; bless($obj); Для того чтобы привести класс к привычному для Perl'a виду, создадим хеш в XS-файле, а скаляр, который является указателем на С++ класс, сохраним в этом же хеше. Бывают случаи, что класс создаётся не в XS файле, а функция получает указатель на него, и/или конструктор копии этого класса находится в секции private. Тогда при уничтожении Perl-объекта С++ класс удаляться не должен. Чтобы класс не удалился, нужно сделать пометку в хеше. Помимо этого, необходимо осуществить и обратную операцию – получить указатель на класс из хеша для работы с вызываемыми функциями. Поскольку описанные выше операции придётся делать для большинства функций, то удобнее вынести этот код наружу – во внешний подключаемый файл, который назовём common.xs. Обратите внимание, что не cpp, а xs. Данное расширение используется, чтобы XS-компилятор сам подхватил common.xs файл. Code: // преобразование С++ класса в 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: Code: #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-файле: Code: 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: Code: 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 обработку перегруженных функций. В результате получаем конструктор такого вида: Code: // перегруженные функции имеют переменное количество параметров, поэтому 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 на данный момент, по моим сведениям, не существует). Несколько примеров: main.cpp Code: /**************************************************************************** ** ** Copyright (C) 2005-2007 Trolltech ASA. All rights reserved. ** ** This file is part of the example classes of the Qt Toolkit. ** ** This file may be used under the terms of the GNU General Public ** License version 2.0 as published by the Free Software Foundation ** and appearing in the file LICENSE.GPL included in the packaging of ** this file. Please review the following information to ensure GNU ** General Public Licensing requirements will be met: ** http://www.trolltech.com/products/qt/opensource.html ** ** If you are unsure which license is appropriate for your use, please ** review the following information: ** http://www.trolltech.com/products/qt/licensing.html or contact the ** sales department at sales@trolltech.com. ** ** This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE ** WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. ** ****************************************************************************/ #include <QApplication> #include <QPushButton> int main(int argc, char *argv[]) { QApplication app(argc, argv); QPushButton hello("Hello world!"); hello.resize(100, 30); hello.show(); return app.exec(); } main.pl Code: #!/usr/bin/perl -w # use blib; use Qt::QApplication; use Qt::QString; use Qt::QPushButton; unshift @ARGV, 'tutorial_1'; my $app = QApplication(\@ARGV); my $hello = QPushButton(QString("Hello world!")); $hello->resize(100,30); $hello->show(); $app->exec(); 1; main.cpp Code: /**************************************************************************** ** ** Copyright (C) 2005-2007 Trolltech ASA. All rights reserved. ** ** This file is part of the example classes of the Qt Toolkit. ** ** This file may be used under the terms of the GNU General Public ** License version 2.0 as published by the Free Software Foundation ** and appearing in the file LICENSE.GPL included in the packaging of ** this file. Please review the following information to ensure GNU ** General Public Licensing requirements will be met: ** http://trolltech.com/products/qt/licenses/licensing/opensource/ ** ** If you are unsure which license is appropriate for your use, please ** review the following information: ** http://trolltech.com/products/qt/licenses/licensing/licensingoverview ** or contact the sales department at sales@trolltech.com. ** ** In addition, as a special exception, Trolltech gives you certain ** additional rights. These rights are described in the Trolltech GPL ** Exception version 1.0, which can be found at ** http://www.trolltech.com/products/qt/gplexception/ and in the file ** GPL_EXCEPTION.txt in this package. ** ** In addition, as a special exception, Trolltech, as the sole copyright ** holder for Qt Designer, grants users of the Qt/Eclipse Integration ** plug-in the right for the Qt/Eclipse Integration to link to ** functionality provided by Qt Designer and its related libraries. ** ** Trolltech reserves all rights not expressly granted herein. ** ** Trolltech ASA (c) 2007 ** ** This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE ** WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. ** ****************************************************************************/ #include <QApplication> #include "screenshot.h" int main(int argc, char *argv[]) { QApplication app(argc, argv); Screenshot screenshot; screenshot.show(); return app.exec(); } screenshot.h Code: /**************************************************************************** ** ** Copyright (C) 2005-2007 Trolltech ASA. All rights reserved. ** ** This file is part of the example classes of the Qt Toolkit. ** ** This file may be used under the terms of the GNU General Public ** License version 2.0 as published by the Free Software Foundation ** and appearing in the file LICENSE.GPL included in the packaging of ** this file. Please review the following information to ensure GNU ** General Public Licensing requirements will be met: ** http://trolltech.com/products/qt/licenses/licensing/opensource/ ** ** If you are unsure which license is appropriate for your use, please ** review the following information: ** http://trolltech.com/products/qt/licenses/licensing/licensingoverview ** or contact the sales department at sales@trolltech.com. ** ** In addition, as a special exception, Trolltech gives you certain ** additional rights. These rights are described in the Trolltech GPL ** Exception version 1.0, which can be found at ** http://www.trolltech.com/products/qt/gplexception/ and in the file ** GPL_EXCEPTION.txt in this package. ** ** In addition, as a special exception, Trolltech, as the sole copyright ** holder for Qt Designer, grants users of the Qt/Eclipse Integration ** plug-in the right for the Qt/Eclipse Integration to link to ** functionality provided by Qt Designer and its related libraries. ** ** Trolltech reserves all rights not expressly granted herein. ** ** Trolltech ASA (c) 2007 ** ** This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE ** WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. ** ****************************************************************************/ #ifndef SCREENSHOT_H #define SCREENSHOT_H #include <QPixmap> #include <QWidget> class QCheckBox; class QGridLayout; class QGroupBox; class QHBoxLayout; class QLabel; class QPushButton; class QSpinBox; class QVBoxLayout; class Screenshot : public QWidget { Q_OBJECT public: Screenshot(); protected: void resizeEvent(QResizeEvent *event); private slots: void newScreenshot(); void saveScreenshot(); void shootScreen(); void updateCheckBox(); private: void createOptionsGroupBox(); void createButtonsLayout(); QPushButton *createButton(const QString &text, QWidget *receiver, const char *member); void updateScreenshotLabel(); QPixmap originalPixmap; QLabel *screenshotLabel; QGroupBox *optionsGroupBox; QSpinBox *delaySpinBox; QLabel *delaySpinBoxLabel; QCheckBox *hideThisWindowCheckBox; QPushButton *newScreenshotButton; QPushButton *saveScreenshotButton; QPushButton *quitScreenshotButton; QVBoxLayout *mainLayout; QGridLayout *optionsGroupBoxLayout; QHBoxLayout *buttonsLayout; }; #endif screenshot.cpp Code: /**************************************************************************** ** ** Copyright (C) 2005-2007 Trolltech ASA. All rights reserved. ** ** This file is part of the example classes of the Qt Toolkit. ** ** This file may be used under the terms of the GNU General Public ** License version 2.0 as published by the Free Software Foundation ** and appearing in the file LICENSE.GPL included in the packaging of ** this file. Please review the following information to ensure GNU ** General Public Licensing requirements will be met: ** http://trolltech.com/products/qt/licenses/licensing/opensource/ ** ** If you are unsure which license is appropriate for your use, please ** review the following information: ** http://trolltech.com/products/qt/licenses/licensing/licensingoverview ** or contact the sales department at sales@trolltech.com. ** ** In addition, as a special exception, Trolltech gives you certain ** additional rights. These rights are described in the Trolltech GPL ** Exception version 1.0, which can be found at ** http://www.trolltech.com/products/qt/gplexception/ and in the file ** GPL_EXCEPTION.txt in this package. ** ** In addition, as a special exception, Trolltech, as the sole copyright ** holder for Qt Designer, grants users of the Qt/Eclipse Integration ** plug-in the right for the Qt/Eclipse Integration to link to ** functionality provided by Qt Designer and its related libraries. ** ** Trolltech reserves all rights not expressly granted herein. ** ** Trolltech ASA (c) 2007 ** ** This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE ** WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. ** ****************************************************************************/ #include <QtGui> #include "screenshot.h" Screenshot::Screenshot() { screenshotLabel = new QLabel; screenshotLabel->setSizePolicy(QSizePolicy::Expanding, QSizePolicy::Expanding); screenshotLabel->setAlignment(Qt::AlignCenter); screenshotLabel->setMinimumSize(240, 160); createOptionsGroupBox(); createButtonsLayout(); mainLayout = new QVBoxLayout; mainLayout->addWidget(screenshotLabel); mainLayout->addWidget(optionsGroupBox); mainLayout->addLayout(buttonsLayout); setLayout(mainLayout); shootScreen(); delaySpinBox->setValue(5); setWindowTitle(tr("Screenshot")); resize(300, 200); } void Screenshot::resizeEvent(QResizeEvent * /* event */) { QSize scaledSize = originalPixmap.size(); scaledSize.scale(screenshotLabel->size(), Qt::KeepAspectRatio); if (!screenshotLabel->pixmap() || scaledSize != screenshotLabel->pixmap()->size()) updateScreenshotLabel(); } void Screenshot::newScreenshot() { if (hideThisWindowCheckBox->isChecked()) hide(); newScreenshotButton->setDisabled(true); QTimer::singleShot(delaySpinBox->value() * 1000, this, SLOT(shootScreen())); } void Screenshot::saveScreenshot() { QString format = "png"; QString initialPath = QDir::currentPath() + tr("/untitled.") + format; QString fileName = QFileDialog::getSaveFileName(this, tr("Save As"), initialPath, tr("%1 Files (*.%2);;All Files (*)") .arg(format.toUpper()) .arg(format)); if (!fileName.isEmpty()) originalPixmap.save(fileName, format.toAscii()); } void Screenshot::shootScreen() { if (delaySpinBox->value() != 0) qApp->beep(); originalPixmap = QPixmap::grabWindow(QApplication::desktop()->winId()); updateScreenshotLabel(); newScreenshotButton->setDisabled(false); if (hideThisWindowCheckBox->isChecked()) show(); } void Screenshot::updateCheckBox() { if (delaySpinBox->value() == 0) hideThisWindowCheckBox->setDisabled(true); else hideThisWindowCheckBox->setDisabled(false); } void Screenshot::createOptionsGroupBox() { optionsGroupBox = new QGroupBox(tr("Options")); delaySpinBox = new QSpinBox; delaySpinBox->setSuffix(tr(" s")); delaySpinBox->setMaximum(60); connect(delaySpinBox, SIGNAL(valueChanged(int)), this, SLOT(updateCheckBox())); delaySpinBoxLabel = new QLabel(tr("Screenshot Delay:")); hideThisWindowCheckBox = new QCheckBox(tr("Hide This Window")); optionsGroupBoxLayout = new QGridLayout; optionsGroupBoxLayout->addWidget(delaySpinBoxLabel, 0, 0); optionsGroupBoxLayout->addWidget(delaySpinBox, 0, 1); optionsGroupBoxLayout->addWidget(hideThisWindowCheckBox, 1, 0, 1, 2); optionsGroupBox->setLayout(optionsGroupBoxLayout); } void Screenshot::createButtonsLayout() { newScreenshotButton = createButton(tr("New Screenshot"), this, SLOT(newScreenshot())); saveScreenshotButton = createButton(tr("Save Screenshot"), this, SLOT(saveScreenshot())); quitScreenshotButton = createButton(tr("Quit"), this, SLOT(close())); buttonsLayout = new QHBoxLayout; buttonsLayout->addStretch(); buttonsLayout->addWidget(newScreenshotButton); buttonsLayout->addWidget(saveScreenshotButton); buttonsLayout->addWidget(quitScreenshotButton); } QPushButton *Screenshot::createButton(const QString &text, QWidget *receiver, const char *member) { QPushButton *button = new QPushButton(text); button->connect(button, SIGNAL(clicked()), receiver, member); return button; } void Screenshot::updateScreenshotLabel() { screenshotLabel->setPixmap(originalPixmap.scaled(screenshotLabel->size(), Qt::KeepAspectRatio, Qt::SmoothTransformation)); } main.pl Code: #!/usr/bin/perl -w use Qt; use Qt::QApplication; use Screenshot; unshift @ARGV, 'screenshot'; my $app = QApplication(\@ARGV); my $screenshot = Screenshot(); $screenshot->show(); $app->exec(); | ||||||||||||
| |
||||||||||||
| |
||||||||||||
|
|
||||||||||||
| |
||||||||||||
| |
||||||||||||
Проголосовавшых: 5 Балов: 2
Среднее: 2.50
Популярность: 4
| ||||||||||||
| Чтобы проголосовать вы должны зарегистрироватся ! | ||||||||||||
| |
||||||||||||
|
|
||||||||||||
| |
||||||||||||
| |
||||||||||||
| Фотоальбомы: | ||||||||||||
| фотоальбомов не найдено | ||||||||||||
| |
||||||||||||
| |
||||||||||||
|
|
||||||||||||
| |
||||||||||||
| |
||||||||||||
| Видеоальбомы: | ||||||||||||
| Видеоальбомов не найдено | ||||||||||||
| |
||||||||||||
| |
||||||||||||
| |
||||||||||||
Комментарии |
||||||||||||
| |
||||||||||||
|
||||||||||||
| |
||||||||||||
| Гостям, запрещено создавать комментарии! Можете зарегистрироватся ... | ||||||||||||
| |
||||||||||||
| |
||||||||||||
| |
||||||||||||