perl C/C++ 扩展（三）

deles

　　第三讲
扩展库使用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