#!/usr/bin/perl
#
#   user-ja-conf
#
#   This file is a part of the Debian user-ja package.
#
#
# Copyright (C) 1998-2000 Tomohiro KUBOTA
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# On Debian GNU/Linux systems, the complete text of the GNU General
# Public License can be found in `/usr/share/common-licenses/GPL'.
#
#
#
#

use Getopt::Std;

# ----------- Initialization -------------
# ----------------------------------------
$delimstart = " ---- user-ja DON'T MODIFY THIS LINE!";
$delimend   = " ---- user-ja end DON'T MODIFY THIS LINE!";
$HOME = $ENV{HOME};
$LIB = "/usr/share/user-ja";
$TMP = "/tmp/user-ja-$$";
$THIS = '/usr/bin/user-ja-conf';
getopts("l:vhNs");

# ------------ Language List -------------
# Making a list of supported list from
# support.<language>.pl files.
# ----------------------------------------
opendir(DIR, $LIB) || die "Cannot open \"$LIB\".\n";
@filelist1 = readdir(DIR);
closedir(DIR);
@filelist = sort(@filelist1);
foreach $filename (@filelist) {
	if ($filename !~ /^support\.(.*)\.pl$/) {next;}
	$lang = $1;
	$libname = "$LIB/$filename";
	open (FILE,$libname) || die "Cannot oepn \"$libname\".\n";
	$langname0 = <FILE>;
	close(FILE);
	if ($langname0 =~ /!(.*)!/) {
		$langname = $1;
		push (@languages, "$lang  ($langname)");
	} else {
		push (@languages, "$lang");
	}
}

if ($opt_s) {
	foreach $lang (@languages) {
		print "$lang\n";
	}
	exit(0);
}

# ----------- Select Language ------------
# This part will be expanded when user-ja
# is expanded into user-i18n or so on.
# Especially, user-ja have to accept '-l'
# option, which specify LANGUAGE.
# ----------------------------------------
if (length($opt_l)) {
	if (-e "$LIB/support.$opt_l.pl") {
		$LANGUAGE=$opt_l;
	} else {
		die "Invalid language: $opt_l\n";
	}
} else {
	$l=-1;
	$l=0 if (@languages==1);
	while(($l<0 || $l>=@languages) && @languages>1) {
		for($i=0; $i<@languages; $i++) {
			print stderr "$i : $languages[$i]\n";
		}
		print STDERR "Input number > "; $l = <STDIN>;
	}
	$languages[$l] =~ /([^ \t]*)/;
	$LANGUAGE = $1;
}

# ----------- Load Language Support File ------------
# $LIB/support.$LANGUAGE.pl contains language-specific 
# functions.
# ---------------------------------------------------
if (open(FILE, "$LIB/support.$LANGUAGE.pl")) {
	@whole = <FILE>; close(FILE); $whole2 = join("",@whole);
	package Lang;
	eval($::whole2);
	if ($@) {
		die "ERROR in $::LIB/support.$::LANGUAGE.pl\n$@\n";
	}
	package main;
} else {
	warn "Warning: Cannot open: $LIB/support.$LANGUAGE.pl\n";
}

# load template file to avoid error by incomplate support file
if (open(FILE, "$LIB/support.language.pl.template")) {
	@whole = <FILE>; close(FILE); $whole2 = join("",@whole);
	package Ltmp;
	eval($::whole2);
	if ($@) {
		die "ERROR in $::LIB/support.language.pl.template\n$@\n";
	}
	package main;
} else {
	die "Cannot open: $LIB/support.language.pl.template\n";
}

# decide which to use
@subs = (isNC, initialize, sourceset2displayset, analcode, convcode);
foreach $sub (@subs) {
	if (defined &{"Lang::".$sub}) {
		${"Lang_".$sub}=\&{"Lang::".$sub};
	} else {
		${"Lang_".$sub}=\&{"Ltmp::".$sub};
		warn "Warning: $LIB/support.$LANGUAGE.pl: '$sub' does not exist.\n";
	}
}

if ($Lang::yes_upper eq "") {$Lang::yes_upper = $Ltmp::yes_upper;}
if ($Lang::yes_lower eq "") {$Lang::yes_lower = $Ltmp::yes_lower;}
if ($Lang::no_upper  eq "") {$Lang::no_upper  = $Ltmp::no_upper; }
if ($Lang::no_lower  eq "") {$Lang::no_lower  = $Ltmp::no_lower; }

# ----------- Load General File for dot.*.pl ------------
# $LIB/general.pl contains subroutines which can be used
# from dot.*.pl.
# -------------------------------------------------------
if (open(FILE, "$LIB/general.pl")) {
	@whole = <FILE>; close(FILE); $whole2 = join("",@whole);
	package Sub; 
	eval($::whole2);
	if ($@) {
		die "ERROR in $::LIB/general.pl\n$@\n";
	}
	package main;
} else {
	die "Cannot open: $LIB/general.pl\n";
}


# ---------- native character environment? ----------
# 'native character environment' means that non-ASCII 
# native characters such as Kanji in Japanese can be 
# displayed correctly.
# The result will be contained into $NC
# and $Sub::NC.
# ---------------------------------------------------
$o = "-l " . $LANGUAGE;
if ($opt_h) {$o .= " -h";}
if ($opt_v) {$o .= " -v";}
$NC = &$Lang_isNC($THIS, $o, $opt_N);
$Sub::NC = $NC;

# ---------- Other Initializations ------------
# ---------------------------------------------
END {
	eval {
		&printf_("\nPush [Enter] key to End.\n");
		$a = <STDIN>;
	}
}
if ($opt_h) {
	&printf_(
"Usage: user-ja-conf [options]\n".
"  -l language : Specify language (otherwise choose from menu)\n".
"  -h          : This help message\n".
"  -v          : 'verbose mode'\n".
"  -s          : Display list of supported languages and exit\n".
"  -N          : Never fork another user-ja-conf (for internal use)\n"
	);
	exit(0);
}
&printf_("Now obtaining package list...\n");
$a = `dpkg --get-selections`;
@a = split('\n',$a);
@b = grep(/[ \t]install$/, @a);
foreach $c (@b) {$d=$c; $d =~ s/[ \t].*//o; push(@DPKG_LIST, $d);}
&$Lang_initialize();

# ---------- main loop ----------
# -------------------------------
opendir(DIR, $LIB) || die "Cannot open \"$LIB\".\n";
@filelist1 = readdir(DIR);
closedir(DIR);
@filelist = sort(@filelist1);
foreach $filename (@filelist) {
	$libname = "$LIB/$filename";
	if ($filename =~ /^$LANGUAGE.dot\.(.*)\.pl$/) {
		$dotname = "$HOME/.$1";
		$mode = 1;
	} elsif ($filename =~ /^$LANGUAGE.dot\.(.*)/) {
		$dotname = "$HOME/.$1";
		$mode = 0;
	} else {
		next;
	}
	print STDERR "\n------- $dotname ($mode) --------\n";
	open(FILE,$libname) || die "Cannot open \"$libname\".\n";
	$first = <FILE>;
	$mes1 = "";
	while ($l = <FILE>) {
		if ($l eq "END\n") {last;}
		$mes1 .= $l;
	}
	$mes2 = "";
	while ($l = <FILE>) {
		if ($l eq "END\n") {last;}
		$mes2 .= $l;
	}
	@whole = <FILE>; close(FILE);
	package Sub;
	&disp($::mes1, $::mes2);
	package main;
	
	print STDERR "\n";
	&printf_("Do setting? ");
	$yn = &Sub::yesno("","");
	if ($yn == 0) {
		&printf_("Setting is not done.\n");
		next;
	}
	&printf_("Do setting...\n");
	
	$comment = substr($first, 0, 1);
	$execute = substr($first, 1, 1);
	$startpoint = (substr($first, 2, 1) == 's');
	$whole2 = join("", @whole);
	if ($mode) {
		if (!open(TMP, "+>$TMP")) {
			&printf_("Cannot open \"%s\".\n",$TMP);
			exit(1);
		}
		open(SAVE, ">&STDOUT");
		open(STDOUT, ">&TMP");
		package Sub;
		eval($::whole2);
		if ($@) {die "Internal error in $::libname !!\n$@";}
		package main;
		open(STDOUT, ">&SAVE");
		seek(TMP, 0, 0);
		@whole1 = <TMP>; close(TMP);
		$whole2 = join("", @whole1);
	}
	&addfile($dotname, $comment, $startpoint, $whole2);
	if ($execute ne 'x') {chmod(0644, $dotname);}
	if ($execute eq 'x') {chmod(0755, $dotname);}
}
unlink($TMP);
print STDERR "--------------------\n";
&printf_(
"   Setting is now done.  To activate these settings,\n".
"logout and login.\n".
"   Read each dotfile and confirm the modification.\n".
"If you don't like the setting, modify directly or\n".
"add overriding setting after 'user-ja end' line.\n".
"   Read /usr/share/doc/user-ja/README.* for detail.\n"
);

if (@RequiredPackageList > 0) {
	print STDERR "\n";
	&printf_("Install the following packages.\n");
	for ($a=0; $a<@RequiredPackageList; $a++){
		print STDERR "$RequiredPackageList[$a]";
		if ($a != @RequiredPackageList-1) {print STDERR ", ";}
	}
	print STDERR "\n";
}


# ---------- subroutine(s) ----------
#
# addfile(name of dotfile, 
#            character a comment line begin with, 
#            whether adding part is added at the first or last,
#            adding content);
#
sub addfile ($$$$) {
	$FILE = $_[0];
	$DELIM1 = "$_[1]$delimstart";
	$DELIM2 = "$_[1]$delimend";
	$STARTPOINT = $_[2];
	$ADD = $_[3];

	# open and lock
	if (open(FP,"+<$FILE")) {
	} elsif (open(FP,"+>$FILE")) {
	} else {
		&printf_("Cannot write to \"%s\".\n",$FILE);
		return;
	}
	if (flock(FP, 2)) {
		@file=<FP>;
	} else {
		&printf_("Cannot lock \"%s\".\n",$FILE);
		return;
	}

	# analysis
	$out1 = ""; $out2 = ""; $mode = 0;
	foreach (@file) {
		if ($mode==0 && $_ eq "$DELIM1\n") {$mode=1;}
		if ($mode==0) {$out1 .= $_;}
		if ($mode==2) {$out2 .= $_;}
		if ($mode==1 && $_ eq "$DELIM2\n") {$mode=2;}
	}

	# check codeset
	$codeset = &$Lang_analcode($out1 . $out2);
	if ($opt_v) {
		$c = &$Lang_analcode($ADD);
		print STDERR "Template is written in codeset \"$c\".\n";
		print STDERR "$FILE is written in codeset \"$codeset\".\n";
	}
	$ADD2 = &$Lang_convcode($ADD, $codeset);

	# output
	$out = "$out1$DELIM1\n$ADD2$DELIM2\n$out2";
	if ($STARTPOINT && $mode==0) {$out = "$DELIM1\n$ADD2$DELIM2\n$out1";}
	seek(FP, 0, 0);
	print FP $out;
	truncate(FP, length($out));
	if (!close(FP)) {
		&printf_("Cannot close \"%s\".\n",$FILE);
		exit(1);
	}
}

# printf_ is a subroutine to display messages in desired
# language according to Native Character Environment.
# The name 'printf_' is come from 'printf' and '_' which
# is usually used as a macro for 'gettext()'.
#
# The message strings in various languages are prepared
# in the language support files
# (/usr/share/user-ja/support.<language>.pl) as a hash
# 'messages'.  The hash variable has to have two sets of
# translated messages, one is written in ASCII character
# set and the other in native character set.  See comments
# in support.language.pl.template and README.i18n for
# detail.
#
# printf_(format, [parameter,...]);

sub printf_ ($@) {
	my ($a, $a1, $a2, $b);
	$a = $Lang::messages{$_[0]};
	if ($a eq "") {$a = $Ltmp::messages{$_[0]};}
	if ($a =~ /([^\000]*)\000([^\000]*)/) {
		if ($Sub::NC) {$b = $2;} else {$b = $1;}
		if ($b eq "") {$b = $1;}
	} else {
		$b = $a;
	}
	if ($b eq "") {$b = $_[0];}
	shift @_;
	print STDERR &$Lang_sourceset2displayset(sprintf($b,@_));
}

