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