+
+
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;
+
+
+
