v8 (Google JavaScript Engine) を Perl XS モジュールにしてみた

やはりやっつけで。Joke module です。

いろいろ書きたいことがあるけど，そのうち（追記するかも）。

libv8 と XS の間をとりもつ bridge.cc。

/* bridge.cc */
#include <v8.h>

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

/* harmful macro!, but, but, ... */
#undef New

#include "bridge.h"

using namespace v8;

class V8Context {
public:

    V8Context() {
        HandleScope scope;

        Handle<ObjectTemplate> global = ObjectTemplate::New();
        Handle<Context> context = Context::New(NULL, global);

        context_ = Persistent<Context>::New(context);
    };

    virtual ~V8Context() {
        context_.Dispose();
    };

    Handle<Context> context() { return context_; };

private:
    Persistent<Context> context_;
};

V8CONTEXT *
create_v8context(void)
{
    return new V8Context();
}

void
release_v8context(V8CONTEXT *ctx)
{
    V8Context *context = static_cast<V8Context *>(ctx);

    delete context;
}

static SV *
_convert_v8value_to_sv(Handle<Value> value)
{
    if (0) ;
    else if (value->IsUndefined())
        return &PL_sv_undef;
    else if (value->IsNull())
        return &PL_sv_undef;
    else if (value->IsInt32())
        return newSViv(value->Int32Value());
    else if (value->IsBoolean())
        return newSVuv(value->Uint32Value());
    else if (value->IsNumber())
        return newSVnv(value->NumberValue());
    else if (value->IsString())
        return newSVpv(*(String::AsciiValue(value)), 0);
    else {
        Perl_warn(aTHX_ "Unsupported value type");
        return &PL_sv_undef;
    }
}

static Handle<Value>
_convert_sv_to_v8value(SV *sv)
{
    HandleScope scope;

    if (0) ;
    else if (SvIOK_UV(sv))
        return Uint32::New(SvUV(sv));
    else if (SvIOK(sv))
        return Integer::New(SvIV(sv));
    else if (SvNOK(sv))
        return Number::New(SvNV(sv));
    else if (SvPOK(sv))
        return String::New(SvPV_nolen(sv));

    return Undefined();
}

static Handle<Value>
_perl_method_by_name(const Arguments &args)
{
    dSP;
    int count;
    Handle<Value> result = Undefined();
    char ** arguments;

    ENTER;
    SAVETMPS;

    String::AsciiValue method(args.Data()->ToString());
    if (0) Perl_warn(aTHX_ "method called: %s", *method);

    arguments = new char *[args.Length() + 1];
    for (int i = 0; i < args.Length(); i ++) {
        String::AsciiValue str(args[i]);
        arguments[i] = savepv(*str);
    }
    arguments[args.Length()] = NULL;

    count = call_argv(*method, G_SCALAR, arguments);

    for (int i = 0; i < args.Length(); i ++) {
        Safefree(arguments[i]);
    }
    delete arguments;

    SPAGAIN;

    if (count > 1) {
        result = _convert_sv_to_v8value(POPs);
    }

    PUTBACK;
    FREETMPS;
    LEAVE;

    return result;
}

void
v8context_register_method_by_name(V8CONTEXT *ctx, const char *method)
{
    V8Context *context = static_cast<V8Context *>(ctx);
    HandleScope scope;
    TryCatch try_catch;

    Context::Scope context_scope(context->context());

    context->context()->Global()->Set(
        String::New(method),
        FunctionTemplate::New(_perl_method_by_name,
                              String::New(method))->GetFunction()
    );
}


SV *
v8context_execute(V8CONTEXT *ctx, const char *source)
{
    V8Context *context = static_cast<V8Context *>(ctx);
    HandleScope scope;
    TryCatch try_catch;

    Context::Scope context_scope(context->context());

    Handle<Script> script
        = Script::Compile(String::New(source), Undefined());
    if (script.IsEmpty()) {
        String::AsciiValue error(try_catch.Exception());
        Perl_croak(aTHX_ "execute(): compile error: %s", *error);
        return &PL_sv_undef;
    }
    else {
        Handle<Value> result = script->Run();
        if (result.IsEmpty()) {
            String::AsciiValue error(try_catch.Exception());
            Perl_croak(aTHX_ "execute(): execute error: %s", *error);
            return &PL_sv_undef;
        }
        else {
            return _convert_v8value_to_sv(result);
        }
    }
    /* NOTREACHED */
}

ヘッダファイル。XS でも読み込んでます。

/* bridge.h */

#ifdef __cplusplus
extern "C" {
#endif

typedef void V8CONTEXT;

V8CONTEXT * create_v8context(void);
void release_v8context(V8CONTEXT *ctx);
void v8context_register_method_by_name(V8CONTEXT *ctx, const char *method);
SV * v8context_execute(V8CONTEXT *ctx, const char *source);

#ifdef __cplusplus
}
#endif

これらの bridge.o を生成するための Makefile。Makefile.PL に組み込めればかっこいいんですけど。

# bridge.mk

V8=../google-v8

PERL_INC=$(shell perl -MConfig -e 'print $$Config{archlib}')/CORE
CFLAGS+=-Wall -fPIC -fno-rtti -I$(PERL_INC) -I$(V8)/include

all:    build

build:  bridge.o

clean:
        rm -f bridge.o

bridge.o:       bridge.cc bridge.h
        g++ $(CFLAGS) -c -o $@ $<

bridge.o:       bridge.mk

.PHONY:	all build clean

んで，XS のコード。の前に，typemap。

TYPEMAP
V8CONTEXT *     T_V8CONTEXT

INPUT
T_V8CONTEXT
        if (SvOK($arg) && SvROK($arg))
            $var = (V8CONTEXT *) mg_find(SvRV($arg), PERL_MAGIC_ext)->mg_obj;
        else
            $var = NULL;

XS の実体，V8.xs。typemap とブリッジのおかげであまりコードがないです。

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

#include "bridge.h"

MODULE = Acme::JavaScript::V8   PACKAGE = Acme::JavaScript::V8::Context

void
_bind_new_v8context(sv)
        SV *sv;
    PREINIT:
        V8CONTEXT *ctx;
    CODE:
        ctx = create_v8context();
        sv_magic(SvRV(sv), NULL, PERL_MAGIC_ext, NULL, 0);
        mg_find(SvRV(sv), PERL_MAGIC_ext)->mg_obj = (void *) ctx;

void
_destroy_v8context(ctx)
        V8CONTEXT *ctx;
    CODE:
        release_v8context(ctx);

MODULE = Acme::JavaScript::V8	PACKAGE = Acme::JavaScript::V8::Context PREFIX = v8context_

void
v8context_register_method_by_name(ctx, method)
        V8CONTEXT *ctx;
        const char *method;

SV *
v8context_execute(ctx, source)
        V8CONTEXT *ctx;
        const char *source;

Perl 側のライブラリインタフェース Acme/JavaScript/V8.pm。XSLoader で読み込んで，Context の new と DESTROY を実装しているだけ。

package Acme::JavaScript::V8;

use strict;
use warnings;

our $VERSION = '0.01';

require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);

package Acme::JavaScript::V8::Context;

sub new {
    my $class = shift;
    my $self = bless {}, $class;

    _bind_new_v8context($self);

    return $self;
}

sub DESTROY {
    my $self = shift;
    _destroy_v8context($self);
}

1;
__END__

念のため，Makefile.PL もおいときますね。

# Makefile.PL

use inc::Module::Install;

name 'Acme-JavaScript-V8';
all_from 'lib/Acme/JavaScript/V8.pm';

my $V8 = '../google-v8';
makemaker_args(
    LDFROM => join(q{ }, '$(OBJECT)', 'bridge.o'),
    LIBS   => join(q{ }, makemaker_args()->{LIBS}, "-L${V8}", '-lv8', '-lstdc++'),
);

build_requires 'Test::More';

auto_include;
WriteAll;

libstdc++ をリンクするとリンカとして g++ を指定しなくてもいいみたい。とりあえず。libv8 のリンクの仕方を変えました。

以下サンプルスクリプト。

use strict;
use warnings;

use Acme::JavaScript::V8;

my $ctx = Acme::JavaScript::V8::Context->new();

my $r = $ctx->execute(<<'END_JS');
a = 1;
b = 2;
a + b;
END_JS

print $r, "\n";     # => 3

sub foo {
    print "foo called: ", join(q{, }, @_), "\n";
    return "bar";
}

# 'foo' という名前の Perl サブルーチンを登録する
$ctx->register_method_by_name("foo");

$r = $ctx->execute(<<'END_JS');
foo(a, b, "baz");   /* => foo called: 1, 2, baz */
END_JS

print $r, "\n";     # => bar

Perl コードサイドの関数を名前でしか呼び出せないのが，まだカコワルイです。あと Global を Perl からいじれるようにしたいですねぇ。