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', # Southern Sotho
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',  # Also Serbian and Bosnian.
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';  # Standard not-used
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;





Creative Commons License
This work is licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.