1 # -*- mode: perl; coding: utf-8 -*-
4 # Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
5 # Copyright (c) 2010 ISHIKAWA Mutsumi <ishikawa@hanzubon.jp>
6 # This program is covered by the GNU General Public License 2
8 package Keitairc::Config;
9 use AppConfig qw(:argcount);
12 use Encode::MIME::Name;
15 our @ISA = qw(AppConfig);
17 ################################################################
21 my @argv = @{$arg->{argv}};
22 my $me = $class->SUPER::new(
26 ARGCOUNT => ARGCOUNT_ONE,
31 'irc_nick' => {ATTR => 'RO|REQ'},
32 'irc_username' => {ATTR => 'RO|REQ'},
33 'irc_server' => {ATTR => 'RO|REQ'},
34 'web_password' => {ATTR => 'RO|REQ'},
35 'web_host' => {ATTR => 'RO|REQ'},
39 'irc_desc' => {DEFAULT => 'keitairc'},
40 'au_subscriber_id' => {DEFAULT => ''},
41 'docomo_foma_icc' => {DEFAULT => ''},
42 'docomo_imodeid' => {DEFAULT => ''},
43 'softbank_serial_key' => {DEFAULT => ''},
44 'emobile_userid' => {DEFAULT => ''},
46 'web_listen_port' => {ATTR => 'RO'},
47 'web_title' => {DEFAULT => 'keitairc'},
48 'common_header' => {DEFAULT => '
49 <meta name="Robots" content="noindex,nofollow" />
50 <meta name="Keywords" content="norobot" />
51 <meta http-equiv="pragma" content="no-cache" />
52 <meta http-equiv="cache-control" content="no-cache" />
53 <meta http-equiv="expires" content="-1" />'},
54 'extra_header' => {DEFAULT => ''},
55 'silent_config' => {DEFAULT => $arg->{silent}, ATTR => 'RO'},
56 'version' => {DEFAULT => $arg->{version}},
57 'template_dir' => {DEFAULT => getcwd() . '/data/templates:__KEITAIRC_DATA_DIR__/templates', ATTR => 'RO'},
58 'plugin_dir' => {DEFAULT => getcwd() . '/data/plugins:__KEITAIRC_DATA_DIR__/plugins', ATTR => 'RO'},
59 'public_dir' => {DEFAULT => getcwd() . '/data/public:__KEITAIRC_DATA_DIR__/public', ATTR => 'RO'},
60 'url_redirect' => {DEFAULT => ''},
61 'smtp_server' => {DEFAULT => ''},
62 'smtp_from' => {DEFAULT => ''},
63 'smtp_to' => {DEFAULT => ''},
64 'rgeocode_server' => {DEFAULT => 'finds'},
65 'pid_file' => {DEFAULT => 'keitairc.pid', ATTR => 'RO'},
67 'web_root' => {TYPE => 'web_root', DEFAULT => '/', ATTR => 'RO'},
68 'web_schema' => {TYPE => 'web_schema', DEFAULT => 'http', ATTR => 'RO'},
69 'fontsize' => {TYPE => 'fontsize', DEFAULT => '+0'},
70 'mobile_fontsize' => {TYPE => 'fontsize', DEFAULT => -1},
71 'irc_charset' => {TYPE => 'charset', DEFAULT => 'utf8'},
72 'web_charset' => {TYPE => 'charset', DEFAULT => 'shiftjis'},
73 'pid_dir' => {TYPE => 'dir', DEFAULT => $ENV{HOME} . '/.keitairc.d', ATTR => 'RO'},
74 'url_target' => {TYPE => 'url_target', DEFAULT => '_self'},
75 'log' => {TYPE => 'log', DEFAULT => 'file', ATTR => 'RO'},
77 # optional integer params
78 'irc_port' => {TYPE => 'int', DEFAULT => 6667, ATTR => 'RO'},
79 'cookie_ttl' => {TYPE => 'int', DEFAULT => 86400 * 3}, # 3 days
80 'session_ttl' => {TYPE => 'int', DEFAULT => 60 * 30}, # 30 min
81 'cache_expire' => {TYPE => 'int', DEFAULT => 3600 * 12}, # 12 hour
82 'web_port' => {TYPE => 'int', DEFAULT => 8080, ATTR => 'RO'},
83 'web_lines' => {TYPE => 'int', DEFAULT => 100},
84 'ping_delay' => {TYPE => 'int', DEFAULT => 30},
85 'reconnect_delay' => {TYPE => 'int', DEFAULT => 10},
87 # optional boolean params
88 'show_joinleave' => {TYPE => 'bool', DEFAULT => 1},
89 'show_console' => {TYPE => 'bool', DEFAULT => 0},
90 'follow_nick' => {TYPE => 'bool', DEFAULT => 1},
91 'debug' => {TYPE => 'bool', DEFAULT => 0},
92 'daemonize' => {TYPE => 'bool', DEFAULT => 0, ATTR => 'RO'},
93 'reverse_message' => {TYPE => 'bool', DEFAULT => 1},
94 'reverse_recent' => {TYPE => 'bool', DEFAULT => 1},
95 'reverse_unread' => {TYPE => 'bool', DEFAULT => 1},
96 'webkit_newui' => {TYPE => 'bool', DEFAULT => 1},
99 'show_newmsgonly' => {TYPE => 'obsolates'},
100 'web_username' => {TYPE => 'obsolates'},
101 'use_cookie' => {TYPE => 'obsolates'},
102 'au_pcsv' => {TYPE => 'obsolates'},
105 if(-r '/etc/keitairc'){
106 $me->file('/etc/keitairc');
108 if(-r $ENV{HOME} . '/.keitairc'){
109 $me->file($ENV{HOME} . '/.keitairc');
111 if(-r $ENV{HOME} . '/.keitairc.d/config.dump'){
112 $me->file($ENV{HOME} . '/.keitairc.d/config.dump');
115 if(defined $argv[0]){
124 # check required parameters
125 foreach my $n (keys %{$me->{'REQ'}}) {
126 if(!defined($me->get($n)) || !length($me->get($n))) {
127 die($n . ' does not specified');
131 if(!defined($me->web_listen_port()) || !length($me->web_listen_port())){
132 $me->web_listen_port($me->web_port());
138 ################################################################
143 $me->SUPER::file($file);
144 print STDERR "Loaded configuration file: $file\n" unless $me->silent_config();
147 warn("$file does not exist");
150 ################################################################
157 my $cfg = ref($_[0]) eq 'HASH' ? shift : { };
158 if (defined $cfg->{TYPE}) {
159 if (!defined $cfg->{VALIDATE} && defined &{'valid_' . $cfg->{TYPE}}) {
160 $cfg->{VALIDATE} = \&{'valid_' . $cfg->{TYPE}};
162 if (!defined $cfg->{ARGCOUNT} && $cfg->{TYPE} eq 'bool') {
163 $cfg->{ARGCOUNT} = ARGCOUNT_NONE;
165 $me->type($var, $cfg->{TYPE});
168 if (defined $cfg->{ATTR}) {
169 my @attr = split(/\|/, $cfg->{ATTR});
170 foreach my $at (@attr) {
172 $me->readonly($var, 1);
173 } elsif ($at eq 'REQ') {
174 $me->required($var, 1);
176 warn 'Ignore unknown attribute: ' . $at;
181 push(@args, $var => $cfg);
184 return $me->SUPER::define(@args);
188 my ($me, $name, $type) = @_;
189 $me->{TYPE} = {} if (!defined $me->{TYPE});
190 $me->{TYPE}->{$name} = $type if (defined $type);
191 return (defined $me->{TYPE}->{$name} ? $me->{TYPE}->{$name} : 'string');
195 my ($me, $type_name, $name, $flag) = @_;
196 $me->{$type_name} = {} if (!defined $me->{$type_name});
199 $me->{$type_name}->{$name} = 1;
201 delete $me->{$type_name}->{$name};
204 return defined $me->{$type_name}->{$name};
209 return $me->bool_attr('RO', @_);
214 return $me->bool_attr('REQ', @_);
217 ################################################################
220 Encode::MIME::Name::get_mime_name(Encode::resolve_alias($me->web_charset()));
223 ################################################################
226 my %list = $me->varlist('.*');
228 foreach my $k (sort keys %list) {
229 if (defined $list{$k} && length($list{$k})) {
230 my $value = $list{$k};
231 $value =~ s/\x0D\x0A|\x0D|\x0A//g;
232 $ret .= $k .' = '. $value . "\n"
240 if (! open(FH, '> ' . $ENV{HOME} . '/.keitairc.d/config.dump') ) {
241 $::log->log_error('can not open config dump file: ' . $ENV{HOME} . '/.keitairc.d/config.dump');
251 ################################################################
252 # config params check utility functions
253 ################################################################
260 my ($name, $value) = @_;
261 return 1 if ($value =~ /^\d+$/);
263 if (my $val = eval $value) {
264 return 1 if ($val =~ /^\d+$/);
271 my ($name, $value) = @_;
272 return ($value =~ /^\//);
275 sub valid_web_schema {
276 my ($name, $value) = @_;
277 return ($value =~ /^https?$/);
281 my ($name, $value) = @_;
282 return ($value =~ /^[+-]?[0-7]$/);
286 my ($name, $value) = @_;
287 return Encode::resolve_alias($value);
291 my ($name, $value) = @_;
295 print STDERR "pid_dir $value is not writable\n";
300 sub valid_url_target {
301 my ($name, $value) = @_;
302 return ($value =~ /^_(?:blank|self|top|parent)$/);
306 my ($name, $value) = @_;
307 return ($value =~ /^(?:(?:file|syslog|stdio)$|(?:file|syslog):)/);
310 sub valid_obsolates {
311 my ($name, $value) = @_;
312 warn($name . ' has obsoleted from keitairc 2.0, ignored');