クリスマスRuby

というような経緯があり、今年はRubyPerlをぶっ潰すことにしました。具体的には今年はRubyを弄るかわりにRubyっぽくPerlを書くためのツールを作ってみました。これでPerlプログラムを生まれる前に消し去りたい。なんか近頃そういうの流行ってるっぽいし。opalとかopalとか。

https://github.com/technohippy/sapphire

簡単な実行例はこんな感じ。

# misc/write_file.rb
require 'path/class'
require 'autodie'

dir = dir '/tmp'
file = dir.file 'file.txt'
file_handle = file.openw
list = %w(a list of lines)
list.each do |line|
  file_handle.print "#{line}\n"
end
$ bin/sapphire misc/write_file.rb | perl
$ cat /tmp/file.txt
a
list
of
lines

ただ、これだとシンプルすぎてRubyだかなんだかわからない上に、ただの文字列置換みたいなのでもうちょっと大きいサンプルを作りました。

SchenkerというPerlSinatraのようなものをRubyっぽくで書き直して、それをPerlに変換してから実行してみます。不毛に見えるけど、自分の英作文が正しいかどうかを確かめるために、英日機械翻訳した結果を日英機械翻訳してオリジナルと比較するような、まぁなんかそういう感じ。*1

Rubyっぽく書きなおしたもの(の一部)。*2

# https://github.com/technohippy/sapphire-sample/blob/master/Schenker/src/Schenker.rb
class Schenker < Exporter
  include 5.00800
  include Any::Moose
  include Carp, %w(croak)
  include Scalar::Util, %w(blessed)

  # ...snip...

  @@App = nil
  @@AppFile = nil
  # ...snip...
  @@EXPORT = %w(
    helpers Before error not_found define_error
    # ...snip...
  )

  def import(__no_self__)
    pkg, file = caller
    croak <<-END_MSG if defined? pkg and pkg == 'main'
Can't use Schenker in the 'main' package.
Please use Schenker in your package.
    END_MSG

    unless defined? @@App
      @@App = pkg
      @@AppFile = file
    end

    self.class.export_to_level 1, @_
    any_moose.import into_level: 1
  end

  def unimport
    caller = caller()
    any_moose.unimport
    no strict 'refs'
    @@EXPORT.each do |method|
      delete ("#{caller}::".to_deref)[method]
    end
  end

  # ...snip...

  def make_stash(*args)
    stash = self
    ->{
      arg_size = scalar args
      if arg_size == 0
        stash
      elsif arg_size == 1
        stash[args[0]]
      elsif arg_size % 2 == 0
        args_hash = args.to_hash
        args_hash.each do |key, val|
          stash[key] = val
        end
      else
        croak 'usage: stash key or stash key => val;'
      end
    }
  end

  def session
    croak 'cannot call session in not running server.'
  end

  def make_session
    if options.sessions
      ->{request.session}
    else
      ->{croak "session is disabled. To enable session, set 'sessions' option true."}
    end
  end

  def helpers(__no_self__, *args)
    croak 'usage: helpers name => code' unless scalar(args) % 2 == 0;
    helpers = args.to_hash
    helpers.each do |name, sub|
      @@App.meta.add_method name, sub
    end
  end

  def Before
    code = self 
    croak 'code required' unless code
    croak 'code must be coderef' unless ref(code) == 'CODE'
    push @@Filters, code
  end

  # ...snip...

  configure do
    set 'environment', ENV['SCHENKER_ENV'] || 'development'
    disable 'sessions'
    enable 'logging'
    # ...snip...
    set 'manager', nil
    set 'keeperr', nil
    set 'encode', {
      'encode' => 'utf-8',
      'decode' => 'utf-8'
    }
    set 'session_options', {
      'state' => {
        'class' => 'Cookie',
        'args' => {
          'name' => 'schenker_sid'
        }
      },
      'store' => {
        'class' => 'OnMemory',
        'args' => {},
      }
    }
    tt_options 'ENCODING', 'utf-8'

    # for prove
    if ENV['HARNESS_ACTIVE']
      set 'server', 'Test'
      set 'environment', 'test'
      disable 'run'
    end

    # for mod_perl
    if ENV['MOD_PERL']
      set 'server', 'ModPerl'
      disable 'run'
    end

    Schenker::Options.parse_argv

    configure 'development' do
      Before do
        headers 'X-Schenker', @@VERSION
      end
      error do |__self__|
        warn self
        status 500
        content_type 'text/html'
        body :$self.stack_trace.as_html 'powered_by', 'Schenker' # TODO
      end
      # ...snip...
    end
  end

  no Any::Moose
  self.meta.make_immutable
end

なんかいろいろPerlっぽいとこが漏れてる気がしますが、とりあえず上記はRubyとして解釈は可能。これを以下のコマンドで変換すると

$ bin/sapphire "Schenker/src/**/*.rb" -O out

こうなります。

use strict;
use warnings;
{

    package Schenker;
    use base 'Exporter';
    use 5.008;
    use Any::Moose;
    use Carp qw(croak);
    use Scalar::Util qw(blessed);
    # ...snip...
    our $App         = undef;
    our $AppFile     = undef;
    our @EXPORT      = ( 
        "helpers",      "Before",  "error",         "not_found",
        # ...snip...
    );  

    sub import {

        my ( $pkg, $file ) = caller();

        if ( ( defined $pkg ) and $pkg eq "main" ) {
            croak(
"Can't use Schenker in the 'main' package.\nPlease use Schenker in your package.\n"
            );
        }

        unless ( ( defined $App ) ) {
            $App     = $pkg;
            $AppFile = $file;
        }

        __PACKAGE__->export_to_level( 1, @_ );
        any_moose()->import( { into_level => 1 } );
    }

    sub unimport {
        my $self   = shift;
        my $caller = caller();
        any_moose()->unimport();
        no strict "refs";
        for my $method (@EXPORT) {
            delete( ${ "" . $caller . "::" }->{$method} );
        }

    }

    # ...snip...

    sub make_stash {
        my $self  = shift;
        my @args  = @_;
        my $stash = $self;
        sub {

            my $arg_size = scalar(@args);
            if ( $arg_size == 0 ) {
                $stash;
            }
            elsif ( $arg_size == 1 ) {
                $stash->{ $args[0] };
            }
            elsif ( $arg_size % 2 == 0 ) {
                my %args_hash = @args;
                while ( my ( $key, $val ) = each(%args_hash) ) {
                    $stash->{$key} = $val;
                }

            }
            else {
                croak("usage: stash key or stash key => val;");
            }

        };
    }

    # ...snip...

    configure(
        sub {
            # ...snip...
            set(
                "session_options",
                {
                    "state" => {
                        "class" => "Cookie",
                        "args"  => { "name" => "schenker_sid" }
                    },
                    "store" => { "class" => "OnMemory", "args" => {} }
                }
            );
            tt_options( "ENCODING", "utf-8" );

            if ( $ENV{"HARNESS_ACTIVE"} ) {
                set( "server",      "Test" );
                set( "environment", "test" );
                disable("run");
            }

            if ( $ENV{"MOD_PERL"} ) {
                set( "server", "ModPerl" );
                disable("run");
            }
            Schenker::Options->parse_argv();
            configure(
                "development",
                sub {

                    Before(
                        sub {

                            headers( "X-Schenker", $VERSION );
                        }
                    );
                    error(
                        sub {
                            my $self = shift;
                            warn($self);
                            status(500);
                            content_type("text/html");
                            body( $self->stack_trace()
                                  ->as_html( "powered_by", "Schenker" ) );
                        }
                    );
                    # ...snip...
                }
            );
        }
    );
    no Any::Moose;
    __PACKAGE__->meta()->make_immutable();
}

1;

辛うじてPerlです。見た目が変わっただけだとよく分からないと思うので、さらにこのSchenker改を使ったアプリを作って

class MyApp
  include Schenker

  get '/' do
    'Hello, world!'
  end

  get '/hello/:name' do |args|
    "Hello, #{args['name']}!"
  end
end

変換した後で

$ bin/sapphire myapp.rb -o myapp.pl
$ cat myapp.pl
use strict;
use warnings;
{

    package MyApp;
    use Schenker;
    get(
        "/",
        sub {

            "Hello, world!";
        }
    );
    get(
        "/hello/:name",
        sub {
            my $args = shift;
            "Hello, " . $args->{"name"} . "!";
        }
    );
}

1;

実行してみます。

$ perl -I out/src myapp.pl 
== Schenker/0.01 has taken the stage on 4567 for development with backup from ServerSimple
HTTP::Engine::Interface::ServerSimple : You can connect to your server at http://0.0.0.0:4567/

http://localhost:4567/

無事にウェブアプリが起動されました。

http://localhost:4567/hello/sapphire

pathパラメーターもOK。

http://localhost:4567/unknownpath

エラー画面も。

・・・

ということで、PerlRubyっぽく書くためのツールの紹介でした。RubyPerlをぶっ潰すと言うよりも、RubyPerlにぶっ潰されている感がないでもないけど (゚ε゚)キニシナイ!!

*1:西口さん、公開許可ありがとうございます

*2:全部を見たければhttps://github.com/technohippy/sapphire-sample/tree/master/Schenker/src:titile=こちらをどうぞ