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

#

# 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

#

# 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,) );

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,) );

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

巴特西

perl C/C++ 扩展（三）

最新文章

热门文章