[e1b08a2] | 1 | #!c:\usr\perl\bin\perl.exe |
---|
| 2 | |
---|
| 3 | use Cwd 'abs_path'; |
---|
| 4 | use File::Basename; |
---|
| 5 | use File::HomeDir; |
---|
| 6 | use File::Spec::Functions; |
---|
| 7 | use POSIX; |
---|
| 8 | |
---|
| 9 | my $sys_home = catdir(dirname(abs_path($0)), ".."); |
---|
| 10 | my $usr_home = catdir(home(), '.utt'); |
---|
| 11 | |
---|
| 12 | prepareUttUsrHome($usr_home); |
---|
| 13 | conf_cor(catfile($usr_home, 'cor.conf'), $sys_home); |
---|
| 14 | conf_grp(catfile($usr_home, 'grp.conf'), $sys_home); |
---|
| 15 | conf_gue(catfile($usr_home, 'gue.conf'), $sys_home); |
---|
| 16 | conf_lem(catfile($usr_home, 'lem.conf'), $sys_home); |
---|
| 17 | conf_ser(catfile($usr_home, 'ser.conf'), $sys_home); |
---|
| 18 | conf_utt(catfile($usr_home, 'utt.conf'), $sys_home); |
---|
| 19 | |
---|
| 20 | print "UTT user configuration created in $usr_home\n"; |
---|
| 21 | |
---|
| 22 | |
---|
| 23 | |
---|
| 24 | #Kasuje stare configi i tworzy katalog .utt |
---|
| 25 | sub prepareUttUsrHome() { |
---|
| 26 | my $dir = shift; |
---|
| 27 | |
---|
| 28 | if(-d $dir) { |
---|
| 29 | print "Old configuration will be deleted!\n"; |
---|
| 30 | my $cnt = unlink <$dir/*>; |
---|
| 31 | print "$cnt files deleted.\n"; |
---|
| 32 | } |
---|
| 33 | else { |
---|
| 34 | print "Creating directory $dir\n"; |
---|
| 35 | if(1 != mkdir $dir) { |
---|
| 36 | die "Unable to create UTT user configuration!\n"; |
---|
| 37 | } |
---|
| 38 | } |
---|
| 39 | } |
---|
| 40 | |
---|
| 41 | # Tworzy naglowek dla wszystkich plikow konfiguracyjnych |
---|
| 42 | sub makeConfigHeader() { |
---|
| 43 | return "# ************************************************************\n". |
---|
| 44 | "# * This file was created automatically during installation. *\n". |
---|
| 45 | "# * If you don't need do not change it. *\n". |
---|
| 46 | "# * *\n". |
---|
| 47 | "# * UAM Text Tools *\n". |
---|
| 48 | "# * Adam Mickiewicz University, Poland *\n". |
---|
| 49 | "# * http://utt.amu.edu.pl *\n". |
---|
| 50 | "# ************************************************************\n". |
---|
| 51 | "#\n". |
---|
| 52 | "# All lines must looks like:\n". |
---|
| 53 | "# parameter_name [=] value\n". |
---|
| 54 | "#\n\n"; |
---|
| 55 | } |
---|
| 56 | |
---|
| 57 | sub conf_cor() { |
---|
| 58 | my $cor_file = shift; |
---|
| 59 | my $utthome = shift; |
---|
| 60 | open(FILE, ">$cor_file"); |
---|
| 61 | |
---|
| 62 | print FILE makeConfigHeader(); |
---|
| 63 | print FILE "dictionary-home=", abs_path("$utthome/share/utt"), "\n"; |
---|
| 64 | |
---|
| 65 | close FILE; |
---|
| 66 | } |
---|
| 67 | |
---|
| 68 | sub conf_grp() { |
---|
| 69 | my $grp_file = shift; |
---|
| 70 | my $utthome = shift; |
---|
| 71 | open(FILE, ">$grp_file"); |
---|
| 72 | |
---|
| 73 | print FILE makeConfigHeader(); |
---|
| 74 | print FILE "macros=", abs_path("$utthome/lib/utt/terms.m4"), "\n"; |
---|
| 75 | |
---|
| 76 | close FILE; |
---|
| 77 | } |
---|
| 78 | |
---|
| 79 | sub conf_gue() { |
---|
| 80 | my $gue_file = shift; |
---|
| 81 | my $utthome = shift; |
---|
| 82 | open(FILE, ">$gue_file"); |
---|
| 83 | |
---|
| 84 | print FILE makeConfigHeader(); |
---|
| 85 | |
---|
| 86 | close FILE; |
---|
| 87 | } |
---|
| 88 | |
---|
| 89 | sub conf_lem() { |
---|
| 90 | my $lem_file = shift; |
---|
| 91 | my $utthome = shift; |
---|
| 92 | open(FILE, ">$lem_file"); |
---|
| 93 | |
---|
| 94 | print FILE makeConfigHeader(); |
---|
| 95 | print FILE "dictionary-home=", abs_path("$utthome/share/utt"), "\n"; |
---|
| 96 | |
---|
| 97 | close FILE; |
---|
| 98 | } |
---|
| 99 | |
---|
| 100 | sub conf_ser() { |
---|
| 101 | my $ser_file = shift; |
---|
| 102 | my $utthome = shift; |
---|
| 103 | open(FILE, ">$ser_file"); |
---|
| 104 | |
---|
| 105 | print FILE makeConfigHeader(); |
---|
| 106 | print FILE "macros=", abs_path("$utthome/lib/utt/terms.m4"), "\n"; |
---|
| 107 | print FILE "flex-template=", abs_path("$utthome/lib/utt/ser.l.template"), "\n"; |
---|
| 108 | |
---|
| 109 | close FILE; |
---|
| 110 | } |
---|
| 111 | |
---|
| 112 | sub conf_utt() { |
---|
| 113 | my $utt_file = shift; |
---|
| 114 | my $utthome = shift; |
---|
| 115 | open(FILE, ">$utt_file"); |
---|
| 116 | |
---|
| 117 | print FILE makeConfigHeader(); |
---|
| 118 | print FILE "# user locale\n"; |
---|
| 119 | print FILE "language=", findLocale(), "\n"; |
---|
| 120 | |
---|
| 121 | close FILE; |
---|
| 122 | } |
---|
| 123 | |
---|
| 124 | # Szuka locali u uzytkownika |
---|
| 125 | sub findLocale() { |
---|
| 126 | $cur_locale = setlocale(LC_CTYPE); |
---|
| 127 | |
---|
| 128 | # we replace Latinx to ISO-8859-x |
---|
| 129 | $cur_locale =~ s/(.+?)Latin(.+?)/$1ISO\-8859\-$2/g; |
---|
| 130 | |
---|
| 131 | if($cur_locale =~ /\w+_\w+\.\S+/) { |
---|
| 132 | $best_locale = $cur_locale; |
---|
| 133 | } |
---|
| 134 | elsif($cur_locale =~ /\w+_\w+/) { |
---|
| 135 | $best_locale = $cur_locale.".UTF-8"; |
---|
| 136 | } |
---|
| 137 | else { |
---|
| 138 | $best_locale = toupper($cur_locale).'_'.tolower($cur_locale).'.UTF-8'; |
---|
| 139 | } |
---|
| 140 | return $best_locale; |
---|
| 141 | } |
---|