# -*- mode: perl; coding: utf-8 -*-
# Keitairc::Config
-# $Id: Config.pm,v 1.16 2008-06-29 09:20:49 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
- smtp_server smtp_from smtp_to debug
- template_dir version daemonize pid_dir pid_file plugin_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'},
+
+ # 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'},
);
- # 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->reverse_message(1);
- $me->reverse_recent(1);
- $me->reverse_unread(1);
- $me->show_joinleave(1);
- $me->fontsize('+0');
- $me->mobile_fontsize(-1);
- $me->debug(0);
+ 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]){
- unless(-r $argv[0]){
- ::log("Can't read $argv[0]");
- exit 1;
+ if(-r $argv[0]){
+ $me->file($argv[0]);
+ shift(@argv);
}
- $me->file($argv[0]);
- shift(@argv);
- }else{
- $me->file('/etc/keitairc');
- $me->file($ENV{HOME} . '/.keitairc');
}
$me->args(\@argv);
-
- if(defined $me->show_newmsgonly()){
- ::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()){
- ::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()){
- ::log('use_cookie has obsoleted from keitairc 2.0');
- }
+ $me;
+}
- if(defined $me->au_pcsv()){
- ::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");
+}
- unless(length $me->irc_nick()){
- ::log_die('irc_nick does not specified');
- }
+################################################################
+sub define {
+ my $me = shift;
+ my @args = ();
- unless(length $me->irc_username()){
- ::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);
}
- unless(length $me->irc_server()){
- ::log_die('irc_server does not specified');
- }
+ 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');
+}
- unless(length $me->web_port()){
- ::log_die('web_port does not specified');
+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', @_);
+}
- unless(length $me->web_host()){
- ::log_die('web_host does not specified');
+################################################################
+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;
+}
- unless(length $me->web_password()){
- ::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);
- ::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+$/);
}
- ::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;
OSDN Git Service
