Signed-off-by: Francois Gouget <fgouget(a)codeweavers.com>
---
testbot/bin/SetWinLocale | 139 +++++++++++++++++++++++++++++++++++++--
1 file changed, 135 insertions(+), 4 deletions(-)
diff --git a/testbot/bin/SetWinLocale b/testbot/bin/SetWinLocale
index 0ab7f935d2..4f50ed555c 100755
--- a/testbot/bin/SetWinLocale
+++ b/testbot/bin/SetWinLocale
@@ -41,6 +41,13 @@ use WineTestBot::Log;
use WineTestBot::TestAgent;
use WineTestBot::Utils;
+my $HKCU_INTERNATIONAL = "HKCU\\Control Panel\\International";
+my $HKCU_GEO = "HKCU\\Control Panel\\International\\Geo";
+my $HKCU_USER_PROFILE = "HKCU\\Control Panel\\International\\User Profile";
+my $HKCU_DESKTOP = "HKCU\\Control Panel\\Desktop";
+my $HKLM_LANGUAGE = "HKLM\\SYSTEM\\CurrentControlSet\\Control\\Nls\\Language";
+my $HKLM_LOCALE = "HKLM\\SYSTEM\\CurrentControlSet\\Control\\Nls\\Locale";
+
#
# Error handling and logging
@@ -289,7 +296,7 @@ sub CheckLocale($$)
return undef;
}
-my ($OptHostName, $OptReboot);
+my ($OptHostName, $OptShow, $OptReboot);
my ($OptDefault, $OptLocale, $OptSystem, $OptMUI, $OptCountry, $OptKeyboard);
while (@ARGV)
{
@@ -298,6 +305,10 @@ while (@ARGV)
{
$Usage = 0;
}
+ elsif ($Arg eq "--show")
+ {
+ $OptShow = 1;
+ }
elsif ($Arg eq "--reboot")
{
if (defined $OptReboot and !$OptReboot)
@@ -414,7 +425,7 @@ if (!defined $Usage)
}
if (!$OptLocale and !$OptSystem and !$OptMUI and !$OptKeyboard and
- !$OptCountry)
+ !$OptCountry and !$OptShow)
{
Error("you must specify at least one locale to change\n");
$Usage = 2;
@@ -433,12 +444,14 @@ if (defined $Usage)
Error("try '$name0 --help' for more information\n");
exit $Usage;
}
+ print "or $name0 [options] --show HOSTNAME\n";
print "or $name0 [options] [--default LOC] [--locale USR] [--system SYS] [--mui MUI] [--keyboard KBD] [--country CTY] HOSTNAME\n";
print "\n";
print "Sets the locale of the specified Windows machine.\n";
print "\n";
print "Where:\n";
print " HOSTNAME Work on the specified Windows host (must be running TestAgentd).\n";
+ print " --show Show the locale settings of the specified host and exit.\n";
print " --default LOC Use this Windows locale as the default for the other options.\n";
print " The locale must be in a form suitable for Windows' intl.cpl\n";
print " control panel module, that is roughly ll-CC where ll is an\n";
@@ -474,6 +487,126 @@ if (defined $Usage)
exit 0;
}
+my $TA = TestAgent->new($OptHostName, $AgentPort);
+
+
+#
+# Registry helpers
+#
+
+sub RegGetValues($;$)
+{
+ my ($Key, $VName) = @_;
+
+ my $Cmd = ["reg.exe", "query", $Key];
+ if ($VName)
+ {
+ push @$Cmd, ($VName =~ /\*/ ? "/f" : "/v"), $VName;
+ }
+ else
+ {
+ push @$Cmd, "/ve";
+ }
+
+ my $Pid = $TA->Run($Cmd, 0, undef, "reg.out");
+ if (!$Pid)
+ {
+ FatalError("failed to run @$Cmd\n");
+ }
+ if (!defined $TA->Wait($Pid, 10))
+ {
+ FatalError("@$Cmd timed out: ", $TA->GetLastError(), "\n");
+ }
+ my $RegOut = $TA->GetFileToString("reg.out");
+ $TA->Rm("reg.out");
+
+ my $Values = {};
+ foreach my $Line (split /\n/, $RegOut)
+ {
+ if ($Line =~ /^\s{4}(.*)\s{4}REG_[A-Z_]+\s{4}(.*)\r$/)
+ {
+ my ($VName, $Value) = ($1, $2);
+ $Value = [split /\\0/, $Value] if ($Value =~ /\\0/);
+ $Values->{$VName} = $Value;
+ }
+ }
+ return $Values;
+}
+
+sub RegGetValue($;$)
+{
+ my ($Key, $VName) = @_;
+ my $Values = RegGetValues($Key, $VName);
+ return $Values->{defined $VName ? $VName : "(Default)"};
+}
+
+
+#
+# Show the host's locale settings
+#
+
+sub GetWinSettings($)
+{
+ my ($All) = @_;
+ my $Settings;
+
+ if ($OptLocale or $All)
+ {
+ my $Values = RegGetValues($HKCU_INTERNATIONAL, "Locale*");
+ map { $Settings->{$_} = $Values->{$_} } ("Locale", "LocaleName");
+ }
+ if ($OptCountry or $All)
+ {
+ my $Values = RegGetValues($HKCU_GEO, "N*");
+ $Settings->{Country} = $Values->{Nation};
+ $Settings->{CountryName} = $Values->{Name};
+ }
+ if ($OptKeyboard or $All)
+ {
+ $Settings->{InputMethod} = RegGetValue($HKCU_USER_PROFILE, "InputMethodOverride");
+ }
+ if ($OptMUI or $All)
+ {
+ my $Values = RegGetValues($HKCU_DESKTOP, "*PreferredUILanguages*");
+ map { $Settings->{$_} = $Values->{$_} } ("PreferredUILanguages", "PreferredUILanguagesPending", "PreviousPreferredUILanguages");
+ }
+ if ($OptSystem or $All)
+ {
+ $Settings->{SysLanguage} = RegGetValue($HKLM_LANGUAGE, "Default");
+ $Settings->{SysLocale} = RegGetValue($HKLM_LOCALE, "(Default)");
+ }
+ return $Settings;
+}
+
+sub Value2Str($)
+{
+ my ($Value) = @_;
+ return !defined $Value ? "<undef>" :
+ ref($Value) ne "ARRAY" ? $Value :
+ ("[". join(", ", @$Value) ."]");
+}
+
+sub ShowWinSettings($)
+{
+ my ($Settings) = @_;
+ print "Locale (--locale) = ", Value2Str($Settings->{Locale}), "\n";
+ print "LocaleName (--locale) = ", Value2Str($Settings->{LocaleName}), "\n";
+ print "Geo:Nation (--country) = ", Value2Str($Settings->{Country}), "\n";
+ print "Geo:Name (--country) = ", Value2Str($Settings->{CountryName}), "\n";
+ print "InputMethod (--keyboard) = ", Value2Str($Settings->{InputMethod}), "\n";
+ print "PreferredUILanguages (--mui) = ", Value2Str($Settings->{PreferredUILanguages}), "\n";
+ print " ...Pending (--mui) = ", Value2Str($Settings->{PreferredUILanguagesPending}), "\n";
+ print " Previous... (--mui) = ", Value2Str($Settings->{PreviousPreferredUILanguages}), "\n";
+ print "Nls:Language (--system) = ", Value2Str($Settings->{SysLanguage}), "\n";
+ print "Nls:Locale (--system) = ", Value2Str($Settings->{SysLocale}), "\n";
+}
+
+if ($OptShow)
+{
+ ShowWinSettings(GetWinSettings("all"));
+ exit(0);
+}
+
#
# Generate the intl.cpl configuration
@@ -526,8 +659,6 @@ push @Config, "</gs:GlobalizationServices>";
# Change the Windows locale using intl.cpl
#
-my $TA = TestAgent->new($OptHostName, $AgentPort);
-
Debug(Elapsed($Start), " Sending the configuration file\n");
print STDERR join("\n", "locales.xml:", @Config, "") if ($DryRun or $Debug);
--
2.30.2