perl C/C++ 扩展（三）
第三讲
扩展库使用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. TYPEMAP HV * 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_OBJECT sv_setref_pv( $arg, CLASS, (void*)$var ); T_OBJECT sv_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. TYPEMAP HV * 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_OBJECT sv_setref_pv( $arg, CLASS, (void*)$var ); T_OBJECT sv_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); ###################################################################### INPUT O_OBJECT if( 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_OBJECT if( SvROK($arg) ) $var = ($type)SvIV((SV*)SvRV( $arg )); else{ warn( \"${Package}::$func_name() -- $var is not an SV reference\" ); XSRETURN_UNDEF; } O_HvRV if( 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_HvRV if( 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_AvRV if( 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_AvRV if( 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 $VERSION PREREQ_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 module AUTHOR => '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_test Duck* 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
再进击
