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
", name.c_str());
        swimming = true;
    }
    else
    {
        printf("%s is already swimming , stop
", 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
";

执行

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