#                                                         -*- Perl -*-
# Copyright (c) 1999, 2000  Motoyuki Kasahara
#
# 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.
#

#
# インデックスを収めたファイルを生成するクラス。
#
package FreePWING::Index;

require 5.005;
require Exporter;
use English;
use FileHandle;
use FreePWING::Reference;
use strict;
use integer;

use vars qw(@ISA
	    @EXPORT
	    @EXPORT_OK
	    $suffix
	    $block_length
	    $max_depth
	    $header_length);

@ISA = qw(Exporter);

#
# ブロックの長さ (バイト数)
#
$block_length = 2048;

#
# ブロックの長さ (バイト数)
#
$block_length = 2048;

#
# インデックスファイルの最大の深さ。
#
$max_depth = 10;

#
# 書式:
#	new()
# メソッドの区分:
# 	public クラスメソッド。
# 説明:
# 	新しいオブジェクトを作る。
# 戻り値:
# 	作成したオブジェクトへのリファレンスを返す。
#
sub new {
    my $type = shift;
    my $new = {
	# インデックスファイル名 (の基本名)
	'file_name' => '',

	# 参照ファイル名 (の基本名)
	'reference_file_name' => '',

	# ファイル名の生成方法
	'godparent' => sub {return $ARG[0] . $ARG[1]},

	# インデックスの各層
	'layers' => [],

	# インデックスの層の数
	'depth' => 0,

	# これまでに書き込んだエントリ数
	'entry_count' => 0,

	# エラーメッセージ
	'error_message' => '',
    };
    return bless($new, $type);
}

#
# 書式:
#	open(file_name, reference_file_name, [godparent])
#           file_name
#		開くインデックスファイル名 (の基本名)。
#           reference_file_name
#		開く参照情報ファイル名 (の基本名)。
#           godparent
#		ファイル名の基本名から正式名を生成するルーチンへの
#		リファレンス。
# メソッドの区分:
# 	public インスタンスメソッド。
# 説明:
# 	指定されたインデックスファイル群を開く。
# 戻り値:
#	成功すれば 1 を返す。失敗すれば 0 を返す。
#
sub open {
    my $self = shift;
    my ($file_name, $reference_file_name, $godparent) = @ARG;

    $self->{'file_name'} = $file_name;
    $self->{'reference_file_name'} = $reference_file_name;
    if (defined($godparent)) {
	$self->{'godparent'} = $godparent;
    }

    #
    # 最初の階層のインデックスを開く。
    #
    if (!$self->open_upper_layer()) {
	return 0;
    }

    return 1;
}

#
# 書式:
#	open_upper_layer()
# メソッドの区分:
# 	private インスタンスメソッド。
# 説明:
# 	次の階層のインデックスファイルを開く。
# 戻り値:
#	成功すれば 1 を返す。失敗すれば 0 を返す。
#
sub open_upper_layer {
    my $self = shift;
    
    #
    # $self->{'layers'} に階層を追加。
    #
    my $layer = {
	# この層の深さ
	'level' => $self->{'depth'},

	# インデックスファイルのハンドル
	'handle' => FileHandle->new(),

	# インデックスファイル名
	'file_name' => &{$self->{'godparent'}}($self->{'file_name'},
					       $self->{'depth'}),

	# 参照情報
	'reference' => FreePWING::Reference->new(),

	# これまでに書き込んだブロック数
	'block_count' => 1,

	# 書き込みを保留しているエントリのキュー
	'entry_queue' => [],

	# そのブロックの固定単語長 (= 単語の最大長)
	# (上位インデックスでのみ使用)
	'block_word_length' => 0,

	# 現在のブロックに書き込んだバイト数
	# (下位インデックスでのみ使用)
	'block_length' => 4,
    };

    # 
    # 本階層用の参照情報ファイルを開く。
    # 
    my $reference_file_name
	= &{$self->{'godparent'}}($self->{'reference_file_name'},
				  $self->{'depth'});
    if (!$layer->{'reference'}->open($reference_file_name)) {
	$self->close_internal();
	return 0;
    }

    # 
    # 本階層用のインデックスファイルを開く。
    # 
    if (!$layer->{'handle'}->open($layer->{'file_name'}, 'w')) {
	$self->{'error_message'} = 
	    "$PROGRAM_NAME: failed to open the file, $ERRNO: "
		. $layer->{'file_name'};
	$self->{'reference'}->close();
	$self->close_internal();
	return 0;
    }
    binmode($layer->{'handle'});

    push(@{$self->{'layers'}}, $layer);
    $self->{'depth'}++;

    return 1;
}

#
# 書式:
#	close()
# メソッドの区分:
# 	public インスタンスメソッド。
# 説明:
# 	オブジェクトが開いているインデックスファイル群を閉じる。
#	インデックスファイルを開いていない場合は、何もしない。
# 戻り値:
#	常に 1 を返す。
#
sub close {
    my $self = shift;

    #
    # インデックスファイルを開いていなければ、メソッドを抜ける。
    #
    if (!$self->{'layers'}->[0]->{'handle'}->fileno()) {
	return 1;
    }

    #
    # 最後の単語を上位インデックスに登録する。
    #
    my $last_word = $self->{'layers'}->[0]->{'entry_queue'}->[-1]->[0];

    my $i;
    for ($i = 1; $i < $self->{'depth'}; $i++) {
	my $last_position = ($self->{'layers'}->[$i - 1]->{'block_count'} - 1)
	    * $block_length;
  	if (!$self->add_medium_layer_entry($i, $last_word, $last_position)) {
  	    return 0;
	}
    }

    #
    # 下位インデックスファイルを閉じる。
    #
    if (!$self->write_leaf_layer_block(1)) {
	return 0;
    }

    #
    # 上位インデックスファイルを閉じる。
    #
    my $i;
    for ($i = 1; $i < $self->{'depth'}; $i++) {
	if (!$self->write_medium_layer_block($i, 1)) {
	    return 0;
	}
    }

    $self->close_internal();
    return 1;
}

#
# 書式:
#	close_internal()
# メソッドの区分:
# 	private インスタンスメソッド。
# 説明:
# 	他のメソッド処理中に異常が起きた場合の処理を行う。
#
sub close_internal {
    my $self = shift;

    my $i;
    my $current_layer;

    my $i;
    for ($i = 0; $i < $self->{'depth'}; $i++) {
        if ($self->{'layers'}->[$i]->{'handle'}->fileno()) {
            $self->{'layers'}->[$i]->{'handle'}->close();
        }
        $self->{'layers'}->[$i]->{'reference'}->close();
    }

    return 1;
}

#
# 書式:
#	error_message()
# メソッドの区分:
# 	public インスタンスメソッド。
# 説明:
# 	最後に発生したエラーのメッセージを返す。
#
sub error_message {
    my $self = shift;
    return $self->{'error_message'};
}

#
# 書式:
#	add_entries_in_file(file_name)
#           file_name
#		インデックスのエントリが記されたファイル。
# メソッドの区分:
# 	public インスタンスメソッド。
# 説明:
# 	file_name の中に記されている全エントリを、インデックスファイル
#	群に対して追加する。
# 戻り値:
#	成功すれば 1 を返す。失敗すれば 0 を返す。
#
sub add_entries_in_file {
    my $self = shift;
    my ($file_name) = @ARG;

    #
    # $file_name を開く。
    #
    my $handle = FileHandle->new();
    if (!$handle->open($file_name, 'r')) {
	$self->{'error_message'} =
	    "failed to open the file, $ERRNO: $file_name";
	$self->close_internal();
	return 0;
    }

    #
    # $file_name を読み、各行に記されているエントリを $self に追加
    # する。
    #
    my $line;
    my @line_fields;
    for (;;) {
	$line = $handle->getline();
	if (!defined($line)) {
	    last;
	}
	chomp $line;
	@line_fields = split(/\t/, $line);
	my $word = $line_fields[0];
	my $heading_position = hex($line_fields[1]);
	my $heading_file_name = $line_fields[2];
	my $text_position = hex($line_fields[3]);
	my $text_file_name = $line_fields[4];
	if (!$self->add_entry($word, $heading_position, $heading_file_name,
			      $text_position, $text_file_name)) {
	    $self->close_internal();
	    return 0;
	}
    }

    #
    # $file_name のハンドルを閉じる。
    #
    $handle->close();

    return 1;
}

#
# 書式:
#	add_entry(word, heading_position, heading_file, text_position,
#                 text_file)
#           word
# 		インデックスへ登録する単語。正規化されていること。
#           heading_position
#           heading_file_name
# 		エントリの見出しを載せているファイル名とファイル内の位置。
#           text_position
#           text_file_name
# 		エントリの本文を載せているファイルとファイル内の位置。
# メソッドの区分:
# 	public インスタンスメソッド。
# 説明:
# 	インデックスファイル群にエントリを一つ追加する。
# 戻り値:
#	成功すれば 1 を返す。失敗すれば 0 を返す。
#
sub add_entry {
    my $self = shift;
    return $self->add_leaf_layer_entry(@ARG);
}

#
# add_entry() の実体
#
sub add_leaf_layer_entry {
    my $self = shift;
    my ($word, $heading_position, $heading_file_name, $text_position,
	$text_file_name) = @ARG;

    my $leaf_layer = $self->{'layers'}->[0];

    #
    # 改ページの必要性が生じたら、エントリキューの内容を 1 つのブロック
    # にして書き出して、次のページへ進む。
    #
    if ($block_length < $leaf_layer->{'block_length'} + length($word) + 13) {
	if (!$self->write_leaf_layer_block()) {
	    return 0;
	}

	#
	# 最後のエントリを上位エントリに追加する。
	#
  	if ($self->{'depth'} == 1 && !$self->open_upper_layer()) {
  	    return 0;
  	}
	my $medium_word = $leaf_layer->{'entry_queue'}->[-1]->[0];
	my $medium_position = ($leaf_layer->{'block_count'} - 1)
	    * $block_length;
  	if (!$self->add_medium_layer_entry(1, $medium_word,
					   $medium_position)) {
  	    return 0;
  	}

  	#
  	# エントリキューをリセットする。
  	#
  	@{$self->{'layers'}->[0]->{'entry_queue'}} = ();
  	$self->{'layers'}->[0]->{'block_length'} = 4;
	$leaf_layer->{'block_count'}++;
    }

    #
    # エントリキューに、今回のエントリを足す。
    #
    push(@{$self->{'layers'}->[0]->{'entry_queue'}},
	 [$word, $heading_position, $heading_file_name, $text_position,
	  $text_file_name]);
    $self->{'layers'}->[0]->{'block_length'} += length($word) + 13;

    return 1;
}

#
# 書式:
#	write_leaf_layer_block(close_flag)
#	    close_flag
#		インデックスを閉じるために呼ぶときは、true がセッ
#		トされなければならない。
# メソッドの区分:
# 	private インスタンスメソッド。
# 説明:
# 	下位インデックスの現在のエントリキューをまとめて 1 ブロックに
#	して書き出す。
# 戻り値:
#	成功すれば 1 を返す。失敗すれば 0 を返す。
#
sub write_leaf_layer_block {
    my $self = shift;
    my ($close_flag) = @ARG;

    my $leaf_layer = $self->{'layers'}->[0];

    #
    # エントリキューが空なら、メソッドを抜ける。
    #
    if (@{$leaf_layer->{'entry_queue'}} == 0) {
	return 1;
    }

    #
    # ブロックのヘッダを書き込む。
    #
    my $block_id = 0x80;
    if ($leaf_layer->{'block_count'} == 1) {
	$block_id |= 0x40;
    }
    if ($close_flag) {
	$block_id |= 0x20;
    }
    if (!$leaf_layer->{'handle'}->
	print(pack("CCn", $block_id, 0,
		   scalar(@{$leaf_layer->{'entry_queue'}})))) {
	$self->close_internal();
	return 0;
    }

    #
    # エントリキューの各エントリを書き込む。
    #
    my $source_position = ($leaf_layer->{'block_count'} - 1) * $block_length
	+ 4;
    my $i;
    for ($i = 0; $i < scalar(@{$leaf_layer->{'entry_queue'}}); $i++) {
	my $entry = $leaf_layer->{'entry_queue'}->[$i];
	my $word = $entry->[0];
	my $word_length = length($word);
	my $heading_position = $entry->[1];
	my $heading_file_name = $entry->[2];
	my $text_position = $entry->[3];
	my $text_file_name = $entry->[4];

	#
	# エントリを書き込む。
	#
	if (!$leaf_layer->{'handle'}
	    ->print(pack("Ca*NnNn", $word_length, $word, 0, 0, 0, 0))) {
	    $self->{'error_message'} = "failed to write the file, $ERRNO: "
		. $leaf_layer->{'file_name'};
	    $self->close_internal();
	    return 0;
	}

	#
	# テキストと見出しの参照情報を書き込む。
	#
	if (!$leaf_layer->{'reference'}
	    ->add_position_entry($source_position + $word_length + 7,
			      $heading_position, $heading_file_name)) {
	    $self->{'error_message'} = $self->{'reference'}->error_message();
	    $self->position_internal();
	    return 0;
	}
	if (!$leaf_layer->{'reference'}
	    ->add_position_entry($source_position + $word_length + 1,
			      $text_position, $text_file_name)) {
	    $self->{'error_message'} = $self->{'reference'}->error_message();
	    $self->close_internal();
	    return 0;
	}
	$source_position += $word_length + 13;
    }

    #
    # 半端なブロックの後方を "\0" で埋める。
    #
    my $pad_length = $block_length - $leaf_layer->{'block_length'};
    if (0 < $pad_length
	&& !$leaf_layer->{'handle'}->print("\0" x $pad_length)) {
	$self->{'error_message'} = "failed to write the file, $ERRNO: "
	    . $leaf_layer->{'file_name'};
	$self->close_internal();
	return 0;
    }

    return 1;
}

#
# 書式:
#	add_medium_layer_entry(level, word, position)
#	    level
#           word
# 		インデックスへ登録する単語。正規化されていること。
#           position
#		一つ下の層のインデックスの位置。
# メソッドの区分:
# 	private インスタンスメソッド。
# 説明:
# 	インデックスファイル群にエントリを一つ追加する。
# 戻り値:
#	成功すれば 1 を返す。失敗すれば 0 を返す。
#
sub add_medium_layer_entry {
    my $self = shift;
    my ($level, $word, $position) = @ARG;
    
    my $current_layer = $self->{'layers'}->[$level];

    #
    # 改ページの必要性が生じたら、エントリキューの内容を 1 つのブロック
    # にして書き出して、次のページへ進む。
    #
    my $word_length = length($word);
    my $overflow = 0;
    if ($current_layer->{'block_word_length'} < $word_length) {
	if ($block_length < (scalar(@{$current_layer->{'entry_queue'}}) + 2)
	    * ($word_length + 4) + 4) {
	    $overflow = 1;
	}
    } else {
	if ($block_length < (scalar(@{$current_layer->{'entry_queue'}}) + 2)
	    * ($current_layer->{'block_word_length'} + 4) + 4) {
	    $overflow = 1;
	}
    }

    if ($overflow) {
	if (!$self->write_medium_layer_block($level)) {
	    return 0;
	}

	#
	# 最後のエントリを上位エントリに追加する。
	#
  	if ($self->{'depth'} == $level + 1 && !$self->open_upper_layer()) {
  	    return 0;
  	}
  	my $upper_word = $current_layer->{'entry_queue'}->[-1]->[0];
	my $upper_position = ($current_layer->{'block_count'} - 1)
	    * $block_length;
  	if (!$self->add_medium_layer_entry($level + 1, $upper_word,
					   $upper_position)) {
  	    return 0;
  	}

  	#
  	# エントリキューをリセット。
  	#
  	@{$current_layer->{'entry_queue'}} = ();
  	$current_layer->{'block_word_length'} = 0;
	$current_layer->{'block_count'}++;
    }

    #
    # エントリキューに、今回のエントリを足す。
    #
    push(@{$current_layer->{'entry_queue'}}, [$word, $position]);
    if ($current_layer->{'block_word_length'} < $word_length) {
	$current_layer->{'block_word_length'} = $word_length;
    }

    return 1;
}

#
# 書式:
#	write_medium_layer_block(level, close_flag)
#	    level
#		インデックスの階層レベル。
#	    close_flag
#		インデックスを閉じるために呼ぶときは、true がセッ
#		トされなければならない。
# メソッドの区分:
# 	private インスタンスメソッド。
# 説明:
# 	level で指定された上位インデックスの現在のエントリキューを
#	まとめて 1 ブロックにして書き出す。
# 戻り値:
#	成功すれば 1 を返す。失敗すれば 0 を返す。
#
sub write_medium_layer_block {
    my $self = shift;
    my ($level, $close_flag) = @ARG;

    my $current_layer = $self->{'layers'}->[$level];

    #
    # エントリキューが空なら、メソッドを抜ける。
    #
    if (@{$current_layer->{'entry_queue'}} == 0) {
	return 1;
    }

    #
    # ダミーのエントリ "\xff\xff...." をキューの末尾に追加する。
    #
    if ($close_flag) {
	push(@{$current_layer->{'entry_queue'}},
	     ["\xff" x $current_layer->{'block_word_length'},
	      $current_layer->{'entry_queue'}->[-1]->[1]]);
    }

    #
    # ブロックのヘッダを書き込む。
    #
    my $block_id = 0x00;
    if ($current_layer->{'block_count'} == 1) {
	$block_id |= 0x40;
    }
    if ($close_flag) {
	$block_id |= 0x20;
    }
    if (!$current_layer->{'handle'}->
	print(pack("CCn", $block_id, $current_layer->{'block_word_length'},
		   scalar(@{$current_layer->{'entry_queue'}})))) {
	$self->close_internal();
	return 0;
    }

    #
    # エントリキューの各エントリを書き込む。
    #
    my $lower_layer_filename = $self->{'layers'}->[$level - 1]->{'file_name'};
    my $source_position = ($current_layer->{'block_count'} - 1) * $block_length
	+ 4;
    my $i;
    for ($i = 0; $i < scalar(@{$current_layer->{'entry_queue'}}); $i++) {
	my $word = $current_layer->{'entry_queue'}->[$i]->[0];
	my $lower_layer_position = $current_layer->{'entry_queue'}->[$i]->[1];

	#
	# エントリを書き込む。
	#
	$word .= "\0" x ($current_layer->{'block_word_length'}
			 - length($word));
	if (!$current_layer->{'handle'}->print(pack("a*N", $word, 0))) {
	    $self->{'error_message'} = "failed to write the file, $ERRNO: "
		. $current_layer->{'file_name'};
	    $self->close_internal();
	    return 0;
	}

	#
	# 一レベル下位のインデックスへの参照情報を書き込む。
	#
	if (!$current_layer->{'reference'}
	    ->add_block_entry($source_position
			      + $current_layer->{'block_word_length'},
			      $lower_layer_position, $lower_layer_filename)) {
	    $self->{'error_message'} = $self->{'reference'}->error_message();
	    $self->position_internal();
	    return 0;
	}
	$source_position += $current_layer->{'block_word_length'} + 4;
    }

    #
    # 半端なブロックの後方を "\0" で埋める。
    #
    my $pad_length = $block_length
	- scalar(@{$current_layer->{'entry_queue'}})
	    * ($current_layer->{'block_word_length'} + 4) - 4;
    if (0 < $pad_length
	&& !$current_layer->{'handle'}->print("\0" x $pad_length)) {
	$self->close_internal();
	return 0;
    }

    #
    # 追加したダミーのエントリ "\xff\xff...." をキューから削除する。
    #
    if ($close_flag) {
	pop(@{$current_layer->{'entry_queue'}});
    }

    return 1;
}

######################################################################
# <インスタンス変数の値を返すメソッド群>
#
# 書式:
#	インスタンス変数名()
# メソッドの区分:
# 	public インスタンスメソッド。
# 戻り値:
#	インスタンス変数の値を返す。
#
sub file_name {
    my $self = shift;
    return $self->{'file_name'};
}

sub reference_file_name {
    my $self = shift;
    return $self->{'reference_file_name'};
}

sub depth {
    my $self = shift;
    return $self->{'depth'};
}

sub entry_count {
    my $self = shift;
    return $self->{'entry_count'};
}

sub error_message {
    my $self = shift;
    return $self->{'error_message'};
}

1;