Fool Pool

ハマった記

Perl で Javascript のようにプログラミングする — プロトタイプチェーンの実装

JavascriptでできることはたいていPerlでもできる。

Perl にはコードレフやハッシュリテラル記法があるので、見た目はともかく(javascriptならドット一つで済むところを、Perlだと毎回アローとブレースを書く必要がある)、機能的には Perl でも javascript と遜色ない使い方ができると思っている。

"Javascript The Good Parts" を読んでいたら、おなじ仕組みを Perl で実装してみたくなった。

要件

  • クラスからの継承ではなく、プロトタイプ継承
  • プロパティやメソッドがオブジェクトに定義されていない場合、プロトタイプチェーンを遡って検索する

利用イメージ

my $vehicle = create();
my $car     = inherit($vehicle);
my $ferrari = inherit($car);

# メソッド定義は関数リテラル(コードレフ)で
$vehicle->{drive} = sub {say "(make some noise...)"};
$car->{drive}     = sub {say "Broom!"};

# apply を呼ぶと、プロトタイプチェーンを遡ってメソッドを検索してくれる
apply($vehicle,"drive"); # STDOUT> (make some noise...)
apply($car    ,"drive"); # STDOUT> Broom!
apply($ferrari,"drive"); # STDOUT> Broom!

仕様

  • オブジェクトの実体はハッシュ
  • 継承後のオブジェクトは、ひな形となるオブジェクトのリファレンスを格納した prototype というプロパティをもつ
  • オブジェクトにプロパティやメソッドが定義されていない場合、prototype プロパティから親オブジェクトのプロパティを再帰的にたどる

実装

  • create : ルートオブジェクト(すべてのオブジェクトの共通の祖先)をひな形にして新たなオブジェクトを生成する
  • inherit : 既存のオブジェクトをひな形にして新たなオブジェクトを生成する
  • apply : プロトタイプチェーンを遡ってメソッドを検索する
use Carp qw(croak);

# ルートオブジェクト(すべてのオブジェクトの共通の祖先)をひな形にして新たなオブジェクトを生成する
sub create {
    my $_Object = {
        prototype => undef,
    };
};

# 既存のオブジェクトをひな形にして新たなオブジェクトを生成する
sub inherit {
    my $this = shift;
    {
        prototype => $this,
    };
}

# プロトタイプチェーンを遡ってメソッドを検索する
sub apply {
    my ($this, $msg) = (shift, shift);
    if (!defined $this) {
        croak "can't apply $msg to an undefined object.";
    }

    if ( defined $this->{$msg} ) {
        $this->{$msg}($this, @_); 
    }
    elsif ( defined $this->{prototype} ) {
        my $proto = $this->{prototype};
        apply($proto, $msg, @_);
    }
    else {
        croak "no message '$msg' found on the prototype chain.";
    }
}

一応、最低限の例外処理も実装してある:
1. レシーバが定義されていない場合
2. プロトタイプチェーン上のどこにもメソッドが定義されていない場合

apply($ferarri,"dive"); # Oops! ferarri can't dive!
apply($honda,"drive");  # Oops! honda isn't defined!

[追記] 今回実装した apply メソッドでは、プロパティを再帰的にたどることはできない。プロパティもメソッドも両方チェーンを辿れるようにするには、applyメソッドで、ハッシュの値がコードレフかそれ以外かを判定すれば良い。

参考文献

[1] Amazon.co.jp: JavaScript: The Good Parts ―「良いパーツ」によるベストプラクティス: Douglas Crockford, 水野 貴明: 本
[2] Amazon.co.jp: 7つの言語 7つの世界: Bruce A. Tate, まつもとゆきひろ, 田和 勝: 本

ちなみに、vehicleとか ferrari の例は、[2]に出てくる、IOという言語のサンプルコードに出てきた変数名を使わせてもらった。IOもJavascriptと同様に、プロトタイプ継承をもつ言語である。

英語版だと電子書籍がフリーで配布されている。

シェルスクリプトによるデータフロープログラミング(1) -- カッコ対応チェック

概要

以前の投稿[1]で実装したカッコ対応チェックのプログラムをデータフローの処理[2]として実装する。

仕様

  • プログラムの第一引数にチェックするコード(テキストファイル)を指定する
  • コードのカッコの対応がとれている場合は、「Hey, your code is perfect!!」と表示する
  • 開きカッコが閉じカッコより多い場合は、「Oops, too many open parens (xx)!」と表示する(カッコ内には超過したカッコの数を表示する。)
  • 閉じカッコが多い場合も上記と同様とする

コード

# 入力ファイル中のカッコの対応付けが正しいかどうか判断する

# 入力文字列のカッコだけ抽出し、+1-1+1...のような数式に変換する
# 開きカッコ"(" => +1
# 閉じカッコ")" => -1
TERM=`cat $1			|\
 # コメント行の除去
 grep -v "^//" 			|\
 tr -d "\n"			|\
 # カッコ以外の文字を削除
 sed -e 's/[^()]//g' \
     -e 's/[(]/+1/g' \
     -e 's/[)]/-1/g'`

# 数式の和を計算する
RESULT=$((TERM))

# 結果を表示する
if [ $RESULT -eq 0 ]; then
  echo "Hey, your code is perfect!!"
elif [ $RESULT -gt 0 ]; then
  echo "Oops, too many open parens: $RESULT"
else
  echo "Oops, too may closed parens: $((-RESULT)) "
fi

解説

上記の例では、問題を下記のデータフローで解決している。

1. 入力コード
2. カッコのみ抽出した文字列
3. カッコを数式に置き換えた文字列
4. カッコの対応結果を表す数値

つまり、「1から4 を求める問題(=もとの問題)」を、「1から2を求める問題」「2から3を求める問題」「3から4を求める問題」に分割したことになる。

マッチした部分のハイライト表示 in Perl

概要

入力ファイル中のパターンを検索し、マッチしたパターンをハイライト表示させる

実行例)
[sample.in]

吾輩わがはいは猫である。名前はまだ無い。
どこで生れたかとんと見当けんとうがつかぬ。
何でも薄暗いじめじめした所でニャーニャー泣いていた事だけは記憶している。
吾輩はここで始めて人間というものを見た。
しかもあとで聞くとそれは書生という人間中で一番獰悪どうあくな種族であったそうだ。

[実行結果]

$ perl code_highlight.pl 吾輩 sample.in 
pattern: 吾輩
1 patterns are matched (at line 1):  *吾輩* わがはいは猫である。名前はまだ無い。
1 patterns are matched (at line 4):  *吾輩* はここで始めて人間というものを見た。

仕様

  • 検索すべきパターンを第1引数に、入力ファイル名を第2引数に与える
  • パターンにマッチした行について、「行数」と「マッチした個数」、および「マッチした部分をハイライトした文字列」を表示する
  • 行中でマッチした部分は、「 *パターン* 」のようにハイライトする
  • マッチしなかった行は表示しない

実装

[code_highlight.pl]

#!/usr/bin/env perl
use 5.0100;

sub match_and_highlight {
    my ($pattern, $line) = (shift, shift);
    my $count = ($line =~ s/$pattern/ *$&* /g);
    ($count, $line); 
};

my $pattern = shift @ARGV;
my @raw_lines = <>;

my @lines = map {
    my $line = $_;
    chomp($line);
    $line;
} @raw_lines;

print "pattern: $pattern\n";

for (0 .. $#lines) {
    my $index = $_;
    my $line = $lines[$index];
    my ($count, $line1) = match_and_highlight ($pattern, $line);
    say $count . " patterns are matched (at line " . ($index + 1) . "): " . $line1 if $count;
}

解説

引数で与えたパターンで一行ずつパターンマッチをかける。まっちしたパターンの全文は $& で参照できる。または、全体をキャプチャグループ「()」で囲み、$1 で参照しても良い。

    my $count = ($line =~ s/($pattern)/ *$1* /g);

今回は例文が短かったので、最初にサンプルテキストの全文を読み込むようにしたが、サイズが大きくなると処理が遅くなる。サンプルテキストが大きい場合は、お決まりのwhile(<>)の書き方の方が良い。

...
my $pattern = shift @ARGV;
my $cnt = 0;

print "pattern: $pattern\n";
while (<>) {
    $line = $_;
    chomp($line);
    $index = $cnt++;
    my ($count, $line1) = match_and_highlight ($pattern, $line);
    say $count . " patterns are matched (at line " . ($index + 1) . "): " . $line1 if $count;
}

Perlでカッコの対応をチェックする

新しい言語を学ぶ上で、最も学習効率が高い方法は、失敗しながら学ぶこと。そのためには、自分で実際にコーディング課題を設定して、それをクリアしていくことがベストだ。今回は初級プログラミング定番のカッコ対応チェックを実装する。

個人的なこだわりとしては、処理を一貫してリスト操作関数を使って書くことにしている。つまり、for, while ではなく、 match や grep 、時々 List::Util の reduce を使う。これらを適切使うと、処理の流れが分かりやすくなり、スパゲティーコードになりにくい。(その代わり、リスト操作を一度にやらずに、分割したりするので、処理速度はしばしば犠牲にすることがある。)

map, grep については、参考文献[1]に解説が載っている。

概要

入力ファイル中のカッコの対応をチェックする。

仕様

  • プログラムの第一引数にチェックするコード(テキストファイル)を指定する
  • コードのカッコの対応がとれている場合は、「Hey, your code is perfect!!」と表示する
  • 開きカッコが閉じカッコより多い場合は、「Oops, too many open parens (xx)!」と表示する(カッコ内には超過したカッコの数を表示する。)
  • 閉じカッコが多い場合も上記と同様とする

コード

#!/usr/bin/env perl

use List::Util qw(sum);

my @lines = <>;

my $total = sum map {
  my $line = $_;
  $line  =~ s/[^()]//g;              # カッコ以外の文字を除去
  my $n_open   = ($line  =~ s/\(//g); # 開き括弧の数を数える
  my $n_closed = ($line  =~ s/\)//g); # 閉じ括弧の数を数える

  $n_open - $n_closed;
} @lines;

print "Hey, your code is perfect!!\n" if $total == 0;
print "Oops, too many open parens! (" . $total . ")\n" if $total > 0;
print "Oops, too many closed parens! (". -$total .")\n" if $total < 0;

テストケース1 (matched.in):

((1+2))+(3)+(4+5)+6+((7+8))
((9)+((10+11)+(12)))

テストケース1の出力結果:

Hey, your code is perfect!!

テストケース2 (too_many_op.in):

((a)(b)(c)(
((hogehoge)(foo)(baa))
(buzz)

テストケース2の出力結果:

Oops, too many open parens! (2)

解説

流れは、
1. 1行ずつ処理する
2. 括弧以外の余計な文字を削除
3. 開き括弧、および閉じ括弧の数を数える
4. すべての行について、「開き括弧の数 - 閉じ括弧の数」を合計する
5. 合計が 0 なら、括弧対応は OK. 負なら、閉じ括弧が多く、正なら、開き括弧が多い。

ここで、3について、Perl で文字列中に含まれる特定の文字の個数を数えるには、いくつかやり方がある。

例1: パターン置換(s///g)を使う方法

    my $n_open = ($line  =~ s/\)//g);

例2: パターンマッチ(//g)を使う方法

    my $n_open = () = ($line =~ /\(/g);

例3: キャラクタ置換(tr//)を使う方法

    my $n_open = ($line =~ tr/\)//);

例4: grep を使う方法

    my $n_open = grep { $_ eq '(' } split(//, $line);

注意すべきは、置換を行った場合(例1, 例3)は、元の文字列 $line が破壊されてしまうこと。
元の文字列を壊したくない場合は、あらかじめ他の変数に退避させておく。

    my $n_open = (my $tmp = $line) =~ s/\)//g);

上記の場合、実際に置換されるのは変数 $tmp なので、元の文字列 $line は無傷。

Haraka -- アウトバウンド転送サーバーの設定

Harakaから直接外にメール送れるのかと思っていたが、どうやら違うらしい。 SMTPサーバには2つの役割があって、

  1. 外から送られてきたメールをインバウンドに転送する
  2. ドメイン内から来たメールを、アウトバウンドに転送する

デフォルトの Haraka は 1 の機能しかない。

2を実装するには、アウトバウンド向けの転送サーバを新たに設定する必要がある。

今回は、SMTPプロトコルの「リレー」という機能を使い、アウトバウンド向けのメールを、GmailのSTMPサーバーに転送するサーバーを作る。

アウトバウンドメール転送サーバーの設定

アウトバウンド向け転送用のプロジェクトを新たに作る。

haraka -i haraka-outbound

cd haraka-outbound

ポート設定

使用するポートを25から587に変更。

vi config/smtp.ini

以下の一行を追加:

listen=[::0]:587

プラグインの設定

今回はアウトバウンド転送機能のみ使うので、auth/flat_file のみロードする。

echo "auth/flat_file" > config/plugins

認証設定

vi config/auth_flat_file.ini

[users]項目に以下を追加:

youraccount@gmail.com=passwod

サーバーの起動

$ haraka -c haraka-outbound

これでポート587を使ってアウトバウンドにメールが転送できるようになる。

転送テスト

swaksというツールを使ってテストしよう。

brew でインストールする

sudo brew install swaks

宛先など、適当なパラメータを入れる。

swaks -tls -f your@yourmain.com -t someone@someone.com -s smtp.gmail.com -p 587 -au you@gmail.com -ap passwordxxx

「-tls」オプションを忘れずに。送り先にテストメールが送られてくれば成功。

件名: test Sun, 13 Apr 2014 17:19:17 +0900

本文: This is a test mailing

[ソース] http://haraka.github.io/manual/Outbound.html

Haraka -- Node.jsで実装された軽快なSMTPサーバー

Haraka(http://haraka.github.io/) は、Node.jsで実装された、SMTPサーバーのこと。

Node.jsなのでノートパソコンから動かすことができるのが便利だ。

インストール

$ npm install -g haraka

使い方

$ haraka -i /path/to/haraka_project

$ haraka -c /path/to/haraka_project

これだけ。超簡単!

Mac OS X Lion のデフォルトのドキュメントルート

$ view /private/etc/apache2/httpd.conf

170行目:

DocumentRoot "/Library/WebServer/Documents"