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;