TRADOS 2007 language code script
Here's the full code for the initial prototype script. This is still a
pretty rudimentary presentation - my ultimate goal here is to learn to
write about software, so I'm experimenting a little with the format.
This is also available in a plain-text format for download.
To use this script, follow the instructions
or wait for the next version, which will be easier to install.
001 use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>1 );
002 use Locale::Language;
003 use strict;
004 use warnings;
005
006 my %languages = (
007 '00' => 'DV',
008 '01' => 'CY',
009 '02' => 'Syriac',
010 '03' => 'Northern Sotho',
011 '04' => '--',
012 '05' => '--',
013 '06' => '--',
014 '07' => 'NE',
015 '08' => '--',
016 '09' => '--',
017 '0A' => '--',
018 '0B' => '--',
019 '0C' => 'QU',
020 '0D' => '--',
021 '0E' => '--',
022 '0F' => '--',
023 '10' => 'BN',
024 '11' => 'PA',
025 '12' => 'GU',
026 '13' => 'OR',
027 '14' => 'ST',
028 '15' => 'SE',
029 '16' => 'KA',
030 '17' => 'HI',
031 '18' => 'AS',
032 '19' => 'MR',
033 '1A' => 'SA',
034 '1B' => 'Konkani',
035 '1C' => 'TA',
036 '1D' => 'TE',
037 '1E' => 'KN',
038 '1F' => 'ML',
039 '40' => 'NB',
040 '41' => 'PL',
041 '42' => 'PT',
042 '43' => 'RM',
043 '44' => 'IT',
044 '45' => 'JA',
045 '46' => 'KO',
046 '47' => 'NL',
047 '48' => 'SQ',
048 '49' => 'SV',
049 '4A' => 'TH',
050 '4B' => 'TR',
051 '4C' => 'RO',
052 '4D' => 'RU',
053 '4E' => 'HR',
054 '4F' => 'SK',
055 '50' => 'ZH',
056 '51' => 'CS',
057 '52' => 'DA',
058 '53' => 'DE',
059 '54' => '--',
060 '55' => 'AR',
061 '56' => 'BG',
062 '57' => 'CA',
063 '58' => 'FR',
064 '59' => 'HE',
065 '5A' => 'HU',
066 '5B' => 'IS',
067 '5C' => 'EL',
068 '5D' => 'EN',
069 '5E' => 'ES',
070 '5F' => 'FI',
071 '60' => 'FO',
072 '61' => 'MT',
073 '62' => 'GA',
074 '63' => 'MS',
075 '64' => '--',
076 '65' => 'XH',
077 '66' => 'ZU',
078 '67' => 'AF',
079 '68' => 'UZ',
080 '69' => 'TT',
081 '6A' => 'MN',
082 '6B' => 'GL',
083 '6C' => 'KK',
084 '6D' => 'SW',
085 '6E' => 'TL',
086 '6F' => 'KY',
087 '70' => 'SL',
088 '71' => 'ET',
089 '72' => 'LV',
090 '73' => 'LT',
091 '74' => 'UR',
092 '75' => 'ID',
093 '76' => 'UK',
094 '77' => 'BE',
095 '78' => 'AZ',
096 '79' => 'EU',
097 '7A' => 'Sorbian',
098 '7B' => 'MK',
099 '7C' => 'MI',
100 '7D' => 'FA',
101 '7E' => 'VI',
102 '7F' => 'HY',
103 );
104
105
106 my $key_not_found = 0;
107 my $key = $Registry->{'HKEY_LOCAL_MACHINE/SOFTWARE/Wow6432Node/TRADOS/'} or $key_not_found = 1;
108 if ($key_not_found) {
109 $key_not_found = 0;
110 $key = $Registry->{'HKEY_LOCAL_MACHINE/SOFTWARE/TRADOS/'} or $key_not_found = 1;
111 }
112 if ($key_not_found) {
113 print "TRADOS 2007 does not appear to be installed on your machine (can't find Registry key)\n";
114 <STDIN>;
115 exit;
116 }
117
118 my $a = $key->{'Shared/IDNG//'} or $key_not_found = 1;
119
120 if ($key_not_found) {
121 print "TRADOS 2007 appears to be installed, but your Registry is configured in an unexpected way.\n";
122 <STDIN>;
123 exit;
124 }
125
126 my $idng = $a->[0];
127
128 DISPLAY:
129 if (not $idng =~ /{(.*-.*-.*-.*-00)(.*)}/) {
130 print "Unexpected IDNG value $idng encountered.\n";
131 <STDIN>;
132 exit;
133 }
134 my ($prefix, $meat) = ($1, $2);
135
136 print "IDNG: $idng\n\n";
137 my $slot = 0;
138 foreach my $language (unpack("(A2)*", $meat)) {
139 my $l = $languages{$language} || "-- ($language)";
140 my $ln = code2language($l);
141 $ln = "Croatian/Serbian/Bosnian" if $l eq 'HR';
142 $l .= " ($ln)" if $ln;
143 $slot++;
144 print "$slot: $l\n";
145 }
146 print "\n";
147 print "Enter new values or <Enter> to quit: ";
148
149 READ:
150 my $line = <STDIN>;
151 chomp $line;
152 exit unless $line;
153
154 my @values = split / /, $line;
155 if (@values > 5) {
156 print "Need 1 to 5 values or <Enter> to quit: ";
157 goto READ;
158 }
159
160 my $problem = 0;
161 foreach my $s (0, 1, 2, 3, 4) {
162
163 if ($s + 1 > @values or $values[$s] eq '--') {
164 $values[$s] = '84';
165 next;
166 }
167 if ($values[$s] =~ /^[0-9][0-9A-F]$/) {
168 $values[$s] =~ tr/a-z/A-Z/;
169 next;
170 }
171 my $ln = language2code ($values[$s]);
172 $values[$s] = $ln if $ln;
173 $values[$s] =~ tr/a-z/A-Z/;
174 $values[$s] = 'HR' if $values[$s] eq 'SR' or $values[$s] eq 'BS';
175 foreach my $n (keys %languages) {
176 if (lc($languages{$n}) eq lc($values[$s])) {
177 $values[$s] = $n;
178 goto NEXTNEXT;
179 }
180 }
181 $problem = 1;
182 print sprintf("Don't understand value in slot \n", $values[$s], $s + 1);
183 NEXTNEXT:
184 }
185
186 if ($problem) {
187 print "Need 1 to 5 values or <Enter> to quit: ";
188 goto READ;
189 }
190
191 $idng = sprintf ("{$prefix}", join ('', @values));
192 $key->{'Shared/IDNG//'} = [$idng, 1];
193 goto DISPLAY;
