$dic_file='main.dic';		# 処理する辞書
my $long_file='out1.dic';	# 出力される辞書（長文）
my $short_file='out2.dic';	# 出力される辞書（短文）
my ($flag, $check, $word, $key, $res, $crkey, $ckey, $key_last, $last_flag, $key_ori);

# 展開したキーワードリストを値とするハッシュの作成
my $keys_ref = &make_key_list;
my %keys = %{$keys_ref};

# 展開したキーワードの最大長・最小長を値とするハッシュの作成
my (%max, %min, $max, $min, $key_dummy);
foreach $key1 (keys %keys) {
	$max = 0;
	$min = 100;
	foreach $key2 (@{$keys{$key1}}) {
		$key2 =~ s/？？//;		# 「？？」は消してしまう
		$key_dummy = $key2;
		$key_dummy =~ s/\.\*//g;
		$max = length($key_dummy) if $max < length($key_dummy);
		$min = length($key_dummy) if $min > length($key_dummy);
	}
	$max{$key1} = $max;
	$min{$key1} = $min;
}

# %maxのキーを値の降順にソートして配列@rkeyに格納
my @rkey = sort { $max{$b} <=> $max{$a}; } keys %max;

# キーワード同士を比較
open DB,"$dic_file";
open OUTS, ">>$short_file";
open OUTL,">>$long_file";

# 辞書の各行のキーワード部分$keyについて
while (<DB>) {
	next unless /:#/;
	$flag = 0;
	$check = 0;
	$word = $_;
	($key,$res) = split /:#/,$word;
	$key_ori = $key;								# $key_ori: &&型
	$key =~ s/([\[\\\]\^\{\|\}\~])/\\$1/g;		# メタ文字のエスケープ
	$key =~ s/&&/|/g;				# &&を|に戻す
	$key =~ s/？？//;				# ？？を消す			# $key: 正規表現型

	if ($key eq $key_last) {
		$check = 1;
		$flag = $last_flag;
	}
	$key_last = $key;

	if ($check == 0) {

		# 比較対照用のキーワードリスト中の各$key1（&&型）について
		LABEL: foreach $key1 (@rkey) {

			# $key1の示す最大長が$key_oriの示す最小長より小さくなったらそれ以降をスキップ
			if ($max{$key1} < $min{$key_ori}) {
				last;

			# $key1と$key_oriが同じなら次に移る
			} elsif ($key1 eq $key_ori) {
				next;
			}
	
			# そのkey1から展開されるキーワード$key2（展開された通常型）いずれかが
			foreach $key2 (@{$keys{$key1}}) {

				# $kye2が$key（正規表現型）とマッチするなら
				if ($key2 =~ /$key/) {
					$crkey = $key2;
					$crkey =~ s/\.\*//g;	# 比較対照用の展開型からワイルドカードを除去

					# 現在チェック中の$key_oriから展開されるキーワード$key3（展開された通常型）いずれかが
					foreach $key3 (@{$keys{$key_ori}}) {
						$ckey = $key3;
						$ckey =~ s/\.\*//g;	# チェック中の展開型からワイルドカードを除去

						# 比較対照用のキーワードより短ければ$flagを1にしてループを大脱出
						if (length($crkey) > length($ckey)) {
							$flag = 1;
							last LABEL;
						}
					}
				}
			}
		}
	}

	# $flagが0なら長文辞書へ書き出し
	if ($flag == 0) {
		print OUTL $word;

	# $flagが1なら短文辞書へ書き出し
	} elsif ($flag == 1) {
		print OUTS $word;
	}
	$last_flag = $flag;
}
close DB;
close OUTS;
close OUTL;

#-----------------------------------------------------------------------------------
# &&型辞書のキーワードリストを作成
# 　・オリジナルのキーワードをkey、展開したリストへの参照をvalueとするハッシュを作成
# 　・戻り値：作成したハッシュ（への参照）
#-----------------------------------------------------------------------------------
sub make_key_list {
	my ($rkey, @rkeys, @conv_keys, $key_old, %keys, $keys_ref);
	open RDB,"$dic_file";
	while(<RDB>){
		next unless /:#/;
		($rkey) = split /:#/;
		push @rkeys, $rkey;
	}
	close RDB;
	sort @rkeys;
	foreach $key (@rkeys) {
		$keys{$key} = &key_conv($key) if $key ne $key_old;
		$key_old = $key;
	}
	$keys_ref = \%keys;
	return $keys_ref;
}

#-----------------------------------------------------------------------------------
# &&型キーワードをリストに展開
# 　・キーワードを括弧と&&からなるユニットの階層構造に分解する
# 　　　・ユニットの基本形：A(B&&C)(D&&E)F
#		・括弧の数、括弧の中の&&の数は任意。ただし、入れ子になった括弧は不可。
# 	・例：A(B&&C(D&&E)(F&&G(H&&I)J)&&K)&&L → A(B&&C(D&&E)(F&&dummy0)&&K)&&L
# 		→ A(B&&dummy1&&K)&&L → dummy2&&L
# 　・引数　：キーワード（$string）
# 　・戻り値：キーワードを展開したリスト（への参照）
#-----------------------------------------------------------------------------------
sub key_conv {
	my $string = $_[0];
	my $i = 0;
	local @stock = ();						# sub convに渡すのがめんどくさかったのでlocalを使用
	my $delete;
	my $string_ref;
	my $match = '(&&)?([^\(\)&]*(\([^\(\)]+\)[^\(\)&]*)+)(&&)?';	# ユニットの正規表現

	while ($string =~ /$match/) {
		push (@stock, $2);					# ユニットを最下層から順次コピーしていく
		$delete = $2;
		$delete =~ s/([\[\\\]\^\{\|\}\~\(\)\.\*])/\\$1/g;
		$string =~ s/$delete/dummy$i/;				# コピーの終了したユニットをダミー（dummyX）と置換
		++$i;
	}
	$string_ref = &conv($string);					# 全てのユニットをダミーに置換したらsub convに渡す
	return $string_ref;						# sub convの戻り値をそのまま返す
}

#-----------------------------------------------------------------------------------
# sub key_convで作成したユニットの階層構造（$stringと@stock）からリストを作成
# 　・sub key_convで作成した階層構造から通常型キーワードを組み立てる。
# 　・引数　：sub key_convによって変換されたキーワード
# 　・戻り値：&&型キーワードがカバーする全ての通常型キーワードのリスト（への参照）
#-----------------------------------------------------------------------------------
sub conv {
	my $string = $_[0];
	my @store = ();
	my @strings = ();
	my $strings_ref;

	# ユニットからリストに展開
	if ($string =~ /\(.*\)/) {
		$strings_ref = &rearrange($string);			# 括弧が含まれている場合はsub rearrangeに渡す
		@strings = @{$strings_ref};
	} else {
		@strings = split /&&/, $string;				# 括弧がなければ&&で分割する
	}

	# 展開されたリストの各要素について階層をひとつ戻す
	foreach (@strings) {						# &&で分割してできたリストの各要素について
		$_ =~ s/dummy([0-9]+)/($stock[$1])/;			# ダミーをコピーしておいたユニットに書き戻す
	}
	foreach $string2 (@strings) {					# リストの各要素について
		if ($string2 =~ /&&|\(|\)/) {
			$string2 = &conv($string2);			# &&や括弧がなくなるまで再帰する（再帰サブルーチンは難しいぞ）
			push @store, @{$string2};
		} else {
			push @store, $string2;				# 展開を完了したキーワードは@storeにコピー
		}
	}
	return \@store;							# @storeへの参照を返す
}

#-----------------------------------------------------------------------------------
# ユニットを通常型キーワードのリストに展開
# 　　　・ユニットの基本形：A(B&&C)(D&&E)F→通常型：ABDF,ABEF,ACDF,ACEF
# ・引数　：ユニット
# ・戻り値：ユニットを展開したリスト
#-----------------------------------------------------------------------------------
sub rearrange {
	my $string = $_[0];
	my @strings = split /\(|\)\(|\)/, $string;			# ユニットを括弧内とその両外側に分割
	my @strings2 = ('');
	my @store = ();
	my $fragment;
	my @fragments;
	my $fragment3;

	while (@strings) {
		$fragment = shift @strings;
		next unless $fragment;
		$fragment = '&&'.$fragment if $fragment =~ s/&&$//;
		@fragments = split /&&/, $fragment;
		foreach $string2 (@strings2) {
			foreach $fragment2 (@fragments) {
				$fragment3 = $string2.$fragment2;
				push @store, $fragment3;
			}
		}
		@strings2 = @store;
		@store = ();
	}
	return \@strings2;
}