続・競馬であそぶ ３

2.　 DBMファイルの使い方　

DBMファイルは、ハッシュデータを保存したディスク上のファイルのことです。 Database Management の略。
ハッシュというのは値をたくさん(or 少し)集めたもので、必要なときにはキーを使って抜き出します。
騎手コードをキーにして騎手名を出したり、逆に馬名をキーにして血統登録番号を知ったりという ような使い方をします。

%hash ;
$hash{ $key } = $value ;

Perl には dbmopen という、関数があります。これは DBMファイルをハッシュに 結合する時に使います。
どういうことかというと、スクリプトで使われるハッシュはメモリー内での始動〜完結が普通ですが、 それでは都合が悪いことがあります。
例えば、外人騎手の場合などでは短期騎手免許が切れるとその騎手のデータが非蓄積系では手に入れ づらくなります。負傷欠場中の騎手も、同様です。現在(2006.01.27)は横山典騎手など。
騎手の巧拙を、提供データから毎回計算するようなスクリプトを書いた場合、今回乗り替った騎手との 比較ができなくなったりするわけです。

そんな場合でも、DBMファイルとハッシュを結合させておけば、新しいデータは追加更新(or 無視)され ますが、古いデータはそのままファイルに残るので解決です。
現在は、暫定で修正用の騎手データ( kshyk2.dat )を併用しているので問題なく見えているだけです。

この騎手ポイントに関する DBMファイルへの切り替えはまだやっていません。
とりあえず、中央以外での過去の戦績では騎手コードが提供されていないので、騎手名をキーに して騎手コードを牽くような DBM を作ってテストしています。
移行が楽なので、この方法でいくかもしれません。 騎手の同姓同名という例もあるので、絶対ではありませんが、、

馬名をキーにした血統登録番号というデータを作る場合でも、新しい馬名があれば追加という形で 簡単にできます。
ただ、これをやり始めると抹消馬の処理などで蓄積系のデータにまで手を伸ばさざるを得なくなり、 そうなるとヤッパリ RDB かなぁ、なんてことにならないとも限らないし、ちょっと迷う。
とは言っても、考えてみると使い道がないですね。やり方だけ以下に。

---

血統登録番号用のスクリプトです。名前は一応、una2cd.pl としています。

#!/usr/bin/perl
# 
# 馬名から血統登録番号が必要になることが万一あれば、、
# DBM ファイルのテスト。データが蓄積されていく、、
# Usage:     perl una2cd.pl yymmdd
# yymmdd は、UMPWファイルの年月日の部分を( 6 or 8 )桁で。
# DB名 は、umacd
# umacd.dir と umacd.pag の二つのファイルが出来る。
# 以下パス等は環境に応じて書き換えること。
# 一括処理( スクリプト書換え or バッチファイル )は省略。

use strict ;
my %umas ;
my $dbpass = 'H:/DB' ;          # ★ DBM ファイル収納場所
my $dtpass = 'H:/TDAT' ;        # ★ 週データパス(UMPWファイル所在地)
        # ここでは、フォルダ名に西暦年が付いていると想定しているので注

my $ymd = shift @ARGV ;
$ymd += 20000000 if $ymd < 10000000 ;
my $yyyy = substr( $ymd, 0, 4 ) ;               # 注
my $fname = "$dtpass/$yyyy/UMPW$ymd\.dat" ;     # 注
dbmopen %umas, "$dbpass/umacd", 0666 or die "Can't open umacd: $!\n" ;
open DAT, $fname or die " そんなファイル ${fname} はナイだよ。\n" ;
while( <DAT> ) {
    chomp ;
    my ( $ucd, $bname ) = unpack '@11 A10 @46 A18', $_ ;
    $bname =~ s/　//g ;
    $umas{ $bname } = $ucd ;
}
close DAT ;
dbmclose %umas ;

どんなデータ( キー＆値 )が保存されているか、少し整形して出力しましょう。test.pl

#!/usr/bin/perl

# DBM出力テスト
# Usage:     perl test.pl

my $dbpass = 'H:/DB' ;      # ★DBM 所在地
my $dbname = 'umacd' ;      # ★DBM の名前

my %test ;                      # 仮のハッシュ名
my $outF = $dbname . '.dat' ;   # 出力ファイル名
open OUT, ">$outF" ;
dbmopen %test, "$dbpass/$dbname", 0666 or die "Can't open DBMs: $!\n" ;
while( ( $key, $value ) = each( %test ) ) {
#   print OUT "$key:$value\n" ;
    printf OUT "%-18s:%s\n", $key, $value ;     # 整形しています。
}
close OUT ;
dbmclose %test ;

こんな感じです。

デルマフローラ    :2002100320
テイエムカリスマ  :2002104853
スズランサイレンス:2003103825
ホクテンジャチクン:2002103262
        ..以下略

---

こみいった話になってきたので、この辺で切り上げます。あとは、参考例ということで、
上で作った DBM ファイルを使って、フリーハンデ用の DBM ファイルを作ってみます。

#!/usr/bin/perl
# 
# フリーハンデを dbm ファイルに。# DBM ファイルのテスト。
# Usage:     perl freehnd.pl
# 以下★パス等は環境に応じて書き換えること。
# DB名 は、freehnd
# 馬コードをキーにしたハッシュを作っている。
# つまり、馬コードが不明なものは除外。

use strict ;
my $dbpass = 'H:/DB' ;              # ★ DBM ファイル置き場
my $dtpass = 'H:/KB_SC/html' ;      # ★ フリーハンデのデータパス
my %fhd ;                       # 新しく作る DBM ファイル用のハッシュ
my %umcd ;                      # DBMファイル置き場にある 馬コードハッシュ 

my @htmls = (
    'fh03_1.html',  'fh03_2.html',  'fh03_3.html',  'fh03_4.html',
    'fh04_1.html',  'fh04_2.html',  'fh04_3.html',  'fh04_4.html',
    'fh04_5.html',  'fh04_6.html',  'fh04_7.html',
    ) ;
my %b2s = ( 'Ｓ' => 'S', 'Ｍ' => 'M', 'Ｉ' => 'I',  'Ｌ' => 'L','Ｅ' => 'E' ) ;

dbmopen %fhd, "$dbpass/freehnd", 0666 or die "Can't open freehnd: $!\n" ;
dbmopen %umcd, "$dbpass/umacd", 0666 or die "Can't open freehnd: $!\n" ;

my $count = 0 ;
my @dat = () ;
for my $fn ( @htmls ) {
    my $file = "$dtpass/$fn" ;
    open DAT, $file or die "ファイル $fn がありません。。$!\n" ;
    while( <DAT> ){
        chomp ;
        next unless /^<(TD class="mfont" align|\/*TR)/ ;
        if ( /^<TR>/ ) {
            $count = 0 ;
            @dat = () ;
            next ;
        }
        if ( /^<\/TRY>/ ) {
            if ( $count > 14 ) {
                my ( $mk, $jun, $sx, $max, $vS, $vM, $vI, $vL, $vE, $hnd,
                     $tdmk, $td, $una ) = @dat ;
                $una =~ s/USA|IRE|GB|FR|AUS// ;     # 不要文字を削除
                $una = substr( $una, 0, 18 ) ;
                $sx = $b2s{$sx} ;
                my $ucd = $umcd{$una} ;
                my $line = sprintf "%3d%s %3s %3s %3s %3s %3s %1s%s %s",
                    $max, $sx, $vS, $vM, $vI, $vL, $vE, $tdmk, $td, $una ;
                $fhd{$ucd} ||= $line if $ucd ;
            }
            $count = 0 ;
            @dat = () ;
        }
        if ( /^<TD/ ) {
            s/<\/FONT>// ;
            s/　//g ;
            my ( $dat ) = ( split '">|<\/', $_ )[-2] ;
            $dat[$count] = $dat ;
            $count++ ;
        }
    }
    close DAT ;
}
dbmclose %fhd ;
dbmclose %umcd ;

中味を、test.pl で出力するとこんな感じです。

2002100991        :109I         109 108 109  T ローゼンクロイツ
2002107008        : 97M      97              T マチカネオーラ
2002110198        : 96M      96              T マルターズビクター
2002106139        : 90I          90          T ウインアルディート
            ..以下略

便利というか思ったより簡単に使えそうです。 情報取得〜DBM ファイル作成なら一本のスクリプトで書けますね。
ただ、これだと血統登録番号が徐々に判明して追加という状況を考えると、バラバラの方が良さそうです。

ホントはこんな回りくどいことをしなくても、直接馬名をキーにしたハッシュを 作ればいいのです。
ただ、そうすると本体のスクリプトでマルチバイトの呪いを解くのが少し面倒かもしれません。
こちらのテストでは、問題なく作動していますが、この問題を整理しておかないといけない段階に差し掛かってきたようです。