# -----------------------------------------------------------------------------
# Tripletail::Ini - 設定ファイルを読み書きする
# -----------------------------------------------------------------------------
package Tripletail::Ini;
use strict;
use warnings;
our $TL;

1;

sub _new {
	my $pkg = shift;
	my $this = {};
	bless $this, $pkg;

	$this->{filename} = undef;
	$this->{ini} = {};

	if(scalar(@_)) {
		$this->read(@_);
	}

	$this;
}

sub const {
	my $this = shift;
	$this->{const} = 1;
	$this;
}

sub read {
	my $this = shift;
	my $filename = shift;

	%{$this->{ini}} = ();

	my $fh = $TL->_gensym;
	if(!open($fh, "$filename")) {
		die __PACKAGE__."#read: failed to open a file to read. [$filename] ($!) (ファイルを読めません)\n";
	}

	binmode($fh);
	flock($fh, 1);
	seek($fh, 0, 0);
	my $group = '';
	while(<$fh>) {
		next if(m/^#/);
		s/^\s+//;
		s/\s+$//;
		next if(m/^$/);
		if(m/^\[(.+)\]$/) {
			$group = $1;
		} else {
			my ($key, $value) = split(/\s*=\s*/, $_, 2);
			if(defined($group) && defined($key) && defined ($value)) {
				if(!exists($this->{ini}{$group}{$key})) {
					$this->{ini}{$group}{$key} = $value;
				}
			} else {
				die __PACKAGE__."#read: syntax error in the ini. line [$.] (INIファイルの形式が不正です)\n";
			}
		}
	}
	close($fh);

	$this->{filename} = $filename;
	$this;
}

sub write {
	my $this = shift;
	my $filename = shift;

	my $fh = $TL->_gensym;
	if(!open($fh, ">$filename")) {
		die __PACKAGE__."#write: failed to open a file to write. [$filename] ($!) (ファイルに書けません)\n";
	}

	binmode($fh);
	flock($fh, 2);
	seek($fh, 0, 0);
	foreach my $group (keys %{$this->{ini}}) {
		print $fh "[$group]\n";
		foreach my $key (keys %{$this->{ini}{$group}}) {
			print $fh "$key = " . $this->{ini}{$group}{$key} . "\n";
		}
		print $fh "\n";
	}
	close($fh);

	$this;
}

sub existsGroup {
	my $this = shift;
	my $group = shift;
	my $raw = shift;

	if(!defined($group)) {
		die __PACKAGE__."#existsGroup: arg[1] is not defined. (第1引数が指定されていません)\n";
	} elsif(ref($group)) {
		die __PACKAGE__."#existsGroup: arg[1] is a reference. [$group] (第1引数がリファレンスです)\n";
	}

	$group = ($this->_getrawgroupname($group))[0] if(!$raw);

	return 0 if(!defined($group));

	if(exists($this->{ini}{$group})) {
		return 1;
	} else {
		return 0;
	}
}

sub existsKey {
	my $this = shift;
	my $group = shift;
	my $key = shift;
	my $raw = shift;

	if(!defined($group)) {
		die __PACKAGE__."#existsKey: arg[1] is not defined. (第1引数が指定されていません)\n";
	} elsif(ref($group)) {
		die __PACKAGE__."#existsKey: arg[1] is a reference. [$group] (第1引数がリファレンスです)\n";
	}
	if(!defined($key)) {
		die __PACKAGE__."#existsKey: arg[2] is not defined. (第2引数が指定されていません)\n";
	} elsif(ref($key)) {
		die __PACKAGE__."#existsKey: arg[2] is a reference. [$key] (第2引数がリファレンスです)\n";
	}

	my @group;
	if($raw) {
		push(@group,$group);
	} else {
		@group = $this->_getrawgroupname($group);
	}

	foreach my $groupname (@group) {
		if(exists($this->{ini}{$groupname}{$key})) {
			return 1;
		}
	}

	undef;
}

sub getGroups {
	my $this = shift;
	my $raw = shift;
	
	if($raw) {
		keys %{$this->{ini}};
	} else {
		my $groups;
		foreach my $group (keys %{$this->{ini}}) {
			$group =~ /^([^:]+)/;
			foreach my $groupname ($this->_getrawgroupname($1)) {
				$groupname =~ /^([^:]+)/;
				$groups->{$1} = 1;
			}
		}
		keys %{$groups};
	}
}

sub getKeys {
	my $this = shift;
	my $group = shift;
	my $raw = shift;

	if(!defined($group)) {
		die __PACKAGE__."#getKeys: arg[1] is not defined. (第1引数が指定されていません)\n";
	} elsif(ref($group)) {
		die __PACKAGE__."#getKeys: arg[1] is a reference. [$group] (第1引数がリファレンスです)\n";
	}

	my @group;
	if($raw) {
		push(@group,$group);
	} else {
		@group = $this->_getrawgroupname($group);
	}

	my @result;
	my %occurence;
	foreach my $groupname (@group) {
		if(my $grp = $this->{ini}{$groupname}) {
			foreach my $key (keys %$grp) {
				if(!$occurence{$key}) {
					push(@result,$key);
					$occurence{$key} = 1;
				}
			}
		}
	}

	@result;
}

sub get {
	my $this = shift;
	my $group = shift;
	my $key = shift;
	my $default = shift;
	my $raw = shift;

	if(!defined($group)) {
		die __PACKAGE__."#get: arg[1] is not defined. (第1引数が指定されていません)\n";
	} elsif(ref($group)) {
		die __PACKAGE__."#get: arg[1] is a reference. [$group] (第1引数がリファレンスです)\n";
	}
	if(!defined($key)) {
		die __PACKAGE__."#get: arg[2] is not defined. (第2引数が指定されていません)\n";
	} elsif(ref($key)) {
		die __PACKAGE__."#get: arg[2] is a reference. [$key] (第2引数がリファレンスです)\n";
	}

	my @group;
	if($raw) {
		push(@group,$group);
	} else {
		@group = $this->_getrawgroupname($group);
	}

	my $result;
	foreach my $groupname (@group) {
		if(exists($this->{ini}{$groupname}) && exists($this->{ini}{$groupname}{$key})) {
			$result = $this->{ini}{$groupname}{$key};
			last;
		}
	}

	if(!defined($result)) {
		$result = $default;
	}

	$result;
}

sub set {
	my $this = shift;
	my $group = shift;
	my $key = shift;
	my $value = shift;

	if(exists($this->{const})) {
		die __PACKAGE__."#set: This instance is a const object. (このIniオブジェクトの内容は変更できません)\n";
	}

	if(!defined($group)) {
		die __PACKAGE__."#set: arg[1] is not defined. (第1引数が指定されていません)\n";
	} elsif(ref($group)) {
		die __PACKAGE__."#set: arg[1] is a reference. [$group] (第1引数がリファレンスです)\n";
	}
	if(!defined($key)) {
		die __PACKAGE__."#set: arg[2] is not defined. (第2引数が指定されていません)\n";
	} elsif(ref($key)) {
		die __PACKAGE__."#set: arg[2] is a reference. [$key] (第2引数がリファレンスです)\n";
	}
	if(!defined($value)) {
		die __PACKAGE__."#set: arg[3] is not defined. (第3引数が指定されていません)\n";
	} elsif(ref($value)) {
		die __PACKAGE__."#set: arg[2] is a reference. [$value] (第2引数がリファレンスです)\n";
	}
	if($group =~ m/[\x00-\x1f]/) {
		die __PACKAGE__."#set: arg[1]: contains a control code. (第1引数にコントロールコードが含まれています)\n";
	}
	if($key =~ m/[\x00-\x1f]/) {
		die __PACKAGE__."#set: arg[2]: contains a control code. (第2引数にコントロールコードが含まれています)\n";
	}
	if($value =~ m/[\x00-\x1f]/) {
		die __PACKAGE__."#set: arg[3]: contains a control code. (第3引数にコントロールコードが含まれています)\n";
	}
	if($group =~ m/^\s+/ or $group =~ m/\s+$/) {
		die __PACKAGE__."#set: arg[1]: the argument is not allowed to have preceding or trailing spaces. (第1引数の前後にスペースが含まれています)\n";
	}
	if($key =~ m/^\s+/ or $key =~ m/\s+$/) {
		die __PACKAGE__."#set: arg[2]: the argument is not allowed to have preceding or trailing spaces. (第2引数の前後にスペースが含まれています)\n";
	}
	if($value =~ m/^\s+/ or $value =~ m/\s+$/) {
		die __PACKAGE__."#set: arg[3]: the argument is not allowed to have preceding or trailing spaces. (第3引数の前後にスペースが含まれています)\n";
	}

	$this->{ini}{$group}{$key} = $value;

	$this;
}

sub delete {
	my $this = shift;
	my $group = shift;
	my $key = shift;
	my $raw = shift;

	if(exists($this->{const})) {
		die __PACKAGE__."#delete, This instance is const object.\n";
	}

	if(!defined($group)) {
		die __PACKAGE__."#delete: arg[1] is not defined. (第1引数が指定されていません)\n";
	} elsif(ref($group)) {
		die __PACKAGE__."#delete: arg[1] is a reference. [$group] (第1引数がリファレンスです)\n";
	}
	if(!defined($key)) {
		die __PACKAGE__."#delete: arg[2] is not defined. (第2引数が指定されていません)\n";
	} elsif(ref($key)) {
		die __PACKAGE__."#delete: arg[2] is a reference. [$key] (第2引数がリファレンスです)\n";
	}

	my @group;
	if($raw) {
		push(@group,$group);
	} else {
		@group = $this->_getrawgroupname($group);
	}

	foreach my $groupname (@group) {
		delete $this->{ini}{$groupname}{$key};
	}


	$this;
}

sub deleteGroup {
	my $this = shift;
	my $group = shift;
	my $raw = shift;

	if(exists($this->{const})) {
		die __PACKAGE__."#delete, This instance is a const object.\n";
	}

	if(!defined($group)) {
		die __PACKAGE__."#delete: arg[1] is not defined. (第1引数が指定されていません)\n";
	} elsif(ref($group)) {
		die __PACKAGE__."#delete: arg[1] is a reference. [$group] (第1引数がリファレンスです)\n";
	}

	$group = $this->_getrawgroupname($group) if(!$raw);

	delete $this->{ini}{$group};

	$this;
}

sub _filename {
	my $this = shift;
	$this->{filename};
}

#特化指定やIPアドレス指定に適合しているグループを全て返す
sub _getrawgroupname {
	my $this = shift;
	my $group = shift;
	
	my @group;
	foreach my $spec (@Tripletail::specialization, '') {
		my $groupname = (length $spec ? "$group:$spec" : $group);
		foreach my $rawgroup ($this->getGroups(1)) {
			if($rawgroup =~ m/^([^\@]+)/) {
				next if($groupname ne $1);
				my $matchflag = 1;
				if($rawgroup =~ m/\@server:([^\@:]+)/){
					$matchflag = 0;
					my $servermask = $this->get('HOST' => $1,undef,1);
					if(defined($servermask)) {
						my $server = $ENV{SERVER_ADDR};
						if(!defined($server)){
							# ipaddress of host.
							$server = $TL->_readcmd("hostname -i 2>&1");
							$server = $server && $server =~ /^\s*([0-9.]+)\s*$/ ? $1 : undef;
						}
						if(defined($server)) {
							if($TL->newValue->set($server)->isIpAddress($servermask)) {
								$matchflag = 1;
							}
						}
					}
				}
				if($matchflag == 1 && $rawgroup =~ m/\@remote:([^\@:]+)/){
					$matchflag = 0;
					my $remotemask = $this->get('HOST' => $1,undef,1);
					if(defined($remotemask)) {
						if(my $remote = $ENV{REMOTE_ADDR}) {
							if($TL->newValue->set($remote)->isIpAddress($remotemask)) {
								$matchflag = 1;
							}
						}
					}
				}
				if($matchflag == 1) {
					push(@group,$rawgroup);
				}
			}
		}
	}
	@group;
}


__END__

=encoding utf-8

=head1 NAME

Tripletail::Ini - 設定ファイルを読み書きする

=head1 SYNOPSIS

  my $ini = $TL->newIni('foo.ini');
  
  print $ini->get(Group1 => 'Key1');
  
  $ini->set(Group2 => 'Key1' => 'value');
  $ini->write('bar.ini');

=head1 DESCRIPTION

以下のような設定ファイルを読み書きする。

  [HOST]
  Debughost = 192.168.10.0/24
  Testuser = 192.168.11.5 192.168.11.50
  [TL@server:Debughost]
  logdir = /home/tl/logs
  errormail = tl@example.org
  [TL:regist@server:Debughost]
  logdir = /home/tl/logs/regist
  [TL]
  logdir = /home/tl/logs
  errormail = tl@example.org
  [TL:regist]
  logdir = /home/tl/logs/regist
  [Debug@remote:Testuser]
  enable_debug=1
  [Group]
  Key=Value
  [DB]
  Type=MySQL
  host=1.2.3.4
  [Cookie]
  expire=30day
  domain=.ymir.jp
  [Smtp]
  host=localhost

=over 4

=item TLのuse及び特化指定も参照する事

=item グループ名には "[" "]" 制御文字(0x00-0x20,0x7f,0x80-0x9f,0xff) 以外の半角英数字が使用可能。

=item グループ名の"@" ":"は特化指定用の文字となる為、任意の項目への使用は出来ない。

=item 空行は無視

=item # で始まる行はコメント

=item 連続行は対応しない

=item 同一グループ名は一つのグループとして扱われる

=item 同一項目は最初に書かれた物が有効

=item 特化指定は グループ名:名称@server:Servermask@remote:Remotemask の順番で記述する必要性がある

=item 適合する特化指定が複数存在する場合、最初に存在する物が有効となる

=item 特化指定が存在する場合、特化指定無しは常に最後に利用される

=item 初期にC<use>で指定されるiniファイル以外のiniファイルにもC<use>で指定した特化指定が有効となる

=item HOSTグループには、特化指定は使用できない

=back


=head2 METHODS

=over 4

=item C<< $TL->newIni >>

  $TL->newIni
  $TL->newIni($filename)

Tripletail::Ini オブジェクトを作成。
設定ファイルを指定してあればreadメソッドで読み込む。

=item C<< read >>

  $ini->read($filename)

指定した設定ファイルを読み込む。

=item C<< write >>

  $ini->write($filename)

指定した設定ファイルに書き込む。
自動的に読み込まれる$INIに関しては書き込みは出来ない。

=item C<< existsGroup >>

  $bool = $ini->existsGroup($group, $raw)

グループの存在を確認する。存在すれば1、しなければundefを返す。
$rawに1を指定した場合、特化指定を含んだグループ文字列で存在を確認する。

=item C<< existsKey >>

  $bool = $ini->existsKey($group => $key, $raw)

指定グループのキーの存在を確認する。存在すれば1、しなければundefを返す。
$rawに1を指定した場合、特化指定を含んだグループ文字列で存在を確認する。

=item C<< getGroups >>
  
  @groups = $ini->getGroups($raw)

グループ一覧を配列で返す。
$rawに1を指定した場合、特化指定を含んだグループ文字列で一覧を返す。

=item C<< getKeys >>

  @keys = $ini->getKeys($group, $raw)

グループのキー一覧を配列で返す。グループがなければ空配列を返す。
$rawに1を指定した場合、特化指定を含んだグループ文字列で確認し一覧を返す。

=item C<< get >>

  $val = $ini->get($group => $key, $default, $raw)

指定されたグループ・キーの値を返す。グループorキーがなければ$defaultで指定された値を返す。
$defaultが指定されなかった場合は、undefを返す。
$rawに1を指定した場合、特化指定を含んだグループ文字列で確認し値を返す。

=item C<< set >>

  $ini->set($group => $key => $value)

指定されたグループ・キーの値を設定する。グループがなければ作成される。

=item C<< const >>

  $ini->const

このメソッドを呼び出すと、以後データの変更は不可能となる。

=item C<< delete >>

  $ini->delete($group => $key, $raw)

指定されたグループ・キーの値を削除する。
$rawに1を指定した場合、特化指定を含んだグループ文字列で確認し削除する。

=item C<< deleteGroup >>

  $ini->deleteGroup($group, $raw)

指定されたグループを削除する。
$rawに1を指定した場合、特化指定を含んだグループ文字列で確認し削除する。

=back


=head1 SEE ALSO

L<Tripletail>

=head1 AUTHOR INFORMATION

=over 4

Copyright 2006 YMIRLINK Inc. All Rights Reserved.

This framework is free software; you can redistribute it and/or modify it under the same terms as Perl itself

このフレームワークはフリーソフトウェアです。あなたは Perl と同じライセンスの 元で再配布及び変更を行うことが出来ます。

Address bug reports and comments to: tl@tripletail.jp

HP : http://tripletail.jp/

=back

=cut
