#!/usr/bin/perl                                           -*- Perl -*-
#
# fpwsdic - SDIC 形式から JIS X 4081 形式に変換する Perl スクリプト
#
# Copyright (C) 1999 Hajime BABA.  All rights reserved.
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# Note: This file must be saved by EUC-JP kanji code.
#

$debug = 1;

use FreePWING::FPWUtils::FPWParser;


sub decode {
    local($s) = @_;

    # decode しとく。
    $s =~ s/&lt;/</g;
    $s =~ s/&gt;/>/g;
    $s =~ s/&amp;/&/g;

    $s;
}

## インスタンスを生成する。
initialize_fpwparser('text'    => \$fpwtext,
		     'heading' => \$fpwheading,
		     'word2'    => \$fpwword2);

for (;;) {
    local($heading, @query_candidates, $content);

    ## 次の一行 (見出し) を読み込む。
    last if (!defined($_ = <>));
    next if (/^#/);
    chomp;

    # headword は読み飛ばす。
    1 while (s,<H>([^(</H>)]*)</H>,,);

    # keyword は検索語として登録する。
    while (s,<K>([^(</K>)]*)</K>,,) {
	push(@query_candidates, decode($1));
    }
    $heading = $query_candidates[0];

    # 残った $_ が content になる。
    $content = &decode($_);

    print("heading = \"$heading\"\t") if $debug;
    print("content = \"$content\"\n") if $debug;


    ## 本文と見出しを新しいエントリに切り替える。
    $fpwtext->new_entry()
	|| die $fpwtext->error_message() . "\n";
    $fpwheading->new_entry()
	|| die $fpwheading->error_message() . "\n";
    
    ## ポインタを移動する。
    $heading_position = $fpwheading->entry_position();
    $text_position = $fpwtext->entry_position();
    
    ## 見出しを書き込む。
    $fpwheading->add_text($heading)
	|| die $fpwheading->error_message() . "\n";
    
    ## 本文の先頭に見出しを書き込む。
    if (!$fpwtext->add_text($heading) || !$fpwtext->add_newline()) {
	die $fpwtext->error_message() . "\n";
    }
	
    ## 検索語を登録する。
    foreach $query (@query_candidates) {
	next if (length($query) == 0);
	if (!$fpwword2->add_entry($query, $heading_position,
				  $heading_file_name, $text_position,
				  $text_file_name)) {
	    die $fpwword2->error_message() . "\n";
	}
    }

    ## 本文を書き込む。
    if (!$fpwtext->add_text($content) || !$fpwtext->add_newline()) {
	die $fpwtext->error_message() . "\n";
    }
}

## 書き込み用の作業ファイルを閉じる。
finalize_fpwparser('text'    => \$fpwtext,
		   'heading' => \$fpwheading,
		   'word2'   => \$fpwword2);

exit 0;


__END__

NAME
    fpwsdic - SDIC 形式から JIS X 4081 形式に変換する Perl スクリプト

SYNOPSIS
    perl fpwsdic [options] file [file ..]

OPTIONS
    -workdir dir  作業ファイルを置くディレクトリ
    その他は fpwutils のマニュアルを参照のこと。

DESCRIPTIONS
    FreePWING を使って JIS X 4081 形式(honmon)の辞書ファイルを作成する。
    fpwutils と連携させて使うので、単体で起動することはないだろう。
    GENE95 と EDICT を SDIC に変換したもので試した限りはいちおう動いた。

FILES
    FreePWING

BUGS
    サンプルコードと何が違うのかっつーくらい適当なコードではあるが、
    パーサ部分は極めて ad hoc であるから、きっとあるに違いない。

AUTHORS
    Hajime BABA <baba@kusastro.kyoto-u.ac.jp>


[EOF]