Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
6 changed files
with
526 additions
and
5 deletions.
There are no files selected for viewing
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,193 @@ | ||
use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>1 ); | ||
use Locale::Language; | ||
use strict; | ||
use warnings; | ||
|
||
my %languages = ( | ||
'00' => 'DV', | ||
'01' => 'CY', | ||
'02' => 'Syriac', | ||
'03' => 'Northern Sotho', | ||
'04' => '--', | ||
'05' => '--', | ||
'06' => '--', | ||
'07' => 'NE', | ||
'08' => '--', | ||
'09' => '--', | ||
'0A' => '--', | ||
'0B' => '--', | ||
'0C' => 'QU', | ||
'0D' => '--', | ||
'0E' => '--', | ||
'0F' => '--', | ||
'10' => 'BN', | ||
'11' => 'PA', | ||
'12' => 'GU', | ||
'13' => 'OR', | ||
'14' => 'ST', # Southern Sotho | ||
'15' => 'SE', | ||
'16' => 'KA', | ||
'17' => 'HI', | ||
'18' => 'AS', | ||
'19' => 'MR', | ||
'1A' => 'SA', | ||
'1B' => 'Konkani', | ||
'1C' => 'TA', | ||
'1D' => 'TE', | ||
'1E' => 'KN', | ||
'1F' => 'ML', | ||
'40' => 'NB', | ||
'41' => 'PL', | ||
'42' => 'PT', | ||
'43' => 'RM', | ||
'44' => 'IT', | ||
'45' => 'JA', | ||
'46' => 'KO', | ||
'47' => 'NL', | ||
'48' => 'SQ', | ||
'49' => 'SV', | ||
'4A' => 'TH', | ||
'4B' => 'TR', | ||
'4C' => 'RO', | ||
'4D' => 'RU', | ||
'4E' => 'HR', # Also Serbian and Bosnian. | ||
'4F' => 'SK', | ||
'50' => 'ZH', | ||
'51' => 'CS', | ||
'52' => 'DA', | ||
'53' => 'DE', | ||
'54' => '--', | ||
'55' => 'AR', | ||
'56' => 'BG', | ||
'57' => 'CA', | ||
'58' => 'FR', | ||
'59' => 'HE', | ||
'5A' => 'HU', | ||
'5B' => 'IS', | ||
'5C' => 'EL', | ||
'5D' => 'EN', | ||
'5E' => 'ES', | ||
'5F' => 'FI', | ||
'60' => 'FO', | ||
'61' => 'MT', | ||
'62' => 'GA', | ||
'63' => 'MS', | ||
'64' => '--', | ||
'65' => 'XH', | ||
'66' => 'ZU', | ||
'67' => 'AF', | ||
'68' => 'UZ', | ||
'69' => 'TT', | ||
'6A' => 'MN', | ||
'6B' => 'GL', | ||
'6C' => 'KK', | ||
'6D' => 'SW', | ||
'6E' => 'TL', | ||
'6F' => 'KY', | ||
'70' => 'SL', | ||
'71' => 'ET', | ||
'72' => 'LV', | ||
'73' => 'LT', | ||
'74' => 'UR', | ||
'75' => 'ID', | ||
'76' => 'UK', | ||
'77' => 'BE', | ||
'78' => 'AZ', | ||
'79' => 'EU', | ||
'7A' => 'Sorbian', | ||
'7B' => 'MK', | ||
'7C' => 'MI', | ||
'7D' => 'FA', | ||
'7E' => 'VI', | ||
'7F' => 'HY', | ||
); | ||
|
||
|
||
my $key_not_found = 0; | ||
my $key = $Registry->{'HKEY_LOCAL_MACHINE/SOFTWARE/Wow6432Node/TRADOS/'} or $key_not_found = 1; | ||
if ($key_not_found) { | ||
$key_not_found = 0; | ||
$key = $Registry->{'HKEY_LOCAL_MACHINE/SOFTWARE/TRADOS/'} or $key_not_found = 1; | ||
} | ||
if ($key_not_found) { | ||
print "TRADOS 2007 does not appear to be installed on your machine (can't find Registry key)\n"; | ||
<STDIN>; | ||
exit; | ||
} | ||
|
||
my $a = $key->{'Shared/IDNG//'} or $key_not_found = 1; | ||
|
||
if ($key_not_found) { | ||
print "TRADOS 2007 appears to be installed, but your Registry is configured in an unexpected way.\n"; | ||
<STDIN>; | ||
exit; | ||
} | ||
|
||
my $idng = $a->[0]; | ||
|
||
DISPLAY: | ||
if (not $idng =~ /{(.*-.*-.*-.*-00)(.*)}/) { | ||
print "Unexpected IDNG value $idng encountered.\n"; | ||
<STDIN>; | ||
exit; | ||
} | ||
my ($prefix, $meat) = ($1, $2); | ||
|
||
print "IDNG: $idng\n\n"; | ||
my $slot = 0; | ||
foreach my $language (unpack("(A2)*", $meat)) { | ||
my $l = $languages{$language} || "-- ($language)"; | ||
my $ln = code2language($l); | ||
$ln = "Croatian/Serbian/Bosnian" if $l eq 'HR'; | ||
$l .= " ($ln)" if $ln; | ||
$slot++; | ||
print "$slot: $l\n"; | ||
} | ||
print "\n"; | ||
print "Enter new values or <Enter> to quit: "; | ||
|
||
READ: | ||
my $line = <STDIN>; | ||
chomp $line; | ||
exit unless $line; | ||
|
||
my @values = split / /, $line; | ||
if (@values > 5) { | ||
print "Need 1 to 5 values or <Enter> to quit: "; | ||
goto READ; | ||
} | ||
|
||
my $problem = 0; | ||
foreach my $s (0, 1, 2, 3, 4) { | ||
|
||
if ($s + 1 > @values or $values[$s] eq '--') { | ||
$values[$s] = '84'; # Standard not-used | ||
next; | ||
} | ||
if ($values[$s] =~ /^[0-9][0-9A-F]$/) { | ||
$values[$s] =~ tr/a-z/A-Z/; | ||
next; | ||
} | ||
my $ln = language2code ($values[$s]); | ||
$values[$s] = $ln if $ln; | ||
$values[$s] =~ tr/a-z/A-Z/; | ||
$values[$s] = 'HR' if $values[$s] eq 'SR' or $values[$s] eq 'BS'; | ||
foreach my $n (keys %languages) { | ||
if (lc($languages{$n}) eq lc($values[$s])) { | ||
$values[$s] = $n; | ||
goto NEXTNEXT; | ||
} | ||
} | ||
$problem = 1; | ||
print sprintf("Don't understand value %s in slot %s\n", $values[$s], $s + 1); | ||
NEXTNEXT: | ||
} | ||
|
||
if ($problem) { | ||
print "Need 1 to 5 values or <Enter> to quit: "; | ||
goto READ; | ||
} | ||
|
||
$idng = sprintf ("{$prefix%s}", join ('', @values)); | ||
$key->{'Shared/IDNG//'} = [$idng, 1]; | ||
goto DISPLAY; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.