# -*- mode: perl; coding: utf-8 -*-
# Keitairc::Config
#
# Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
# Copyright (c) 2010 ISHIKAWA Mutsumi <ishikawa@hanzubon.jp>
# This program is covered by the GNU General Public License 2

package Keitairc::Config;
use AppConfig qw(:argcount);
use Cwd;
use Encode;
use Encode::MIME::Name;
use strict;
use warnings;
our @ISA = qw(AppConfig);

################################################################
sub new{
	my $class = shift;
	my $arg = shift;
	my @argv = @{$arg->{argv}};
	my $me = $class->SUPER::new(
		{CASE => 1,
		 ERROR => \&on_error,
		 GLOBAL => {
			 ARGCOUNT => ARGCOUNT_ONE,
		 }});

	$me->define(
		# required
		'irc_nick' => {ATTR => 'RO|REQ'},
		'irc_username' => {ATTR => 'RO|REQ'},
		'irc_server'  => {ATTR => 'RO|REQ'},
		'web_password'  => {ATTR => 'RO|REQ'},
		'web_host' => {ATTR => 'RO|REQ'},

		# optional
		'irc_password',
		'irc_desc' => {DEFAULT => 'keitairc'},
		'au_subscriber_id' => {DEFAULT => ''},
		'docomo_foma_icc' => {DEFAULT => ''},
		'docomo_imodeid' => {DEFAULT => ''},
		'softbank_serial_key' => {DEFAULT => ''},
		'emobile_userid' => {DEFAULT => ''},
		'irc_keyword',
		'web_listen_port' => {ATTR => 'RO'},
		'web_title' => {DEFAULT => 'keitairc'},
		'common_header' => {DEFAULT => '
<meta name="Robots" content="noindex,nofollow" />
<meta name="Keywords" content="norobot" />
<meta http-equiv="pragma" content="no-cache" />
<meta http-equiv="cache-control" content="no-cache" />
<meta http-equiv="expires" content="-1" />'},
		'extra_header' => {DEFAULT => ''},
		'silent_config' => {DEFAULT => $arg->{silent}, ATTR => 'RO'},
		'version' => {DEFAULT => $arg->{version}},
		'template_dir'  => {DEFAULT => getcwd() . '/data/templates:__KEITAIRC_DATA_DIR__/templates', ATTR => 'RO'},
		'plugin_dir' => {DEFAULT => getcwd() . '/data/plugins:__KEITAIRC_DATA_DIR__/plugins', ATTR => 'RO'},
		'public_dir' => {DEFAULT => getcwd() . '/data/public:__KEITAIRC_DATA_DIR__/public', ATTR => 'RO'},
		'url_redirect' => {DEFAULT => ''},
		'smtp_server' => {DEFAULT => ''},
		'smtp_from' => {DEFAULT => ''},
		'smtp_to' => {DEFAULT => ''},
		'rgeocode_server' => {DEFAULT => 'finds'},
		'pid_file' => {DEFAULT => 'keitairc.pid', ATTR => 'RO'},

		'web_root' => {TYPE => 'web_root', DEFAULT => '/', ATTR => 'RO'},
		'web_schema' => {TYPE => 'web_schema', DEFAULT => 'http', ATTR => 'RO'},
		'fontsize' => {TYPE => 'fontsize', DEFAULT => '+0'},
		'mobile_fontsize' => {TYPE => 'fontsize', DEFAULT => -1},
		'irc_charset' => {TYPE => 'charset', DEFAULT => 'utf8'},
		'web_charset' => {TYPE => 'charset', DEFAULT => 'shiftjis'},
		'pid_dir' => {TYPE => 'dir', DEFAULT => $ENV{HOME} . '/.keitairc.d', ATTR => 'RO'},
		'url_target' => {TYPE => 'url_target', DEFAULT => '_self'},
		'log' => {TYPE => 'log', DEFAULT => 'file', ATTR => 'RO'},

		# optional integer params
		'irc_port' => {TYPE => 'int', DEFAULT => 6667, ATTR => 'RO'},
		'cookie_ttl' => {TYPE => 'int', DEFAULT => 86400 * 3},  # 3 days
		'session_ttl' => {TYPE => 'int', DEFAULT => 60 * 30},  # 30 min
		'cache_expire' => {TYPE => 'int', DEFAULT => 3600 * 12}, # 12 hour
		'web_port' => {TYPE => 'int', DEFAULT => 8080, ATTR => 'RO'},
		'web_lines' => {TYPE => 'int', DEFAULT => 100},
		'ping_delay' => {TYPE => 'int', DEFAULT => 30},
		'reconnect_delay' => {TYPE => 'int', DEFAULT => 10},

		# optional boolean params
		'show_joinleave' => {TYPE => 'bool', DEFAULT => 1},
		'show_console' => {TYPE => 'bool', DEFAULT => 0},
		'follow_nick' => {TYPE => 'bool', DEFAULT => 1},
		'debug' => {TYPE => 'bool', DEFAULT => 0},
		'daemonize' => {TYPE => 'bool', DEFAULT => 0, ATTR => 'RO'},
		'reverse_message' => {TYPE => 'bool', DEFAULT => 1},
		'reverse_recent' => {TYPE => 'bool', DEFAULT => 1},
		'reverse_unread' => {TYPE => 'bool', DEFAULT => 1},
		'webkit_newui' => {TYPE => 'bool', DEFAULT => 1},

		# obsolates (ignored)
		'show_newmsgonly' => {TYPE => 'obsolates'},
		'web_username' => {TYPE => 'obsolates'},
		'use_cookie' => {TYPE => 'obsolates'},
		'au_pcsv' => {TYPE => 'obsolates'},
		);

	if(-r '/etc/keitairc'){
		$me->file('/etc/keitairc');
	}
	if(-r $ENV{HOME} . '/.keitairc'){
		$me->file($ENV{HOME} . '/.keitairc');
	}
	if(-r $ENV{HOME} . '/.keitairc.d/config.dump'){
		$me->file($ENV{HOME} . '/.keitairc.d/config.dump');
	}

	if(defined $argv[0]){
		if(-r $argv[0]){
			$me->file($argv[0]);
			shift(@argv);
		}
	}

	$me->args(\@argv);

	# check required parameters
	foreach my $n (keys %{$me->{'REQ'}}) {
		if(!defined($me->get($n)) || !length($me->get($n))) {
			die($n . ' does not specified');
		}
	}

	if(!defined($me->web_listen_port()) || !length($me->web_listen_port())){
		$me->web_listen_port($me->web_port());
	}

	$me;
}

################################################################
sub file {
	my $me = shift;
	my $file = shift;
	if(-r $file){
		$me->SUPER::file($file);
		print STDERR "Loaded configuration file: $file\n" unless $me->silent_config();
		return;
	}
	warn("$file does not exist");
}

################################################################
sub define {
	my $me = shift;
	my @args = ();

	while (@_) {
		my $var = shift;
		my $cfg = ref($_[0]) eq 'HASH' ? shift : { };
		if (defined $cfg->{TYPE}) {
			if (!defined $cfg->{VALIDATE} && defined &{'valid_' . $cfg->{TYPE}}) {
				$cfg->{VALIDATE} = \&{'valid_' . $cfg->{TYPE}};
			}
			if (!defined $cfg->{ARGCOUNT} && $cfg->{TYPE} eq 'bool') {
				$cfg->{ARGCOUNT} = ARGCOUNT_NONE;
			}
			$me->type($var, $cfg->{TYPE});
			delete $cfg->{TYPE};
		}
		if (defined $cfg->{ATTR}) {
			my @attr = split(/\|/, $cfg->{ATTR});
			foreach my $at (@attr) {
				if ($at eq 'RO') {
					$me->readonly($var, 1);
				} elsif ($at eq 'REQ') {
					$me->required($var, 1);
				} else {
					warn 'Ignore unknown attribute: ' . $at;
				}
			}
			delete $cfg->{ATTR};
		}
		push(@args, $var => $cfg);
	}

	return $me->SUPER::define(@args);
}

sub type {
	my ($me, $name, $type) = @_;
	$me->{TYPE} = {} if (!defined $me->{TYPE});
	$me->{TYPE}->{$name} = $type if (defined $type);
	return (defined $me->{TYPE}->{$name} ? $me->{TYPE}->{$name} : 'string');
}

sub bool_attr {
	my ($me, $type_name, $name, $flag) = @_;
	$me->{$type_name} = {} if (!defined $me->{$type_name});
	if (defined $flag) {
		if ($flag) {
			$me->{$type_name}->{$name} = 1;
		} else {
			delete $me->{$type_name}->{$name};
		}
	}
	return defined $me->{$type_name}->{$name};
}

sub readonly {
	my $me = shift;
	return $me->bool_attr('RO', @_);
}

sub required {
	my $me = shift;
	return $me->bool_attr('REQ', @_);
}

################################################################
sub content_charset{
	my $me = shift;
	Encode::MIME::Name::get_mime_name(Encode::resolve_alias($me->web_charset()));
}

################################################################
sub dump {
	my $me = shift;
	my %list = $me->varlist('.*');
	my $ret = '';
	foreach my $k (sort keys %list) {
		if (defined $list{$k} && length($list{$k})) {
			my $value = $list{$k};
			$value =~ s/\x0D\x0A|\x0D|\x0A//g;
			$ret .= $k .' = '. $value . "\n"
		}
	}
	return $ret;
}

sub dump2file {
	my $me = shift;
	if (! open(FH, '> ' . $ENV{HOME} . '/.keitairc.d/config.dump') ) {
		$::log->log_error('can not open config dump file: ' . $ENV{HOME} . '/.keitairc.d/config.dump');
		return 0;
	}

	print FH $me->dump;

	close(FH);
	return 1;
}

################################################################
# config params check utility functions
################################################################
sub on_error {
	my $msg = shift;
	die $msg;
}

sub valid_int {
	my ($name, $value) = @_;
	return 1 if ($value =~ /^\d+$/);

	if (my $val = eval $value) {
		return 1 if ($val =~ /^\d+$/);
	}

	return 0;
}

sub valid_web_root {
	my ($name, $value) = @_;
	return ($value =~ /^\//);
}

sub valid_web_schema {
	my ($name, $value) = @_;
	return ($value =~ /^https?$/);
}

sub valid_fontsize {
	my ($name, $value) = @_;
	return ($value =~ /^[+-]?[0-7]$/);
}

sub valid_charset {
	my ($name, $value) = @_;
	return Encode::resolve_alias($value);
}

sub valid_dir {
	my ($name, $value) = @_;
	if (-w $value) {
		return 1;
	} else {
		print STDERR "pid_dir $value is not writable\n";
		return 0;
	}
}

sub valid_url_target {
	my ($name, $value) = @_;
	return ($value =~ /^_(?:blank|self|top|parent)$/);
}

sub valid_log {
	my ($name, $value) = @_;
	return ($value =~ /^(?:(?:file|syslog|stdio)$|(?:file|syslog):)/);
}

sub valid_obsolates {
	my ($name, $value) = @_;
	warn($name . ' has obsoleted from keitairc 2.0, ignored');
	return 1;
}

1;
