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_utt(catfile($usr_home, 'utt.conf'), $sys_home); |
---|
15 | |
---|
16 | conf_cor(catfile($usr_home, 'cor.conf'), $sys_home); |
---|
17 | conf_grp(catfile($usr_home, 'grp.conf'), $sys_home); |
---|
18 | conf_gue(catfile($usr_home, 'gue.conf'), $sys_home); |
---|
19 | conf_lem(catfile($usr_home, 'lem.conf'), $sys_home); |
---|
20 | conf_ser(catfile($usr_home, 'ser.conf'), $sys_home); |
---|
21 | |
---|
22 | print "UTT user configuration created in $usr_home\n"; |
---|
23 | |
---|
24 | |
---|
25 | |
---|
26 | #Kasuje stare configi i tworzy katalog .utt |
---|
27 | sub prepareUttUsrHome() { |
---|
28 | my $dir = shift; |
---|
29 | |
---|
30 | print "Preparing user configuration.\n"; |
---|
31 | |
---|
32 | if(-d $dir) { |
---|
33 | print "Old configuration detected. "; |
---|
34 | my $cnt = unlink <$dir/*>; |
---|
35 | print "($cnt files deleted)\n"; |
---|
36 | } |
---|
37 | else { |
---|
38 | print "Creating directory $dir\n"; |
---|
39 | if(1 != mkdir $dir) { |
---|
40 | die "Unable to create UTT user configuration!\n"; |
---|
41 | } |
---|
42 | } |
---|
43 | } |
---|
44 | |
---|
45 | # Tworzy naglowek dla wszystkich plikow konfiguracyjnych |
---|
46 | sub makeConfigHeader() { |
---|
47 | return "# ************************************************************\n". |
---|
48 | "# * This file was created automatically during installation. *\n". |
---|
49 | "# * If you don't need do not change it. *\n". |
---|
50 | "# * *\n". |
---|
51 | "# * UAM Text Tools *\n". |
---|
52 | "# * Adam Mickiewicz University, Poland *\n". |
---|
53 | "# * http://utt.amu.edu.pl *\n". |
---|
54 | "# ************************************************************\n". |
---|
55 | "#\n". |
---|
56 | "# All lines must looks like:\n". |
---|
57 | "# parameter_name [=] value\n". |
---|
58 | "#\n\n"; |
---|
59 | } |
---|
60 | |
---|
61 | sub conf_cor() { |
---|
62 | my $cor_file = shift; |
---|
63 | my $utthome = shift; |
---|
64 | open(FILE, ">$cor_file"); |
---|
65 | |
---|
66 | print FILE makeConfigHeader(); |
---|
67 | print FILE "dictionary-home=", abs_path("$utthome/share/utt"), "\n"; |
---|
68 | |
---|
69 | close FILE; |
---|
70 | } |
---|
71 | |
---|
72 | sub conf_grp() { |
---|
73 | my $grp_file = shift; |
---|
74 | my $utthome = shift; |
---|
75 | open(FILE, ">$grp_file"); |
---|
76 | |
---|
77 | print FILE makeConfigHeader(); |
---|
78 | print FILE "macros=", abs_path("$utthome/lib/utt/terms.m4"), "\n"; |
---|
79 | |
---|
80 | close FILE; |
---|
81 | } |
---|
82 | |
---|
83 | sub conf_gue() { |
---|
84 | my $gue_file = shift; |
---|
85 | my $utthome = shift; |
---|
86 | open(FILE, ">$gue_file"); |
---|
87 | |
---|
88 | print FILE makeConfigHeader(); |
---|
89 | |
---|
90 | close FILE; |
---|
91 | } |
---|
92 | |
---|
93 | sub conf_lem() { |
---|
94 | my $lem_file = shift; |
---|
95 | my $utthome = shift; |
---|
96 | open(FILE, ">$lem_file"); |
---|
97 | |
---|
98 | print FILE makeConfigHeader(); |
---|
99 | print FILE "dictionary-home=", abs_path("$utthome/share/utt"), "\n"; |
---|
100 | |
---|
101 | close FILE; |
---|
102 | } |
---|
103 | |
---|
104 | sub conf_ser() { |
---|
105 | my $ser_file = shift; |
---|
106 | my $utthome = shift; |
---|
107 | open(FILE, ">$ser_file"); |
---|
108 | |
---|
109 | print FILE makeConfigHeader(); |
---|
110 | print FILE "macros=", abs_path("$utthome/lib/utt/terms.m4"), "\n"; |
---|
111 | print FILE "flex-template=", abs_path("$utthome/lib/utt/ser.l.template"), "\n"; |
---|
112 | |
---|
113 | close FILE; |
---|
114 | } |
---|
115 | |
---|
116 | sub conf_utt() { |
---|
117 | my $utt_file = shift; |
---|
118 | my $utthome = shift; |
---|
119 | |
---|
120 | my $lang = getUserLanguage(abs_path(catdir($utthome, "share/utt"))); |
---|
121 | |
---|
122 | open(FILE, ">$utt_file"); |
---|
123 | |
---|
124 | print FILE makeConfigHeader(); |
---|
125 | print FILE "# user locale (dictionary)\n"; |
---|
126 | print FILE "language=", $lang, "\n"; |
---|
127 | |
---|
128 | close FILE; |
---|
129 | } |
---|
130 | |
---|
131 | sub getUserLanguage() { |
---|
132 | my $dict_dir = shift; |
---|
133 | |
---|
134 | print "Setup dictionaries.\n"; |
---|
135 | |
---|
136 | opendir(DIR, $dict_dir) || die "Install dictionary first!\n"; |
---|
137 | @files = grep(/[^\.{1,2}]/ && -d "$dict_dir/$_", readdir(DIR)); |
---|
138 | closedir DIR; |
---|
139 | my $cnt = scalar @files; |
---|
140 | print "$cnt dictionary(ies) found.\n"; |
---|
141 | if(0 == $cnt) { |
---|
142 | die("Install dictionary first!\n"); |
---|
143 | } |
---|
144 | |
---|
145 | foreach my $file (@files) { |
---|
146 | print "Do you select dictionary $file [yes/no]? "; |
---|
147 | my $ans = <STDIN>; |
---|
148 | if($ans =~ /y(es)?/i) { |
---|
149 | return $file; |
---|
150 | } |
---|
151 | } |
---|
152 | die "No dictionary selected - setup failed!\n"; |
---|
153 | } |
---|
154 | |
---|
155 | # Szuka locali u uzytkownika |
---|
156 | sub findLocale() { |
---|
157 | $cur_locale = setlocale(LC_CTYPE); |
---|
158 | |
---|
159 | # we replace Latinx to ISO-8859-x |
---|
160 | $cur_locale =~ s/(.+?)Latin(.+?)/$1ISO\-8859\-$2/g; |
---|
161 | |
---|
162 | if($cur_locale =~ /\w+_\w+\.\S+/) { |
---|
163 | $best_locale = $cur_locale; |
---|
164 | } |
---|
165 | elsif($cur_locale =~ /\w+_\w+/) { |
---|
166 | $best_locale = $cur_locale.".UTF-8"; |
---|
167 | } |
---|
168 | else { |
---|
169 | $best_locale = toupper($cur_locale).'_'.tolower($cur_locale).'.UTF-8'; |
---|
170 | } |
---|
171 | return $best_locale; |
---|
172 | } |
---|