4. スクリプトを改造（2）
サブルーチンについて説明しようと思ったけれど、実は自分はナニも知らない
と気がついて愕然。
しかしまぁ、いい加減さと変わり身の速さだけが取り柄なので立ち直りは早い。。
要するに、、サブでしょ。サブ。
サブルーチンを実行するときには、普通アタマに & をつけます。引数あれば
( ) 内に。
実行する場所より前にサブルーチンを置いた場合はナニも付けなくてもいいのですが、別に格好つける
必要は無いので付けましょう。ってこれだけかい知ってることは〜
sub get_ymd { # リストBOXから、レース日を指定
$yymmdd = $ls->get( 'anchor' ) ;
($yyyy, $mm, $dd ) = unpack 'A4A2A2', $yymmdd ;
$mmdd = sprintf( "%02d%02d", $mm, $dd ) ;
# タイムローカル〜エポック数
$tml = timelocal( 0, 0, 0, $dd, $mm - 1, $yyyy - 1900 ) ;
$sa_day = 60 * 60 * 24 ; # 86400 一日分
&hrt_jyo() ;
&rd_dat() ;
&rd_base() ;
}
一番最初に働くサブルーチン get_ymd です。日付が決まらないと何も始まりません。
ココではリストBOXから持ってきた日付からイロイロ準備していますね。
エポック数は、結構使うので自力で調べた方がいいと思います。
sprintf の後の（ ）を、自分はあまり使わないのですがココでは使っています。どっちでも好き
なように
してください。
更に、このサブルーチンのなかで三つのサブルーチンを実行させています。
最後の３行の hrt_jyo、rd_dat、rd_base です。
以下、順に説明します。
sub hrt_jyo { ############## 開催場の配列 ##########
@kaisai = () ;
my $schedF = "$pass/YSNW" . $yyyy . '9999.dat' ;
open DAT, $schedF or die "?? $schedF ??:$!\n" ;
while ( <DAT> ) {
chomp ;
my $record = $_ ;
my ( $nngp, $jocd ) = unpack '@11A8@19A2', $record ;
if ( $yymmdd == $nngp ) {
push @kaisai, $jocd ;
}
last if $yymmdd < $nngp ;
}
close DAT ;
&sep_k() ;
}
sub sep_k {
for my $i ( 1..10 ) {
$jon[$i]->configure( -state => 'disabled', -backgr => 'gray' ) ;
for my $j ( @kaisai ) {
$jon[$i]->configure( -state => 'normal' ) if $i == $j ;
}
}
}
開催スケジュールのファイルから開催場所(のコード)を、@kaisai という名の配列に取り込みます。
そして最後の sep_k というサブルーチンで、開催されていない場所のボタンを無効に
しています。
別に $record に $_ を代入してから unpack する必要はありませんね。
my $record = $_ ; の行を削除して、次の行の $record を $_ に書き換えます。
この辺、カットアンドペーストの祟りかもしれませんね。
-background を -backgr と省略していますが、この辺は好きなように。-bg でもＯＫな筈です。
ルールに抵触しない範囲で省略してるつもりなんですが、あまり真似しない方がいいです。ハイ。
sub rd_dat {
&disp_1() if $dance ;
print "\t ${yyyy}年 ${mm}月 ${dd}日 データ読み込み中..\n" ;
{ # 出馬表と出走馬データ
my $datRA = "$pass/RADW" . $yymmdd . '.DAT' ; # 出馬表レースデータ
-e $datRA or $datRA = "$pass/RABW" . $yymmdd . '.DAT' ;
-e $datRA or $datRA = "$pass/RAGW" . $yymmdd . '.DAT'
or die "?? 出馬表データ RA〜 が見つからない ??:$!\n" ;
my $datSE = "$pass/SEDW" . $yymmdd . '.DAT' ; # 出走馬データ
-e $datSE or $datSE = "$pass/SEBW" . $yymmdd . '.DAT' ;
-e $datSE or $datSE = "$pass/SEGW" . $yymmdd . '.DAT'
or die "?? 出走馬データ SE〜 が見つからない ??:$!\n" ;
open DAT, $datRA ;
while( <DAT> ) {
chomp ;
my ( $jcd, $rnum ) = unpack '@19 A2 @25 A2', $_ ;
$racejho[$jcd][$rnum] = $_ ;
}
close DAT ;
open DAT, $datSE ;
while ( <DAT> ) {
chomp ;
my ( $jcd, $rnum, $umbn ) = unpack '@19 A2 @25 A2 @28 A2', $_ ;
$umadata[$jcd][$rnum][$umbn] = $_ ;
}
close DAT ;
}
}
最初の &disp_1() if $dance ; というのは、テキスト画面出力のテストですね。
kbcfg.ini で設定していれば、テスト画面が出ますが、暫らく使う予定はありません。
RADW、SEDW、だけでなく BW、GWのファイルも日付が一致すれば読み込めるようにしてあり
ますが、
現行では対応させていません。前日前々日の前売りが必要ならコレを活かして、、
ここで、配列の配列とかの説明をしても混乱するだけなので省略。理屈より実行です。
sub rd_base {
my @mfile = grep { -e and /UMPW|KSPW|RAQW|SEQW/i } glob "$pass/*.DAT";
# -T で取りこぼすので -e 。。ファイル名を限定しているが
for my $file ( @mfile ) {
my $fn = ( split '/', $file )[-1] ;
my ( $head, $nn, $gg, $pp ) = unpack '@0A4@4A4@8A2@10A2', $fn ;
next if $gg > 12 ;
# タイムローカル〜エポック数で計算。
my $hdksa = $tml - timelocal( 0, 0, 0, $pp, $gg - 1, $nn - 1900 ) ;
# 日付がレース日と同じ or 前で６日未満でなければスキップ。 以下手抜き
next if ( $hdksa < 0 or $hdksa > $sa_day * 5 ) ;
rd_base は少し長いので幾つかに分割し、ファイルの特定方法も変更してしまうつもり
ですが、現状で
説明します。
この最初の部分で、 @mfile というこのサブルーチン内だけに棲息している配列に UMPW か KSPW
か RAQW か SEQW かが含まれているファイル名を(パスも一緒に)保存します。
そのあと対象のレース日に対応したファイルを抽出、という所までが上の部分です。
if ( $head eq 'RAQW' ) {
open DAT, $file or die "?? $file ??:$!\n" ;
until ( eof( DAT ) ) {
my $record ;
my $dm = read ( DAT, $record, 1271 ) ;
my ( $raceID, $grcd, $ksoshcd, $ksokgcd, $jkcd, $kyo, $trcd, $ssto ) =
unpack '@11 A16 @614 A1 @616 A2 @618 A3 @634 A3 @697 A4
@705 A2 @883 A2', $record ;
my ( $nen, $gat, $pii ) = unpack '@0 A4 @4 A2 @6 A2', $raceID ;
my $rtml = timelocal( 0, 0, 0, $pii, $gat - 1, $nen - 1900 ) ;
next if $tml - $rtml > $sa_day * 400 ;
# レースIDをキーに
$kakora{ $raceID } =
[ $rtml, $grcd, $ksoshcd, $ksokgcd, $jkcd, $kyo, $trcd, $ssto ] ;
}
close DAT ;
}
ここでは rd_base の中の、RAQW が名前に含まれているファイル処理の部分だけを取り
上げること
にします。
早速、目的のファイルを一行づつ読み込みます。必要なデータを変数に収めてから、raceID をキー
に配列のリファレンスの形でハッシュとして保存します。
難しく言ってますが、この場合は開催年月日とレース場、レースナンバがわかる部分を切り取ってそれ
をraceID にしています。その raceID 用の箱の中に、必要なデータを入れておいたので、あとで使う
ときに、raceID をキーにして取り出すことができるよ！ということなんです。
あ、、ミスがありますね。 next if の行の $sa_day * 400 は $sa_day * $itumade
の間違いです。
訂正しておいてください。折角 kbcfg.ini で設定してもこの部分では無意味になってました。
他の部分も、基本的には似たようなモンです。ということで、 rd_base の説明を終わりにします。
sub push_buttb {
$bbcd = shift ;
for my $i ( @kaisai ) {
if ( $i == $bbcd ) {
$jon[$i]->configure( -backgr => "#FFFFAB" ) ;
} else {
$jon[$i]->configure( -backgr => 'gray' ) ;
}
}
}
push_buttb 場所ボタンを押したあと、ボタンの色が変るヤツです。
引数は直ちに、変数 $bbcd に入れられます。
sub push_butta {
$racenum = shift ;
$buffer = "${racenum}R" ;
&step1() ;
}
sub step1 {
if ( $racenum and $bbcd and $yymmdd ) {
&kbs() ;
}
}
push_butta レースナンバーボタンを押すと右側にレースナンバーが出ます。
引数は直ちに、変数 $racenum に入れられ、そして、これがスイッチになります。
step1 は要件が整っていれば、一番肝心なサブルーチンkbs を起動させます。
sub push_buttc { # $rad の値で分岐
my $w = ${$_[0]} ;
$rad = ${$w->cget(-variable)} ;
}
push_buttc 一番上の条件分岐ボタン用です。
選択されると、ラジオボタンの何番目が押されたのかが、変数 $rad に入れられます。
普通サブルーチンの引数は、例えば abcd というサブルーチンの場合
&abcd( $qwert, $asdf, $zxcv ) とか &abcd( @qwerty ) のように渡されるのですが、
Tk の部分に関しては、上のスクリプトのように [ \&push_butta, $i ] というような特殊な
形、それも各場面でリファレンスが多用されたりします。
中途半端に、Perl を知っているより知らないほうがスンナリ行けるかもしれません。
残っている最大のサブルーチン？ kbs は殆ど前の denm.pl をそっくり { } で囲った
だけです。
手入れ手直し見直し厚化粧が必要なので、全体の説明はしません。
ただし、encoding 後の固定長ファイルの扱い方で困った点などについて、次回にでも少し触
れておこうかなと思っています。
