第三讲
扩展库使用c++实现，在调用函数后，返回对象变量，perl 能正确使用所有对象成员
使用h2xs 命令生成初始文件
h2xs -A -n three_test
登录目录
cd three_test
c++ 头文件
#ifndef INCLUDED_DUCK_H #define INCLUDED_DUCK_H 1 #include <string> using std::string; class Duck { public:Duck(char*);char* getName();void swim();~Duck(){} private:bool swimming;string name; }; #endif /* INCLUDED_DUCK_H */
c++程序代码
#include "Duck.h" #include <cstdio>using namespace std;Duck::Duck(char* n) :swimming(false), name(n) { } const char* Duck::getName() {return name.c_str(); } void Duck::swim() {if (!swimming){printf("%s, ok .. go swimming\n", name.c_str());swimming = true;}else{printf("%s is already swimming , stop\n", name.c_str());swimming = false;}return; }
使用g++编译成动态库
g++ -g -Wall -fpic -shared -o libduck.so Duck.cpp 将libduck.so 文件与Duck.h 文件拷贝到 three_test 目录下
cp libduck.so three_test; cp Duck.h three_test;
XS是一种用于描述接口的文件格式，当我们希望把我们的C/C++库映射成Perl的package时，需要在一个.xs文件中描述接口的映射。另外，我们还需要进行数据类型的映射，下文会提到 perlobject.map文件的使用。
perlobject.map 内容：（原文件地址：http://cpansearch.perl.org/src/ELEONORA/text_hunspell_1.3/perlobject.map）
# "perlobject.map" Dean Roehrich, version 19960302 # # TYPEMAPs # # HV * -> unblessed Perl HV object. # AV * -> unblessed Perl AV object. # # INPUT/OUTPUT maps # # O_* -> opaque blessed objects # T_* -> opaque blessed or unblessed objects # # O_OBJECT -> link an opaque C or C++ object to a blessed Perl object. # T_OBJECT -> link an opaque C or C++ object to an unblessed Perl object. # O_HvRV -> a blessed Perl HV object. # T_HvRV -> an unblessed Perl HV object. # O_AvRV -> a blessed Perl AV object. # T_AvRV -> an unblessed Perl AV object.TYPEMAPHV * T_HvRV AV * T_AvRV###################################################################### OUTPUT# The Perl object is blessed into 'CLASS', which should be a # char* having the name of the package for the blessing. O_OBJECTsv_setref_pv( $arg, CLASS, (void*)$var );T_OBJECTsv_setref_pv( $arg, Nullch, (void*)$var );# Cannot use sv_setref_pv() because that will destroy # the HV-ness of the object. Remember that newRV() will increment # the refcount. O_HvRV # "perlobject.map" Dean Roehrich, version 19960302 # # TYPEMAPs # # HV * -> unblessed Perl HV object. # AV * -> unblessed Perl AV object. # # INPUT/OUTPUT maps # # O_* -> opaque blessed objects # T_* -> opaque blessed or unblessed objects # # O_OBJECT -> link an opaque C or C++ object to a blessed Perl object. # T_OBJECT -> link an opaque C or C++ object to an unblessed Perl object. # O_HvRV -> a blessed Perl HV object. # T_HvRV -> an unblessed Perl HV object. # O_AvRV -> a blessed Perl AV object. # T_AvRV -> an unblessed Perl AV object.TYPEMAPHV * T_HvRV AV * T_AvRV###################################################################### OUTPUT# The Perl object is blessed into 'CLASS', which should be a # char* having the name of the package for the blessing. O_OBJECTsv_setref_pv( $arg, CLASS, (void*)$var );T_OBJECTsv_setref_pv( $arg, Nullch, (void*)$var );# Cannot use sv_setref_pv() because that will destroy # the HV-ness of the object. Remember that newRV() will increment # the refcount. O_HvRV$arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) );T_HvRV$arg = newRV((SV*)$var);# Cannot use sv_setref_pv() because that will destroy # the AV-ness of the object. Remember that newRV() will increment # the refcount. O_AvRV$arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) );T_AvRV$arg = newRV((SV*)$var);###################################################################### INPUTO_OBJECTif( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )$var = ($type)SvIV((SV*)SvRV( $arg ));else{warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" ); XSRETURN_UNDEF;}T_OBJECTif( SvROK($arg) )$var = ($type)SvIV((SV*)SvRV( $arg ));else{warn( \"${Package}::$func_name() -- $var is not an SV reference\" ); XSRETURN_UNDEF;}O_HvRVif( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) )$var = (HV*)SvRV( $arg );else {warn( \"${Package}::$func_name() -- $var is not a blessed HV reference\" ); XSRETURN_UNDEF;}T_HvRVif( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) )$var = (HV*)SvRV( $arg );else {warn( \"${Package}::$func_name() -- $var is not an HV reference\" ); XSRETURN_UNDEF;}O_AvRVif( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) )$var = (AV*)SvRV( $arg );else {warn( \"${Package}::$func_name() -- $var is not a blessed AV reference\" ); XSRETURN_UNDEF;}T_AvRVif( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) )$var = (AV*)SvRV( $arg );else {warn( \"${Package}::$func_name() -- $var is not an AV reference\" ); XSRETURN_UNDEF;}
将文件perlobject.map 拷贝到 three_test 目录下
cp perlobject.map three_test
增加一个Duck类型，保存在文件typemap
touch three_test/typemap typemap 文件内容
TYPEMAP
Duck* O_OBJECT
修改Makefile.PL 文件
#use 5.014002; use ExtUtils::MakeMaker; $CC = 'g++'; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile(NAME => 'three_test',VERSION_FROM => 'lib/three_test.pm', # finds $VERSIONPREREQ_PM => {}, # e.g., Module::Name => 1.1($] >= 5.005 ? ## Add these new keywords supported since 5.005(ABSTRACT_FROM => 'lib/three_test.pm', # retrieve abstract from moduleAUTHOR => 'root <root@>') : ()),LIBS => ['-L./ -lduck'], # e.g., '-lm'DEFINE => '', # e.g., '-DHAVE_SOMETHING''CC' => $CC,'LD' => '$(CC)',INC => '-I.', # e.g., '-I. -I/usr/include/other'# Un-comment this if you add C files to link with later:# OBJECT => '$(O_FILES)', # link all the C files too'XSOPT' => '-C++','TYPEMAPS' => ['perlobject.map'] );
注意，红色部分为增加会修改内容，特别需要指出的是，第一行use 5.014002; 一定需要注释，否则无法正确生成makefile
修改部分，主要是指定编译使用g++
修改three_test.xs 文件
#ifdef __cplusplus extern "C"{ #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef __cplusplus } #endif #include "ppport.h" #include "Duck.h" using namespace std;MODULE = three_test PACKAGE = three_testDuck* Duck::new(char * name)char* Duck::getName()void Duck::swim()void Duck::DESTROY()
红色部分为增加内容
编译并安装
perl Makefile.PL make make install
编写一个perl 测试程序 test.pl
use three_test;my $duck = new three_test("Dan"); my $name = $duck->getName(); $duck->swim(); $duck->swim(); print "$name\n";
执行
perl test.pl
输出：
Dan, ok .. go swimming
Dan is already swimming , stop
Dan
正确调用了C++的库
参考文章：
http://chunyemen.org/archives/493
http://www.johnkeiser.com/perl-xs-c++.html
官方文档：http://perldoc.perl.org/perlxs.html#NAME