#! /usr/bin/perl -c
package dbm_longstr;
##
##   DBM の文字列長制限を突破するための細工
##   --- こんなもの用意するより、もっとちゃんとしたものを‥と思うけどね
##   --- 文字列が長大になってくると、かなり遅くなります。
##
## BUGS
##    $DB{$key} の文字長が約 500*500 バイトを越えるとたぶん爆死します (^_^;
##    つまり、このルーチンで対処できる文字列長は
##    ($vallenmax \times 244 \times 244) 文字程度ということになります。
## 
## ---------------------------------------------------------------
##   2004.1111  aiba 従来より $vallenmax 倍の長さの文字列にも対応
##   2002.1228  aiba
## ---------------------------------------------------------------

##
## 指定された *DB に $key,$val の組を追加保存する
##
sub add {
  local(*DB, $key, $val, $sep, $vallenmax) = @_;
  {
    ## $sep は $key 中で絶対使われない文字列というのが前提
#    if($sep =~ /^$/)   { $sep = "\r"; }
    if($sep =~ /^$/)   { $sep = "\@"; }
    ## $vallenmax はその DBM で使える文字列長の上限
    if($vallenmax < 1) { $vallenmax = 500; }
  }
  local($cntz) = &getkeylist(*DB, $key, $sep);
  local($cnta);
  if($cntz =~ /./) {
    $cntz =~ /[\t]?[^\t]+[\t]*$/;
    ($cntz,$cnta) = ($`, $&); $cnta =~ s/\t+//g; $cntz .= "\t";
    $val = $DB{"$key$sep$cnta"} . $val;
  }
  else {
    $cnta = &next_numstr;
  }
  ##
  ## 以下は $DB{"$key$sep$cnta"} に $val を格納する話
  ##
  local($valz);
  local(@vals) = &my_split($val, $vallenmax);
  foreach $valz ( @vals ) {
    #$mode_debug = 'yes';
    #if(defined($mode_debug)) {
    #  local($len) = length($valz);
    #  print "##Set>DB{$key$sep$cnta}==>[$len] $valz\n"; $| = 1;
    #}
    $DB{"$key$sep$cnta"} = $valz;
    $cntz .= "$cnta\t";
    $cnta = &next_numstr($cnta);
  }
  ## ここからは $DB{$key} に $cntz を書き込む話
  {
    ## はたまた場当たり的な機能追加 ^^; (2004/11/11)
    local(@cnts) = &my_split($cntz, $vallenmax);
    if(0 < $#cnts) {
      local($i, @is);
      foreach $i ( 1 .. $#cnts ) {
	$DB{"$sep${sep}ExLst${sep}$key$sep$i"} = $cnts[$i];
	push(@is, $i);
      }
      $DB{"$sep${sep}ExIdx${sep}$key"} = join("\t", @is);
      $cntz = $cnts[0];
    }
  }
  $DB{$key} = $cntz;
  return 'ok';             ## とりあえず何か返しとく
}

##
## add 等によって保存された *DB の $key,$val の組を取り出す
##
sub get {
  local(*DB, $key, $sep, ) = @_;
  {
    ## $sep は put で使ってるのと同じ文字列にしてね
    if($sep =~ /^$/)   { $sep = "\r"; }
  }

  local($val);
  local($mylist) = &getkeylist(*DB, $key, $sep);

  local(@cnts) = split("\t+", $mylist);
  
  local($cnt);
  foreach $cnt ( @cnts ) {
    if($cnt !~ /./) { next; }
    $val .= $DB{"$key$sep$cnt"};
  }
  return $val;
}

##
##  「各レコードが入ってる場所のポインタのリストを得る」
##
##  2004.1111 以前のバージョンで $mylist = $DB{$key} とやっていた
##  個所を $mylist = &getkeylist(*DB, $key, $sep) に書き換えた。
sub getkeylist {
  local(*DB, $key, $sep, ) = @_;
  local($ret) = $DB{$key};  #return $ret;

  if($DB{"$sep${sep}ExIdx$sep$key"} =~ /./) {
    local(@zzz) = split("\t", $DB{"$sep${sep}ExIdx$sep$key"});
    local($zz);
    foreach $zz ( @zzz ) {
      if($zz =~ /./ && $DB{"$sep${sep}ExLst$sep$key$sep$zz"} =~ /./) {
	$ret .= $DB{"$sep${sep}ExLst$sep$key$sep$zz"};
      }
    }
  }
  return $ret;
}


sub next_numstr {
  local($nstr) = @_;
  local($num) = hex($nstr);
  $num++;
  return sprintf("%x",$num);
}

sub my_split {
  local($buf, $len) = @_;
  local(@ret);
  while(length($buf) > $len) {
    local($car) = substr($buf, 0, $len);
    local($cdr) = substr($buf, $len);
    push(@ret, $car);
    $buf = $cdr;
  }
  push(@ret, $buf);
  return(@ret);
}

1;