SpiderMonkeyでCGI

updated_on: 10-31

サーバサイドでのJavaScriptが流行る予定らしいので、ちょっと挑戦してみる。
なんかいろいろJavaScriptのエンジンがあるみたいだけど、とりあえずSpiderMonkeyを使うことに。


モジラのサイト(http://www.mozilla-japan.org/js/spidermonkey/)の通りにソースを落としてきて
make -f Makefile.ref

OSSP版(http://www.ossp.org/pkg/lib/js/)の方がなにかと都合が良さそうなのでこちらを使うことにした。
Fileオブジェクトとかその辺が標準で使える状態になっている。

% ./configure
% make 
% make install

でインストール。

Apacheの設定で.js3をCGIとして実行するようにして、

#! /usr/local/bin/js

print("Content-type: text/plain\n\n");

for( var name in environment )
    print("\t" + name + "\t: " + environment[name]);

とりあえず、動いた。

Perlを使う

JSからPerlモジュールを使えれば超便利。
調べてみると、spidermonkeyにはPerlConnectなるものが用意されている。
ということで、

% ./configure --with-perl
% make
% make install
#! /usr/local/bin/js

var perl = new Perl();
perl.use('CGI');

var cgi = perl.eval('CGI->new();');

動いたー!ほんとならperl.CGI.new()としたいところだけど、newはNGなのでevalを用いて。


jslibs( http://code.google.com/p/jslibs/ )なるものがあるらしい。
無理してPerlモジュールを使うとかしなくても、SQLiteなら使えるのか。

slice_hash() PHPでハッシュのスライスを行う

$_POSTからまとめて必要なものを変数に格納したい。ということで、slice_hash()
Perlなら($foo, $bar) = @hash{"foo", "bar"}と書くところです。

<?php
// list($foo, $bar) = slice_hash($hash, array("foo", "bar"));
function slice_hash($hash, $keys){
    $result = array();
    foreach( $keys as $i => $key ){
        $result[$i] = $hash[$key];
    }
    return $result;
}
?>

というほどではないけどコードギアスについて

コードギアスブリタニア帝国って名前はブリタニアな上に「Yes, you highness!」とかいってるけど皇帝の名前は「シャルル・ド・ブリタニア」とフランスっぽい。
おそらくブリタニアの言語や文化はイギリスとフランスが混ざったものなのでしょう。
こういう状況に至った理由を考えてみた。


仮説1.英仏百年戦争でイギリス王がフランス王位ゲット
神の声を聞いた乙女が現れる事もなく百年戦争でイギリス勝利。 イギリス-フランスは巨大な同君連合国家となる。
おそらくハプスブルクスペイン&オーストリアと激しく対立したりいろいろあったことだろう。
17世紀のイギリスで市民革命。結果、英仏は再び分裂。 しかし分裂したときには互いの言語、文化は融合していて、その英仏融合国家を母体とするアメリカがブリタニアの起源となった。


仮説2.カナダ起源説
18世紀にアメリカ合衆国が独立せず、19世紀に北アメリカのイギリス植民地全体が自治領カナダとなる。
その後このカナダは現在のアメリカ合衆国のように繁栄し、なんかあってブリタニア帝国になった。
カナダはなにかとフランスの影響が大きいし、ニューファンドランドルイジアナのフランス文化圏の影響もあってちゃんぽん状態になった、と。


妄想終わり。 ちなみに公式の設定とかあるんだろうか。

Ter.pm

PHPをテンプレートとして用いたのと同じような動きをします。<% 〜 %>内はPerlのコードして解釈<%= 〜 %>はechoでし
ただし、<% for(...) { %>〜〜<% } %>ってのは醜いと思うので<% for(...) %>〜〜<% end %>としてます。

package Ter;

=head1 NAME

Ter - small template engine

=head1 SYNOPSIS

  use Ter;
  print Ter->load( filename => 'hoge.t' )->compile( qw/var1/ )->execute( var1 => val, ... );

  my $obj = Ter->new();
  $obj->source("template text...");
  print $obj->compile( qw/var1/ )->execute( var1 => val, ... );

=cut

use strict;
use warnings;
use Carp;

sub new{
    my $class = shift;
    my $self  = bless({
        __PACKAGE__ . '_source'   => undef,
        __PACKAGE__ . '_perlcode' => undef
    }, $class);

    return $self;
}

sub load{
    my $class = shift;
    my $self  = $class->new();
    my %args  = @_;

    croak "args: filename" unless defined $args{filename};

    open( my $in, '<', $args{filename} ) or croak $!;
    { my $t = join('', <$in>); $self->source($t); }
    close($in);

    return $self;
}

sub save{
    my $self  = shift;
    my %args  = @_;

    croak "args: filename" unless defined $args{filename};

    open( my $out, '>', $args{filename} ) or croak $!;
    print $out $self->perlcode;
    close($out);

    return $self;
}

sub execute{
    my $self = shift;
    my $code = $self->perlcode;

    croak "execute after compile" unless $code;

    my $s = eval( $code );
    croak $@ if( $@ );

    return $s->(@_);
}

sub compile{
    my $self = shift;
    my @vars = @_;
    my $body = $self->source;

    my $dec_vars;
    $dec_vars .= '    my $' . $_ . ' = $param{' . $_ . "};\n" foreach (@vars);;

    my $head = <<END;
return sub {
    my \$buffer;
    my \%param = \@_;
$dec_vars;
    \$buffer .= <<'___TEMPLATE___';
END
    my $foot = <<'END';
___TEMPLATE___
    return $buffer;
}
END

    my $begin = q{$buffer .= <<'___TEMPLATE___';} . "\n";
    my $end   = "\n___TEMPLATE___\n" . q{    chomp $buffer;} . "\n";
    $body  =~ s{
                   <%(=?) \s* (.+?) \s* \%> (\r?\n?)
           }{$end . _parse($1, $2, $3) . $begin}emgx;

    $self->perlcode( $head . $body . $foot );

    return $self;
}

sub _parse{
    my $print   = shift;
    my $content = shift;
    my $rn      = shift;

    $print = 0 unless defined $print;
    $rn    = 1 unless defined $rn;

    if( $print ){
        $content .= ' . "\n"' if $rn;
        return <<END
    \$buffer .= $content;
END
    }

    if( $content =~ /^(foreach|for|while|if|unless)\s*\((.+)\)$/ ){
        return <<END
    $1($2){
END
    }
    elsif( $content =~ /^(foreach|for)\s*(.+)\s*\((.+)\)$/ ){
        return <<END
    $1 $2 ($3){
END
    }
    elsif( $content =~ /^elsif\((.+)\)$/ ){
        return <<END
    }
    elsif($1){
END
    }
    elsif( $content =~ /^else$/ ){
        return <<END
    }
    else{
END
    }
    elsif( $content eq 'end' ){
        return <<END
    }
END
    }
    else {
        return <<END
    $content;
END
    }

}

###accessors
sub source{
    my $self = shift;
    $self->{__PACKAGE__ . "_source"} = shift if @_;
    return $self->{__PACKAGE__ . "_source"};
}

sub perlcode{
    my $self = shift;
    $self->{__PACKAGE__ . "_perlcode"} = shift if @_;
    return $self->{__PACKAGE__ . "_perlcode"};
}

return 1;