X-Git-Url: http://git.osdn.net/view?a=blobdiff_plain;f=lib%2FKeitairc%2FConfig.pm;h=2033dc066925ca3bf78259a165dcd27c0a2d5379;hb=466219c1c6a3b7e1120af8cbe462e3a2fab33f0d;hp=db2a7984cc0f96ae591666acb5b78f3ba39624fb;hpb=191d85728a56fefe16e4b4c0e610e2b5bea4b7f7;p=keitairc%2Fkeitairc.git

diff --git a/lib/Keitairc/Config.pm b/lib/Keitairc/Config.pm
index db2a798..2033dc0 100644
--- a/lib/Keitairc/Config.pm
+++ b/lib/Keitairc/Config.pm
@@ -1,73 +1,106 @@
 # -*- mode: perl; coding: utf-8 -*-
 # Keitairc::Config
-# $Id: Config.pm,v 1.20 2008-08-03 02:58:19 morimoto Exp $
-# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/lib/Keitairc/Config.pm,v $
 #
 # 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, $version, @argv) = @_;
+	my $class = shift;
+	my $arg = shift;
+	my @argv = @{$arg->{argv}};
 	my $me = $class->SUPER::new(
-		{
-			CASE => 1,
-			GLOBAL => {
-				ARGCOUNT => ARGCOUNT_ONE,
-			}
-		},
-		qw(irc_nick irc_username irc_desc
-		   irc_server irc_port irc_password
-		   irc_keyword irc_charset
-		   au_subscriber_id au_pcsv
-		   docomo_foma_icc docomo_imodeid
-		   softbank_serial_key emobile_userid
-		   use_cookie cookie_ttl session_ttl
-		   web_port web_title web_lines web_root
-		   web_username web_password web_host web_charset
-		   fontsize mobile_fontsize
-		   show_newmsgonly show_joinleave show_console
-		   ping_delay reconnect_delay follow_nick
-		   smtp_server smtp_from smtp_to debug
-		   version daemonize pid_dir pid_file
-		   template_dir plugin_dir public_dir
-		   reverse_message reverse_recent reverse_unread)
-		);
+		{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'},
 
-	# set default values
-	$me->version($version);
-	$me->irc_desc('keitairc');
-	$me->irc_port(6667);
-	$me->irc_charset('iso-2022-jp-1');
-	$me->web_port(8080);
-	$me->web_title('keitairc');
-	$me->web_lines(100);
-	$me->web_root('/');
-	$me->web_charset('shiftjis');
-	$me->ping_delay(30);
-	$me->reconnect_delay(10);
-	$me->cookie_ttl(86400 * 3);  # 3 days
-	$me->session_ttl(60 * 30);  # 30 min
-	$me->pid_dir('/var/run');
-	$me->pid_file('keitairc.pid');
-	$me->plugin_dir(getcwd() . '/lib/plugins:/usr/share/keitairc/lib/plugins');
-	$me->template_dir(getcwd() . '/lib/templates:/usr/share/keitairc/lib/templates');
-	$me->public_dir(getcwd() . '/lib/public:/usr/share/keitairc/lib/public');
-	$me->reverse_message(1);
-	$me->reverse_recent(1);
-	$me->reverse_unread(1);
-	$me->show_joinleave(1);
-	$me->fontsize('+0');
-	$me->mobile_fontsize(-1);
-	$me->follow_nick(1);
-	$me->debug(0);
+		# 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');
@@ -75,6 +108,9 @@ sub new{
 	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]){
@@ -85,59 +121,196 @@ sub new{
 
 	$me->args(\@argv);
 
-	if(defined $me->show_newmsgonly()){
-		Keitairc::Log::log('show_newmsgonly has obsoleted from keitairc 2.0');
+	# 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_username()){
-		Keitairc::Log::log('web_username has obsoleted from keitairc 2.0');
+	if(!defined($me->web_listen_port()) || !length($me->web_listen_port())){
+		$me->web_listen_port($me->web_port());
 	}
 
-	if(defined $me->use_cookie()){
-		Keitairc::Log::log('use_cookie has obsoleted from keitairc 2.0');
-	}
+	$me;
+}
 
-	if(defined $me->au_pcsv()){
-		Keitairc::Log::log('au_pcsv has obsoleted from keitairc 2.0');
+################################################################
+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");
+}
 
-	if(!defined($me->irc_nick()) || !length($me->irc_nick())){
-		Keitairc::Log::log_die('irc_nick does not specified');
-	}
+################################################################
+sub define {
+	my $me = shift;
+	my @args = ();
 
-	if(!defined($me->irc_username()) || !length($me->irc_username())){
-		Keitairc::Log::log_die('irc_username does not specified');
+	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);
 	}
 
-	if(!defined($me->irc_server()) || !length($me->irc_server())){
-		Keitairc::Log::log_die('irc_server does not specified');
-	}
+	return $me->SUPER::define(@args);
+}
 
-	if(!defined($me->web_port()) || !length($me->web_port())){
-		Keitairc::Log::log_die('web_port does not specified');
+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()));
+}
 
-	if(!defined($me->web_host()) || !length($me->web_host())){
-		Keitairc::Log::log_die('web_host does not specified');
+################################################################
+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;
+}
 
-	if(!defined($me->web_password()) || !length($me->web_password())){
-		Keitairc::Log::log_die('web_password does not specified');
+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;
 	}
 
-	$me;
+	print FH $me->dump;
+
+	close(FH);
+	return 1;
 }
 
 ################################################################
-sub file{
-	my $me = shift;
-	my $file = shift;
-	if(-r $file){
-		$me->SUPER::file($file);
-		Keitairc::Log::log("Loaded configuration file: $file");
-		return;
+# 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+$/);
 	}
-	Keitairc::Log::log("$file does not exist");
+
+	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;