（作成：2005/10）
定数・変数・値
多次元配列の初期化
こんな感じに、参照渡しをしてやるのが楽ちん。勿論 @hoge0 、 @hoge1 は改変しない事前提。
my @hoge;
my @hoge0 = (7, 14, 21, 28, 35, 42, 43, 36, 29, 22,
23, 24, 31, 30, 37, 38, 39, 40, 41, 0);
my @hoge1 = (1, 2, 3, 4, 5, 6, 13, 12, 11, 10,
9, 16, 17, 18, 19, 20, 27, 34, 41, 0);
@hoge = (\@hoge0, \@hoge1);
Perlスクリプト / シェルスクリプト共用設定
機械的な処理をスクリプトで済ます場合、Perlスクリプトは文字列処理に特化してるし、シェルスクリプトはコマンド実行処理に特化してるんで、結構Perlスクリプトとシェルスクリプトを共用する場合は多いと思う。それでも共通に用いたい設定内容は結構あるので、例えば以下のようなPerlスクリプトに共通設定を定義するのは如何かなと。
## Setting.pm ##
package setting;
use strict;
## 各種設定
##################################################
use constant PARAM_1 => "hoge fuga";
use constant PARAM_2 => 40;
use constant ARRAY_1 =>
{ 0 => [0, 1, 2, 3, 4, 5, 6, 7],
1 => [8, 9, 10, 11, 12, 13, 14, 15] };
...
1;
#!/bin/perl
## callSet.pl ##
use strict;
use lib "$ENV{HOME}/program/";
use Setting;
##################################
## コマンドライン呼出
eval("print Setting::".$ARGV[0]);
exit 0;
Perlスクリプト側では直接Setting.pmを読込めば良い。具体的にはこんな感じで使える。
#!/bin/perl
## test.pl ##
use strict;
use lib "$ENV{'HOME'}/program/";
use Setting;
## 共通設定読込
my $param1 = Setting::PARAM_1;
my $param2 = Setting::PARAM_2;
my $array1 = Setting::ARRAY_1;
my $ptn = 0; my $idx = 0;
my $arr = ();
while((my $dat = $array1->{0}[$idx]) ne '') {
push($arr, $dat);
$idx++;
}
...
sh側ではcallSet.plを介してデータを取得する。具体的にはこんな感じ。文字列ならダブルクォートで囲むこと。
#!/bin/bash
## test.sh ##
BIN=$HOME"/Research/Develop/research_bin/"
CALLSET=$BIN"callSet.pl"
## 共通設定読込
$param1="`$CALLSET param1`"
$param2=`$CALLSET param2`
...
入出力
Javaで作成したバイナリデータの読込
Javaで作成した、と断ってはいるけれど、他のプログラミング言語で作成したものでも、データサイズ等の約束事さえ守っていれば大して変わんないと思う。
何はともあれ、以下のようなPerlModuleを作ってみた。
ReadBinary.pm（長いので折り畳み）
# @file ReadBinary.pm
# @author Riyo
# @date September 22, 2005 16:03:08
#
# @brief バイナリファイル読込モジュール
#
# Last Modified: September 23, 2005 16:18:55 edited.
### ReadBinaryクラス
package ReadBinary;
########## Don't touch! ##########
use constant TRUE => 1; ## Flags
use constant FALSE => 0;
##################################
# コンストラクタ
#
sub new {
my $this = shift;
## ハッシュリファレンス生成
my $hash = bless { "fh" => shift,
"fname" => shift,
"eof_flag" => FALSE,
}, $this;
$this->openBinary($hash->{fh}, $hash->{fname});
return $hash;
}
# バイナリファイルのオープン
#
# @param fname ファイル名
sub openBinary {
my $this = shift;
local ($fh, $fname) = @_;
## ファイル存在チェック
if(!-e $fname || !-f $fname) {
die "File '$fname' not found or illegal file.";
}
## バイナリチェック
elsif(!-B $fname) {
die "File '$fname' isn't Binary.";
}
## ファイルオープンチェック
if(!open($fh, $fname)) {
die "File open error.";
}
binmode($fh);
seek($fh, 0, 0);
}
sub eofBinary {
my $this = shift;
return $this->{eof_flag};
}
# バイナリファイルのクローズ
#
sub closeBinary {
my $this = shift;
close($this->{fh});
}
# 文字読込
#
# @return 文字
sub readChar {
my $this = shift;
my $tmp;
my $char = "";
## 例外
if($this->{eof_flag} == TRUE) { die "over EOF."; }
## データ取得
if(sysread($this->{fh}, $tmp, 2) == undef) {
$this->{eof_flag} = TRUE;
return;
}
## 1バイト文字チェック
my $hex = unpack("h*", $tmp);
if($hex =~ /^00/) {
## 一端packし直すことで1バイトにする
$hex = substr($hex, 2);
$char = unpack("A*", pack("h*", $hex));
}
else {
$char = unpack("A*", $tmp);
}
return $char;
}
# 文字列読込
#
# @param length 文字列長(ASCII)
#
# @return 文字列
sub readString {
my $this = shift;
local ($length) = @_;
my $str = "";
for(my $i = 0;$i < $length;$i++) {
$str .= $this->readChar();
}
return $str;
}
# Byteデータ読込
#
# @param flag 符号フラグ(TRUE : 符号付 / FALSE : 符号無)
#
# @return Byteデータ
sub readByte {
my $this = shift;
local ($flag) = @_;
my $tmp;
## 例外
if($this->{eof_flag} == TRUE) { die "over EOF."; }
## 符号判定
$code = ($flag == FALSE) ? "C" : "c";
## データ取得
if(sysread($this->{fh}, $tmp, 1) == undef) {
$this->{eof_flag} = TRUE;
return;
}
return unpack($code, reverse($tmp));
}
# Shortデータ読込
#
# @param flag 符号フラグ(TRUE : 符号付 / FALSE : 符号無)
#
# @return Shortデータ
sub readShort {
my $this = shift;
local ($flag) = @_;
my $tmp;
## 例外
if($this->{eof_flag} == TRUE) { die "over EOF."; }
## 符号判定
$code = ($flag == FALSE) ? "S" : "s";
## データ取得
if(sysread($this->{fh}, $tmp, 2) == undef) {
$this->{eof_flag} = TRUE;
return;
}
return unpack($code, reverse($tmp));
}
# Integerデータ読込
#
# @param flag 符号フラグ(TRUE : 符号付 / FALSE : 符号無)
#
# @return Integerデータ
sub readInt {
my $this = shift;
local ($flag) = @_;
my $tmp;
## 例外
if($this->{eof_flag} == TRUE) { die "over EOF."; }
$code = ($flag == FALSE) ? "I" : "i";
## データ取得
if(sysread($this->{fh}, $tmp, 4) == undef) {
$this->{eof_flag} = TRUE;
return;
}
return unpack($code, reverse($tmp));
}
# Floatデータ読込
#
# @return Floatデータ
sub readFloat {
my $this = shift;
my $tmp;
## 例外
if($this->{eof_flag} == TRUE) { die "over EOF."; }
## データ取得
if(sysread($this->{fh}, $tmp, 4) == undef) {
$this->{eof_flag} = TRUE;
return;
}
return unpack("f", reverse($tmp));
}
# Doubleデータ読込
#
# @return Doubleデータ
sub readDouble {
my $this = shift;
my $tmp;
## 例外
if($this->{eof_flag} == TRUE) { die "over EOF."; }
## データ取得
if(sysread($this->{fh}, $tmp, 8) == undef) {
$this->{eof_flag} = TRUE;
return;
}
return unpack("d", reverse($tmp));
}
1;
最初ちょっと困ったのが、 Int や Double のデータを読込む際にバイナリ pack を reverse しなけりゃいかんかった事。16進表記を見て気付いた事なんだけど、何でかなぁ。ファイル読み書き方法がスタックなのかな。
今度は拙サイト「Java雑記 - バイナリファイル入出力」で作ったバイナリデータを読み込んでみる。例外処理も入れてみたので、 eval{} で die をキャッチ。
Java雑記
（作成：2005/09）
入出力
なかなか面白い事を言うサイトを見付けて印象に残ったこと（アドレス忘却。。。失礼）。使い方も様々ではあ...
riyo10.s1003.xrea.com
#! /usr/bin/perl
## test.pl ##
### Testクラス
package Test;
########## Don't touch! ##########
use constant TRUE => 1; ## Flags
use constant FALSE => 0;
##################################
use lib "$ENV{HOME}/Program/";
use ReadBinary;
# コンストラクタ
#
sub new {
my $this = shift;
my (@foo) = @_;
## ハッシュリファレンス生成
my $hash = bless {
}, $this;
return $hash;
}
# メイン関数
#
sub main {
my $this = shift;
local (@array) = @_;
eval {
my $rBin = ReadBinary->new('DAT', "bin.dat");
print $rBin->readString(3)."\n";
for($i = 0;$i < 3;$i++) {
print $rBin->readDouble()."\n";
print $rBin->readInt(0)."\n";
}
$rBin->closeBinary();
};
## 例外処理
if($@) {
print $@."\n";
exit -1;
}
return 0;
}
$class = Test->new();
$class->main();
exit 0;
test.plの実行結果はこんな感じ。
$ ./test.pl
DAT
0.10375824386834
1
2.33947852193202
14
1.79769313486232e+308
2147483647
なかなか良い感じですな。
まだ他のデータ型について作ってないので、弄ってみるのも面白いかも。
文字列操作
ごく簡単なHTMLタグ削除法
あんまし複雑なHTMLタグ削除が要らない場合。例えばFORM入力文字列のチェックなんかにはこんな程度の削除機構で良いんじゃなかろーか。
$original = "<center><font size='10'>★ <我が家の献立> ★</font></center><br>".
"<hr width='75%'>".
"<p>最近は専ら芋ばかり。<img src='imo.jpg'></p>";
$str = $original;
$str =~ s/<\/?(hr|br|center|font|img|p)( +[^>]*|)>/ /gi
print $str."\n";
$ test.pl
★ <我が家の献立> ★ 最近は専ら芋ばかり。
<> 括弧があれば何も考えず削除したいなら、正規表現の (hr|br|center|font|img|p) の部分をざっくり消しちゃえば良い。
トークン切り出し
要するに strtok() みたいな事をするにはどうしたら良いか。
$original = "perl - Practical Extraction and Report Language";
$str = " ".$original;
while($str ne "") {
if($str =~ /\s+(\S+).*/) {
$tok = $1;
}
print $tok."\n";
$str =~ s/\s+\S+//;
}
簡単に作るとこんな感じ。スペース区切りなら「スペース+文字列」を1トークンとして、文字列が無くなるまでトークン切り出し+トークン削除すれば良い。だから文字列の頭にスペースを1個加えている。
プログラム書くうえでこういう事すると「最初の切り出しだけ別にした方が良い」と嫌がる人も居るけれど、正直、以下のような理由でケースバイケースだと思うね。
- 最初の切り出しを別にする
- データを改変しないので故意のデータクラッシュは無くせる
- 下手に似たような別処理を加えるとバグを盛り込む可能性がある
- 同一処理で全て切り出す
- 処理は一通りなのでデバグが容易
- 複雑な切り出しの場合下手にデータを修正するとクラッシュさせる可能性がある
ごく簡単な処理でデータ修正に因る問題も予想の範疇と思われる場合、ウチは後者の書き方もアリかなーと思うがどうか。
因みに、恐らく一番一般的な方法は以下（ぉ
$original = "perl - Practical Extraction and Report Language";
@array = split(/ /, $original);
foreach $tok (@array) {
print $tok."\n";
}