package FFFF::Config;

# --------------------------------------------------------------------
# FFFF::Config
#
# - Apache::ConfigFile 1.18 を使っていますが使い方がめちゃくちゃ。
#   このモジュールは作り直すか、考え直す必要アリ。
#   いい加減につくってしまいました。スミマセン……
#
#   Apache::ConfigFile 1.14 では動かないことを確認しております。
#   ので最新版を同根しました。
#
# --------------------------------------------------------------------
use strict;
use FFFF::Apache::ConfigFile;
use Data::Dumper;

# --------------------------------------------------------------------
# - Apache::ConfigFile を使って設定ファイルを読み込み
# - 扱い安いようにデータを加工
#
# --------------------------------------------------------------------
sub read {
	my $class = shift;

	#
	# 設定ファイルの読み込み
	#
	my $conf = FFFF::Apache::ConfigFile->read(ignore_case => 1);
	my $config = {$conf->data()};
	my %config;


	#
	# システム情報読み込み
	#
	$config{DEBUG}        = $conf->cmd_config('Debug');
	$config{DEBUG}        = ($config{DEBUG} =~ /^On$/i)? 1 : 0;
	$config{SESSION_DIR}  = $conf->cmd_config('SessionDir');
	$config{COOKIE_NAME}  = $conf->cmd_config('CookieName');
	$config{SESSION_TYPE} = $conf->cmd_config('SessionType');
	$config{SESSION_TYPE} = ($config{SESSION_TYPE} =~ /^None$/i)? 'NONE' : 'COOKIE';

	eval {
		$config{SEARCH_PATH} = [
			'.',
			map{@$_} $conf->cmd_config_array('SearchPath')
		];
	};
	if ($@) {
		$config{SEARCH_PATH} = ['.'];
	}

	#
	# ディフォルト値の読み込み
	#
	eval {
		my %default = $conf->cmd_context(DefaultValue => "")->data();
		while (my ($key, $value) = each %default) {
			$default{$key} = join("", map {@$_} @$value);
		}
		$config{DEFAULT_VALUE} = \%default;
	};

	#
	# 標準で表示するテンプレート
	#
	my @action = $conf->get_action();
	$config{DEFAULT_TEMPLATE} = $conf->cmd_config('DefaultTemplate') || "$action[0].tmpl";

	#
	# オブジェクト作成
	#
	my $self = bless {
		DATA         => {%config},
		SEARCH_PATH  => $config{SEARCH_PATH},
		ACTION_ARRAY => [@action],
	}, $class;

	#
	# Action 毎のデータ解析
	#
	$self->config_action($conf);

	return $self;
}

# --------------------------------------------------------------------
# Actionディレクティブの解析
#
# --------------------------------------------------------------------
sub config_action {
	my $self = shift;
	my ($conf) = @_;

	my @action = @{$self->{ACTION_ARRAY}};
	for (my $i=0; $i<scalar(@action); $i++) {
		my $action = $action[$i];
		my %config;
		my $action_conf = $conf->{config_data}->{action}->{$action}->[0];

		#
		# 指定されてなければ次の {ActionName}.tmpl
		#
		$config{TEMPLATE}->{NEXT} = $action_conf->{next}->[0]->[0] || "$action[$i+1].tmpl";

		#
		# 指定されてなければ前のAction の {template}->{next}
		#
		$config{TEMPLATE}->{ERROR} = $action_conf->{error}->[0]->[0]
			|| $self->{DATA}->{ACTION}->{uc $action[$i-1]}->{TEMPLATE}->{NEXT}
			|| $self->{DATA}->{DEFAULT_TEMPLATE};

		#
		# 指定されて無くて ACTION が最後だったら On
		#
		$config{SESSION_EXPIRE} = $action_conf->{sessionexpire}->[0];
		if ($config{SESSION_EXPIRE} eq "") {
			$config{SESSION_EXPIRE} = ($i == scalar(@action)-1)? 1:0;
		}
		else {
			$config{SESSION_EXPIRE} = ($config{SESSION_EXPIRE} =~ /^On$/i)? 1 : 0;
		}

		#
		# セッションを作成するかどうか
		#
		$config{SESSION_CREATE} = $action_conf->{sessioncreate}->[0];
		$config{SESSION_CREATE} = ($config{SESSION_CREATE} =~ /^On$/i)? 1 : 0;

		#
		# 入力チェック
		#
		eval {
			#
			# 配列のリファレンスが入っている配列のリファレンス（ややこしぃ）を
			# 配列のリファレンスへ変換
			#
			# [
			#   ['INT'],
			#   ['NOT_NULL', 'HIRANGANA']
			# ]
			#
			# ↓↓↓↓↓↓↓↓↓↓↓
			#
			# ['INT', 'NOT_NULL', 'HIRANGANA']
			#
			my $input = $action_conf->{inputcheck}->{''}->[0];
			my %alias;
			while (my ($key, $value) = each %$input) {
				
				my @check;
				for my $check (map{@$_} @$value) {
					if ($check =~ /ALIAS\{([\w]+)\}/i) {
						$alias{$key} = $1;
					}
					else {
						
						#
						# IDENTICAL の場合は { } 内 はそのまま
						# それ以外は KEY は大文字に変換
						#
						if ($check =~ /IDENTICAL\{([\w]+)\}/i) {
							push(@check, "IDENTICAL{$1}");
						}
						else {
							push(@check, uc $check);
						}
					}
				}
				$input->{$key} = [@check];
			}
			$config{INPUT_CHECK}->{PLAN}  = $input;
			$config{INPUT_CHECK}->{ALIAS} = \%alias;
		};

		#
		# セッションチェック
		# 設定されてなければ前の Action の InputCheck を使う
		#
		my @session_check;
		eval {
			@session_check = map {@$_} $action_conf->{sessioncheck};
		};
		if ($i != 0 and scalar(@session_check) == 0) {
			$config{SESSION_CHECK} = [
				map {uc $_} @action[0..$i-1]
			];
		}
		else {
			$config{SESSION_CHECK} = [
				map {uc $_} @session_check
			];
		}

		#
		# 拡張機能
		#
		my @module;
		while (my ($key, $value) = each %{$action_conf->{module}}) {
			push (@module, $self->config_module($key, $value));
		}
		$config{MODULE} = [@module];

		$self->{DATA}->{ACTION}->{uc $action} = {%config};
	}
}

# --------------------------------------------------------------------
# Moduleディレクティブの設定読み込み
#
# --------------------------------------------------------------------
sub config_module {
	my $self = shift;
	my ($key, $value) = @_;

	$key = lc $key;

	#
	# モジュールの読み込み
	#
	my @require = (@{$self->{SEARCH_PATH}}, qw(FFFF/Module ./Module));
	for my $require (@require) {
		eval { require "$require/mod_${key}.pl"; };
		last unless ($@);
	}
	if ($@) {
		die "Can't locate: mod_${key}.pl in search path.(@require)";
	}

	#
	# モジュール側の オブジェクトを取得。
	#
	my $module = "FFFF::Module::${key}";
	my @module;
	for my $config (@{$value}) {
		my $obj = $module->new($config);
		push(@module, $obj);
	}
	return @module;
}

=head CHANGES
0.0.4   2002/05/22
	- モジュールはオブジェクトに

0.0.3   2002/05/21
	- SessionType を追加。
	  従来通りの Cookie とセッションを使わない None。

0.0.2   2002/05/14
    - IDENTICAL のキーが必ず大文字になっているバグ修正。

0.0.1   2002/05/09
    - original version
=cut

1;
