lib/Keitairc/Config.pm

   1 # -*- mode: perl; coding: utf-8 -*-
   2 # Keitairc::Config
   3 #
   4 # Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
   5 # This program is covered by the GNU General Public License 2
   6
   7 package Keitairc::Config;
   8 use AppConfig qw(:argcount);
   9 use Cwd;
  10 use Encode;
  11 use Encode::MIME::Name;
  12 use strict;
  13 use warnings;
  14 our @ISA = qw(AppConfig);
  15
  16 ################################################################
  17 sub new{
  18         my $class = shift;
  19         my $arg = shift;
  20         my @argv = @{$arg->{argv}};
  21         my $me = $class->SUPER::new(
  22                 {CASE => 1,
  23                  ERROR => \&on_error,
  24                  GLOBAL => {
  25                          ARGCOUNT => ARGCOUNT_ONE,
  26                  }});
  27
  28         $me->define(
  29                 # required
  30                 'irc_nick',
  31                 'irc_username',
  32                 'irc_server',
  33                 'web_password',
  34                 'web_host',
  35
  36                 # optional
  37                 'irc_password',
  38                 'irc_desc' => {DEFAULT => 'keitairc'},
  39                 'au_subscriber_id' => {DEFAULT => ''},
  40                 'docomo_foma_icc' => {DEFAULT => ''},
  41                 'docomo_imodeid' => {DEFAULT => ''},
  42                 'softbank_serial_key' => {DEFAULT => ''},
  43                 'emobile_userid' => {DEFAULT => ''},
  44                 'irc_keyword',
  45                 'web_listen_port',
  46                 'web_title' => {DEFAULT => 'keitairc'},
  47                 'common_header' => {DEFAULT => '
  48 <meta name="Robots" content="noindex,nofollow" />
  49 <meta name="Keywords" content="norobot" />
  50 <meta http-equiv="pragma" content="no-cache" />
  51 <meta http-equiv="cache-control" content="no-cache" />
  52 <meta http-equiv="expires" content="-1" />'},
  53                 'extra_header' => {DEFAULT => ''},
  54                 'silent_config' => {DEFAULT => $arg->{silent}},
  55                 'version' => {DEFAULT => $arg->{version}},
  56                 'template_dir'  => {DEFAULT => getcwd() . '/data/templates:__KEITAIRC_DATA_DIR__/templates'},
  57                 'plugin_dir' => {DEFAULT => getcwd() . '/data/plugins:__KEITAIRC_DATA_DIR__/plugins'},
  58                 'public_dir' => {DEFAULT => getcwd() . '/data/public:__KEITAIRC_DATA_DIR__/public'},
  59                 'url_redirect' => {DEFAULT => ''},
  60                 'smtp_server' => {DEFAULT => ''},
  61                 'smtp_from' => {DEFAULT => ''},
  62                 'smtp_to' => {DEFAULT => ''},
  63                 'rgeocode_server' => {DEFAULT => 'finds'},
  64                 'pid_file' => {DEFAULT => 'keitairc.pid'},
  65
  66                 'web_root' => {DEFAULT => '/', VALIDATE => \&valid_web_root},
  67                 'web_schema' => {DEFAULT => 'http', VALIDATE => \&valid_web_schema},
  68                 'fontsize' => {DEFAULT => '+0', VALIDATE => \&valid_fontsize},
  69                 'mobile_fontsize' => {DEFAULT => -1, VALIDATE => \&valid_fontsize},
  70                 'irc_charset' => {DEFAULT => 'utf8', VALIDATE => \&valid_charset},
  71                 'web_charset' => {DEFAULT => 'shiftjis', VALIDATE => \&valid_charset},
  72                 'pid_dir' => {DEFAULT => $ENV{HOME} . '/.keitairc_log', VALIDATE => \&valid_dir},
  73                 'url_target' => {DEFAULT => '_self', VALIDATE => \&valid_url_target},
  74                 'log' => {DEFAULT => 'file', VALIDATE => \&valid_log},
  75
  76                 # optional integer params
  77                 'irc_port' => {DEFAULT => 6667, VALIDATE => \&valid_int},
  78                 'cookie_ttl' => {DEFAULT => 86400 * 3, VALIDATE => \&valid_int},  # 3 days
  79                 'session_ttl' => {DEFAULT => 60 * 30, VALIDATE => \&valid_int},  # 30 min
  80                 'cache_expire' => {DEFAULT => 10800, VALIDATE => \&valid_int},
  81                 'web_port' => {DEFAULT => 8080, VALIDATE => \&valid_int},
  82                 'web_lines' => {DEFAULT => 100, VALIDATE => \&valid_int},
  83                 'ping_delay' => {DEFAULT => 30, VALIDATE => \&valid_int},
  84                 'reconnect_delay' => {DEFAULT => 10, VALIDATE => \&valid_int},
  85
  86                 # optional boolean params
  87                 'show_joinleave' => {ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 1},
  88                 'show_console' => {ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0},
  89                 'follow_nick' => {ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 1},
  90                 'debug' => {ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0},
  91                 'daemonize' => {ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0},
  92                 'reverse_message' => {ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 1},
  93                 'reverse_recent' => {ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 1},
  94                 'reverse_unread' => {ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 1},
  95                 'webkit_newui' => {ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 1},
  96
  97                 # obsolates (ignored)
  98                 'show_newmsgonly' => {VALIDATE => \&valid_obsolates},
  99                 'web_username' => {VALIDATE => \&valid_obsolates},
 100                 'use_cookie' => {VALIDATE => \&valid_obsolates},
 101                 'au_pcsv' => {VALIDATE => \&valid_obsolates},
 102                 );
 103
 104         if(-r '/etc/keitairc'){
 105                 $me->file('/etc/keitairc');
 106         }
 107         if(-r $ENV{HOME} . '/.keitairc'){
 108                 $me->file($ENV{HOME} . '/.keitairc');
 109         }
 110
 111         if(defined $argv[0]){
 112                 if(-r $argv[0]){
 113                         $me->file($argv[0]);
 114                         shift(@argv);
 115                 }
 116         }
 117
 118         $me->args(\@argv);
 119
 120         # check required parameters
 121         foreach my $n (qw(irc_nick irc_username irc_server web_host web_password)) {
 122                 if(!defined($me->get($n)) || !length($me->get($n))) {
 123                         die($n . ' does not specified');
 124                 }
 125         }
 126
 127         if(!defined($me->web_listen_port()) || !length($me->web_listen_port())){
 128                 $me->web_listen_port($me->web_port());
 129         }
 130
 131         $me;
 132 }
 133
 134 ################################################################
 135 sub file{
 136         my $me = shift;
 137         my $file = shift;
 138         if(-r $file){
 139                 $me->SUPER::file($file);
 140                 print STDERR "Loaded configuration file: $file\n" unless $me->silent_config();
 141                 return;
 142         }
 143         warn("$file does not exist");
 144 }
 145
 146 ################################################################
 147 sub content_charset{
 148         my $me = shift;
 149         Encode::MIME::Name::get_mime_name(Encode::resolve_alias($me->web_charset()));
 150 }
 151
 152 ################################################################
 153 sub dump {
 154         my $me = shift;
 155         my %list = $me->varlist('.*');
 156         my $ret = '';
 157         foreach my $k (sort keys %list) {
 158                 if (defined $list{$k} && length($list{$k})) {
 159                         my $value = $list{$k};
 160                         $value =~ s/\x0D\x0A|\x0D|\x0A//g;
 161                         $ret .= $k .' = '. $value . "\n"
 162                 }
 163         }
 164         return $ret;
 165 }
 166
 167 ################################################################
 168 # config params check utility functions
 169 ################################################################
 170 sub on_error {
 171         my $msg = shift;
 172         die $msg;
 173 }
 174
 175 sub valid_int {
 176         my ($name, $value) = @_;
 177         return 1 if ($value =~ /^\d+$/);
 178
 179         if (my $val = eval $value) {
 180                 return 1 if ($val =~ /^\d+$/);
 181         }
 182
 183         return 0;
 184 }
 185
 186 sub valid_web_root {
 187         my ($name, $value) = @_;
 188         return ($value =~ /^\//);
 189 }
 190
 191 sub valid_web_schema {
 192         my ($name, $value) = @_;
 193         return ($value =~ /^https?$/);
 194 }
 195
 196 sub valid_fontsize {
 197         my ($name, $value) = @_;
 198         return ($value =~ /^[+-]?[0-7]$/);
 199 }
 200
 201 sub valid_charset {
 202         my ($name, $value) = @_;
 203         return Encode::resolve_alias($value);
 204 }
 205
 206 sub valid_dir {
 207         my ($name, $value) = @_;
 208         if (-w $value) {
 209                 return 1;
 210         } else {
 211                 print STDERR "pid_dir $value is not writable\n";
 212                 return 0;
 213         }
 214 }
 215
 216 sub valid_url_target {
 217         my ($name, $value) = @_;
 218         return ($value =~ /^_(?:blank|self|top|parent)$/);
 219 }
 220
 221 sub valid_log {
 222         my ($name, $value) = @_;
 223         return ($value =~ /^(?:(?:file|syslog|stdio)$|(?:file|syslog):)/);
 224 }
 225
 226 sub valid_obsolates {
 227         my ($name, $value) = @_;
 228         warn($name . ' has obsoleted from keitairc 2.0, ignored');
 229         return 1;
 230 }
 231
 232 1;