#!/usr/local/bin/perl
# -*-perl-*-
#
#  P-dic検索スクリプト
#
$rcsid = '$Id: pdic,v 1.4 1996/03/28 09:00:31 tagu Exp tagu $'; #'
#
# [インストール]
#  このファイルをパスの通ったディレクトリに置き、abbrev、genre、tag.def
#  をP-dicと同じディレクトリに置いてください。そして、$PDIC_DIR にP-dic
#  の辞書があるディレクトリを、$TO_EUC にEUC変換するコマンドをセットし
#  てください。
# 
#  また、必要ならこのファイルの先頭の #!/usr/local/bin/perl を適切に
#  設定してください。jperl を使用する場合には Ver 1.4 以上を使用し、
#  #!/usr/local/bin/jperl -Leuc
#  のようにしてください。
# 
# [使い方の例]
#   % pdic [-options] inoue takako
#
# [オプション]
#   -r            出力を加工しない
#   -f file-name  辞書ファイル(`-'で標準入力)
#
# [必要な物]
#   perl
#   nkf とか
#
# [動作確認]
#   P-dic  Ver. 3.00 - 1993.08.01
#   perl 5.001m
#
# [ばぐ…かな?]
#   ・生年月日の月日がないときは、1月1日とみなして年齢の計算をします。
#
# [謝辞]
#   I-dic 4.3b1に付属のツールからコードを使わせて頂きました。作者の
#   佐藤一郎さん(ichirou@hyperware.co.jp)に感謝致します。
#
# [著作権]
#   I-dic付属のツールから使わせて頂いたコードの部分の著作権は佐藤一郎さん(
#  ichirou@hyperware.co.jp)が保持しています。その他の部分の著作権にはP-dic
#  ML が保持しています。
#
#

##### 以下の変数は必ず適切な値に設定すること ##############################

# P-dic を置いてあるディレクトリ(フルパス名で)
$PDIC_DIR = "$ENV{'HOME'}/P-dic.4.0/";

# 検索する辞書をならべる。
@PDIC = ("p-dic-1",
	 "p-dic-2",
	 "p-dic-f",
	 "p-dic-t"
	 );

##### 設定はここまで ######################################################

require 'getopts.pl';	# perlがちゃんとinstallされてればいっしょに
                        # はいってるので、どこにあるか気にしないでよい

($myname= $0) =~ s%.*[/\\]%%;	# 自分自身のコマンド名
&init;				# 初期値設定
&Getopts('f:rh') || exit;	# オプションを解釈
$opt_h && &usage;

# OPENする辞書をフルパス名に変換
if($opt_f){
  @PDIC = ($opt_f);
}else{
  @PDIC = grep($_ = "$PDIC_DIR/$_",@PDIC);
}

# 引数(検索文字列)を仮名変換してつなげて検索パターンを作成
$pattern=join('', grep(($_=~s/[\w\-]+/&roma2kana($&)||$&/ge,1), @ARGV))
  if @ARGV;
print STDERR "検索中:$pattern\n" if $pattern;

# 検索
foreach $file (@PDIC){
  open(FILE, $file) || die "Can't open P-dic: $!";
  while (<FILE>) {
    chop;
    next if /^$/;
    if(! $pattern || /$pattern/){
      if($opt_r){
	print "$_\n";
      }else{
	print "\n" if $match;
	&pdic_conv($_);
      }
      $match++;
    }    
  }
  close(FILE);
}

# １つもマッチしなかったら表示
print STDERR "No match:", $pattern, "\n"  unless $match;


###### サブルーチン #######################################################
sub usage {
  print <<EOU;
usage: ${myname} [options] yomi ...
         options:
           -r            出力を加工しない
           -f file-name  辞書ファイル(`-'で標準入力)
           -h            このヘルプ
EOU
#'`
  exit;
}

sub init{
  local($key, $val, *FILE, @genre, @tmp, $abbrev_han, $abbrev_zen, $name);

  open(FILE, "$PDIC_DIR/genre") || die "Can't open genre: $!";
  while (<FILE>) {
    chop;
    next if /^(#|$)/;
    ($key, $val) = split;
    $GENRE{$key} = $val;
  }
  close(FILE);

  open(FILE, "$PDIC_DIR/abbrev") || die "Can't open abbrev: $!";
  while (<FILE>) {
    chop;
    next if /^(#|$)/;
        ($abbrev_han, $abbrev_zen, $name) = split;
        $ABBREV{$abbrev_han} = $name;
  }
  close(FILE);


  @GAKUNEN =
    ('', '', '', '', '', '', '',
     '小学一年','小学二年','小学三年','小学四年','小学五年','小学六年',
     '中学一年','中学二年','中学三年',
     '高校一年','高校二年','高校三年',
     '大学一年','大学二年','大学三年','大学四年',
     '修士一年','修士二年',
     '博士一年','博士二年','博士三年');

  @SEIZA =
    (21,'水瓶',20,'魚',21,'牡羊',21,'牡牛',22,'双子',22,'蟹',
     24,'獅子',24,'乙女',24,'天秤',24,'蠍',23,'射手',23,'山羊');

  @GENGOU_LIST =
    ('平成',1989,1,8,'昭和',1926,12,25,'大正',1912,7,30,'明治',1868,9,8);


  %R2K = ('a','あ','i','い','u','う','e','え','o','お','-','ー',
	  'N', 'ん',

	  'ba','ば','bi','び','bu','ぶ','be','べ','bo','ぼ',
	  'ca','か','ci','し','cu','く','ce','せ','co','こ',
	  'da','だ','di','ぢ','du','づ','de','で','do','ど',
	  'fa','ふぁ','fi','ふぃ','fu','ふ','fe','ふぇ','fo','ふぉ',
	  'ga','が','gi','ぎ','gu','ぐ','ge','げ','go','ご',
	  'ha','は','hi','ひ','hu','ふ','he','へ','ho','ほ',
	  'ja','じゃ','ji','じ','ju','じゅ','je','じぇ','jo','じょ',
	  'ka','か','ki','き','ku','く','ke','け','ko','こ',
#	  'la','ら','li','り','lu','る','le','れ','lo','ろ', # Normal style
	  'la','ぁ','li','ぃ','lu','ぅ','le','ぇ','lo','ぉ', # ATOK sytle (^_^;
	  'ma','ま','mi','み','mu','む','me','め','mo','も',
	  'na','な','ni','に','nu','ぬ','ne','ね','no','の',
	  'pa','ぱ','pi','ぴ','pu','ぷ','pe','ぺ','po','ぽ',
	  'ra','ら','ri','り','ru','る','re','れ','ro','ろ',
	  'sa','さ','si','し','su','す','se','せ','so','そ',
	  'ta','た','ti','ち','tu','つ','te','て','to','と',
	  'va','ば','vi','び','vu','ぶ','ve','べ','vo','ぼ',
	  'wa','わ','wi','ゐ','wu','う','we','ゑ','wo','を',
	  'xa','ぁ','xi','ぃ','xu','ぅ','xe','ぇ','xo','ぉ',
	  'ya','や','yi','い','yu','ゆ','ye','え','yo','よ',
	  'za','ざ','zi','じ','zu','ず','ze','ぜ','zo','ぞ',

	  'cha','ちゃ','chi','ち','chu','ちゅ','che','ちぇ','cho','ちょ',
	  'sha','しゃ','shi','し','shu','しゅ','she','しぇ','sho','しょ',
	  'kwa','くゎ','kwi','くぃ','kwe','くぇ','kwo','くぉ',
	  'tsa','つぁ','tsi','つぃ','tsu','つ','tse','つぇ','tso','つぉ',
	  'gwa','ぐゎ','gwi','ぐぃ','gwe','ぐぇ','gwo','ぐぉ',
	  'xya','ゃ','xyi','ぃ','xyu','ゅ','xye','ぇ','xyo','ょ','xwa','ゎ',
	  'xtu','っ','dhi','でぃ','thi','てぃ'
	  );

  %YOUON = ('b','び','d','ぢ','f','ふ','g','ぎ','h','ひ','j','じ','k','き',
	    'l','り','m','み','n','に','p','ぴ','r','り','s','し','t','ち',
	    'z','じ');

}

sub pdic_conv {
  local($src)=@_;
  local(@f,@sf,$_);
  
  @f = split("\t",$src);

  # 第1〜3フィールド
  printf("%s【%s】[%s]\n", $f[1], $f[0], $GENRE{$f[2]});

  ## ここから第4フィールドの処理
  @sf = split(";",$f[3]) if $f[3];

  # 分類番号15,20,24,25のとき
  if ($f[2] eq 15 || $f[2] eq 20 || $f[2] eq 24 || $f[2] eq 25) {

    # 略記を正式名に変換
    $sf[0] =~ s/[A-Za-z0-9\-]+/$ABBREV{$&}||$&/ge if $sf[0];
    # 第4フィールドの最初のフィールドは「他を参照」の意味の時がある
    printf("           %s| %s\n",
	   (($sf[0] =~ s/^→/⇒/)?"参照":"所属"), $sf[0]) if $sf[0];

    printf("           本名| %s\n", $sf[1]) if $sf[1];

    # 生年月日の処理
    local(@birth) = split("/",$sf[2]) if $sf[2];
    local($sec, $min, $hour, $mday, $mon, $year) = localtime(time);
    local($age, $age_month, $gakunen)
      = &get_age($birth[0], ($birth[1]||1), ($birth[2]||1),
  		 $year+1900, $mon+1, $mday)
	if $birth[0];
    
    printf("       生年月日| %d年(%s)%s月%s日 [%s座]\n",
           $birth[0],
           &get_gengou($birth[0],($birth[1]||1), ($birth[2]||1)),
           ($birth[1]||'?'), ($birth[2]||'?'),
           ($birth[1]? &get_seiza($birth[1], ($birth[2]||1)):'?')
	  )
      if $birth[0];
    printf("           年齢| %d歳%dヶ月", $age, $age_month) if $birth[0];
    printf(" [%s 相当]", $gakunen) if ($birth[0] && $gakunen);
    printf(" −今日は誕生日−")
      if ($sf[2] && $birth[1] == $mon+1 && $birth[2] == $mday);
    printf("\n") if $sf[2];

    printf("         出身地| %s\n", $sf[3]) if $sf[3];

    if ($sf[4] || $sf[5]){
      printf("     身長・体重| ");
      printf("%s ", $sf[4]) if $sf[4];
      printf("%s", $sf[5])  if $sf[5];
      printf("\n");
    }
    printf("         得意技| %s\n", $sf[6]) if $sf[6];
    printf("   入場テーマ曲| %s\n", $sf[7]) if $sf[7];
    printf("       コメント| %s\n", $sf[8]) if $sf[8];

  # 分類番号26(入場テーマ曲)の時は第4フィールドには別の分類がある
  } elsif ($f[2] eq 26) {
    printf("         選手名| %s\n", $sf[0]) if $sf[0];
    printf(" 演奏(作曲)者名| %s\n", $sf[1]) if $sf[1];
    printf("       コメント| %s\n", $sf[2]) if $sf[2];

  # 上の分類番号以外は第4フィールドはまとめて「コメント」
  } else {
    printf("       %s| %s\n",
	   (($sf[0] =~ s/^→/⇒/)?"    参照":"コメント"), $sf[0]) if $sf[0];

  }
}


sub get_age {
    local($yy, $mm, $dd, $cyy, $cmm, $cdd) = @_;
    local($age) = $cyy - $yy;
    local($age_month) = $cmm - $mm;
    local($gakunen_offset);

    --$age if (($cmm < $mm) || (($cmm == $mm) && ($cdd < $dd)));
    --$age_month if ($cdd < $dd);
    $age_month += 12 if ($age_month < 0);
    $cmm += 12 if ($cmm < 4 || ($cmm == 4 && $cdd == 1));
    $mm += 12 if ($mm < 4 || ($mm == 4 && $dd == 1));
    $gakunen_offset = 1 if (($cmm < $mm) || (($cmm == $mm) && ($cdd < $dd)));
    ($age, $age_month, $GAKUNEN[$age+$gakunen_offset]);
}

sub get_seiza {
    local($mm, $dd) = @_;

    if ($SEIZA[($mm-1)*2] < $dd) {
        return $SEIZA[($mm-1)*2+1];
    } else {
        return $SEIZA[($mm+10)%12*2+1];
    }
}

sub get_gengou {
    local($y, $m, $d) = @_;
    local($gengou, $y1, $m1, $d1);

    for ($i = 1; $i < $#GENGOU_LIST; $i += 4) {
        $y1 = $GENGOU_LIST[$i];
        $m1 = $GENGOU_LIST[$i+1];
        $d1 = $GENGOU_LIST[$i+2];
        $gengou = $GENGOU_LIST[$i-1];
        if ($y > $y1 || $y == $y1 && ($m > $m1 || $m == $m1 && $d >= $d1)) {
            return(sprintf("%s%s年", $gengou, ($y == $y1) ? '元' : $y-$y1+1));
        }
    }
    '';
}

sub roma2kana {

  local($roma) = @_;
  local($kana, $r, $r2, $r3, $k, $k2);

  while ($roma) {
    $r = substr($roma, 0, 1);
    $roma = substr($roma ,1);
    ($k = $R2K{$r}) && ($kana .= $k) && next;

    $r2 = substr($roma, 0, 1);
    $r eq $r2 && ($kana .= $r2 eq 'n' ? 'ん' : 'っ') && next;
    $r eq 'n' && $r2 =~ /[bcdfghjklmnpqrstvwxz]/ && ($kana .= 'ん') && next;
    $roma = substr($roma ,1);
    ($k = $R2K{$r.$r2}) && ($kana .= $k) && next;

    $r3 = substr($roma, 0, 1);
    $roma = substr($roma ,1);
    $r2 eq 'y' && ($k = $YOUON{$r}) && ($k2 = $R2K{'xy'.$r3})
      && ($kana .= $k.$k2) && next;
    ($k = $R2K{$r.$r2.$r3}) && ($kana .= $k) && next;

    !$roma && $r eq 'n' && return $kana . 'ん';
    return '';
  }
  $kana;
}

__END__

# Local Variables:
# file-coding-system: *euc-japan*unix
# kanji-fileio-code: 3
# End: