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