[tools] testbot/SetWinLocale: Add an option to show the current locale settings.

Francois Gouget fgouget at codeweavers.com
Thu Dec 23 10:29:11 CST 2021


Signed-off-by: Francois Gouget <fgouget at 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



More information about the wine-devel mailing list