utt/app/dist/common/utt_make_config.pl

142 lines
3.5 KiB
Perl
Raw Normal View History

#!c:\usr\perl\bin\perl.exe
use Cwd 'abs_path';
use File::Basename;
use File::HomeDir;
use File::Spec::Functions;
use POSIX;
my $sys_home = catdir(dirname(abs_path($0)), "..");
my $usr_home = catdir(home(), '.utt');
prepareUttUsrHome($usr_home);
conf_cor(catfile($usr_home, 'cor.conf'), $sys_home);
conf_grp(catfile($usr_home, 'grp.conf'), $sys_home);
conf_gue(catfile($usr_home, 'gue.conf'), $sys_home);
conf_lem(catfile($usr_home, 'lem.conf'), $sys_home);
conf_ser(catfile($usr_home, 'ser.conf'), $sys_home);
conf_utt(catfile($usr_home, 'utt.conf'), $sys_home);
print "UTT user configuration created in $usr_home\n";
#Kasuje stare configi i tworzy katalog .utt
sub prepareUttUsrHome() {
my $dir = shift;
if(-d $dir) {
print "Old configuration will be deleted!\n";
my $cnt = unlink <$dir/*>;
print "$cnt files deleted.\n";
}
else {
print "Creating directory $dir\n";
if(1 != mkdir $dir) {
die "Unable to create UTT user configuration!\n";
}
}
}
# Tworzy naglowek dla wszystkich plikow konfiguracyjnych
sub makeConfigHeader() {
return "# ************************************************************\n".
"# * This file was created automatically during installation. *\n".
"# * If you don't need do not change it. *\n".
"# * *\n".
"# * UAM Text Tools *\n".
"# * Adam Mickiewicz University, Poland *\n".
"# * http://utt.amu.edu.pl *\n".
"# ************************************************************\n".
"#\n".
"# All lines must looks like:\n".
"# parameter_name [=] value\n".
"#\n\n";
}
sub conf_cor() {
my $cor_file = shift;
my $utthome = shift;
open(FILE, ">$cor_file");
print FILE makeConfigHeader();
print FILE "dictionary-home=", abs_path("$utthome/share/utt"), "\n";
close FILE;
}
sub conf_grp() {
my $grp_file = shift;
my $utthome = shift;
open(FILE, ">$grp_file");
print FILE makeConfigHeader();
print FILE "macros=", abs_path("$utthome/lib/utt/terms.m4"), "\n";
close FILE;
}
sub conf_gue() {
my $gue_file = shift;
my $utthome = shift;
open(FILE, ">$gue_file");
print FILE makeConfigHeader();
close FILE;
}
sub conf_lem() {
my $lem_file = shift;
my $utthome = shift;
open(FILE, ">$lem_file");
print FILE makeConfigHeader();
print FILE "dictionary-home=", abs_path("$utthome/share/utt"), "\n";
close FILE;
}
sub conf_ser() {
my $ser_file = shift;
my $utthome = shift;
open(FILE, ">$ser_file");
print FILE makeConfigHeader();
print FILE "macros=", abs_path("$utthome/lib/utt/terms.m4"), "\n";
print FILE "flex-template=", abs_path("$utthome/lib/utt/ser.l.template"), "\n";
close FILE;
}
sub conf_utt() {
my $utt_file = shift;
my $utthome = shift;
open(FILE, ">$utt_file");
print FILE makeConfigHeader();
print FILE "# user locale\n";
print FILE "language=", findLocale(), "\n";
close FILE;
}
# Szuka locali u uzytkownika
sub findLocale() {
$cur_locale = setlocale(LC_CTYPE);
# we replace Latinx to ISO-8859-x
$cur_locale =~ s/(.+?)Latin(.+?)/$1ISO\-8859\-$2/g;
if($cur_locale =~ /\w+_\w+\.\S+/) {
$best_locale = $cur_locale;
}
elsif($cur_locale =~ /\w+_\w+/) {
$best_locale = $cur_locale.".UTF-8";
}
else {
$best_locale = toupper($cur_locale).'_'.tolower($cur_locale).'.UTF-8';
}
return $best_locale;
}