hollyさんのwiki

perlxsねた編集する

最終更新： kurt0027 kurt0027 2011年01月05日(水) 23:57:17履歴

もう忘れてしまってるのでよくわからん

参考になりそうなところ

変数の型

  • SV スカラー
  • AV 配列
  • HV ハッシュ
  • CV コード
  • GV グロブ
  • RV リファレンス
  • IV 整数
  • NV 実数
  • PV 文字列

C++なxsを作ってみる

h2xs

せっかくなのでC++にしたい場合。まずはいつものh2xs
h2xs -A -n CPPXS
Makefile.PLを編集
# WriteMakefileの引数に追加
CC => "g++",
LD => "g++",
CPPXSディレクトリに移動してMakefile.PLを編集し、実行
perl Makefile.PL
CPPXS.xsを編集
#ifdef __cplusplus
extern "C" {
#endif

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#ifdef __cplusplus
}
#endif

#include <iostream>
using namespace std;

MODULE = CPPXS          PACKAGE = CPPXS

void
hello()
CODE:
  cout << "hello" << endl;
makeする
make
できたモジュールの中身をみてみる。XSが呼ばれているところはこのようになっている
require XSLoader;
XSLoader::load('CPPXS', $VERSION);
テスト用スクリプト作成 cppxs.pl
#!/usr/bin/perl

use strict;
use ExtUtils::testlib;
use CPPXS;

CPPXS::hello();
テスト用スクリプト実行
perl cppxs.pl
hello

module-starter + xs

たぶんどっちかっていうとこっちが主流？
Module::Starter, Module::Starter::PBPが必要なので、なければインストールする
# CPANPLUSもなかったのでついでに
yum -y install perl-CPANPLUS perl-Module-Starter perl-Module-Starter-PBP
次にModule::Starter::XSimpleが必要だが、これはyumにはないので、cpanpでインストール
cpanp i Module::Starter::XSimple
あとはmodule-starterを実行するときの--classにModule::Starter::XSimpleを指定する
module-starter --module=CPPXS --class=Module::Starter::XSimple --author=holly --email=your@mailaddress
これでh2xsをつかわなくても可能。ちなみにhttp://blog.clouder.jp/archives/001094.htmlこんなのもあるみたい。

とりあえずいろいろ早く試してみる

単純に文字列出力

PrintXSというパッケージを作る。初めは丁寧にやってみる
h2xs -A -n PrintXS
PrintXSディレクトリのPrintXS.xsを編集。PerlIO_printfを使う
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"
 
 
MODULE = PrintXS               PACKAGE = PrintXS

void 
stdout_print()
CODE:
   PerlIO_printf(PerlIO_stdout(), "標準出力\n");
 
void
stderr_print()
CODE:
   PerlIO_printf(PerlIO_stderr(), "標準エラー出力\n");

make
perl Makefile.PL
make
テストプログラム作成。printxs.pl
#!/usr/bin/perl

use strict;
use lib qw(./lib);
use PrintXS;

PrintXS::stdout_print();
PrintXS::stderr_print();
実行
# 標準出力
perl printxs.pl 2>/dev/null
# 標準エラー出力
perl printxs.pl > /dev/null
PerlIO_printfの第2引数に渡す変数はCのchar*型でないとだめなので、SV*とかの場合は
SvPVX(SV*)
のようにして被参照を行うといいらしい。

true or false

BoolXSというpackageを作成としたして、BoolXS.xsを編集
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"
#include <string.h>
#include <stdbool.h>

MODULE = BoolXS         PACKAGE = BoolXS

bool
check_hoge(char* str)
CODE:
   RETVAL = (strcmp(str, "hoge") == 0) ? true : false;
OUTPUT:
   RETVAL
テストプログラム作成。boolxs.pl makeまで終わった段階で
#!/usr/bin/perl

use strict;
use lib qw(./lib);
use BoolXS;

my $str = shift;

if(BoolXS::check_hoge($str)){
   print "$str ok\n";
}else{
    print "$str not ok\n";
}

xsからpackage変数を参照したい場合

get_svを使う。Hoge.pm内で
$Hoge::VERSION = '1.00';
などとあって、Hoge.xsからこれを参照する場合
SV* version = get_sv("Hoge::VERSION", FALSE);
とするとよい。第2引数はFALSEにしてるほうが無難。TRUEにすると変数が生成される
# こうするとxsから設定できる
SV* sv = perl_get_sv("foo", TRUE);
sv_setpv(sv, "bar");
SvPOK_on(sv);
Double_Typed_SVs とか参考になる

blessされたリファレンスのpackage名を取得する

HvName?(SvSTASH(SvRV(SV*)))を使うとcharで返って来るみたい
char * get_package_name_from_sv(SV * sv)
 INIT:
   char *pkg;
 CODE:
   if(sv_isobject(sv)){
       pkg = HvNAME(SvSTASH(SvRV(sv)));
   }else{
       Perl_croak(aTHX_ "Usage: get_package_name_from_sv(SV*). sv is not reference");
   }
   RETVAL = pkg;
 OUTPUT:
   RETVAL
このあたり参照 http://fleur.hio.jp/perldoc/mix/pod/perlguts.html#...
参考に 
SV * new(...)
   INIT:
       char *classname;
       /* get the class name if called as an object method */
       if ( sv_isobject(ST(0)) ) {
           classname = HvNAME(SvSTASH(SvRV(ST(0))));
       }
       else {
           classname = (char *)SvPV_nolen(ST(0));
       }
Module::Starter::XSimpleを使うとこのようなnewを生成してくれる。引数が可変なので...であらわし、int itemsで受け取った引数の数を取得できる

リストを返す

PPCODEを使って、リストを返す
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"
#include <string.h>

MODULE = Hoge           PACKAGE = Hoge

void get_list()
PPCODE:
  char* c1 = "hoge";
  char* c2 = "hage";
  char* c3 = "uge";
  XPUSHs(sv_2mortal(newSVpv( c1, strlen(c1) )));
  XPUSHs(sv_2mortal(newSVpv( c2, strlen(c2) )));
  XPUSHs(sv_2mortal(newSVpv( c3, strlen(c3) )));
新たな変数を作るときはnewSV**で生成。newSV**で作成した変数に対しては必ずsv_2mortalをする。メモリリークを引き起こす原因らしい。
そしてリストを返す場合はPPCODE + XPUSHs**セットで使う（他にもやり方はあるだろうけど）
ただし返り値をRETVALで返す場合は**.cのほうで
ST(0) = RETVAL;
sv_2mortal(ST(0));
としてくれるので変数の揮発化（っていうらしい）は行う必要はない
あとはperl側から
my($c1, $c2, $c3) = Hoge::get_list();
とすると受け取り可能。余談だがXPUSHsは引数スタックを自動的に拡張してくれる。あらかじめ返す引数の数がわかっている場合は
EXTEND(sp, 3);
としてから
char* c1 = "hoge";
char* c2 = "hage";
char* c3 = "uge";
PUSHs(sv_2mortal(newSVpv( c1, strlen(c1) )));
PUSHs(sv_2mortal(newSVpv( c2, strlen(c2) )));
PUSHs(sv_2mortal(newSVpv( c3, strlen(c3) )));
とすると速度がはやくなるようだ

perlのundef返す

&PL_sv_undefを使う。（&sv_undefでもいいみたい。XSRETURN_UNDEFでもいいような気がする）。
2010/9/30追加。newSV(0)らしい。NULL 型の空の SV を返す。ということだそうな。

ARRAYリファレンス

ARRAYリファレンスを返す
※ここからC++で。相変わらずあまりわかってないけど
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"
#ifdef __cplusplus
}
#endif

#include <iostream>
#include <string>
#include <vector>
using namespace std;
typedef vector<string> container;
typedef container::iterator it;

MODULE = Hoge           PACKAGE = Hoge

SV* get_arrayref()
INIT:
  container v;
  AV* av = newAV();
CODE:
  v.push_back("hoge");
  v.push_back("uge");
  v.push_back("hage");

  for(it i = v.begin(); i != v.end(); i++){
      av_push(av, newSVpv((*i).c_str(), (*i).size()));
  }

  RETVAL = newRV_noinc((SV *)av);
OUTPUT:
  RETVAL

あとはperl側から
my $arrayref = Hoge::get_arrayref();

Data::Dumperとか使ってたら結果は
$VAR1 = [
         'hoge',
         'uge',
         'hage'
       ];
として結果が得られるはず。

HASHリファレンス

HASHリファレンスを返す
ほとんど配列の時と変わらない
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"
#ifdef __cplusplus
}
#endif

#include <iostream>
#include <string>
#include <map>
using namespace std;
typedef map<string,string> hash;
typedef hash::iterator it;

MODULE = Hoge           PACKAGE = Hoge


SV* get_hashref()
INIT:
  hash h;
  HV* hv = newHV();
CODE:
  h.insert(hash::value_type("apple", "りんご"));
  h.insert(hash::value_type("banana", "ばなな"));
  h.insert(hash::value_type("melon", "めろん"));

  for(it i = h.begin(); i != h.end(); i++){
   // cout << (*i).first << ":" << (*i).second << endl;
    string key = (*i).first;
    string val = (*i).second;
    hv_store(hv, key.c_str(), key.size(), newSVpv(val.c_str(), val.size()), 0);
  }

  RETVAL = newRV_noinc((SV*)hv);
OUTPUT:
  RETVAL

CODEリファレンス

をまずは参照
XSの中でCODEリファレンスを実行 
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"
#ifdef __cplusplus
}
#endif

#include <iostream>
using namespace std;


MODULE = CV             PACKAGE = CV

void
want_cv(CV *code)
   PREINIT:
   CODE:
   call_sv((SV *)code, G_VOID);

perlから実行する時は
CV::want_cv(sub { print "あいうえお\n" });
とすればよい
XSの中でCODEリファレンスから返り値を受け取る 
void
want_cv(CV* code)
   PREINIT:
   CODE:
         I32 retnum = call_sv((SV *)code, G_SCALAR);
         // 引数があるならかならずチェック
         if(retnum != 1) {
             Perl_croak(aTHX_ "retnum is not 1(result: %i)", retnum);
         }
         PerlIO_printf(PerlIO_stdout(), "%s\n", POPp);

引数はPOP*で受け取る
  • POPs SV
  • POPp ポインタ
  • POPn 倍精度
  • POPi 整数
  • POPl long 整数
http://www.namazu.org/~tsuchiya/perl/info/perl-ja_...を見真似すると
void
want_cv(CV* code)
   PREINIT:
   CODE:
         {
             ENTER;
             SAVETMPS;
             I32 retnum = call_sv((SV *)code, G_SCALAR);

             SPAGAIN;

             PerlIO_printf(PerlIO_stdout(), "%s\n", POPp);

             PUTBACK
             FREETMPS;
             LEAVE;
         }
としておかないといけないのかもしれない。もう少し意味を調べる必要あり。 perlから実行する時は
 CV::want_cv(sub { "あいうえお" });
返り値が2つある場合は
void
want_cv(CV* code)
   PREINIT:
   CODE:
         {
             ENTER;
             SAVETMPS;
             I32 retnum = call_sv((SV *)code, G_ARRAY);

             SPAGAIN;
             if(retnum != 2) {
                 Perl_croak(aTHX_ "retnum is not 2(result: %i)", retnum);
             }
             PerlIO_printf(PerlIO_stdout(), "%s\n", POPp);
             PerlIO_printf(PerlIO_stdout(), "%s\n", POPp);

             PUTBACK;
             FREETMPS;
             LEAVE;
         }
perlから実行する時は
 CV::want_cv(sub { "あいうえお", "かきくけこ" });
XSの中でCODEリファレンスに引数を渡す 
void want_cv2(CV* code, int a, int b)

   PREINIT:
   CODE:
       {
           dSP;
           ENTER;
           SAVETMPS;

           PUSHMARK(SP);
           XPUSHs(sv_2mortal(newSViv(a)));
           XPUSHs(sv_2mortal(newSViv(b)));
           PUTBACK;

           call_sv((SV *)code, G_VOID | G_DISCARD);

           //PUTBACK;
           FREETMPS;
           LEAVE;
       }
perlから実行する時は
 CV::want_cv(sub { print $_[0] + $_[1]; print "\n" }, 100, 200);
とすると第2, 3引数の合計値が出力される。

new

newをxsで実装する 
#ifdef __cplusplus
extern "C" {
#endif

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#ifdef __cplusplus
}
#endif

#include <iostream>
using namespace std;

MODULE = Hoge           PACKAGE = Hoge
PROTOTYPES: ENABLE

SV *
new(SV *classname)
 INIT:
   SV *sv;
   HV *hv;
   HV *stash;
 CODE:
   // ハッシュを作成
   hv = newHV();
   // リファレンスにする
   sv = newRV_noinc((SV *)hv);
   // シンボルテーブル取得。trueはなければ作成
   stash = gv_stashpv(SvPV_nolen(classname), true);
   // bless!
   sv_bless(sv, stash);
   RETVAL = sv;
 OUTPUT:
   RETVAL

// helloメソッド
void
hello(SV *self)
 INIT:
   char *pkg;
 CODE:
   if(!sv_isobject(self)){
       croak("can not call hello() on a non-object");
   }
   pkg = HvNAME(SvSTASH(SvRV(self)));
   cout << "Hello, " << pkg << endl;
 OUTPUT:

これでperlからは
my $hoge = Hoge->new;
とするとHogeのインスタンスを得ることができ、
$hoge->hello;
を実行すると
Hello, Hoge
と出力される
c++のクラスをperlの世界にmapping
とでもいえばいいのか
#ifdef __cpluscplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#ifdef __cpluscplus
}
#endif

#include <iostream>
using namespace std;

class ManCPP {
  private:
    char *name;
    int    age;
  public:
    ManCPP(char *name, int age);
    ~ManCPP();
    char * get_name();
    int get_age();
    void set_name(char *name);
    void set_age(int age);
};

ManCPP::ManCPP(char *name, int age) {
    this->name = name;
    this->age = age;
}

ManCPP::~ManCPP() {
    cout << "ManCPP destroy" << endl;
}

char * ManCPP::get_name() {
    return this->name;
}

int ManCPP::get_age() {
    return this->age;
}

void ManCPP::set_name(char *name) {
    this->name = name;
}

void ManCPP::set_age(int age) {
    this->age = age;
}

MODULE = ManCPP		PACKAGE = ManCPP		
PROTOTYPES: ENABLE

ManCPP * 
ManCPP::new(char *name, int age)

void
ManCPP::DESTROY()

char *
ManCPP::get_name()

int
ManCPP::get_age()

void
ManCPP::set_name(char *name)

void
ManCPP::set_age(int age)

typemapも必要
TYPEMAP

ManCPP * O_OBJECT

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;
   }

OUTPUT
O_OBJECT
   sv_setref_pv($arg, CLASS, (void *)$var);

PERL_NO_GET_CONTEXT

threadを意識するような場合はしておくべきらしい。https://github.com/holly/perl-Proc-Wait4/blob/mast... は対応してみた
このエントリーをTumblrにポストClip to Evernoteこのエントリーをはてなブックマークに追加
perlxsねた - holly's wiki 先頭へ
 

Wiki内検索

最近更新したページ

最新コメント

Menu

ここは自由に編集できるエリアです。

タグ

eclipse git javascript kyototycoon linux magent memcached mojolicious openshift paas perl pgpool php postgresql python rails rpm ruby shell solaris supervisord tmux unix vi vmware zsh

アクセス解析中

管理人/副管理人のみ編集できます