im 1:152-1 / usr / share / perl5 / IM / Config.pm

# -*-Perl-*-
################################################################
###
###			      Config.pm
###
### Author:  Internet Message Group <img@mew.org>
### Created: Apr 23, 1997
### Revised: May 25, 2011
###

my $PM_VERSION = "IM::Config.pm version 20151220(IM152)";

package IM::Config;
require 5.003;
require Exporter;

use IM::Util;
use integer;
use strict 'vars';
use strict 'subs';
use vars qw(@ISA @EXPORT);

@ISA = qw(Exporter);
@EXPORT = qw(
    read_cfg_selector
    init_opt
    read_env read_cfg read_opt
    set_selector used_selectors
    sanity_check
    help
    home_dir conf_dir
    mail_dir mail_path news_dir news_path queue_dir queue_path
    inbox_folder draft_folder trash_folder config_cases config_case_inbox
    preserve_dot
    folder_mode msg_mode allowcrlf use_cl no_sync fsync_no preferred_fsync_no
    addrbook_file aliases_file petname_file mail_folders_file
    context_file getchksbr_file getsbr_file scansbr_file scan_header_pick
    address addresses_regex
    msgdbfile msgdbtype
    mbox_style mbox_filter
    nntpservers nntphistoryfile nntpauthuser set_nntpauthuser
    popaccount pophistoryfile imapaccount httpproxy noproxy
    usepwagent pwagentport pwagent_tmp_dir pwagent_tmp_path usepwfiles pwfiles
    expand_path use_xdispatcher usetouchfile touchfile
    namazuv2 namazu_dir namazu_path namazu_lock_dir namazu_lock_path
    mknmz_options mknmz_include_file mknmz_ignore_folders_regex
    pop_timeout imap_timeout nntp_timeout dns_timeout
    connect_timeout command_timeout rcv_buf_siz
    db_type file_attr ssh_path);

##
## Constant
##
use vars qw($CURRENT_DIR $HOME_DIR $IM_SYS_DIR
	    $IM_USER_DIR $IM_SYS_PROFILE $IM_USER_PROFILE
	    @CfgConfig %CASES
	    @O_IORD %O_DESC %O_VNAM %O_FULL %O_ABBR %O_HELP
	    $O_FOPT %C_DESC %C_VNAM
	    %WHO_SET
	    @SELECTORS
	    $IM_SYSCONFDIR $IM_DB_TYPE $FSYNC_NO
	    $prefix $exec_prefix $SSH_PATH);

##
## configurable value by configure
##

$prefix="/usr";
$exec_prefix= "${prefix}";
$IM_SYSCONFDIR  = "/etc/im";
$IM_DB_TYPE = 'DB';
$FSYNC_NO = 0;
$SSH_PATH = "/usr/bin/ssh";

sub file_attr() {
    return Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL();
}

##
##

$CURRENT_DIR = $ENV{'PWD'} || eval { use Cwd; fastcwd(); } ||
    im_die("can't get your current directory\n");

$HOME_DIR = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7] ||
    im_die("can't get your home directory\n");
$HOME_DIR =~ s:\\:/:g;     # "\home\user" -> "/home/user"
$HOME_DIR =~ s/\/$//;      # "/home/" -> "/home"

$IM_SYS_DIR = $ENV{'IM_SYS_DIR'} || "$IM_SYSCONFDIR";
$IM_USER_DIR = &expand_home($ENV{'IM_USER_DIR'} || '.im');

$IM_SYS_PROFILE = "$IM_SYS_DIR/SiteConfig";
$IM_USER_PROFILE = "$IM_USER_DIR/Config";

##
##
##
BEGIN {

@CfgConfig = (
    'maildir;s;;MailDir'	=> 'A directory to contain mail messages',
    'newsdir;s;;NewsDir'	=> 'A directory to contain news messages',
    'queuedir;s;;QueueDir'      => 'A directory to store messages to be sent',
    'inboxfolder;f;;InboxFolder'	=> 'Inbox folder',
    'draftfolder;f;;DraftFolder'	=> 'Draft folder',
    'trashfolder;f;;TrashFolder'	=> 'Trash folder',
    'foldermode;i;;FolderMode'		=> 'Folder directory mode when created',
    'msgmode;i;;MsgMode'		=> 'Message file mode when created',
    'usecl;b;;UseCL' => 'Use value of Content-Length header for delimitation',
    'nosync;b;;NoSync'		=> 'Do not need fsync(2) on writing file',
    'fsyncnumber;i;;FsyncNumber'	=> 'System call number of fsync',
    'sshpath;s;;SshPath'		=> 'Path name of SSH program',
    'allowcrlf;b;;AllowCRLF'		=> 'CRLF may be in saved message',
    'preservedot;b;;PreserveDot'	=> 'Not substitute "." with "/"',
    'addrbookfile;s;;AddrBookFile'      => 'Address book file',
    'aliasesfile;s;;AliasesFile'        => 'Aliases file',
    'petnamefile;s;;PetNameFile'	=> 'PetName file',
    'petnamefile;s;;PetNameFile'	=> 'PetName file',
    'mailfoldersfile;s;;MailFoldersFile'	=> 'Mail folders file',
    'contextfile;s;Context;ContextFile'	=> 'Context file',
    'address;s;;Address'		=> 'Email addresses',
    'addrregex;s;;AddrRegex'		=> 'Email addresses by regex',
    'msgdbfile;s;;MsgDBFile'		=> 'Message database location',
    'msgdbtype;s;;MsgDBType'		=> 'Message database type',
    'getchksbr;s;;GetChkSbrFile'	=> 'GetChk hook subroutine script',
    'getsbr;s;;GetSbrFile'		=> 'Get hook subroutine script',
    'scansbr;s;;ScanSbrFile'		=> 'Scan hook subroutine script',
    'scanheaderpick;s;;ScanHeaderPick'  => 'Scan headers to pick up',
    'mboxstyle;s;;MBoxStyle'		=> 'Style of local mailbox format',
    'mboxfilter;s;;MboxFilter'		=> 'Filter for mbox file',
    'nntpservers;s;;NNTPservers'	=> 'List of NNTP servers',
    'nntphistory;s;;NNTPhistory'	=> 'Status file of NNTP access',
    'nntpauthuser;s;;NNTPauthuser'	=> 'User name for NNTP authentication',
    'popaccount;s;;POPaccount'		=> 'Account info for POP access',
    'pophistory;s;;POPhistory'		=> 'Status file of POP access',
    'imapaccount;s;;IMAPaccount'	=> 'Account info for IMAP access',
    'httpproxy;s;;HTTPproxy'		=> 'Proxy server for HTTP access',
    'noproxy;s;;Noproxy'		=> 'URL regex not to use Proxy server',
    'usepwagent;b;;UsePwAgent'		=> 'Use password agent',
    'pwagentport;i;;PwAgentPort'	=> 'Port to connect agent with TCP/IP',
    'pwagenttmpdir;s;;PwAgentTmpDir'	=> 'Temporary directory for impwagent',
    'usepwfiles;b;;UsePwFiles'		=> 'Use password files',
    'pwfiles;s;;PwFiles'		=> 'Password files',
    'poptimeout;i;20;PopTimeout'	=> 'Timeout for POP connection',
    'imaptimeout;i;20;ImapTimeout'	=> 'Timeout for IMAP connection',
    'nntptimeout;i;20;NntpTimeout'	=> 'Timeout for NNTP connection',
    'dnstimeout;i;60;DnsTimeout'	=> 'Timeout for DNS connection',
    'connecttimeout;i;60;ConnectTimeout'  => 'Timeout for connection making',
    'commandtimeout;i;300;CommandTimeout' => 'Timeout for each command',
    'rcvbufsiz;i;;RcvBufSiz'		=> 'Receive buffer size of TCP',
    'usexdispatcher;b;;UseXDispatcher'	=> 'Use X-Dispatcher field',
    'usetouchfile;b;;UseTouchFile'	=> 'Use touch file',
    'touchfile;s;;TouchFile'		=> 'Touch file name',
    'namazuv2;b;;NamazuV2'		=> 'Use Namazu Version 2 (1.9 or late)',
    'namazudir;s;;NamazuDir'	=> 'A directory to contain Namazu indexes',
    'namazulockdir;s;;NamazuLockDir'	=> 'Lock directory for Namazu',
    'mknmzoptions;s;;MknmzOptions'	=> 'Options for mknmz',
    'mknmzincludefile;s;;MknmzIncludeFile'	=> 'A file for mknmz -I',
    'mknmzignorefoldersregex;s;;MknmzIgnoreFoldersRegex'	=> 'Folders regex ignored by immknmz',
    );

    # these vars should be in current package?
    my(@vars) = ();
    my($i, $name, $desc, $dflt, $vnam);
    for ($i = 0; $i < $#CfgConfig; $i+=2) {
	($name, $desc, $dflt, $vnam) = split(';', $CfgConfig[$i]);
	if ($vnam) {
	    push(@vars, '$' . $vnam);  #'
        }
    }
    # print "use vars qw(@vars);\n";
    eval "use vars qw(@vars);";
}

##
##
##

sub read_cfg_selector($) {
    my $argvref = shift;
    my $i = 0;
    my $selector = '';

    foreach $a (@$argvref) {
	if ($a =~ /^--config=(.*)$/i) {
	    $selector = $1;
## side effect!
## --config=value is removed from @ARGV
	    splice(@$argvref, $i, 1);
	}
	$i++;
    }
    return $selector;
}

sub init_opt($;$) {
    my($optref, $cptref) = @_;
    my($name, $desc, $dflt, $vnam, $optn, $help);
    my($i, $N);

    @O_IORD = (); ## option list in order
    %O_DESC = (); # --help -> s|s@|i|i@|f|f@|F|F@|b|B
    %O_VNAM = (); # --help -> help
    %O_FULL = (); # -h -> --help
    %O_ABBR = (); # --help -> -h
    %O_HELP = (); # --help -> "help message"

    # $O_FOPT;    # --src or --dst for help

    %C_DESC = (); # address -> s|s@|i|f|f@|b|B
    %C_VNAM = (); # address -> Address

    # set @CfgConfig
    $i = 0;
    $N = scalar(@CfgConfig);
    while ($i < $N) {
	($name, $desc, $dflt, $vnam) = split(';', $CfgConfig[$i]);
	$i += 2;
	if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B)$/) {
	    $optn = $name;
	    if ($vnam) {
		# no main:: !
		$C_VNAM{$optn} = $vnam;
	    } else {
		$C_VNAM{$optn} = "main::opt_\L$name";
	    }
	    $C_DESC{$optn} = $desc;
	    ${$C_VNAM{$optn}} = $dflt if $dflt;
	} else {
	    im_warn("invalid opt desc ``$desc'' for $optn\n");
	    return undef;
	}
    }

    # set @OptConfig
    $i = 0;
    $N = scalar(@$optref);
    while ($i < $N) {
	($name, $desc, $dflt, $vnam) = split(';', $$optref[$i]);
	$i++;
	$help = $$optref[$i];
	$i++;
	if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B|d)$/) {
	    my $abbr;
	    if ($name =~ ',') {
		($name, $abbr) = split(',', $name);
		$abbr = "-$abbr";
	    }
	    $optn = lc("--$name");
	    push(@O_IORD, $optn);
	    if ($vnam) {
		$O_VNAM{$optn} = "main::$vnam";
	    } else {
		$O_VNAM{$optn} = "main::opt_\L$name";
	    }
	    ${$O_VNAM{$optn}} = $dflt if $dflt;
	    $O_DESC{$optn} = $desc;
	    $O_HELP{$optn} = $help;
	    unless ($cptref || $desc eq 'd') {
		# no @CptConfig, so set abbrev
		$abbr = substr($optn, 1, 2) unless $abbr;  # -h
		$O_FULL{$abbr} = $optn;
		$O_ABBR{$optn} = $abbr;
	    }
	    $O_FOPT = $optn if $desc =~ /^F/;
	} else {
	    im_warn("invalid opt desc ``$desc'' for $optn\n\n");
	    return undef;
	}
    }
    # set @CptConfig
    if ($cptref) {
	$i = 0;
	$N = scalar(@$cptref);
	while ($i < $N) {
	    ($name, $desc, $dflt, $vnam) = split(';', $cptref->[$i]);
    	    $i++;
	    $help = $cptref->[$i];
	    $i++;
	    if ($desc =~ /^(s|s@|i|i@|f|f@|F|F@|b|B)$/) {
	        $optn = "-$name"; ## no lc()
		push(@O_IORD, $optn);
	        if ($vnam) {
		    $O_VNAM{$optn} = "main::$vnam";
	        } else {
		    $O_VNAM{$optn} = "main::opt_\L$name";
	        }
		# $dflt should be "off" if /b/ and "on" if /B/ usually
		# but no such limitations here to allow -opt and -noopt pair.
		${$O_VNAM{$optn}} = $dflt if $dflt;
	        $O_DESC{$optn} = $desc;
	        $O_HELP{$optn} = $help;
	    } else {
	        im_warn("invalid opt desc ``$desc'' for $optn\n\n");
	        return undef;
	    }
	}
    }

    return 1;
}

sub read_env($) {
    my $envref = shift;
    my($i, $N) = (0, scalar(@$envref));
    my($name, $desc, $dflt, $var);

    while ($i < $N) {
	($name, $desc, $dflt, $var) =  split(';', $envref->[$i]);
	if ($ENV{$name}) {
	    set_value($desc, $var, $ENV{$name}, 'env');
	} elsif ($dflt) {  # not else !
	    set_value($desc, $var, $dflt, 'env');
	}
	$i++;
    }
}

sub read_cfg() {
    my($profile, @profiles);
    my $prev_line = '';
    my $case;
    my $use;
    my @USECASES;
    my @prog_cfg;

    @profiles = ('<DATA>', $IM_SYS_PROFILE, $IM_USER_PROFILE);

    foreach $profile (@profiles) {
	my $fh;
	if ($profile eq '<DATA>') {
	    $fh = \*DATA;
	}
	elsif (open(PROFILE, "<$profile")) {
	    $fh = \*PROFILE;
	}
	else {
	    next;
	}

	# start with 'default'
	$case = 'default';
	$CASES{$case}++;
	while (<$fh>) {
	    last if /^__END__/;	# for sake of SelfLoader
	    next if /^#/;
	    chomp;
	    # continuous line processing (\ at EOL style)
	    if ($prev_line ne '') {
		s/^\s*//;
		$_ = $prev_line . $_;
		$prev_line = '';
	    }
	    if (/\\$/) {
		chop;
		$prev_line = $_;
		next;
	    }
	    # Src=inbox<space>#<any>
	    s/\s#.*$//;
	    s/\s*$//;
	    if (/^case\s*(.*)/) {
		($case = $1) =~ s/\s*//g;
		# make sure %{$case} is true
		foreach (split(',', $case)) {
		    $_->{0} = '';
		    delete $_->{0};
		    $CASES{$_}++;
		}
		next;
	    }
	    if (/^use\s+(.*)/) {
		($use = $1) =~ s/\s*//g;
		my @array = ($case, $use);
		push(@USECASES, \@array);
	    }
	    if (/^(\*|[\w]+)\.(\w+)[:=]\s*(.*)$/) {
		# Imls.Src=+inbox
		if ($1 eq '*') {
		    set_value_cfg($2, $3, $case);
		}
		if (lc($1) eq progname()) {
		    my @array = ($2, $3, $case);
		    push(@prog_cfg, \@array);
		}
		next;
	    }
	    if (/^(\w+)[:=]\s*(.*)$/) {
		# Src = +inbox
    		set_value_cfg($1, $2, $case);
		next;
	    }
	}
	if ($profile ne '<DATA>') {
	    # don't close DATA, and we broke on __END__ for SelfLoader
	    close (PROFILE);
	    if ($prev_line ne '') {
		im_die("Unexpected EOF at the bottom of config file.\n");
	    }
	}
    }

    my $array;
    foreach $array (@prog_cfg) {
	set_value_cfg(@$array);
    }
    foreach $array (@USECASES) {
	($case, $use) = @$array;
	foreach (split(',', $case)) {
	    set_selector($use, $_);
	}
    }
}

sub read_opt($) {
    my $argref = shift;
    my($ref, $i, $N) = (0, 0, scalar(@$argref));
    my($name, $val, $desc, $vnam);

    # delete options from @ARGV so that main{} can treat
    # @ARGV as argments.

    while ($i < $N) {
	$_ = $argref->[$ref];
	$i++;
	if (/^(--\w+)=(.*)/) {
	    $name = lc($1);
	    $val = $2;
	    $desc = $O_DESC{$name} || im_die("unknown option $name\n");
	    $vnam = $O_VNAM{$name};
	    splice(@$argref, $ref, 1);
	    set_value($desc, $vnam, $val, 'opt');
	} elsif (/^(--\w+)$/) {
	    $name = lc($1);
	    $desc = $O_DESC{$name} || im_die("unknown option $name\n");
	    $vnam = $O_VNAM{$name};
	    if ($desc =~ /s/) {
		$val = '';
	    } elsif ($desc =~ /i/) {
		$val = 0;
#	    } elsif ($desc =~ /f/) { # xxx
#		$val = '+inbox';
	    } elsif ($desc =~ /b/) {
		$val = 'on';
	    } elsif ($desc =~ /B/) {
		$val = 'off';
	    } elsif ($desc =~ /d/) { # for debug option
		$val = 'all';
	    }
	    set_value($desc, $vnam, $val, 'opt');
	    splice(@$argref, $ref, 1);
	} elsif (/^(-\w+)$/) {
	    $name = $1;
	    $name = $O_FULL{$name} if $O_FULL{$name};
	    $desc = $O_DESC{$name} || im_die("unknown option $name\n");
	    $vnam = $O_VNAM{$name};
	    if ($desc =~ /[sifF]/) { # bB never take the next argment
		$val = $argref->[$ref + 1];
		$i++;
		splice(@$argref, $ref, 2);
	    } elsif ($desc =~ /b/) {
		$val = 'on';
		splice(@$argref, $ref, 1);
	    } elsif ($desc =~ /B/) {
		$val = 'off';
		splice(@$argref, $ref, 1);
	    }
	    set_value($desc, $vnam, $val, 'opt');
	} elsif (/(^[+\-=%.\/~])|(^[a-zA-Z]:)/ && $O_FOPT) {
	    $name = $O_FOPT;
	    $val = $_;
	    $desc = $O_DESC{$name} || im_die("unknown option $name\n"); # must be F or F@
	    $vnam = $O_VNAM{$name};
	    splice(@$argref, $ref, 1);
	    set_value($desc, $vnam, $val, 'opt');
	} else {
	    # else may be an argment, so let it be...
	    $ref++;
	}
    }
}

sub set_selector($;$) {
    my($selector, $base) = @_;
    my $s;

    foreach $s (split(',', $selector)) { ### xxx lc
	next if ($s eq 'default');
	unless (%{$s}) {
	    im_err("no 'case $s' in config file.\n");
	    return -1;
	} else {
	    if (!defined($base) or $base eq 'default') {
	        push(@SELECTORS, $s) if !defined($base);
	        foreach (keys(%{$s})) {
	    	    ${$_} = $s->{$_};
	        }
	    } else {
	        foreach (keys(%{$s})) {
		    $base->{$_} = $s->{$_};
	        }
	    }
	}
    }
    return 0;
}

sub used_selectors() {
    return join(',', @SELECTORS);
}

sub sanity_check() {
    unless ($MailDir) {
	im_die("config files\n" .
	       "Please setup user profile \"$IM_USER_PROFILE\".\n" .
	       "MailDir is required.");
    }
}

sub help($) {
    my $explanation = shift;
    my($name, $spec, $desc, $abbr, $dflt);

    print "${explanation}\nOptions are: \n";

    foreach $name (@O_IORD) {
	next unless (defined($O_HELP{$name}));

	$desc = $O_DESC{$name};
	if ($O_ABBR{$name}) {
	    $abbr = "($O_ABBR{$name})";
	} else {
	    $abbr = '';
	}
	if ($desc =~ /^[sifF]\@$/) {
	    $dflt = join(',', @{$O_VNAM{$name}});
	} else {
  	    $dflt = ${$O_VNAM{$name}};
	}

	$spec = '';

	$spec = '<string>'         if $desc =~ /^s/;
	$spec = '<num>'            if $desc =~ /^i/;
	$spec = '<folder>'         if $desc =~ /^[fF]/;
	$spec = '<on|off>'         if $desc =~ /^[bB]/;
	$spec = "$spec,$spec..."   if ($desc =~ /^[sifF]\@$/) && $spec;
	$spec = '<debug option>'   if $desc =~ /^d/;
	$spec = "=$spec"           if $spec;

	if ($desc =~ /[bB]/) {
	    if ($dflt && $dflt =~ /^(on|yes|true|1)$/) {
		$dflt = 'on';
	    } else {
		$dflt = 'off';
	    }
	}

	print "\t$name$spec $abbr($dflt)\n";
	print "\t\t", $O_HELP{$name}, "\n";
    }

    if ($O_FOPT) {
	print "\nNote that +xxx is equivalent to $O_FOPT=+xxx.\n";
    }
    print "\nReport bugs to <tats\@vega.ocn.ne.jp>.\n";
    return 1;
}

##
##
##

sub set_value_cfg($$$) {
    my($name, $val, $case) = @_;
    my($mnam, $desc, $vnam);

    $val =~ s/\$\{(\w+)\}/$ENV{$1}/ge;
    if ($val =~ /^\$(.*)/) {
	# $InboxFolder -> +inbox
	$val = ${$C_VNAM{lc($1)}};
    } elsif ($val =~ /^~(.*)/) {
	# ~/.im/Config -> $HOME_DIR/.im/Config
	$val = "$HOME_DIR$1";
    }

    $name = lc($name);
    $mnam = "--$name";
    if ($O_VNAM{$mnam}) {
	# $main::opt_help
	$desc = $O_DESC{$mnam};
	$vnam = $O_VNAM{$mnam};
    } elsif ($C_VNAM{$name}) {
	# $MailDir
	$desc = $C_DESC{$name};
	$vnam = $C_VNAM{$name};
    }
    if ($vnam && $desc) {
        foreach (split(',', $case)) {
	    if ($_ eq 'default') {
		set_value($desc, $vnam, $val, 'cfg');
	    } else {
		set_value_case($desc, $vnam, $val, $_);
	    }
	}
    }
}

# set_value is not in safe manner.
# see if $desc exists before calling this.

sub set_value($$$$) {
    my($desc, $vnam, $val, $who) = @_;  # b, $main::opt_help, yes

    # require numeric but not numeric, return undef
    return undef if ($desc =~ /i/ && $val !~ /\d+/);

    if ($desc =~ /\@/) {
	# --xxx=foo,bar --xxx=baz
	# -> @xxx = (foo, bar, gaz)
	my @val = split(',', $val);
	if ($desc =~ /F/) { # xxx how about f
	    my($i, $N) = (0, scalar(@val));
	    while ($i < $N) {
		$val[$i] = "+$val[$i]"
		    unless $val =~ /(^[+\-=%~\/])|(^[a-zA-Z]:)/;
		$i++;
	    }
	}
	if (($who eq 'env') || ($who eq 'cfg')) {
	    # override it
	    @{$vnam} = @val;
	} elsif ($WHO_SET{$vnam} eq 'opt') {
	    # set by 'opt', so just append.
	    push(@{$vnam}, @val);
	} else {
	    # set by 'env' or 'cfg' but I'm 'opt', so override it
	    @{$vnam} = @val;
	}
	$WHO_SET{$vnam} = $who;
	im_debug("\@$vnam = @{$vnam}\n") if &debug('config');
    } else {
	if ($desc =~ /[bB]/) {
	    # the difference between 'b' and 'B' appears only when
	    # value is omitted or "-opt" specified. In that case,
	    # 'b' becames 1 while 'B' becames 0.
	    # 'B' never means negate boolean. True is always '1'.
	    if ($val =~ /^(yes|on|true|1)$/i) {
		${$vnam} = 1;
	    } else {
		${$vnam} = 0;
	    }
	} elsif ($desc =~ /F/) {  # xxx how about f
	    # +inbox -> + inbox -> --src +inbox
	    if ($val =~ /(^[+\-=%~\/])|(^[a-zA-Z]:)/) {
		${$vnam} = $val;
	    } else {
		${$vnam} = "+$val";
	    }
	} else {
	    ${$vnam} = $val;
	}
	im_debug("\$$vnam = ${$vnam}\n") if &debug('config');
    }

    return 1;
}

sub set_value_case($$$$) {
    my($desc, $vnam, $val, $case) = @_;  # b, $main::opt_help, yes

    # require numeric but not numeric, return undef
    return undef if ($desc =~ /i/ && $val !~ /\d+/);
##    $case = lc($case); #xxx

    if ($desc =~ /[bB]/) {
	if ($val =~ /^(yes|on|true|1)$/i) {
	    $case->{$vnam} = 1;
	} else {
	    $case->{$vnam} = 0;
	}
    } elsif ($desc =~ /F/) {  # xxx how about f
	# +inbox -> + inbox -> --src +inbox
	if ($val =~ /(^[+\-=%\/])|(^[a-zA-Z]:)/) {
	    $case->{$vnam} = $val;
	} else {
	    $case->{$vnam} = "+$val";
	}
    } else {
	$case->{$vnam} = $val;
    }

    return 1;
}

###
### Config vs Default
###

sub current_dir() {
    return $CURRENT_DIR;
}

sub home_dir() {
    return $HOME_DIR;
}

sub conf_dir() {
    return $IM_USER_DIR;
}

sub mail_dir() {
    return $MailDir;
}

sub mail_path() {
    return expand_home(mail_dir());
}

sub news_dir() {
    return $NewsDir;
}

sub news_path() {
    return expand_home(news_dir());
}

sub queue_dir() {
    return $QueueDir;
}

sub queue_path() {
    expand_path(queue_dir());
}

sub inbox_folder(;$) {
    my($case) = split(',', shift); ## use the first one only
    if (defined($case) && $case ne 'default' &&
	defined($case->{InboxFolder}) &&
	$case->{InboxFolder} ne '') {
	return $case->{InboxFolder};
    } else {
	return $InboxFolder;
    }
}

sub draft_folder() {
    return $DraftFolder;
}

sub trash_folder() {
    return $TrashFolder;
}

sub config_cases() {
    my @cases = keys(%CASES);
    if (scalar(@cases) >= 2) {
	return join(',', @cases);
    } else {
	return '';
    }
}

sub config_case_inbox() {
    my @cases = keys(%CASES);
    my @caseinbox = ();
    if (scalar(@cases) >= 2) {
	foreach (@cases) {
	    if (defined($_->{InboxFolder})) {
		push(@caseinbox, "$_:$_->{InboxFolder}");
	    }
	}
        return join(',', @caseinbox);
    } else {
  	return '';
    }
}

sub preserve_dot() {
    return $PreserveDot;
}

sub folder_mode($) {
    my $setumask = shift;

    $FolderMode = oct($FolderMode) if ($FolderMode =~ /^0\d/);
    my $umask = 0777 ^ $FolderMode;
    umask($umask) if ($setumask);
    return $FolderMode;
}

sub msg_mode($) {
    my $setumask = shift;

    $MsgMode = oct($MsgMode) if ($MsgMode =~ /^0\d/);
    my $umask = 0666 ^ $MsgMode;
    umask($umask) if ($setumask);
    return $MsgMode;
}

sub allowcrlf() {
    return $AllowCRLF;
}

sub use_cl() {
    return $UseCL;
}

sub no_sync() {
    return $NoSync;
}

sub fsync_no() {
    return $FSYNC_NO;
}

sub preferred_fsync_no() {
    return $FsyncNumber;
}

sub addrbook_file() {
    return join(',', map {expand_path($_)} split(',', $AddrBookFile));
}

sub aliases_file() {
    return join(',', map {expand_path($_)} split(',', $AliasesFile));
}

sub context_file() {
    return &expand_path($ContextFile);
}

sub getchksbr_file() {
    return &expand_path($GetChkSbrFile);
}

sub getsbr_file() {
    return &expand_path($GetSbrFile);
}

sub scansbr_file() {
    return &expand_path($ScanSbrFile);
}

sub scan_header_pick() {
    return $ScanHeaderPick;
}

sub petname_file() {
    return &expand_path($PetNameFile);
}

sub mail_folders_file() {
    return &expand_path($MailFoldersFile);
}

sub address() {
    return $Address;
}

sub addresses_regex() {
    return $AddrRegex;
}

sub msgdbfile() {
    return &expand_path($MsgDBFile);
}

sub msgdbtype() {
    return $MsgDBType;
}

sub mbox_style() {
    return $MBoxStyle;
}

sub mbox_filter() {
    return $MboxFilter;
}

sub nntpservers() {
    return $NNTPservers;
}

sub nntphistoryfile() {
    return &expand_path($NNTPhistory);
}

sub nntpauthuser() {
    return $NNTPauthuser;
}

sub set_nntpauthuser($) {
    $NNTPauthuser = shift;
}

sub popaccount() {
    return $POPaccount;
}

sub pophistoryfile() {
    return &expand_path($POPhistory);
}

sub imapaccount() {
    return $IMAPaccount;
}

sub httpproxy() {
    return $HTTPproxy;
}

sub noproxy() {
    return $Noproxy;
}

sub usepwagent() {
    return $UsePwAgent;
}

sub pwagentport() {
    return $PwAgentPort;
}

sub pwagent_tmp_dir() {
    return $PwAgentTmpDir;
}

sub pwagent_tmp_path() {
    return expand_path(pwagent_tmp_dir());
}

sub usepwfiles() {
    return $UsePwFiles;
}

sub pwfiles() {
    return $PwFiles;
}

sub use_xdispatcher() {
    return $UseXDispatcher;
}

sub usetouchfile() {
    return $UseTouchFile;
}

sub touchfile() {
    return $TouchFile;
}

sub pop_timeout() {
    return $PopTimeout;
}

sub imap_timeout() {
    return $ImapTimeout;
}

sub nntp_timeout() {
    return $NntpTimeout;
}

sub dns_timeout() {
    return $DnsTimeout;
}

sub connect_timeout() {
    return $ConnectTimeout;
}

sub command_timeout() {
    return $CommandTimeout;
}

sub rcv_buf_siz() {
    return $RcvBufSiz;
}

sub db_type() {
    return $IM_DB_TYPE;
}

sub ssh_path() {
    return $SshPath || $SSH_PATH;
}

sub namazuv2() {
    return $NamazuV2;
}

sub namazu_dir() {
    return $NamazuDir;
}

sub namazu_path() {
    return expand_home(namazu_dir());
}

sub mknmz_options() {
    return $MknmzOptions;
}

sub mknmz_include_file() {
    return &expand_path($MknmzIncludeFile);
}

sub mknmz_ignore_folders_regex() {
    return $MknmzIgnoreFoldersRegex;
}

sub namazu_lock_dir() {
    return $NamazuLockDir;
}

sub namazu_lock_path() {
    return expand_path(namazu_lock_dir());
}

###
### path expansion
###

sub expand_home($) {
    my $folder = shift;

    return '' if ($folder eq '');
    if ($folder =~ /^\//) {
	# nothing
    } elsif ($folder =~ /^[a-zA-Z]:\//) {
	# nothing
    } elsif ($folder =~ /^\~\/(.*)/) {
	$folder = home_dir() . '/' . $1;
    } else {
	$folder = home_dir() . '/' . $folder;
    }
    return $folder;
}

sub expand_path($) {
    my $folder = shift;

    $folder =~ s/^\s*(.*?)\s*$/$1/; # SPC may be used in folder names
    return '' unless $folder;

    if ($folder =~ /^\//) {
	# nothing
    } elsif ($folder eq '.') {
	$folder = current_dir();
    } elsif ($folder eq '..') {
	$folder = current_dir() . '/..';
    } elsif ($folder =~ /^\.\//) {
	$folder = current_dir() . '/' . $folder;
    } elsif ($folder =~ /^-/) {
	$folder = '';
    } elsif ($folder =~ /^\%/) {
	$folder = '';
    } elsif ($folder =~ /^\+(.*)/) {
	$folder = mail_path() . '/' . $1;
    } elsif ($folder =~ /^=(.*)/) {
	$folder = $1;
	$folder =~ s/\./\//g unless preserve_dot();
	$folder = news_path() . '/' . $folder;
    } elsif ($folder =~ /^[a-zA-Z]:\//) {
	# nothing
    } elsif ($folder =~ /^\~\/(.*)/) {
	$folder = home_dir() . '/' . $1;
    } elsif (&unixp() && $folder =~ /^\~([^\/]+)\/(.*)/) {
	$folder = (getpwnam($1))[7] . '/' . $2;
    } else {
	$folder = conf_dir() . '/' . $folder;
    }
    return $folder;
}

1;
__DATA__
##
## Default global parameters
##
MailDir=Mail			# relative to ~/
NewsDir=News			# relative to ~/
# folders for mail messages
InboxFolder=+inbox		# default destination of imget
DraftFolder=+draft
TrashFolder=+trash		# default destination of message removal in mew
# mode for creation
FolderMode=0700
MsgMode=0600
# to keep state of IM commands (CurrentFolder, etc.)
ContextFile=Context		# relative to ~/.im/
##
## Default settings
##
# folders
Src=$InboxFolder		# default source of most commands
Imclean.Src=$TrashFolder	# default source for message cleanups
Immknmz.Src=			# folders specified by Mail/.folders are used
#Imget.dst=$InboxFolder		# default inbox folder
Imrm.dst=$TrashFolder		# default trash folder
# mail address aliases for imali/imput
AddrBookFile=Addrbook		# relative to ~/.im/
AliasesFile=Aliases		# relative to ~/.im/
#PetnameFile=Petnames		# relative to ~/.im/
MailFoldersFile=~/Mail/.folders
UseTouchFile=off
TouchFile=.mew-touch
# imget/imls
Form=%+5n %m%d %-14A %S || %b	# default format for scanning
Width=80			# default width for scanning
JisSafe=on			# escape seq. of JIS char. should be managed
Indent=2			# indent step for threading
DupCheckTarget=message-id	# Duplicate Check Target 
				# 'message-id' or 'message-id+subject'
ImGrep.DupCheckTarget=none
# servers
Smtpservers=localhost		# default server for SMTP
NntpServers=localhost		# default server for NNTP
# imput
FccDir=$MailDir
QueueDir=queue			# relative to ~/.im/
UseXDispatcher=on		# use X-Dispatcher field
# imget
Imget.Src=local			# default source of imget (local mailbox)
PopHistory=pophist-{POPSERVERID}	# to save last state (relative to ~/.im/)
NntpHistory=newshist		# to save last state (relative to ~/.im/)
# impwagent
PwAgentTmpDir=pwagtmp		# temporary directory (relative to ~/.im/)
# namazu
NamazuV2=yes			# use Namazu version 2 (1.9.x or late)
NamazuDir=Namazu		# relative to ~/
NamazuLockDir=nmzlock		# lock directory (relative to ~/.im/)
#MknmzOptions=--decode-base64	# options for mknmz
MknmzIncludeFile=~/Namazu/mknmz-inc.pl	# mknmz -I <file>
MknmzIgnoreFoldersRegex=\+(attach|draft|trash|queue|postq|schedule)
__END__

=head1 NAME

IM::Config - confiugration for IM

=head1 SYNOPSIS

 use IM::Config;

Subroutines:
read_cfg_selector
init_opt
read_env read_cfg read_opt
set_selector used_selectors
sanity_check
help
home_dir conf_dir
mail_dir mail_path news_dir news_path queue_dir queue_path
inbox_folder draft_folder trash_folder config_cases config_case_inbox
preserve_dot
folder_mode msg_mode allowcrlf use_cl no_sync fsync_no preferred_fsync_no
addrbook_file aliases_file petname_file mail_folders_file
context_file getchksbr_file getsbr_file scansbr_file scan_header_pick
address addresses_regex
msgdbfile msgdbtype
mbox_style mbox_filter
nntpservers nntphistoryfile nntpauthuser set_nntpauthuser
popaccount pophistoryfile imapaccount httpproxy noproxy
usepwagent pwagentport pwagent_tmp_dir pwagent_tmp_path usepwfiles pwfiles
expand_path use_xdispatcher usetouchfile touchfile
namazuv2 namazu_dir namazu_path namazu_lock_dir namazu_lock_path
mknmz_options mknmz_include_file mknmz_ignore_folders_regex
pop_timeout imap_timeout nntp_timeout dns_timeout
connect_timeout command_timeout rcv_buf_siz
db_type file_attr ssh_path

=head1 DESCRIPTION

The I<IM::Config> module is for configuration of IM.

This modules is provided by IM (Internet Message).

=head1 COPYRIGHT

IM (Internet Message) is copyrighted by IM developing team.
You can redistribute it and/or modify it under the modified BSD
license.  See the copyright file for more details.

=cut

### Copyright (C) 1997, 1998, 1999 IM developing team
### All rights reserved.
### 
### Redistribution and use in source and binary forms, with or without
### modification, are permitted provided that the following conditions
### are met:
### 
### 1. Redistributions of source code must retain the above copyright
###    notice, this list of conditions and the following disclaimer.
### 2. Redistributions in binary form must reproduce the above copyright
###    notice, this list of conditions and the following disclaimer in the
###    documentation and/or other materials provided with the distribution.
### 3. Neither the name of the team nor the names of its contributors
###    may be used to endorse or promote products derived from this software
###    without specific prior written permission.
### 
### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
### PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.