桜曲オレオレランキング

bonlifeです。桜が咲き始めましたね!(花粉症がヒドくなってきましたね!) ということで、こんな時期にピッタリの桜ソングたちをbonlife基準で選んでみましたよ!

  1. 「桜の花、舞い上がる道を」 (エレファントカシマシ)
  2. 「さくらの花咲くころ」 (エレクトリックギュインズ)
  3. 「sakura」 (NIRGILIS)

1位はもうブッチギリ。良過ぎて仕方がないです。桜見ただけで泣きそうになる!

2位は2004年からずっとトップに君臨していたギュインズの「さくらの花咲くころ」。チクショー、試聴サイトが見当たらないぜ。と諦めかけましたが、根性検索で発見。コチラ! (サビが聴けないのでアレですね…。)

3位はNIRGILIS。こないだ神戸ZINKですっごいサイン書いてもらったので、また画像アップしますね。そのTシャツ着て名古屋までSAKAE SP-RING 2008を観に行きます!

その他、bonlifeのiTunesライブラリに入ってた春っぽい曲はこちら。(厳しく絞り込んでないので、ノイズも混じってますが、それも「味」ということで。)

Chara Cherry Cherry Cherry Cherry
Chara Cherry Cherry Cherry Cherry (instrumental)
FoZZtone カントリークラブ 春と鉛
FREENOTE オトノハトライアングル サクラノート
HALCALI サイボーグ俺達 春狩道〜19の夜〜
LUNKHEAD 桜日和 桜日和
miniature tripplanet 白鳥座 x-1 サクラ
NIRGILIS BOY sakura
NIRGILIS GIRL sakura (RAM RIDER REMIX)
NIRGILIS sakura sakura
NIRGILIS sakura sakura (cherry blossom)
NIRGILIS sakura sakura (original instrumental)
Syrup16g syrup16g さくら
Syrup16g syrup16g 来週のヒーロー
waffles Orangery 春舞人
WATER WATER CAMEL 花がよくにあう
アンジェラ・アキ サクラ色 サクラ色
エレクトリックギュインズ 幻惑デイズ さくらの花咲くころ
エレクトリックギュインズ 幻惑デイズ さくらの唄
エレファントカシマシ 桜の花、舞い上がる道を 桜の花、舞い上がる道を
エレファントカシマシ 桜の花、舞い上がる道を 桜の花、舞い上がる道を [Instrumental]
カジヒデキ NEW PRETTY SIOUXIE AND THE CHERRY COKES (スージ
キャプテンストライダム わがままチャック CHERRY BOY
サンボマスター サンボマスターは君に語りかける 青春狂騒曲
サンボマスター 音楽の子供はみな歌う 春なんです
サンボマスター 音楽の子供はみな歌う 青春のベル鳴りっぱなし
シガキマサキ 黄昏フリーク 春の色
シーマス 約束の丘
タニザワトモフミ 七色 泣くなと桜
チャットモンチー 女子たちに明日はない 春夏秋
トルネード竜巻 アラートボックス (320k) 春風吹いて
ハンバート ハンバート 11のみじかい話 桜の木の下で
フジファブリック フジファブリック 桜の季節 (Album ver.)
メレンゲ 星の出来事 君に春を思う
夏待ちレスター あの日、僕らは夏だった 泣きながら歩いてた (春夏秋冬)
小谷美紗子 adore 春遠し
残像カフェ あたらしい日々 きみのいる春の景色
残像カフェ あたらしい日々 春を歩く人
残像カフェ めくるめく僕らの毎日 思春期 ON MY MIND
音速ライン 青春色 青春色

iTunesで管理してる曲たちはデフォルトの命名規則に従ってるので、iTunes Music用のフォルダに移動して、以下のPerlワンライナー

perl -MFile::Find -MFile::Basename -e "find(sub {@list = split(qq(/),$File::Find::name); $list[3] =~ s/^\d+\s(.*)\..*$/$1/; printf(qq(|%s|%s|%s|\n),$list[1],$list[2],$list[3]) if (-f $_) && basename($File::Find::name) =~ /cherry|sakura|桜|さくら|サクラ/i;},'.')"

縦棒で区切ってはてなダイアリーに貼り付けやすく。やり方ちょっと微妙かもしれませんが、そこはPerl(に限らず)素人ということでご愛嬌。あ、「チェリー」って単語を検索対象に含めるのを忘れてた!と思って追加するとカタカナの伸ばし棒が [ と解釈されてエラーになる罠。ベターなやり方教えてくれる人、待ってます!
いやぁ、それにしても春ですなぁ。

MD5ハッシュ値を表示するスクリプトサンプル

最近C言語の勉強を始めたbonlifeです。先日、ベンダーから会社で使っているミドルウェアのPatchが送られてきた時、MD5ハッシュ値がメールに記載されていました。今まであまり気にしたことはなかったのですが、せっかくなので、簡単なスクリプトを書いて、確認してみることにしました。得意な言語がないので、色々と試しちゃいましたよ。(ファイルのMD5ハッシュ値を調べることなんて滅多にないとは思いますが…。)

  • Perlのサンプル
#! /usr/local/bin/perl

use strict;
use warnings;

use Digest::MD5 qw(md5 md5_hex);

my @files;

foreach (@ARGV) {
    push @files, glob "$_" ;
}

foreach (@files) {
    eval {
        open (FH, $_) or die "Can't open '$_' : $!";
        binmode(FH);
        print Digest::MD5->new->addfile(*FH)->hexdigest, " : $_\n";
        close(FH);
    };
    if ($@) {
        print "error occured while processing '$_' : $!\n";
    }
}
  • Rubyのサンプル
require 'digest/md5'

ARGV.each {|file|

  begin
    print Digest::MD5.new(File.open(file,'rb').read), " : ", file , "\n"
  rescue
    abort(("error occured while processing '" << file << "' : " << $!))
  end

}
# coding: utf-8
import sys
import glob
import md5

# [参考URL]
# http://white.s151.xrea.com/wiki/index.php?cmd=read&page=memo%2Fpython%2Fmd5

def getMd5(path):
    m = md5.new()
    for f in open(path,'rb'):
        m.update(f)
#    m.update(open(path,'rb').read())
    return m.hexdigest()

for i in range(1,len(sys.argv)):
    for f in glob.glob(sys.argv[i]):
        try:
            print getMd5(f), ":", f
        except:
            print "error occured while processing '" + f + "' :", sys.exc_info()[0]
  • PHPのサンプル
<?php

for ( $i = 1; $i < count($argv) ; $i++ ){
    foreach (glob($argv[$i]) as $file){
        print md5_file($file) . " : $file\n";
    }
}

?>

全て結果は同じになりました!という当たり前の結果にちょっと感動したりして(苦笑)。
PHPコマンドラインで実行するのってやっぱり違和感ありますね。専用の関数があって一番楽なんですけどね。引数の1番目をどう扱うのかが言語によって違ってたりするのを体感できて面白かったです。Pythonだけ(他の人のスクリプトを参考にして)関数を定義していたり、バランスが良くないですが、まぁ、ご愛嬌。
ところで、そもそもMD5ハッシュ値ってどういう意味があるんでしょう。よく、ファイルをダウンロードできるところで、そのファイルのMD5ハッシュ値が記載されてたりしますが、改ざんに対しては無防備ですよね。(ファイル書き換えられるぐらいなら、WEBページも同時に書き換えるでしょうし。)DL途中にファイルが壊れなかったことの確認にはなるかしら。
最後に-Mスイッチでモジュール呼び出してる無理矢理感のあるPerlワイライナーも載せておきます。

perl -MDigest::MD5 -e 'foreach (@ARGV) { open (FH, $_) or die "open \"$_\": $! ";binmode(FH);print Digest::MD5->new->addfile(*FH)->hexdigest, " : $_\n";close(FH); }' filename [filename...]
perl -MDigest::MD5 -e "foreach (@ARGV) { open (FH, $_) or die \"open \'$_\' : $! \";binmode(FH);print Digest::MD5->new->addfile(*FH)->hexdigest, \" : $_\n\";close(FH); }" filename [filename...]

そんなこんなで、ワンライナーの中でシングルクォートを使う方法が分からないbonlifeなのでした。(誰かご存知でしたら教えてくださいませ。)

「初めてのPerl」 17章 (上級テクニック)

お腹が空きました。bonlifeです。体重の増減はほとんどないのですが、筋力が明らかに落ちてます。運動しなきゃ…。ということで、「初めてのPerl」。最終章の17章は「上級テクニック」。「初めて」なのに「上級テクニック」ってところにほのかなエロスの薫り(違)。17章の内容はだいたい以下のような感じです。

  • evalによるエラートラップ ($@にエラーの内容がセットされる)
  • grepを使ってリストから要素を選び出す
  • mapを使ってリストを変換する
  • クォートなしのハッシュキー
  • より強力な正規表現
    • 欲ばりでない量指定子 (パターンの後に?)
    • 複数行のテキストに対するマッチ (m正規表現オプション)
  • スライス (配列スライスやハッシュスライス)

grepやmap、スライスは自由自在に使いこなせるようになりたいですね。すごく便利そうですし。正規表現についてはフクロウ本の方が遥かに詳しいですね。(当たり前ですが。)特にビックリするような内容もなかったので、練習問題のbonlife的(not 模範)解答例です。
ex17-1.pl

  • ファイルから文字列のリストを読み込み、ユーザがキーボードから対話的に入力したパターンに文字列をマッチさせる、という処理を繰り返す
  • 入力されたパターンがファイルに入っていた文字列何個にマッチしたか、および実際にマッチした文字列を表示
  • パターンを新たに入力するたびにファイルを読み直すというやり方はしない (すべての文字列をメモリ上の変数に保存)
  • パターンが正しくなければ、そのエラーを報告してから、ユーザに再びパターンを入力してもらうようにする
  • ユーザがパターンの代わりに空行を入力したら、プログラムが終了するようにする
#! perl
use strict;
use warnings;

if ($#ARGV +1 != 1 ){
    print "Please set one file name to the argument.\n";
    exit 1;
}

my $file = $ARGV[0];
my @contents;
if ( -f $file ) {
    open (IN, "$file");
    while (<IN>) {
       push @contents, $_;
    }
    close(IN);
} else {
    print "'$file' is not a readable file.\n";
    exit 1;
}
while (1){
    print "-" x 60, "\n" ;
    print "Please input some string : ";
    chomp(my $input = <STDIN>);
    if ( $input =~ /^\s*$/ ){
        print "-" x 60, "\n" ;
        print "Bye!\n";
        print "-" x 60, "\n" ;
        exit;
    }
    my @found;
    eval {
        foreach my $line (@contents) {
            if ( $line =~ /$input/ ){
                push @found, $line;
            }
        }
        my $found_number = $#found + 1;
        print "-" x 60, "\n" ;
        print "INF : '$found_number' found.\n";
        foreach (@found){
            print $_;
        }
    };
    if ($@) {
        print "-" x 60, "\n" ;
        print "ERR : An error occured ($@), continuing\n";
    }

}

出力結果は以下の通り。

C:\test\perl>ex17-1.pl sample_text
------------------------------------------------------------
Please input some string : test
------------------------------------------------------------
INF : '0' found.
------------------------------------------------------------
Please input some string : here
------------------------------------------------------------
INF : '5' found.
you and fred can sneak over there."
bring it with us. where do you keep it?"
"fred, where do you keep your bowling ball? is it in the garage?"
heard someone named barney on the line. but there is no one named
barney here. no barney at all. put that bowling ball down,
------------------------------------------------------------
Please input some string : \bask(ed)?
------------------------------------------------------------
INF : '5' found.
wilma saw this and said to betty, "you should ask barney to take
"what are we going to do for tonight?" betty asked. "wilma wants
bathroom. "what color is it?" she asked.
wilma answered the phone. "hello?" she asked.
"barney, is that you?" she asked the phone.
------------------------------------------------------------
Please input some string : (i|you
------------------------------------------------------------
ERR : An error occured (Unmatched ( in regex; marked by <-- HERE in m/( <-- HERE
 i|you/ at C:\test\perl\ex17-1.pl line 35, <STDIN> line 5.
), continuing
------------------------------------------------------------
Please input some string : want
------------------------------------------------------------
INF : '4' found.
"do you want to bring pebbles and bamm-bamm along?"
out bowling every night this week. betty and i want to go to the
romantic vacation on the rock of gibraltar. i want to win that
"what are we going to do for tonight?" betty asked. "wilma wants
------------------------------------------------------------
Please input some string :
------------------------------------------------------------
Bye!
------------------------------------------------------------

解答例を見て気づいたことは以下の通り。

  • 変数(というより配列)への値の格納はファイルハンドルの代入だけで簡単行える
  • 行の末尾の改行はchompで取り除いておいた方が良い
  • パターンにマッチする行を取り出す際、foreachで1行ずつチェックするのではなく、grepを使う

while (1)を使うあたりは良い感じでしたが、この章の上級テクニックの1つであるgrepを使わなかったので失格ですね…。なんか変だなぁ、とは思ってたんですが、またもや無理やり書いてしまいました。もうちょっと簡単に書けそうだな、と思うところはだいたいスマートな書き方がありますね。最初のうちは時間かかってもスマートかつ分かりやすい書き方を心がけていこうと思います。
ということで、ようやく「初めてのPerl」、読了です!練習問題も全て解きました。ふぅ。引き続き「続・初めてのPerl」もコツコツやっていこうと思いますので、細々と応援よろしくお願いします。

「初めてのPerl」 16章 (単純なデータベース)

2007年の手帳はほぼ日手帳2007で良いかなぁ、と思っているbonlifeです。流行に踊らされたいです。「1日教養、1日休養」ということでお勉強、お勉強です。「初めてのPerl」の16章は「単純なデータベース」。RDBMSとかじゃなく、DBMですね。16章の内容はだいたい以下のような感じです。

  • DBMハッシュのオープン、クローズ (dbmopen, dbmclose)
  • DBMハッシュを使う (スキャンする時はeach関数使った方が良い)
  • packとunpackを使ってデータを加工
  • 固定長ランダムアクセスデータベース (seek, read)
  • 可変長(テキスト)データベース
  • コマンドラインから書き戻し編集 (-e, -p)

要するにハッシュをファイルに保存するってことですかね。なんか違うのかな。操作自体は特に難しくなさそうです。ということで早速練習問題のbonlife的(not 模範)解答例です。
ex16-1.pl

  • perlfunc.podファイルを読んで、その中から=item行に置かれている識別子名を探し出すプログラムを書く
  • 各識別子が登場する最初の行番号を記録したデータベースを作成する
  • 特殊変数$.には最後に入力した行の行番号が入っている
#! perl
use strict;
use warnings;

@ARGV = `perldoc -l perlfunc`;
dbmopen(my %DATA, "perlfunc_database", 0644)
  or die "Cannot create perlfunc_database : $!";
while (<>) {
    if ( /=item (.*?)\s/ ) {
        if (! defined $DATA{"$1"}) {
            $DATA{"$1"} = $. ;
        }
    }
}
#foreach my $key (keys %DATA) {
#    print "$key appears in the $DATA{$key} line.\n";
#}

dbmclose(%DATA);

出力結果はなし。解答例を見て気づいたことは以下の通り。

  • ファイルは@ARGV使って無理やりダイヤモンド演算子で読み込むよりも、ちゃんとファイルハンドラを使った方が良いような
  • 正規表現が雑過ぎる (^は必要)
  • %DATAの初期化(空にすること)を行っていない
  • definedを使う判定ではなく、||を使って前から順に評価することで「最初の行番号」の取得が可能
  • 処理完了後のメッセージがあった方が良い

簡単そう!と思って適当に書いた感丸出しです(恥)。4点目の || を使って前の処理が false の時のみ後ろの処理を実行する、みたいなのはかなりPerlっぽいですよね。このあたりを使いこなせるようになりたいです。そんなこんなで、2問目。
ex16-2.pl

  • コマンドラインからPerl関数の名前を1個受け取って、perlfunc.podファイルの中でその関数が最初に現れる=item行の行番号を表示するプログラムを書く
#! perl
use strict;
use warnings;

if ($#ARGV +1 != 1 ){
    print "Please set one function name to the argument.\n";
    exit 1;
}

dbmopen(my %DATA, "perlfunc_database", 0644)
  or die "Cannot open perlfunc_database : $!";

if ( defined $DATA{$ARGV[0]} ) {
    print "'$ARGV[0]' appears $DATA{$ARGV[0]} line firstly.\n";
} else {
    print "Function '$ARGV[0]' doesn't exist.\n";
}

dbmclose(%DATA);

出力結果は以下の通り。

ex16-2.pl shift
'shift' appears 4812 line firstly.
ex16-2.pl shifto
Function 'shifto' doesn't exist.

解答例を見て気づいたことは以下の通り。

  • このプログラムはデータベースが存在しなければ動作しないので、dbmopenの第3パラメータにはundefを指定した方が良い
  • || を使ってハッシュに値がある場合とない場合のメッセージを分けると格好良い

なるほど、といったところですね。(やっぱり || は使いこなしたい!)続いて、3問目。
ex16-3.pl

  • 問題2のプログラムを改造して、データベースから関数を見つけたら、ページャプログラムを起動して、perlfunc.podファイルのその行を見られるようにする
  • less +1234 filename のように起動するとそのファイルの1234行目を見ることができる
#! perl
use strict;
use warnings;

if ($#ARGV +1 != 1 ){
    print "Please set one function name to the argument.\n";
    exit 1;
}

my $file = `perldoc -l perlfunc`;

dbmopen(my %DATA, "perlfunc_database", 0644)
  or die "Cannot open perlfunc_database : $!";

if ( defined $DATA{$ARGV[0]} ) {
    my $start_line = $DATA{$ARGV[0]} - 1 ;
#    exec 'more', "+${start_line}", $file;
    system "more +${start_line} $file";
} else {
    print "Function '$ARGV[0]' doesn't exist.\n";
}

dbmclose(%DATA);

出力結果は以下の通り。

ex16-3.pl shift
=item shift ARRAY
X<shift>

=item shift
(中略)
^CTerminating on signal SIGINT(2)

なぜかexecを使うとmoreの動きがおかしかったので、systemを使いました。その結果、Ctrl+Cで終了したので、SIGINT(2)で終わってます。解答例を見て気づいたことは以下の通り。

  • ページャを起動する部分にも or die を書いた方が良い
  • execを使っている
  • ページャに渡す行番号はデータベースで見つかった行番号 (DOSコマンドのmoreの場合、データベースに格納した行番号をそのまま渡すと =item の次の行から表示されてしまったので、-1 してしまいました)

素直にUNIX(というよりLinux)環境でやった方が良い気がずーっとしてますが、まぁ、そこは気にしない方向で。時間はかかりましたが、なんとかここまでやってきました。残すは17章のみ。一気に片付けます!

「初めてのPerl」 15章 (文字列処理とソート)

1月25日にOSAKA MUSEで行われるAPOGEEのワンマンライヴの日は会社を休んでやろう!と思ってスケジュールを確認したら、Oracleの研修を受ける予定になってました…。この間、両親が大阪、京都を訪問する時期と重なってしまったのでOracleの研修は延期した(というより申し込まなかった)んだよなぁ…。研修後に行っても普通に観れるかしら。などとすっかりAPOGEEモードのbonlifeです。とりあえず、11月27日は定時退社して2nd LINEへ!
そんなこんなでPerlのお勉強です。「初めてのPerl」の15章は「文字列処理とソート」。15章の内容はだいたい以下のような感じです。

  • index (部分文字列の位置を返す)
  • substr (部分文字列をいじる)
  • sprintf (フォーマットした文字列を変数にしまったり)
  • 高度なソート (ハッシュを値でソートしたり、複数のキーでソートしたり)

このあたりは比較的とっつきやすい内容ですね。ハッシュのソートは慣れないとちょっと難しい気がしますが、なんとかなりそうです。ということで練習問題のbonlife的(not 模範)解答例です。
ex15-1.pl

  • 数値のリストを読み込んで、それを数値としてソートした上で、右寄せで表示するプログラムを書く
  • numbersというファイルを使う (内容は以下の通り)
17 1000 04 1.50 3.14159
-10 1.5 4 2001 90210 666
9 0 2 1 0
2001 42 -40 98.6 2.71828
#! perl
use strict;
use warnings;

my @num_list;
while (<>) {
    chomp;
    push @num_list, split(/\s/,$_);
}
foreach (sort { $a <=> $b } @num_list) {
    printf "%20s\n", $_;
}

出力結果は以下の通り。

ex15-1.pl numbers
                 -40
                 -10
                   0
                   0
                   1
                1.50
                 1.5
                   2
             2.71828
             3.14159
                  04
                   4
                   9
                  17
                  42
                98.6
                 666
                1000
                2001
                2001
               90210

解答例を見て気づいたことは以下の通り。

  • splitはデフォルトでスペースで区切ってくれるので、 $_ を処理するのであれば split だけで十分
  • printfのフォーマット指定で s ではなく、 g でも良い (その場合、前ゼロや小数部の末尾ののゼロが消える)

考え方は合ってましたが、細かい部分の書き方がまだまだダサいですね。こざっぱりしたコードを書けるようになりたいです。続いて2問目。
ex15-2.pl

  • ハッシュのデータを、姓のアルファベット順(大文字と小文字は区別しない)でソートして表示するプログラムを書く
  • 姓が同じ場合には、名(大文字と小文字は区別しない)でソート
#! perl
use strict;
use warnings;

my %last_name = qw{ 
	fred flintstone Wilma Flintstone Barney Rubble
	betty rubble Bamm-Bamm Rubble PEBBLES FLINTSTONE
};

my @keys = sort {
    "\L$last_name{$a}" cmp "\L$last_name{$b}" or
    "\L$a"             cmp "\L$b"
} keys %last_name;
foreach my $key (@keys) {
    printf "%-10s %-10s\n",$key ,$last_name{$key};
}

出力結果は以下の通り。

ex15-2.pl
fred       flintstone
PEBBLES    FLINTSTONE
Wilma      Flintstone
Bamm-Bamm  Rubble
Barney     Rubble
betty      rubble

解答例を見て気づいたことは特になし。ほぼ同じでした。続いて3問目。
ex15-3.pl

  • ユーザから与えられた文字列の中から、与えられた部分文字列が現れる場所をすべて探し出して、その位置を表示するプログラムを書く
#! perl
use strict;
use warnings;

print "Please input some string      : ";
chomp (my $value = <STDIN>);
print "Please input some part string : ";
chomp (my $part  = <STDIN>);

my $where = index($value, $part);
my @position;

while ($where != -1) {
    push @position, $where;
    $where = index($value, $part,$where + 1);
}

if (@position) {
    print "Matched position(s) : @position\n";
} else {
    print "Not matched.\n";
}

出力結果は以下の通り。

ex15-3.pl
Please input some string      : This is a test.
Please input some part string : t
Matched position(s) : 10 13

解答例を見て気づいたことは以下の通り。

  • $whereがwhileループの外に出てしまっているのはスコープの面であまりよくなさそう
  • forループに初期値だけ与えて、lastを使ってループを抜けるとスッキリ
  • while(1)などを使っても良い

$whereの使い方がイマイチだなぁ、と思っていたら、なるほどな解説でしたよ。勉強になります。(最初、indexが3つ目の引数取れることを忘れていて、substrで文字列を切り取ったりするコードを書きかけていたのは秘密です。)
いよいよ「初めてのPerl」の終わりが近づいてきましたよ。あと2章!今週中には終わらせられそうです。細々と頑張りますよっ。

「初めてのPerl」 14章 (プロセス管理)

APOGEEの『Fantastic』を爆音で聴きながらPerlの勉強をしているbonlifeです。いやぁ、このアルバムは凄い。という話はまた後日。「初めてのPerl」の14章は「プロセス管理」。14章の内容はだいたい以下のような感じです。

  • system関数 (子プロセスを起動)
  • exec関数 (Perlプロセス自身がジャンプする感じ)
  • 逆クォートを使った出力の取り込み
  • パイプオープン (プロセスをファイルハンドルとして使う)
  • fork (詳細は別の本で学んで状態)
  • シグナルの送受信

なんだか結構難しいじゃないの。結構OS寄りの低レベルな内容ですね。forkは何度か見たことがある気がするので、次に見かけた時にちゃんと勉強することにして、今回はスルー。そんなこんなで早速練習問題のbonlife的(not 模範)解答例です。
ex14-1.pl

#! perl
use strict;
use warnings;

my $dir = 'C:\test';
chdir $dir or die "Can't chdir to $dir : $!\n";
system "dir";

出力結果は省略。解答例を見て気づいたことは以下の通り。

  • 解答例ではexecを使用 (Perlのプロセスに戻る必要がないので、execなのかしら)
  • execの行にも or die を書いておいた方が良い

手を抜かずにちゃんとLinux立ち上げてやった方が良い気がしてきましたが、もう14章まできちゃったので、意地でWindows上のActivePerlで頑張ります。続いて2問目。
ex14-2.pl

  • 問題1のプログラムを改造して、コマンドの出力をカレントディレクトリの ls.out というファイルに書き出すようにする
  • エラー出力は、 ls.err というファイルに出力する
#! perl
use strict;
use warnings;

my $dir = 'C:\test';
chdir $dir or warn "Can't chdir to $dir : $!\n";
my $dir_list = `(dir > ls.dat) 2> ls.err`;
print $dir_list;

出力結果は省略。解答例を見て気づいたことは以下の通り。

  • 豪快に間違えました (ファイルの出力がカレントディレクトリじゃない!)
  • 出力は STDOUT、 STDERR を open して行う

なんとまぁ、お恥ずかしい。chdirしたところにファイル出力しちゃってました。気を取り直して3問目。
ex14-3.pl

  • dateコマンドの出力を解析して、今日が何曜日か調べるプログラムを書く
  • ウィークデーなら get to work、そうでなければ go play と表示する
  • Unix以外のシステムを使っていて、dateコマンドが用意されていない場合には、以下のプログラムを使う
#!/usr/bin/perl
print localtime() . "\n";

私は上記のプログラムを date.pl として保存して活用しました。

#! perl
use strict;
use warnings;

if ( `date.pl` =~ /^(Sat|Sun)/) {
    print "go play\n";
} else {
    print "get to work\n";
}

出力結果は省略。解答例を見て気づいたことは以下の通り。

  • 頭文字が S かどうかだけでウィークデーでない曜日は特定できる (そのやり方がベターだとは限らない)

なるほどなるほどです。バッククォートでの出力取り込みを上手いこと使えば色々なUnixコマンドや既存のツールと連携した簡易ツールをお手軽に作れそうですね。そもそもPerl勉強し始めた動機がAIX環境でシェルより便利に簡易ツールを作るためだったことを思い出しました。ただ、どんなツールを作りたかったのかは思い出せない罠…。ま、その程度の動機だったので、このぐらいのペースでしか勉強が捗らないわけです。と開き直ることなく、コツコツと勉強してみます。

「初めてのPerl」 13章 (ファイルとディレクトリの取り扱い)

「総集編 GANTZ the 1000 Vol.1」を買って読んでみたbonlifeです。1048ページで800円。やっぱりGANTZは良いね。
ということで、お久しぶりのPerlです。「初めてのPerl」の13章は「ファイルとディレクトリの取り扱い」。13章の内容はだいたい以下のような感じです。

  • ファイルの削除 (unlink)
  • ファイルの名前を変更 (rename)
  • リンク (link, symlink)
  • ディレクトリの作成と削除 (mkdir, rmdir)
  • パーミッションの変更 (chmod)
  • ファイルのオーナーの変更 (chown)
  • タイムスタンプの変更 (utime)
  • 単純なモジュールの利用
    • File::Basenameモジュール
    • File::Specモジュール

こういうのって慣れてるせいか「シェルで書いた方が簡単!」とか思ってしまいましたよ。でも、コマンド名もほとんど同じですし、特に難しい部分はなかったかな。モジュールの使い方はちゃんとマスターしたいですね。というわけで、早速練習問題のbonlife的(not 模範)解答例です。
ex13-1.pl

  • rmと同じ働きをするプログラムを書く
  • コマンドラインに指定したすべてのファイルを削除
  • rmのオプションを扱う必要はない
#! perl
use strict;
use warnings;

my @files;
foreach (@ARGV) {
    push @files, glob "$_" ;
}
foreach my $file (@files) {
    my $successful = unlink $file;
    if ( $successful != 0 ){
        print "I deleted \"$file\".\n";
    } else {
        print "I couldn't delete \"$file\". : $!\n";
    }
}

出力結果は以下の通り。

ex13-1.pl *.dat aaa bbb
I deleted "a.dat".
I deleted "b.dat".
I deleted "c.dat".
I deleted "aaa".
I couldn't delete "bbb". : No such file or directory

解答例を見て気づいたことは以下の通り。

  • もっとシンプルに解く
  • globは意識しなくて良かったっぽい

解答例があまりにもシンプルでビックリでしたよ。ということで、続いて2問目。
ex13-2.pl

  • mvと同じ働きをするプログラムを書く
  • 1番目のコマンドライン引数で指定したファイルを2番目のコマンドライン引数で指定した名前にリネーム
  • 2番目の引数にはディレクトリも指定できるようにし、その場合、新しいディレクトリの中で、リネームする前と同じベース名を持つようにする
  • mvのオプションや3個以上の引数を扱う必要はない
#! perl
use strict;
use warnings;
use File::Basename qw(basename);
use File::Spec;

if ( $#ARGV + 1 != 2 ) {
    print "Please input 2 arguments.\n";
    exit 1;
}

my $org_name, my $new_name;
$org_name = $ARGV[0];
$new_name = $ARGV[1];

if ( -d $new_name ){
    my $basename = basename $org_name;
    my $new_name = File::Spec->catfile($new_name, $basename);
    rename $org_name, $new_name or warn "can't rename $org_name to $new_name : $!\n";
} else {
    rename $org_name, $new_name or warn "can't rename $org_name to $new_name : $!\n";
}

出力結果は特にないので省略。解答例を見て気づいたことは以下の通り。

  • 引数のチェックは不要
  • 一行で引数をまとめて変数に代入した方が格好良い
  • renameの行は共通なので、if文の外に出せる

ソース書きながら、なんとなく同じようなことをどこかで書いてしまっている気がしましたが、あらためて見るとrenameコマンドがある2行は全く同じでした…。続いて、3問目。
ex13-3.pl

  • lnと同じ働きをするプログラムを書く
  • 1番目のコマンドライン引数に対して、2番目の引数で指定した名前を持ったハードリンクを作成
  • lnのオプションや3個以上の引数を扱う必要はない
#! perl
use strict;
use warnings;
use File::Basename qw(basename);
use File::Spec;

if ( $#ARGV + 1 != 2 ) {
    print "Please input 2 arguments.\n";
    exit 1;
}

my $org_name, my $link_name;
$org_name  = $ARGV[0];
$link_name = $ARGV[1];

if ( -d $link_name ){
    my $basename  = basename $org_name;
    my $link_name = File::Spec->catfile($link_name, $basename);
    link $org_name, $link_name or warn "can't link $org_name to $link_name : $!\n";
} else {
    link $org_name, $link_name or warn "can't link $org_name to $link_name : $!\n";
}

出力結果は特にないので省略。解答例を見て気づいたことは2問目と同じなので省略。4問目。
ex13-4.pl

  • 問題3のプログラムを改造して、引数の前に-sスイッチを指定した場合、ハードリンクの代わりにシンボリックリンクを作成するようにする
#! perl
use strict;
use warnings;
use File::Basename qw(basename);
use File::Spec;
use Getopt::Std;

our($opt_s);
getopts('s');

if ( $#ARGV + 1 != 2 ) {
    print "Please input 2 arguments.\n";
    exit 1;
}

my $org_name, my $link_name;
$org_name  = $ARGV[0];
$link_name = $ARGV[1];

if ($opt_s){
    if ( -d $link_name ){
        my $basename  = basename $org_name;
        my $link_name = File::Spec->catfile($link_name, $basename);
        symlink $org_name, $link_name or warn "can't symlink $org_name to $link_name : $!\n";
    } else {
        symlink $org_name, $link_name or warn "can't symlink $org_name to $link_name : $!\n";
    }
} else {
    if ( -d $link_name ){
        my $basename = basename $org_name;
        my $link_name = File::Spec->catfile($link_name, $basename);
        link $org_name, $link_name or warn "can't link $org_name to $link_name : $!\n";
    } else {
        link $org_name, $link_name or warn "can't link $org_name to $link_name : $!\n";
    }
}

出力結果は以下の通り。

ex13-4.pl -s a.dat b.dat
The symlink function is unimplemented at C:\test\perl\ex13\ex13-4.pl line 26.

あらまぁ。やはりWindows(のActivePerl)ではsymlinkは使えませんでしたか。
解答例を見て気づいたことは以下の通り。

  • オプションが1つぐらいだったら第1引数である$ARGV[0]をチェックすれば良い
  • 2つ目の引数がディレクトリかどうかによって処理を分ける部分は、-sの有無に関係なく共通なので、if文の外に出すべき (if文のネストが不要)

やはり、自分で書いてて「あー、なんか無駄に長い気がする。」と思ったところは解答例では短くなってますね。勉強になります。そして、ラストの5問目。
ex13-5.pl

#! perl
use strict;
use warnings;

my @files;
@files = glob "* .*";
foreach my $file (@files){
    if (-l $file){
        my $where = readlink $file;
        printf "%-20s -> %-20s\n", $file, $where;
    }
}

出力結果はなし。(そもそもシンボリックリンク自体がないので。)解答例を見て気づいたことは以下の通り。

  • globで取得した配列を渡すのではなく、foreachに直接globを渡してしまった方がスッキリ
  • シンボリックリンクかどうかのチェックをせず、readlinkの結果、$whereに値がセットされたかどうかをdefinedで確認するとシンプル

なるほど、としか言いようがありませんね。readlinkの結果によって表示するかどうかを制御すれば良かったなんて。早くこういうのをパッと思いつくようになりたいです。
ちなみに最近では「初めてのPerl」の問題は解ききってませんが、「続・初めてのPerl」読んでます。分かったような気になったり、ならなかったりする日々です。

続・初めてのPerl - Perlオブジェクト、リファレンス、モジュール

続・初めてのPerl - Perlオブジェクト、リファレンス、モジュール