Sep 09, 2013

Perl で grep.pl

UNIX/Linux のコマンドに lv/lgrep というのがあります。ぽちは UTF-8 や CP932、EUC-JP や 7bitJIS の各日本語文字エンコーディングに跨ってテキストファイルの中身を検索するのに使っています。この lgrep を、ぽちが普段使う機能の範囲だけ、Windows上の Emacs を通して使えるように、Perl で書いてみました。

grep.pl

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use Encode qw/ encode decode /;
use Encode::Guess qw/ euc-jp cp932 iso-2022-jp utf8 /;
use Encode::Locale;
use Getopt::Std;

my %opts;
getopts 'n', \%opts;

my $expr = decode 'console_in', shift @ARGV;
my @trg = map { glob } @ARGV;

for my $file ( @trg ) {
    -f $file or next;
    open my $fh, '<', $file or die "Couldn't open $file: $!";
    my $str = join '', <$fh>;
    close $fh;
    $str or next;

    my $encobj = Encode::Guess->guess( $str );
    my $enc;
    unless ( ref $encobj ) {
        $enc = 'utf8';
        warn "Couldn't guess: $encobj. $file is decoded by $enc.\n";
    } else {
        $enc = $encobj->name;
    }
    my @decoded =  split "\n", decode $enc, $str;

    my ( $i, @linum, @greped, @maped );
    for my $line ( @decoded ) {
        ++$i;
        if ( $line =~ /$expr/g ) {
            push @greped, $line;
            push @linum, $i;
        }
    }

    for my $greped ( @greped ) {
        my $linum = shift @linum;
        if ( $#trg > 0 ) {
            if ( $opts{ n } ) {
                push @maped, "$file:$linum:$greped";
            } else {
                push @maped, "$file:$greped";
            }
        } else {
            if ( $opts{ n } ) {
                push @maped, "$linum:$greped";
            } else {
                push @maped, $greped;
            }
        }
    }

    my $encoded = encode 'console_out', join "\n", @maped;
    print $encoded, "\n" if $encoded;
}

__END__

使い方はこんな感じ。

C¥> perl grep.pl -n 金剛 kiniro_mosaic_utf8.txt kongou_mosaic_euc-jp.txt kan_colle_cp932.txt sasebo_kaigunbochi_7bitjis.txt
kongou_mosaic_euc-jp.txt:3:英国生まれの金剛デース!!
kan_colle_cp932.txt:7:金剛 「Hi!今日も良い天気ネー!」
sasebo_kaigunbochi_7bitjis.txt:14:地元住民には海軍墓地として知られる佐世保市東公園には、金剛・加賀・飛龍・瑞鳳・大鷹・矢矧の慰霊碑が存在する。

第一引き数には正規表現を受け取るので、正規表現のメタ文字が含まれる文字列をそのままの形で検索したい場合には、メタ文字をバックスラッシュでエスケープしてあげて下さい。

Posted at 12:59 in perl | Permalink | Comments/Trackbacks ()

Sep 03, 2013

Perl で cat.pl

UNIX/Linux のコマンドに cat というのがあって、ぽちは主にテキストファイルの中身を表示させたり、バイナリファイルを結合するのに使っています。先日、Windows上でバイナリファイルを結合しなければならなくなり、Unixコマンドの cat相当のものを Perl でざっと書いてみました。

cat.pl

#!/usr/bin/env perl

use strict;
use warnings;

binmode STDOUT;

while ( <@ARGV> ) {
    open my $fh, '<', $_ or die "Couldn't open $_: $!";
    binmode $fh;
    print while <$fh>;
    close $fh;
}

コードを見ての通りですけども、こんな感じで使います。

C¥> perl cat.pl file1 file2 file3 > catenated_file

Windows上でバイナリファイルを扱わなきゃいけないので、ファイルハンドルを通しての遣り取りでは binmode を使っています。

と、ここまでは良かったのですけども、これを書いた直後に Windows のコマンドの copy で、

C¥> copy /b file1+file2+file3 catenated_file

とバイナリファイルの結合が出来る事が発覚して、全部無意味になってしまいました……。

Posted at 19:55 in perl | Permalink | Comments/Trackbacks ()

Aug 02, 2013

当ブログのコメント&トラックバック機能を停止します

ぽち*ろぐのコメント欄にびっくりするぐらい大量のスパムコメントが押し寄せてしまいました。この所記事の更新もあまり無く、ましてや訪れてコメントに書き込みして下さる方も絶えて久しいので、いっその事と思ってブログからコメントやトラックバックのプラグインを取り外してしまいました。どうしても犬山ぽち丸に伝えたい事がある方は、Twitterアカウントの pochimarui まで @ を飛ばすか pochi@hoshinoumi.net までメールをお送り下さいませ。

コメントやトラックバックを使わないんだったら、ブログ形式で記事を書く理由がほとんど無くなってしまいました。[犬]ω;)

Posted at 19:39 in 日記 | Permalink | Comments/Trackbacks ()

Jul 14, 2013

Flash Player を導入して Linux で『艦これ』を遊ぶ

2014/09/07追記:この記事を書いた当時とは違って、現在の艦これでは、以下の記事を参考にして Linux で艦これを遊ぶ事は出来ません。特に拘りが無い限りは Webブラウザに Linux版の Google Chrome を利用するのが Linux で艦これを遊ぶのには簡単です。(FireFox や Iceweasel等の他の Webブラウザで艦これを遊ぶ方法もあります。)

ぽち、相変わらずブラウザゲームの『艦これ』にハマっています。ユーザー数がとうとう十五万人を突破して、ブラウザゲームとしては破格のヒットになって来てるみたいですね。

艦これ母港画面201307141425サムネイル

明らかに Windows でも Mac でも無いデスクトップ画面を見ての通り、ぽちは Linux上で、具体的には debian wheezy上で iceweasel 17.0.7 という Webブラウザを使って艦これを遊んでいます。艦これは Flash Player を利用したゲームなので、当然、Webブラウザだけでは動きません。艦これを遊ぶ為には Linux向けの Flash Player を adobe の公式サイトからダウンロードして来て適切な場所に置いてあげる必要があります。

Flash Player のダウンロード時の画面

そこで「その他の Linux用.tar.gzファイル」を選択してダウンロードすると、install_flash_player_11_linux.i386.tar.gz というファイルがやって来るので、これを展開します。

$ tar zxvf install_flash_player_11_linux.i386.tar.gz

展開して出て来た libflashplayer.so というファイルが Flash Player の本体なので、これを /usr/lib/mozilla/plugins/ か ~/.mozilla/plugins/ に置いてあげると iceweasel で Flash Player が利用出来るようになります。

艦これもニコ動もこれでオッケー♪

ついでに、展開して出来た usr/bin/flash-player-properties も /usr/local/bin/ か実行パスを通した ~/bin/ に置いておくと便利です。

Posted at 16:17 in linux | Permalink | Comments/Trackbacks ()

Jun 27, 2013

『艦これ』はじめました

一、二週間ぐらい前からブラウザゲームの『艦これ』を遊んでいます。提督名は daisy です。この眼鏡っ子は巡洋戦艦の霧島さん(CV: 東山奈央さん)。

艦これ母港画面201306271930サムネイル

「巡洋戦艦」というと戦艦の仲間みたいなイメージですけども、調べたところによると `Battle Cruiser' を「巡洋戦艦」と訳したのは誤訳に近くて、装甲は巡洋艦並みの薄さでもお蔭で軽くて巡洋艦並みに高速を出せるという、簡単に言うと「主砲が戦艦並みの大きめな巡洋艦」で、「巡洋戦艦」というより「戦闘巡洋艦」と訳すのが実態に近いみたいです。

艦これ編成画面201306271930サムネイル

そして、現在のひなぎく艦隊の陣容はこんな感じ。実は主力の方々が手酷い損傷を受けて軒並み長時間のドック入りをしているので、このメンバーは控えの皆さんになります。油断して戦艦や正規空母などの大型艦をどんどん出撃させていると、あっというまに油やボーキサイトが尽きてしまうので、なかなか遣り繰りが大変なゲームだったりします。運営の事前の予想以上に大量のプレイヤーが殺到してサーバがパンクしてしまい、今のところプレイヤーの新規登録が停止されていますけども、わりと楽しい育成系ゲームですので興味があれば登録が再開されたら遊んでみるのも良いかも?

May 20, 2013

ぽちたて 0.1.8 をリリースしました

IPAフォント使用時のぽちたて0.1.8画面サムネイル

放置されたまま幾星霜……なんと二年振りの更新になりますが、ぽちたて 0.1.8 をリリースしました。

今月は、長い間 testing だった debian wheezy が stable になったり、perl-5.18.0 が出たりと、ぽちのパソコン環境的に何かと色々ありました。testing時代からずっと wheezy を使って来たので前者はどうという事も無かったのですけども、後者の Perl 5.18.0 では、ぽちたて 0.1.7 がファイルを開こうとすると、

Strings with code points over 0xFF may not be mapped into in-memory file handles

とエラーを吐いて die してしまいます。

perl5180delta を読んでみると、Updated Modules and Pragmata の * PerlIO::scalar has been upgraded to 0.16. にこんな文章が。

The buffer scalar supplied may now only contain code points 0xFF or lower. [perl #109828]

つまり、 PerlIO::scalar はコードポイント 0xFF以下の文字列しか open 出来なくなっちゃってたのでした。ぽちの緩い書き方のせいで内部表現の文字列入りスカラー変数のリファレンスを open していた 0.1.7 がファイルを開けなくなるのも当然です。

というわけで、ぽちたて 0.1.8 ではきちんと中身の文字列を UTF-8 でエンコードしてから open するように修正しました。

ぽちは、「お行儀良く書いてね?」と怒られてたわけです。ちゃんと怒ってくれるなんて素晴らしい!!

Nov 23, 2012

blosxom なぽち*ろぐで静的URI

ぽち*ぷ〜ちぽち*ろぐXHTML5 への移行を考えてぽち*ぷ〜ち関係のディレクトリをあちこち引っ繰り返していたら、数年前にメモしたまま放置されていた apachemod_rewrite を使って blosxom の動的URI を静的URI に書き換える為の設定が出てきました。なんでメモを取っただけで放置されていたのか自分でも良く分かりませんけども、これも良い機会なので .htaccess や blosxom.cgi の設定を書き換えて静的URI に見えるようにしてみました。

.htaccess

RewriteEngine On
RewriteRule ^blog/?(.*)$ /cgi-bin/blosxom/blosxom.cgi/$1

.htaccess を上のように書き足した後、blosxom.cgi が見ている設置URI の設定を、http://pochi.usamimi.info/blog にしてあげると出来上がり。

Posted at 00:42 in blosxom | Permalink | Comments/Trackbacks ()

Sep 23, 2012

Linux で卓m@s動画を作ってみた

随分前に Linuxファー・ローズ・トゥ・ロード卓ゲm@ster動画を作って途中で挫折した事がありました。最近、当時の動画の断片や素材を発掘したので、これを機会に頑張ってきちんと作ろうなんて思って毎日少しずつちまちま作っていたりします。そこで、ぽち的卓m@s動画作成手順を簡単にメモしてみました。今更言うまでもありませんけども、ぽち環境は Debian/GNU Linux 7.0 wheezy です。

使っているツールは

です。

まずは gimp で 640x360 の画像を作成して pngファイルの画像としてエクスポートします。

次に pngファイルの画像を mpgファイルの動画にエンコードします。

$ ffmpeg -f image2 -loop 1 -i scene_001.png -c:v mpeg1video -t 8 -b:v 4000k -r 30 -an scene_001.mpg

例では一枚の pngファイルから、ビットレートを 4000kbps に フレームレート を 30fps にした 8秒間の MPEG-1動画を作成しています。

そしてたくさんの png画像から作った mpg動画をファイル名の番号順に cat で連結します。

$ cat scene_*.mpg > movie.mpg

完成した movie.mpg を avidemux に読み込んで動画時間の長さを確認し、audacity でそれと同じ長さのステレオで無音のオーディオトラックを作成します。具体的には、audacity の[ジェネレーター]→[無音]で継続時間を尋ねられるので、フォーマットを時:分:秒.ミリ秒に設定して動画時間の長さを入力すると、モノラルで無音のオーディオトラックが作られます。これをもう一度繰り返すとモノラルで無音のオーディオトラックが二つ出来上がり、[トラック名の下向き三角]→[ステレオトラックの作成]でステレオで無音のオーディオトラックが出来上がります。

後は movie.mpg を読み込んだ avidemux で音を付けたいフレームの時間を確認しながら、ベースとなるステレオ無音オーディオトラックの適切な時間に audacity で効果音や BGM を貼り付けて wavファイル、movie.wav として書きだせば完成です。

そして最後にこんな感じで動画と音声を連結して、アップロード用動画にエンコードしてあげます。

$ ffmpeg -i movie.mpg -c:v libx264 -b:v 400k -r 30 -pass 1 -passlogfile passlog -an /dev/null
$ ffmpeg -i movie.mpg -i movie.wav -c:v libx264 -b:v 400k -r 30 -pass 2 -passlogfile passlog -c:a libfaac -ar 44100 -ab 128k -y upload.mp4
Posted at 23:04 in linux | Permalink | Comments/Trackbacks ()

May 13, 2012

FFmpeg で静止画から動画を作ってみた

少し前に、アニメ『坂道のアポロン』の舞台探訪(聖地巡礼?)写真を撮影してスライドショウ動画を作り、ニコニコ動画にアップロードしました。

『坂道のアポロン』の舞台探訪してみた-第1回 『坂道のアポロン』の舞台探訪してみた-第2回

撮影した画像の切り出しや縮小には GIMP を、動画の連結には Avidemux を使っていますけども、jpeg形式の静止画から mjpeg形式の動画の作成と最終的なアップロード形式への変換には FFmpeg を使っています。

ここで挙げているのは FFmpeg 0.10.2 で jpeg画像を mjpeg動画にする例です。FFmpeg はバージョンによってコマンドオプションの使い方がわりと違っていたりするので気をつけましょう。

$ ffmpeg -f image2 -loop 1 -i hachiman.jpg -c:v mjpeg -sameq -t 10 -r 1 -an 01_hachiman.avi

こうすると mjpeg形式でエンコードされ aviコンテナフォーマットに入った動画が出来上がりです。tオプションでは秒単位で動画の長さを指定しています。素のままの数字は秒で受け取りますが hh:mm:ss.ms での指定も出来たりします。

Posted at 17:32 in linux | Permalink | Comments/Trackbacks ()

Nov 13, 2011

IRCダイスボットへの道 - POE から AnyEvent へ

PerlIRCダイスボットへの道第六回は、第四回第五回と IRCサーバに接続するのに使っていた POE::Component::IRCAnyEvent::IRC に置き換えます。

今回 POE::Component::IRC から AnyEvent::IRC に置き換えるのは、どどんとふにも使われている IRCダイスボットボーンズ&カーズを書かれた Facelessさんに、「POE はあんまり信用出来なくて……」と言われたから、なんてわけでもありません。

実は Perl界隈では POE は以前から、妙にこんがらがり過ぎてコードが難読化してウザイとか、独特の書き方をしないといけないのがウザイとか、評判が良くありませんでした。POE は Perl Obfuscation Engine や Portal Of Evil の略だなんて言われたりもしています。ぽちがずっと前に最初の IRCダイスボットを書いた時に POE::Component::IRC を使ったのは、その時の選択肢には Net::IRC か POE::Component::IRC ぐらいしか見当たらず、Net::IRC を使った IRCダイスボットは既に書いている方がいたから、というごくごく単純な理由からでした。

今はそんな二択じゃないし、今書くのなら評判良さげなのを使っちゃえば良いじゃない!!

というわけで、なんとなく評判の良さげな気がする AnyEvent::IRC に置き換えちゃいます。

simpledicebot.pl

2012年 5月31日追記:irc.cre.jp系IRCサーバ群の文字コードが ISO-2022-JP から UTF-8 に変更された為、初期設定例の接続先IRCサーバの文字コードを UTF-8 に変更しました。

2012年 6月 6日追記:ダイスコマンドの引き数の個数に制限を加えました。

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use Encode;
use AnyEvent;
use AnyEvent::IRC::Client;
use Parse::RecDescent;
use Data::Transformer;
use Math::Random::MT;

my $irc_server = 'localhost';   # 接続先IRCサーバ
my $room       = '#犬小屋';     # 接続先チャンネル
my $name       = 'dice_smpl';   # IRCサーバでのダイスボット名
my $encoding   = 'utf8';        # 接続先IRCサーバの文字コード

my $e = find_encoding( $encoding );

my $grammar = <<'GRAMMER';
expression: add end { { left => $item[1] } }
add: mult '+' add { { left => $item[1], op => '+', right => $item[3] } }
add: mult '-' add { { left => $item[1], op => '-', right => $item[3] } }
add: mult
mult: brack '*' mult { { left => $item[1], op => '*', right => $item[3] } }
mult: brack
brack: '(' add ')' { $item[2] }
brack: val
val: /[1-9]\d?d(?:120|100|60|30|24|20|16|12|10|8|6|4|3|2)/i
val: /\d{1,2}/
end: /\s*$/
GRAMMER

my $parser = Parse::RecDescent->new( $grammar ) or die 'Bad grammar';

my $seed = time ^ ( $$ + ( $$ << 15 ) );
my $gen  = Math::Random::MT->new( $seed );

my $c = AnyEvent->condvar;
my $irc = AnyEvent::IRC::Client->new;

$irc->reg_cb(
    irc_privmsg => sub {
	my ($self, $msg) = @_;
	if ( $msg->{ params }->[-1] =~ /^\(?[1-9]\d?d(?:120|100|60|30|24|20|16|12|10|8|6|4|3|2)/i ) {
	    my $result = dice( $msg->{ params }->[-1] );
	    $msg->{ prefix } =~/^(.*)!/;
	    defined $result
		and $irc->send_chan( $e->encode( $room ), 'PRIVMSG', $e->encode( $room ), "$1: $result" );
	}
    }
);

$irc->reg_cb (
    connect => sub {
	my ( $irc, $err ) = @_;
	defined $err and print "Couldn't connect to server: $err\n";
    },
    registered => sub {
	my ( $self ) = @_;
	print "registered\n";
	$irc->enable_ping( 60 );
    },
    disconnect => sub {
	print "disconnected: $_[1]\n";
    }
);

$irc->send_srv( 'JOIN', $e->encode( $room ) );

$irc->connect(
    $irc_server,
    6667,
    { nick => $name, user => $name, real => $name },
);

$c->wait;

sub dice {
    my @results;
    my @comments;
    my @args = split /\s+/, $e->decode( $_[0] );

    scalar( @args ) > 15 and return;

    foreach ( @args ) {
        if ( my $parsed = $parser->expression( $_ ) ) {
            my $dt =  Data::Transformer->new( normal => \&roll );
            $dt->traverse( $parsed );
            push @results, gathering( $parsed->{ left } );
        }
        elsif ( @results ) {
            push @comments, $_;
        }
        else {
            return;
        }
    }

    if ( !@comments ) {
        return join ' ', @results;
    }
    else {
        my $comment;
        foreach ( @comments ) {
            $comment = $comment . "$_ ";
        }
        chop $comment;
        return ( join ' ', @results )  . ' ' . $e->encode( $comment );
    }
}

sub roll {
    my $val = shift;
    if ( $$val =~ /^([1-9]\d?)d(120|100|60|30|24|20|16|12|10|8|6|4|3|2)$/i ) {
        my $dices;
        my ( $counts, $planes ) = ( $1, $2 );
        while ( $counts ) {
            my $a_dice = int $gen->rand( $planes ) + 1;
            $dices += $a_dice;
            $counts--;
        }
        $$val = $dices;
    }
    undef;
}

sub gathering {
    my $val = shift;
    if ( ref $val ) {
        if ( $val->{ op } =~ /\+/ ) {
            return gathering( $val->{ left } ) + gathering( $val->{ right } );
	}
        elsif ( $val->{ op } =~ /-/ ) {
            return gathering( $val->{ left } ) - gathering( $val->{ right } );
        }
        else {
            return gathering( $val->{ left } ) * gathering( $val->{ right } );
        }
    }
    else {
        return $val;
    }
}

使い方は以前と一切変わりません。コマンドライン操作の

$ ./simpledicebot.pl

で、設定した IRCサーバの設定したチャンネルに接続します。接続先IRCサーバや接続先チャンネル、IRCサーバでのダイスボット名は適切に書き換えて使って下さい。接続を終える時は、実行中に Ctrl + c で停止させるか、実行したターミナルエミュレータのウィンドウを閉じて停止させます。

同じチャンネルに接続した IRCクライアントから

>pochi< (1d8+3d6+1d100-2)*2

と発言すると、

<dice_smpl> pochi: 158

のようにロールの結果を合計して返してくれます。ダイスコマンドの後に半角または全角スペースを挟むと、それ以後はダイスロールについてのコメントとして、ロール結果と一緒に再び表示されます。

>pochi< 1d100 SANチェック
<dice_smpl> pochi: 75 SANチェック

ダイスロールの内訳が必要な場合には、演算子の代わりに半角スペースを空けてダイスコマンドを発言してあげるとこんな感じになります。

>pochi< 1d8 1d6 1d10 1d100
<dice_smpl> pochi: 4 3 9 45
>pochi< (1D8+3D6+1D100-2)*2 1d8+1d6+2 1D100-20
<dice_smpl> pochi: 192 11 35
Posted at 15:42 in perl | Permalink | Comments/Trackbacks ()

Oct 27, 2011

Windows の Perl でテキストファイルの文字コードを変換

2011年11月12日追記:ぽち*ぷ〜ちいさましいちびのツールたち unzip.pl untar.pl enc.pl に enc.pl についてもう少しだけ詳しく書きました。

父の Vista機に Strawberry Perl をインストールして Windows上で Perl を使っていると、ぽちの Linux機で書いた日本語のテキストファイルを読みたい場合があったりします。けれども、それぞれのファイルシステムで使われている日本語文字コードが異なると、文字コードを変換しないままでは文字化けしてしまう事があります。高機能なテキストエディタがインストールしてあれば、わざわざ文字コードを変換したりしなくても読めるのですが、父の Vista機にはテキストエディタはメモ帳しか入っていません。メモ帳は Windows で使われている CP932以外にも UTF-8 ならそのまま表示出来るのですけども、日本語のメールで使われている ISO-2022-JP や、古いUNIX/Linux で使われている EUC-JP は文字コードを変換しないと読めません。

ものぐさなぽちは、文字コードや改行コードを自分で指定するのがめんどくさいので、unzip.pluntar.pl の文字コード自動推測部分を流用して、こんなのを書いて楽をしています。

enc.pl

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use Encode;
use Encode::UTF8Mac; # utf-8-mac は fオプションと tオプションでしか使えません。
use Encode::Guess qw/ euc-jp cp932 iso-2022-jp utf8 /; # 自動推測の対象
use Encode::Locale;
use Path::Class;
use Getopt::Std;

my %opts;
getopts('f:t:', \%opts);

@ARGV or die "Usage: enc.pl [-f encoding_name] [-t encoding_name] text_file\n";

foreach ( @ARGV ) {
    my $file = file $_;
    my $reader = $file->openr or die "Couldn't open $file for reading: $!\n";
    my $content = $file->slurp;
    $reader->close;

    rename $file, "$file.bak";
    my ( $from, $to );
    if ( $opts{ f } ) {
        $from = $opts{ f };
    } else {
        my $f_obj = Encode::Guess->guess( $content );
        ref $f_obj ? $from = $f_obj->name : die "Couldn't guess: $f_obj\n";
    }
    if ( $opts{ t } ) {
        $to = $opts{ t };
    } else { $to = 'locale_fs'; }
    $content = encode( $to, decode( $from, $content ) );
    $from =~ /cp932|iso-2022-jp/ and $content =~ s/\r\n/\n/g;
    $to =~ /cp932|iso-2022-jp/ and $content =~ s/\n/\r\n/g;

    my $writer = $file->openw or die "Couldn't open $file for writing: $!\n";
    $writer->print( $content );
    $writer->close;
}

exit;
C¥> perl enc.pl [-f エンコード名] [-t エンコード名] テキストファイル

基本的には fオプションや tオプションも無くても適切に変換します。変換前の文字コードの推測に失敗してエラーが出た時には fオプションで、変換後の文字コードをファイルシステムのロケールにしたくない場合には tオプションで文字コードを指定して下さい。

一応、Mac で使われてる UTF-8-MAC も扱えますけども、UTF-8 と UTF-8-MAC の判別が難しいので、自動推測の候補には入れていません。UTF-8-MAC を扱う場合にはオプションで指定して下さい。

Posted at 18:09 in perl | Permalink | Comments/Trackbacks ()

Oct 22, 2011

Strawberry Perl 5.12.3.0 をインストール

2011年11月12日追記:ぽち*ぷ〜ちいさましいちびのツールたち unzip.pl untar.pl enc.pl に untar.pl についてもう少しだけ詳しく書きました。

Windows上で使う Perl に疎いぽちは、Perl で書いたコードを Windows上で実行可能な単独の exeファイルに纏める PARPAR::Packer というモジュールがある事を最近知りました。これらのモジュールは何も Windows の exe形式だけに限らず単独の実行形式ファイルを作るのに使えるのですけども、Windows上で Perl のコードから単独で実行可能な exeファイルを作るのは、Perl をインストールさせる事なく、Perl で書いたものを気軽に「これ使ってね♪」と渡せるという点ではとっても便利そうな気がします。

そこでぽちは、父が年賀状作成と孫たちの動画の保管や写真のプリントにしか使っていない、インターネット回線にさえ繋げる気が無い Windows Vista機に Strawberry Perl 5.12.3.0 を入れる許可を得て、インストールしてみました。Strawberry Perl自体は msi に纏められているので、オフラインでもぽちの Linux機でダウンロードしたものを持って来て簡単にインストール出来るのですけども、追加でインストールしたいモジュールは CPAN Search で個別に探してダウンロードして、それぞれ CPAN Dependencies で依存関係を確認しながら、必要なものから順序良く手動で入れるという作業をする事になってしまいました。

父の Vista機を回線に繋げられれば、わざわざこんな作業をしなくても cpanm なり、cpanm -f なりで済んでしまうんですけど、自分の PC じゃ無い以上「回線には繋げるな」という父の意向を無視するわけにはいきません。今時、私用の PC をスタンドアローンで使うなんていうセキュリティ確保の方法は現実的じゃない気がしますが…ぽちが言っても耳を貸してくれませんでした。

Vista機は数年前の購入時のままの状態で、Perlモジュールの圧縮形式、tar.gzファイルを展開するツールなんて入っていません。そこで入れたばっかりの Perl を利用してコマンドプロンプトから

C¥> perl -MArchive::Extract -e "$ae = Archive::Extract->new(archive => q/Path-Class-0.24.tar.gz/); $ae->extract;"

こんなふうにワンライナーで展開してみました。

これで充分用は足りるんですけども、ついでなのでぽちの unzip.plArchive::Tar で書き換えてこんな感じにしてみました。

untar.pl

#!/usr/bin/env perl

use strict;
use warnings;
use Archive::Tar;
use utf8;
use Encode;
use Encode::UTF8Mac; # utf-8-mac は fオプションでしか使えません。
use Encode::Guess qw/ euc-jp cp932 iso-2022-jp utf8 /; # 自動推測の対象
use Encode::Locale;
use Path::Class;
use Getopt::Std;

my %opts;
getopts('f:', \%opts);

@ARGV or die "Usage: untar.pl [-f encoding_name] tar_file\n";

foreach ( @ARGV ) {
    my $file = file $_;
    my $tar = Archive::Tar->new();
    $tar->read( "$file" ) or die "Couldn't read: $file\n";

    my $str;
    $str .= $_ foreach ( $tar->list_files );
    my $enc_name;
    if ( $opts{ f } ) {
        $enc_name = $opts{ f };
    } else {
        my $enc = Encode::Guess->guess( $str );
        ref $enc ? $enc_name = $enc->name : die "Couldn't guess: $enc\n";
    }

    foreach ( $tar->list_files ) {
        my $file = file( encode( 'locale_fs', decode( $enc_name, $_ ) ) );
        my $dir = $file->parent;
        -d $dir or dir( $dir )->mkpath;
        print "extract $file ...";
        $tar->extract_file( $_, "$file" );
        print "done.\n";
    }
}

exit;

見ての通り対象となるファイルのアーカイブ・圧縮形式が違うだけで、使い方は unzip.pl と同じです。

C¥> perl untar.pl [-f エンコード名] tarファイル

追加したモジュールですけども、文字コードcp932 の日本語版Windows上で Encode::Locale のテストの t/env.t が通らないのは有名みたいですね。

調べたらこんな感じだった。
env.t
> Encode::Locale::reinit("cp1252");
Windowsではコードページの変更が出来ない

> $ENV{"m\xf6ney"} = "\x80uro";
・コードページ"cp932"(日本標準)ではこの設定ができない
・なぜかPerlが落ちる
・コードページが元から"cp1252"(西欧標準)の場合は上手く行く

英語版のWindowsだと問題を把握できないかも。

626 - Perlについての質問箱 48箱目 - 2chプログラム技術板 より

とりあえずテストの失敗を無視して入れてもきちんと動いているようです。

Posted at 08:25 in perl | Permalink | Comments/Trackbacks ()

Oct 19, 2011

Perl で unzip.pl

2011年11月12日追記:ぽち*ぷ〜ちいさましいちびのツールたち unzip.pl untar.pl enc.pl に unzip.pl についてもう少しだけ詳しく書きました。

UNIX/Linuxzipファイルの展開に使われる unzip という有名な展開ツールがありますが、ファイルシステムのロケールに設定された文字コードが異なる環境で作成された zipファイルで、日本語ファイル名が含まれているものを展開すると、ファイル名が文字化けしてしまいます。C で書かれた unzip のソースコードに、マルチバイト文字のファイル名に対応するパッチを当てれば文字化けしないようになるのですけども、Perl大好きなぽちはずっと以前から、狐の王国の Suganoさんが書かれた unzip.pl をもとに、ぽちが使い易いようにちまちま改造を加えたものを zipファイルの展開に使っています。最近のぽちの unzip.pl はこんな感じです。

unzip.pl

#!/usr/bin/env perl

use strict;
use warnings;
use Archive::Zip qw/ :ERROR_CODES /;
use utf8;
use Encode;
use Encode::UTF8Mac; # utf-8-mac は fオプションでしか使えません。
use Encode::Guess qw/ euc-jp cp932 iso-2022-jp utf8 /; # 自動推測の対象
use Encode::Locale;
use Path::Class;
use Getopt::Std;

my %opts;
getopts('f:', \%opts);

@ARGV or die "Usage: unzip.pl [-f encoding_name] zip_file\n";

foreach ( @ARGV ) {
    my $file = file $_;
    my $zip = Archive::Zip->new();
    $zip->read( "$file" ) == AZ_OK or die "Couldn't read: $file\n";

    my $str;
    $str .= $_->fileName foreach ( $zip->members );
    my $enc_name;
    if ( $opts{ f } ) {
        $enc_name = $opts{ f };
    } else {
        my $enc = Encode::Guess->guess( $str );
        ref $enc ? $enc_name = $enc->name : die "Couldn't guess: $enc\n";
    }

    foreach ( $zip->members ) {
        my $file = file( encode( 'locale_fs', decode( $enc_name, $_->fileName ) ) );
        my $dir = $file->parent;
        -d $dir or dir( $dir )->mkpath;
        print "extract $file ...";
        $zip->extractMember( $_->fileName, "$file" );
        print "done.\n";
    }
}

exit;

使い方は、

$ ./unzip.pl [-f エンコード名] zipファイル

基本的に fオプションは必要なく、zipファイルの中のファイル名からエンコードされている文字コードを推測して、そのファイル名をファイルシステムのロケールに合わせて変換してから展開してくれます。たまに推測に失敗する時もありますが、そんな時はエラーメッセージを見て fオプションで適切な文字コードを指定してあげます。

Archive::ZipPOD を読んでみたら、「展開するだけなら Archive::Zip じゃなくて Archive::Extract を使ってね?」なんて書いてありますね。けど Archive::Extractって一度展開した後でないと内容物のファイル名を取得出来ないんで、文字コードの変換をするにはちょっと不便なんですよねえ。

Posted at 20:43 in perl | Permalink | Comments/Trackbacks ()

Aug 01, 2011

IRCダイスボットへの道 - IRCダイスボットをもう少し実用的に

PerlIRCダイスボットへの道第五回は、第四回のシンプルな IRCダイスボットをもう少しだけ実用的にしてみます。具体的には一行のダイスコマンドで複数のダイスロール結果を表示出来るようにします。これはダイスロールの合計ではなくダイスロールの内訳が必要な場合の為の機能です。基本的な仕組みは前回のものと全く変わっていませんし、短くて単純なコードなので説明の必要は無い気もしますけども、どういう感じで動いているかは、前回の

を読んでみて下さい。

simpledicebot.pl

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use Encode;
use POE;
use POE::Component::IRC::State;
use POE::Component::IRC::Plugin::AutoJoin;
use Parse::RecDescent;
use Data::Transformer;
use Math::Random::MT;

my $irc_server = 'irc.trpg.net'; # 利用する IRCサーバ
my $room       = '#ぽち小屋';    # IRC で入るチャンネル名
my $name       = 'dice_smp';     # IRC でのダイスボットの名前
my $encoding   = 'iso-2022-jp';  # 大抵これで OK、駄目な場合は utf-8 に変更

my $e = find_encoding( $encoding );

my $grammar = <<'GRAMMER';
expression: add end { { left => $item[1] } }
add: mult '+' add { { left => $item[1], op => '+', right => $item[3] } }
add: mult '-' add { { left => $item[1], op => '-', right => $item[3] } }
add: mult
mult: brack '*' mult { { left => $item[1], op => '*', right => $item[3] } }
mult: brack
brack: '(' add ')' { $item[2] }
brack: val
val: /[1-9]\d?d(?:100|30|20|12|10|8|6|4|2)/i
val: /\d{1,2}/
end: /\s*$/
GRAMMER

my $parser = Parse::RecDescent->new( $grammar ) or die 'Bad grammar';

my $seed = time ^ $$;
my $gen  = Math::Random::MT->new($seed);

POE::Session->create(
    package_states => [
        main => [ qw/ _start irc_public / ]
    ]
);

$poe_kernel->run();

sub _start {
    my $irc = POE::Component::IRC::State->spawn(
        Nick   => $name,
        Server => $irc_server,
    );

    $irc->plugin_add( 'AutoJoin', POE::Component::IRC::Plugin::AutoJoin->new(
        Channels => [ $e->encode( $room ) ]
    ));

    $irc->yield( register => 'join' );
    $irc->yield( 'connect' );
}

sub irc_public {
   my ( $sender, $who, $where, $what ) = @_[SENDER, ARG0, ARG1, ARG2];
   my $nick = ( split /!/, $who )[0];
   my $channel = $where->[0];
   my $irc = $sender->get_heap();

   if ( $what =~ /^\(?[1-9]\d?d(?:100|30|20|12|10|8|6|4|2)/i ) {
       my $result = &dice( $what );
       defined $result
           and $irc->yield( privmsg => $channel => "$nick: $result" );
   }
   return;
}

sub dice {
    my @results;
    my @comments;
    my @args = split /\s+/, $e->decode( $_[0] );

    foreach ( @args ) {
        if ( my $parsed = $parser->expression( $_ ) ) {
            my $dt =  Data::Transformer->new( normal => \&roll );
            $dt->traverse( $parsed );
            push @results, &gathering( $parsed->{ left } );
        }
        elsif ( @results ) {
            push @comments, $_;
        }
        else {
            return;
        }
    }

    if ( !@comments ) {
        return join ' ', @results;
    }
    else {
        my $comment;
        foreach ( @comments ) {
            $comment = $comment . "$_ ";
        }
        chop $comment;
        return ( join ' ', @results )  . ' ' . $e->encode( $comment );
    }
}

sub roll {
    my $val = shift;
    if ( $$val =~ /^([1-9]\d?)d(100|30|20|12|10|8|6|4|2)$/i ) {
        my $dices;
        my ( $counts, $planes ) = ( $1, $2 );
        while ( $counts ) {
            my $a_dice = int $gen->rand( $planes ) + 1;
            $dices += $a_dice;
            $counts--;
        }
        $$val = $dices;
    }
    undef;
}

sub gathering {
    my $val = shift;
    if ( ref $val ) {
        if ( $val->{ op } =~ /\+/ ) {
            return &gathering( $val->{ left } ) + &gathering( $val->{ right } );
	}
        elsif ( $val->{ op } =~ /-/ ) {
            return &gathering( $val->{ left } ) - &gathering( $val->{ right } );
        }
        else {
            return &gathering( $val->{ left } ) * &gathering( $val->{ right } );
        }
    }
    else {
        return $val;
    }
}

コマンドライン操作の

$ ./simpledicebot.pl

で、設定した IRCサーバの設定したチャンネルに接続します。接続を終える時は、実行中に Ctrl + c で停止させるか、実行したターミナルエミュレータのウィンドウを閉じて停止させます。

同じチャンネルに接続した IRCクライアントから

>pochi< (1d8+3d6+1d100-2)*2

と発言すると、

<dice_smp> pochi: 158

のようにロールの結果を合計して返してくれます。ダイスコマンドの後に半角または全角スペースを挟むと、それ以後はダイスロールについてのコメントとして、ロール結果と一緒に再び表示されます。

>pochi< 1d100 SANチェック
<dice_smp> pochi: 75 SANチェック

ダイスロールの内訳が必要な場合には、演算子の代わりに半角スペースを空けてダイスコマンドを発言してあげるとこんな感じになります。

>pochi< 1d8 1d6 1d10 1d100
<dice_smp> pochi: 4 3 9 45
>pochi< (1D8+3D6+1D100-2)*2 1d8+1d6+2 1D100-20
<dice_smp> pochi: 192 11 35
Posted at 22:46 in perl | Permalink | Comments/Trackbacks ()

Jul 29, 2011

IRCダイスボットへの道 - IRCボットにローカルダイスを組み込んでみる

PerlIRCダイスボットへの道第四回は、第三回のローカルダイスを IRCボットに組み込んでみます。

ローカルダイスは、Perlモジュールの Parse::RecDescent を使ってダイスコマンド文字列をパースして無名ハッシュのリファレンスに収め、Data::Transformer を使ってそのままの状態でダイスだけ転がした後、ハッシュリファレンスから値を取り出して集計しています。ロールの乱数には Perl の標準関数 の rand ではなく、メルセンヌ・ツイスタを使った Math::Random::MT を利用しています。今回 IRCボットに組み込むに当たっては、POE::Component::IRC を使ってみました。

simpledicebot.pl

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use Encode;
use POE;
use POE::Component::IRC::State;
use POE::Component::IRC::Plugin::AutoJoin;
use Parse::RecDescent;
use Data::Transformer;
use Math::Random::MT;

my $irc_server = 'irc.trpg.net'; # 利用する IRCサーバ
my $room       = '#ぽち小屋';    # IRC で入るチャンネル名
my $name       = 'dice_smp';     # IRC でのダイスボットの名前
my $encoding   = 'iso-2022-jp';  # 大抵これで OK、駄目な場合は utf-8 に変更

my $e = find_encoding( $encoding );

my $grammar = <<'GRAMMER';
expression: add end { { left => $item[1] } }
add: mult '+' add { { left => $item[1], op => '+', right => $item[3] } }
add: mult '-' add { { left => $item[1], op => '-', right => $item[3] } }
add: mult
mult: brack '*' mult { { left => $item[1], op => '*', right => $item[3] } }
mult: brack
brack: '(' add ')' { $item[2] }
brack: val
val: /[1-9]\d?d(?:100|30|20|12|10|8|6|4|2)/i
val: /\d{1,2}/
end: /\s*$/
GRAMMER

my $parser = Parse::RecDescent->new( $grammar ) or die 'Bad grammar';

my $seed = time ^ $$;
my $gen  = Math::Random::MT->new($seed);

POE::Session->create(
    package_states => [
        main => [ qw/ _start irc_public / ]
    ]
);

$poe_kernel->run();

sub _start {
    my $irc = POE::Component::IRC::State->spawn(
        Nick   => $name,
        Server => $irc_server,
    );

    $irc->plugin_add( 'AutoJoin', POE::Component::IRC::Plugin::AutoJoin->new(
        Channels => [ $e->encode( $room ) ]
    ));

    $irc->yield( register => 'join' );
    $irc->yield( 'connect' );
}

sub irc_public {
   my ( $sender, $who, $where, $what ) = @_[SENDER, ARG0, ARG1, ARG2];
   my $nick = ( split /!/, $who )[0];
   my $channel = $where->[0];
   my $irc = $sender->get_heap();

   if ( $what =~ /^\(?[1-9]\d?d(?:100|30|20|12|10|8|6|4|2)/i ) {
       my $result = &dice( $what );
       defined $result
           and $irc->yield( privmsg => $channel => "$nick: $result" );
   }
   return;
}

sub dice {
    my $arg = $e->decode( $_[0] );
    my @args = split /\s+/, $arg;
    my $text = shift @args;
    my $data = $parser->expression( $text ) or return;

    my $roll =  Data::Transformer->new(
        normal => sub {
                      my $val = shift;
	              if ( $$val =~ /^([1-9]\d?)d(100|30|20|12|10|8|6|4|2)$/i ) {
                          my ( $counts, $planes ) = ( $1, $2 );
                          my $dices;
                          while ( $counts ) {
	                      my $a_dice = int $gen->rand( $planes ) + 1;
                              $dices += $a_dice;
                              $counts--;
                          }
                          $$val = $dices;
                      }
                  },
    );
    $roll->traverse( $data );

    if ( !@args ) {
        return &gathering( $data->{ left } );
    }
    else {
        my $comments;
        foreach ( @args ) {
            $comments = $comments . "$_ ";
        }
        chop $comments;
        return &gathering( $data->{ left }) . ' ' . $e->encode( $comments );
    }
}

sub gathering {
    my $val = shift;
    if ( ref $val ) {
        if ( $val->{ op } =~ /\+/ ) {
            return &gathering( $val->{ left } ) + &gathering( $val->{ right } );
	}
        elsif ( $val->{ op } =~ /-/ ) {
            return &gathering( $val->{ left } ) - &gathering( $val->{ right } );
        }
        else {
            return &gathering( $val->{ left } ) * &gathering( $val->{ right } );
        }
    }
    else {
        return $val;
    }
}

コマンドライン操作の

$ ./simpledicebot.pl

で、設定した IRCサーバの設定したチャンネルに接続します。接続を終える時は、実行中に Ctrl + c で停止させるか、実行したターミナルエミュレータのウィンドウを閉じて停止させます。

同じチャンネルに接続した IRCクライアントから

>pochi< (1d8+3d6+1d100-2)*2

と発言すると、

<dice_smp> pochi: 158

のようにロールの結果を合計して返してくれます。ダイスコマンドの後に半角または全角スペースを挟むと、それ以後はダイスロールについてのコメントとして、ロール結果と一緒に再び表示されます。

>pochi< 1d100 SANチェック
<dice_smp> pochi: 75 SANチェック

とてもシンプルではありますけども、なんとかまた IRCダイスボットをでっちあげる事が出来ました。

Posted at 21:35 in perl | Permalink | Comments/Trackbacks ()

Page 1 of 10: 1 2 3 4 5 6 7 8 9 10 »