#!/usr/bin/perl #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_utt(catfile($usr_home, 'utt.conf'), $sys_home); conf_cor(catfile($usr_home, 'cor.conf'), $sys_home); conf_compiledic(catfile($usr_home, 'compiledic.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); print "UTT user configuration created in $usr_home\n"; #Kasuje stare configi i tworzy katalog .utt sub prepareUttUsrHome() { my $dir = shift; print "Preparing user configuration.\n"; if(-d $dir) { print "Old configuration detected. "; 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_compiledic() { my $compiledic_file = shift; my $utthome = shift; open(FILE, ">$compiledic_file"); print FILE makeConfigHeader(); my $hm = home(); my $lang=`grep language $hm/.utt/utt.conf | cut -d= -f 2`; chomp $lang; # powinno byc $utthome/share/utt/pl_PL.ISO-8859-2/pl_PL.ISO-8892-2.sym # ale to bez sensu print FILE "symbols=", abs_path("$utthome/share/utt"); print FILE "/$lang/$lang.sym\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_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; my $lang = getUserLanguage(abs_path(catdir($utthome, "share/utt"))); open(FILE, ">$utt_file"); print FILE makeConfigHeader(); print FILE "# user locale (dictionary)\n"; print FILE "language=", $lang, "\n"; close FILE; } sub getUserLanguage() { my $dict_dir = shift; print "Setup dictionaries.\n"; opendir(DIR, $dict_dir) || die "Install dictionary first!\n"; @files = grep(/[^\.{1,2}]/ && -d "$dict_dir/$_", readdir(DIR)); closedir DIR; my $cnt = scalar @files; print "$cnt dictionary(ies) found.\n"; if(0 == $cnt) { die("Install dictionary first!\n"); } foreach my $file (@files) { print "Do you select dictionary $file [yes/no]? "; my $ans = ; if($ans =~ /y(es)?/i) { return $file; } } die "No dictionary selected - setup failed!\n"; } # 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; }