PerlLiveCD / PerlLiveUSB
LiveCDやLiveUSBを作ってみたい
http://www.perlfoundation.org/perl5/index.cgi?perllivecdという記事を見つけて，自分なりのLiveCDかLiveUSBを作ってみたいと思いました．簡単にできるのかと思ったら，以外にはまったので，現時点までにできたことをまとめてみます．
最小構成のLiveCD / LiveUSBを作る
準備
ベースにしたのはCentOSです．最近よく使っているので選んでみました．CentOSでのLiveCDの作り方が載っているので，これに沿って進めました．注意が必要なのは以下の2点です．
- CentOS5.3ならこの手順でLiveCDが作れます
- CentOS5.4だと，livecd-tools-014-4.i386.rpmにバージョンダウンしないとLiveCDが作れません．以下のエラーが発生します．
Error creating Live CD : syslinux not installed : no suitable *menu.c32 found in /usr/lib/syslinux or /usr/share/syslinux
kickstartを作る
LiveCDに何を載せるかはkickstartファイルで指定します．その最小構成はCentOSでのLiveCDの作り方に載っているminimal.ksになります．これをこのまま使ってもいいのですが，キーボードをjp106に，タイムゾーンをAsia/Tokyoに変更しました．変更したkickstartは次のようになります．
lang en_US.UTF-8 keyboard jp106 timezone Asia/Tokyo auth --useshadow --enablemd5 selinux --enforcing firewall --disabled repo --name=a-base --baseurl=http://mirror.centos.org/centos/5/os/$basearch repo --name=a-updates --baseurl=http://mirror.centos.org/centos/5/updates/$basearch #repo --name=a-extras --baseurl=http://mirror.centos.org/centos/5/extras/$basearch repo --name=a-live --baseurl=http://www.nanotechnologies.qc.ca/propos/linux/centos-live/$basearch/live %packages bash kernel syslinux passwd policycoreutils chkconfig authconfig rootfiles comps-extras xkeyboard-config kbd %post --nochroot cp /usr/share/zoneinfo/Japan $INSTALL_ROOT/etc/localtime %end
変更したのは以下の4点です．
- keyboardをjp106に
- timezoneをAsia/Tokyoに
- kbdパッケージを追加
- %postを使って，LiveCDの/etc/localtimeに/usr/share/zoneinfo/Japanを設定
LiveCDを作る
ここまでできれば，コマンドを実行するだけです．コマンドとのその実行結果は以下のようになります．
# LANG=C livecd-creator --config=centos-livecd-minimal.ks --fslabel=CentOS-minimal mke2fs 1.39 (29-May-2006) Filesystem label=CentOS-minimal OS type: Linux ... Total translation table size: 4488 Total rockridge attributes bytes: 1580 Total directory bytes: 4096 Path table size(bytes): 40 Max brk space used 0 70917 extents written (138 MB) Inserting md5sum into iso image... md5 = 95caaa1adc7a9cb350d2182cfbdf0e23 Inserting fragment md5sums into iso image... fragmd5 = b4b64b32998547d6e7fc5612c2c53f545e6c7d3dee886528bdef27c99977 frags = 20 Setting supported flag to 0 Exception exceptions.AttributeError: "'NoneType' object has no attribute 'sysconf'" in <bound method LiveCDYum.__del__ of <imgcreate.yuminst.LiveCDYum object at 0x9a7478c>> ignored
最後に何か出ていますが，無視してよさそうです．これでCentOS-minimal.isoができました．
LiveUSBを作る
最近のLinuxではUSBメモリを差し込めば認識してマウントまでできると思っていたのですが，手持ちのUSBメモリではマウントしませんでした．そのため，ファイルシステムを作って
Command (m for help): p Disk /dev/sdb: 4007 MB, 4007624704 bytes 32 heads, 63 sectors/track, 3882 cylinders Units = cylinders of 2016 * 512 = 1032192 bytes Device Boot Start End Blocks Id System /dev/sdb1 1 3882 3913024+ b W95 FAT32
LiveUSBの作り方に載っているコマンドを実行しました．
# livecd-iso-to-disk CentOS-minimal.iso /dev/sdb1 Verifying image... CentOS-minimal.iso: 95caaa1adc7a9cb350d2182cfbdf0e23 Fragment sums: b4b64b32998547d6e7fc5612c2c53f545e6c7d3dee886528bdef27c99977 Fragment count: 20 Percent complete: 100.0% Fragment[20/20] -> OK 100.0 The supported flag value is 0 The media check is complete, the result is: PASS. It is OK to install from this media. Copying live image to USB stick Updating boot config file Installing boot loader /media/usbdev.c21097/syslinux is device /dev/sdb1 USB stick set up as live image!
これでできあがりです．
インストールされてるモジュール
LiveCD作成時にでてくるメッセージから考えて，インストールされているパッケージは111個あるようです．羅列すると以下のようになります．
Installing: setup ##################### [ 1/111]
Installing: filesystem ##################### [ 2/111]
Installing: basesystem ##################### [ 3/111]
Installing: termcap ##################### [ 4/111]
Installing: nash ##################### [ 5/111]
Installing: tzdata ##################### [ 6/111]
Installing: glibc-common ##################### [ 7/111]
Installing: centos-release-notes ##################### [ 8/111]
Installing: cracklib-dicts ##################### [ 9/111]
Installing: libgcc ##################### [ 10/111]
Installing: comps-extras ##################### [ 11/111]
Installing: rootfiles ##################### [ 12/111]
Installing: xkeyboard-config ##################### [ 13/111]
Installing: glibc ##################### [ 14/111]
Installing: mktemp ##################### [ 15/111]
Installing: chkconfig ##################### [ 16/111]
Installing: popt ##################### [ 17/111]
Installing: zlib ##################### [ 18/111]
Installing: audit-libs ##################### [ 19/111]
Installing: glib2 ##################### [ 20/111]
Installing: libtermcap ##################### [ 21/111]
Installing: bash ##################### [ 22/111]
Installing: libsepol ##################### [ 23/111]
Installing: ncurses ##################### [ 24/111]
Installing: info ##################### [ 25/111]
Installing: sed ##################### [ 26/111]
Installing: readline ##################### [ 27/111]
Installing: nspr ##################### [ 28/111]
Installing: nss ##################### [ 29/111]
Installing: bzip2-libs ##################### [ 30/111]
Installing: libattr ##################### [ 31/111]
Installing: libacl ##################### [ 32/111]
Installing: sqlite ##################### [ 33/111]
Installing: gawk ##################### [ 34/111]
Installing: elfutils-libelf ##################### [ 35/111]
Installing: gdbm ##################### [ 36/111]
Installing: libstdc++ ##################### [ 37/111]
Installing: db4 ##################### [ 38/111]
Installing: perl ##################### [ 39/111]
Installing: perl-Digest-SHA1 ##################### [ 40/111]
Installing: iproute ##################### [ 41/111]
Installing: pcre ##################### [ 42/111]
Installing: grep ##################### [ 43/111]
Installing: hmaccalc ##################### [ 44/111]
Installing: cpio ##################### [ 45/111]
Installing: diffutils ##################### [ 46/111]
Installing: binutils ##################### [ 47/111]
Installing: less ##################### [ 48/111]
Installing: gzip ##################### [ 49/111]
Installing: procps ##################### [ 50/111]
Installing: iputils ##################### [ 51/111]
Installing: keyutils-libs ##################### [ 52/111]
Installing: libsysfs ##################### [ 53/111]
Installing: slang ##################### [ 54/111]
Installing: cyrus-sasl-lib ##################### [ 55/111]
Installing: mingetty ##################### [ 56/111]
Installing: sgpio ##################### [ 57/111]
Installing: libcap ##################### [ 58/111]
Installing: ethtool ##################### [ 59/111]
Installing: perl-Crypt-PasswdMD5 ##################### [ 60/111]
Installing: centos-release ##################### [ 61/111]
Installing: crontabs ##################### [ 62/111]
Installing: libselinux ##################### [ 63/111]
Installing: device-mapper ##################### [ 64/111]
Installing: e2fsprogs-libs ##################### [ 65/111]
Installing: shadow-utils ##################### [ 66/111]
Installing: kpartx ##################### [ 67/111]
Installing: e2fsprogs ##################### [ 68/111]
Installing: openssl ##################### [ 69/111]
Installing: logrotate ##################### [ 70/111]
Installing: findutils ##################### [ 71/111]
Installing: openldap ##################### [ 72/111]
Installing: device-mapper-multipath ##################### [ 73/111]
Installing: MAKEDEV ##################### [ 74/111]
Installing: krb5-libs ##################### [ 75/111]
Installing: device-mapper-event ##################### [ 76/111]
Installing: lvm2 ##################### [ 77/111]
Installing: tar ##################### [ 78/111]
Installing: libselinux-utils ##################### [ 79/111]
Installing: net-tools ##################### [ 80/111]
Installing: psmisc ##################### [ 81/111]
Installing: cracklib ##################### [ 82/111]
Installing: coreutils ##################### [ 83/111]
Installing: pam ##################### [ 84/111]
Installing: python ##################### [ 85/111]
Installing: udev ##################### [ 86/111]
Installing: util-linux ##################### [ 87/111]
Installing: libuser ##################### [ 88/111]
Installing: dmraid ##################### [ 89/111]
Installing: passwd ##################### [ 90/111]
Installing: usermode ##################### [ 91/111]
Installing: newt ##################### [ 92/111]
Installing: libselinux-python ##################### [ 93/111]
Installing: audit-libs-python ##################### [ 94/111]
Installing: libsemanage ##################### [ 95/111]
Installing: SysVinit ##################### [ 96/111]
Installing: rsyslog ##################### [ 97/111]
Installing: tcsh ##################### [ 98/111]
Installing: mtools ##################### [ 99/111]
Installing: dmraid-events ##################### [100/111]
Installing: syslinux ##################### [101/111]
Installing: authconfig ##################### [102/111]
Installing: initscripts ##################### [103/111]
Installing: rpm ##################### [104/111]
Installing: mcstrans ##################### [105/111]
Installing: rpm-libs ##################### [106/111]
Installing: policycoreutils ##################### [107/111]
Installing: kbd ##################### [108/111]
Installing: mkinitrd ##################### [109/111]
Installing: module-init-tools ##################### [110/111]
Installing: kernel ##################### [111/111]
次は必要なperlモジュールを突っ込むところに挑戦したいと思います．
Tatsumakiのdemoプログラム解析
使い方
まずapp.psgiを調べてみます．
$ plackup -s AnyEvent
で実行すると5000番ポートでTatsumakiサーバが起動します．まず，アクセスするパスですが，mainパッケージをみてみると，
package main; use File::Basename; my $chat_re = '[\w\.\-]+'; my $app = Tatsumaki::Application->new([ "/chat/($chat_re)/poll" => 'ChatPollHandler', "/chat/($chat_re)/mxhrpoll" => 'ChatMultipartPollHandler', "/chat/($chat_re)/post" => 'ChatPostHandler', "/chat/($chat_re)" => 'ChatRoomHandler', ]);
となっているのでローカルサーバにアクセスするのであれば，チャットルーム名をsampleとした場合には
http://localhost:5000/chat/sample
とアクセスすることでチャット画面が起動します．"Your email(for Gravatar)"のテキストエリアにGravatar用のメールアドレスを記入すると，"Something to say"に記入したメッセージ送信時に，そのヘッダにGravatarに登録したアイコンを表示します．
次にtemplates/chat.htmlを見てみます．
% my $channel = $_[0]->{handler}->args->[0]; % my $mxhr = $_[0]->{handler}->request->param('mxhr'); <html> <head> <title>Tatsumaki Chat demo</title> <script src="/static/jquery-1.3.2.min.js"></script> % if ($mxhr) { <script src="/static/DUI.js"></script> <script src="/static/Stream.js"></script> % } else { <script src="/static/jquery.ev.js"></script> % }
requestのパラメータに"mxhr"という文字列が入っているとincludeするjavascriptライブラリが変わって挙動が変化するようになっています．具体的には，
http://localhost:5000/chat/sample?mxhr=1
とすると挙動が変わります．mxhrをつけずに起動した場合にはjquery.ev.jsが働き"long poll"型のアーキテクチャとして動きます．一方mxhrをつけて起動した場合にはDUI.jsが働いてmultipart/mixed型のアーキテクチャとして動きます．さらに，"oembed.js"をインクルードしているので"Something to say"のテキストエリアに記入した，サードパーティサイトのURLで現されたコンテンツを埋め込むことができます．例えば
http://www.flickr.com/photos/bulknews/2694608273/
と記入すると，miyagawaさんとLarry Wallが写ってる写真を取込みます．
構成
使い方の項でも見たように，アクセスパスと呼び出すクラスの関係は以下のようになっています．
my $app = Tatsumaki::Application->new([ "/chat/($chat_re)/poll" => 'ChatPollHandler', "/chat/($chat_re)/mxhrpoll" => 'ChatMultipartPollHandler', "/chat/($chat_re)/post" => 'ChatPostHandler', "/chat/($chat_re)" => 'ChatRoomHandler', ]);
まず，テンプレートを使ってhtmlファイルを書き出す場合のサンプルはChatRoomHandlerになります．このパッケージをみると，
sub get { my($self, $channel) = @_; $self->render('chat.html'); }
となっていて，テンプレートファイルを読み込んでレンダリングする場合には，
$self->render('テンプレートファイル');
とすることがわかります．テンプレートの描画にはText::MicroTemplate::Fileを使っていて，
my $mt = Text::MicroTemplate::File->new( include_path => [ 'templates' ], use_cache => 0, tag_start => '<%', tag_end => '%>', line_start => '%', );
とカスタマイズしています．先頭に"%"を入れるとperlスクリプトがそのまま書けるわけです．
次に，メッセージをpostするサンプルはChatPostHandlerで，
sub post { my($self, $channel) = @_; ... $self->write({ success => 1 }); }
jsonでのデータをクライアントに返します．さらに，longpoll型のアーキテクチャ用のサンプルはChatPollHandlerになります．
sub get { my($self, $channel) = @_; ... $mq->poll_once($client_id, sub { $self->on_new_event(@_) }); } sub on_new_event { my($self, @events) = @_; $self->write(\@events); $self->finish; }
writeしてからfinishする必要があると．最後にmultipart/mixed型のサンプルはChatMultipartPollHandlerになります．
sub get { my($self, $channel) = @_; my $client_id = $self->request->param('client_id') || rand(1); $self->multipart_xhr_push(1); my $mq = Tatsumaki::MessageQueue->instance($channel); $mq->poll($client_id, sub { my @events = @_; for my $event (@events) { $self->stream_write($event); } }); }
この場合はstream_writeを使っています．finishを呼び出す必要はありません．
おわりに
なんか中途半端な感もありますが，とりあえずこんなところで．
We Wish You A Merry Chrismas
Advent Calendar大流行り
今年はPerlネタのAdvent Calendarが大流行りですね．miyagawaさんのPlack Advent Calendar Day 2の記事を見て，ちょっと試してみたのでそのメモです．
env.psgi
miyagawaさんの記事では
my $app = sub { my $env = shift; return [ 200, ['Content-Type' => 'text/plain'], [ "Hello stranger from $env->{REMOTE_ADDR}!"], ]; };
となっていたので，どんなエントリがあるのか全部出力させてみました．
environment: $VAR1 = { 'psgi.multiprocess' => '', 'SCRIPT_NAME' => '', 'SERVER_NAME' => 0, 'HTTP_ACCEPT_ENCODING' => 'gzip,deflate', 'HTTP_CONNECTION' => 'keep-alive', 'PATH_INFO' => '/', 'HTTP_ACCEPT' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8', 'REQUEST_METHOD' => 'GET', 'psgi.multithread' => '', 'HTTP_ACCEPT_CHARSET' => 'Shift_JIS,utf-8;q=0.7,*;q=0.7', 'HTTP_USER_AGENT' => 'Mozilla/5.0 (Macintosh; U; PPC Mac OS X 10.4; ja-JP-mac; rv:1.9.1.6) Gecko/20091201 Firefox/3.5.6', 'QUERY_STRING' => '', 'SERVER_PORT' => 5000, 'HTTP_CACHE_CONTROL' => 'max-age=0', 'HTTP_ACCEPT_LANGUAGE' => 'ja,en-us;q=0.7,en;q=0.3', 'REMOTE_ADDR' => '127.0.0.1', 'HTTP_KEEP_ALIVE' => '300', 'SERVER_PROTOCOL' => 'HTTP/1.1', 'psgi.errors' => *::STDERR, 'REQUEST_URI' => '/', 'psgi.version' => [ 1, 0 ], 'psgi.url_scheme' => 'http', 'psgi.run_once' => '', 'HTTP_HOST' => 'localhost:5000', 'psgi.input' => \*{'Plack::Server::Standalone::$input'} };
色々沢山ありますね．ちなみに，これを出力させるスクリプトはこんな感じでした．
use Data::Dumper; my $app = sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain' ], ["environment: \n " . Dumper( $env )], ]; };
あれ，ストリームデータのときはどうやってデータを渡すんだろう．興味深いですね．
androidをeeepc 701に
701の有効活用法を探して
最近eeepc 701をあまり使っていません．そんな時にふと見つけたのがandroid-x86 projectでした．これをインストールしてwifiを使えて，アプリケーションをダウンロードできるところまで確認したので，そこまでのまとめです．今回使ったimgだと中国語のIMEがついてるんですが日本語IMEがありません．SimejiというIMEをインストールしようとしたんですが，うまくいきませんでした．それから，Android Script Environment(ASE)をインストールして遊んでみようと思っていたんですが，これもインストールできませんでした．
imgを作る
この文章を書いている段階でAndroid-x86の最新のバージョンは1.6で，isoイメージとusbイメージが用意されています．今回はusbイメージを使用しました．ダウンロードして解凍したら，usbにそれを展開します．私はmacを使っているので，こんな手順になります．
# まずusbをささないでdiskutilを実行 $ diskutil list # 今度はusbをさしてdiskutilを実行 $ diskutil list # 増えたディスクがusbを現しています．今回は/dev/disk1だとします # usbをunmountします $ diskuitl unmountDisk /dev/disk1 # usbに書き込みます $ sudo dd if=~/android-x86-1.6_usb.img of=/dev/disk1 bs=1m # macが壊れたディスクだとか言ってくるかもしれませんが，「無視」を選択します # 最後にディスクをejectして，usbを抜きます $ diskutil eject /dev/disk1
これでboot用のusbメモリができました．
boot
usbを刺して電源を入れます．画面が明るくなったらESCを連打．Boot画面が出てきます．EeePCの種類によっては，F2を押してBIOSのBoot設定を変更しないとESCが効かないことがあるようです．
==================
Please select boot devices:
==================
HDD:SM-SILICONMOTION SM223AC
USB:I-O USB Flash Disk==================
↑and↓to move selection
ENTER to select boot device
ここから後のインストールの説明は本家の説明が詳しいです．アプリケーションインストールの際にはsdcardが必要ですが，起動する前に本体に差し込んでおけば自動認識して/sdcardにmountされるようです．
必要な設定
- Settings
ぐらいが必要です．
アプリ
Android MarketにアクセスできるのはGoogleが認証したハードウェアだけなので，Android-x86を動かしている端末からはアクセスできません．そのかわり，AndAppStoreというサイトがあってここからアプリをダウンロードできます．が，少ないんだよねー，ここ…
後，apkファイルをurl指定でダウンロードすればそのままインストールできるはずなんですが，使ってみようと思ったSimeji（日本語IME）や，ASEで試してみたのですがうまく動きませんでした．AppHowToを見ると，うまくいけばインストールできる，というような記述があるので色々試してみないと無理なようです．
メール送信
モダンなメールの送信法
モダンと言ってもたいした事はありません．仕事で使っているnagios用のスクリプトを見たらjcode.plを使っていて，いつから同じものを使ってるんだろうとぐったりしたのでなんとなく書いてみました．最近の日本語処理はEncode.pmですよ．subjectのMIMEエンコードもこれだけでいいんです．
簡単な送信方法
mailコマンドを使ってメールを送信します．送信できる環境になっているのが前提ですね．気にしないといけないのは，スクリプトにテキストを読込む時にdecodeして，書き出す時にencodeすることです．メールの本体はJISコードで件名(Subject)はMIMEエンコードしましょう．
#!/usr/bin/perl use utf8; use Encode; use strict; use warnings; my ( $body, $header, $mail_command ); $body=<<EOD; 台場です． メールの本文をutf8で書きましょう． 後でjisコードに変換します． EOD $header = '要件も日本語で書きましょう'; $header = encode( 'MIME-Header-ISO_2022_JP', $header ); $mail_command = 'mail -s ' . $header . ' foo@hoge.co.jp'; open( MAIL, '|-', $mail_command ); $body = encode('jis', $body); print MAIL $body; close MAIL;
簡単でしょ？後は$bodyの作り方を工夫してみてくださいな．
Google::Chartの使い方
さくっとグラフを描く
Cactiでグラフを作成しようと思っていたデータがあったのですが，色々なしがらみが面倒になったので，ローカルにデータを取得してグラフ化することにしました．どうやってグラフ化するかちょっと考えて，思い出したのがGoogle::Chartでした．まず作ろうと思ったのが棒グラフ．これはこんな感じで動きます．ワンライナーなので，本来は1行です．
perl -MGoogle::Chart -le ' $c = Google::Chart->new( type => "Bar", color => ["4d89f9","c6d9fd"], data => [[1,2,3,4,5,6],[7,8,9,10,11,12]] ); print $c->as_uri'
こんなグラフができあがります．ところがこのスクリプトに必要なデータを突っ込もうとしたら動きませんでした．
perl -MGoogle::Chart -le ' $c = Google::Chart->new( type => "Bar", color => ["4d89f9","c6d9fd"], data => [[101],[101]] ); print $c->as_uri'
つまりこういうのです．どうも値が100を越えるとだめなようです．
Google::Chart::Data::Extendedを使う
testスクリプトやいくつかのモジュールを眺めていたらGoogle::Chart::Data::Extendedというのを見つけました．どうやら100を越える値を使う時にはこれを使う必要があるようです．
perl -MGoogle::Chart -MGoogle::Chart::Data::Extended -le ' $c = Google::Chart->new( type => "Bar", color => ["4d89f9","c6d9fd"], data => Google::Chart::Data::Extended->new( dataset => [[100,101,102,103,104,105],[100,101,102,103,104,105]], max_value => 200) ); print $c->as_uri'
これを実行するとこういうグラフになります．ここまでできると，今度は軸にラベルをつけたくなりますね．その時にはこうします．
perl -MGoogle::Chart -MGoogle::Chart::Data::Extended -le ' $c = Google::Chart->new( type => "Bar", color => ["4d89f9","c6d9fd"], data => Google::Chart::Data::Extended->new( dataset => [[100,101,102,103,104,105],[100,101,102,103,104,105]], max_value => 200), axis => [ {location => "x", labels => [1,2,3,4,5,6]}, {location => "y", labels => [0,50,100,150,200,250,300]} ], ); print $c->as_uri'
こんなグラフになります．
おまけ
最後にタイトルをつけてみます．
perl -MGoogle::Chart -MGoogle::Chart::Data::Extended -le ' $c = Google::Chart->new( type => "Bar", color => ["4d89f9","c6d9fd"], data => Google::Chart::Data::Extended->new( dataset => [[100,101,102,103,104,105],[100,101,102,103,104,105]], max_value => 200), axis => [ {location => "x", labels => [1,2,3,4,5,6]}, {location => "y", labels => [0,50,100,150,200,250,300]} ], title => { text => 'Sample1'}, ); print $c->as_uri'
これでこんなグラフになります．えーと，元々何しようとしてたんだっけ…．結構時間かかってしまいましたよ．
ArduinoとAnyEventを使って，モールス信号でSOS !
AnyEventでタイマー
perl -MAnyEvent -le ' map{ $i = $_; my $c = AnyEvent->condvar; my $w; $w = AnyEvent->timer( after => $i, cb => sub {$w; print "OK"; $c->send}); $c->recv }(0.1,0.5,1,2,0.1)'
なんてワンライナーで簡単なタイマーを作れる事を知りました．それで思いついたのがモールス信号，テキストを入力すると何かちかちかと点滅するものを作ってみようと思いました．まず，CPANでMorseをキーワードにして検索してみたところ，モジュールはいくつかでてきましたが，テキストを短点（'-'）と長点（'ー'）に変換するものばかりで，長点が短点の何倍の時間なのかなんてことはわかりませんでした．そこでwikipediaを探してみた所，詳しい説明が載っていました．
長点1つは短点3つ分の長さに相当し、各点の間は短点1つ分の間隔をあける。また、文字間隔は短点3つ分、語間隔は短点7つ分あけて区別する。
おまけに「符号化方式詳説」というのがあって，これを元にすることで簡単に符号化することができました．それが
以下のConverterモジュールです．
package Converter; use Moose::Role; use namespace::clean -except => 'meta'; requires 'output'; has 'encoding_rule' => ( is => 'rw', isa => 'HashRef[Str]', lazy_build => 1, ); sub _build_encoding_rule { return { A => '[-_---_]', B => '[---_-_-_-_]', C => '[---_-_---_-_]', D => '[---_-_-_]', E => '[-_]', F => '[-_-_---_-_]', G => '[---_---_-_]', H => '[-_-_-_-_]', I => '[-_-_]', J => '[-_---_---_---_]', K => '[---_-_---_]', L => '[-_---_-_-_]', M => '[---_---_]', N => '[---_-_]', O => '[---_---_---_]', P => '[-_---_---_-_]', Q => '[---_---_-_---_]', R => '[-_---_-_]', S => '[-_-_-_]', T => '[---_]', U => '[-_-_---_]', V => '[-_-_-_---_]', W => '[-_---_---_]', X => '[---_-_-_---_]', Y => '[---_-_---_---_]', Z => '[---_---_-_-_]', '.' => '[-_---_-_---_-_---_]', ',' => '[---_---_-_-_---_---_]', '/' => '[---_-_-_-_---_]', ':' => '[---_---_---_-_-_-_]', '\'' => '[-_---_---_---_---_-_]', '-' => '[---_-_-_-_-_---_]', '?' => '[-_-_---_---_-_-_]', '!' => '[-_-_---_---_-_]', '@' => '[-_-_-_---_-_---_]', '+' => '[-_---_-_---_-_]', 0 => '[---_---_---_---_---_]', 1 => '[-_---_---_---_---_]', 2 => '[-_-_---_---_---_]', 3 => '[-_-_-_---_---_]', 4 => '[-_-_-_-_---_]', 5 => '[-_-_-_-_-_]', 6 => '[---_-_-_-_-_]', 7 => '[---_---_-_-_-_]', 8 => '[---_---_---_-_-_]', 9 => '[---_---_---_---_-_]', ' ' => '[__]', }; } sub encode { my $self = shift; my $str = $self->{plain_text}; $str =~ s/(\w)/uc($1)/eg; $str =~ s/(.)/$self->encoding_rule->{$1}/eg; return $str; } 1;
これを使って，コンソール上で短点と長点を表示することができるようになりました．
Arduinoを使ってLED出力
最初はタイマーを使って，コンソール上に'-'と'ー'を出力しようかと思っていたのですが，考えただけでも非常に地味です．やる気が落ちて来るほど．そこでArduinoを使ってLEDを点滅させることにしました．まず，Arduinoを使って，port13とGNDに脚を刺したLEDを点滅させるprocessingのコードは以下のようになります．
void setup() { Serial.begin(9600); pinMode(13, OUTPUT); } void loop() { if (Serial.available() > 0) { int inByte = Serial.read(); if (inByte == 'I') { digitalWrite(13, HIGH); } if (inByte == 'O') { digitalWrite(13, LOW); } } }
これをコントロールするperlのワンライナーは例えば次のように（macの場合）なります．
perl -MDevice::SerialPort -le ' $p = Device::SerialPort->new("/dev/tty.usbserial-A6008iod"); $p->baudrate(9600); $p->databits(8); $p->parity("none"); # $p->stopbits(1); $p->write("I")'
以前試した時にはstopbits(1)を入れないと動かなかったはずなんですが，今回Arduino017で動かしてみたら，外さないと動かなくなってました．理由はよくわかりません．それはともかく，これを元に作ってみたコードは以下のようになりました．
package Morse; use Moose; use AnyEvent; use Device::SerialPort; with 'Converter'; has 'plain_text' => ( is => 'rw', isa => 'Str', required => 1, ); has 'morse_code' => ( is => 'rw', isa => 'Str', lazy_build => 1, ); has 'port' => ( is => 'rw', isa => 'Device::SerialPort', default => sub {Device::SerialPort->new("/dev/tty.usbserial-A6008iod")}, ); sub _build_morse_code { my $self = shift; return $self->encode; } __PACKAGE__->meta->make_immutable; no Moose; sub output { my $self = shift; my $str = $self->morse_code; $self->port->baudrate(9600); $self->port->databits(8); $self->port->parity("none"); $str =~ s/[\[\]]/_/sg; $str =~ s/(-+)/I$1E/g; $str =~ s/(-+)/length($1)/eg; $str =~ s/(_+)/O$1E/g; $str =~ s/(_+)/length($1)/eg; my @timer = split /E/, $str; map { my ( $state, $time ) = $_ =~ m/(.)(.)/; my $c = AnyEvent->condvar; $self->port->write($state); my $w; $w = AnyEvent->timer( after => $time * 0.1, cb => sub { undef $w; $c->send; } ); $c->recv } @timer; } 1;
これらのモジュールを使って動かすスクリプトは簡単で，例えばこんな感じになります．
package main; $a = Morse->new( plain_text => "sos" ); $a->output;
動かしてみると，「ちゃっ，ちゃっ，ちゃっ，ちー，ちー，ちー，ちゃっ，ちゃっ，ちゃっ」とLEDが光ります．
まとめ
当初はAcme::MorseCordeとかってモジュールにしてアップしようと思っていたのですが，連休中に作れなかったので挫折してます．ついでに言うと，Mooseの使い方がいまいちよくわからないので，色々変更した方がいいように思ってます．それから，上のスクリプトは一つのファイルにして動かすように作っています．つまり，以下のようになります．これからの展望としては，LEDの灯りをセンサーで読み込んでそれを文字列に変換するプログラムを作ってみたいんですが，うまい方法をまだ思いついていません．そのうちやってみたいと思っています．ま，その前にArduinoでセンサーを動かしてAD変換する方法を調べないといけないんですよね…
package Converter; use Moose::Role; use namespace::clean -except => 'meta'; requires 'output'; has 'encoding_rule' => ( is => 'rw', isa => 'HashRef[Str]', lazy_build => 1, ); sub _build_encoding_rule { return { A => '[-_---_]', B => '[---_-_-_-_]', C => '[---_-_---_-_]', D => '[---_-_-_]', E => '[-_]', F => '[-_-_---_-_]', G => '[---_---_-_]', H => '[-_-_-_-_]', I => '[-_-_]', J => '[-_---_---_---_]', K => '[---_-_---_]', L => '[-_---_-_-_]', M => '[---_---_]', N => '[---_-_]', O => '[---_---_---_]', P => '[-_---_---_-_]', Q => '[---_---_-_---_]', R => '[-_---_-_]', S => '[-_-_-_]', T => '[---_]', U => '[-_-_---_]', V => '[-_-_-_---_]', W => '[-_---_---_]', X => '[---_-_-_---_]', Y => '[---_-_---_---_]', Z => '[---_---_-_-_]', '.' => '[-_---_-_---_-_---_]', ',' => '[---_---_-_-_---_---_]', '/' => '[---_-_-_-_---_]', ':' => '[---_---_---_-_-_-_]', '\'' => '[-_---_---_---_---_-_]', '-' => '[---_-_-_-_-_---_]', '?' => '[-_-_---_---_-_-_]', '!' => '[-_-_---_---_-_]', '@' => '[-_-_-_---_-_---_]', '+' => '[-_---_-_---_-_]', 0 => '[---_---_---_---_---_]', 1 => '[-_---_---_---_---_]', 2 => '[-_-_---_---_---_]', 3 => '[-_-_-_---_---_]', 4 => '[-_-_-_-_---_]', 5 => '[-_-_-_-_-_]', 6 => '[---_-_-_-_-_]', 7 => '[---_---_-_-_-_]', 8 => '[---_---_---_-_-_]', 9 => '[---_---_---_---_-_]', ' ' => '[__]', }; } sub encode { my $self = shift; my $str = $self->{plain_text}; $str =~ s/(\w)/uc($1)/eg; $str =~ s/(.)/$self->encoding_rule->{$1}/eg; return $str; } 1; package Morse; use Moose; use AnyEvent; use Device::SerialPort; with 'Converter'; has 'plain_text' => ( is => 'rw', isa => 'Str', required => 1, ); has 'morse_code' => ( is => 'rw', isa => 'Str', lazy_build => 1, ); has 'port' => ( is => 'rw', isa => 'Device::SerialPort', default => sub {Device::SerialPort->new("/dev/tty.usbserial-A6008iod")}, ); sub _build_morse_code { my $self = shift; return $self->encode; } __PACKAGE__->meta->make_immutable; no Moose; sub output { my $self = shift; my $str = $self->morse_code; $self->port->baudrate(9600); $self->port->databits(8); $self->port->parity("none"); $str =~ s/[\[\]]/_/sg; $str =~ s/(-+)/I$1E/g; $str =~ s/(-+)/length($1)/eg; $str =~ s/(_+)/O$1E/g; $str =~ s/(_+)/length($1)/eg; my @timer = split /E/, $str; map { my ( $state, $time ) = $_ =~ m/(.)(.)/; my $c = AnyEvent->condvar; $self->port->write($state); my $w; $w = AnyEvent->timer( after => $time * 0.1, cb => sub { undef $w; $c->send; } ); $c->recv } @timer; } 1; package main; $a = Morse->new( plain_text => "sos" ); $a->output;
Arduino面白いですよ．
