src/tools/win32tzlist.pl

   1 #################################################################
   2 #
   3 # win32tzlist.pl -- compare Windows timezone information
   4 #
   5 # Copyright (c) 2008-2024, PostgreSQL Global Development Group
   6 #
   7 # src/tools/win32tzlist.pl
   8 #################################################################
   9
  10 #
  11 # This script compares the timezone information in the Windows registry
  12 # with that in src/bin/initdb/findtimezone.c.  A list of changes will be
  13 # written to stdout - no attempt is made to automatically edit the file.
  14 #
  15 # Run the script from the top-level PG source directory.
  16 #
  17
  18 use strict;
  19 use warnings FATAL => 'all';
  20
  21 use Config;
  22
  23 our $HKEY_LOCAL_MACHINE;
  24
  25 BEGIN
  26 {
  27         if ($Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys')
  28         {
  29                 require Win32::Registry;
  30                 Win32::Registry->import;
  31         }
  32 }
  33
  34 my $tzfile = 'src/bin/initdb/findtimezone.c';
  35
  36 #
  37 # Fetch all timezones in the registry
  38 #
  39 my $basekey;
  40 $HKEY_LOCAL_MACHINE->Open(
  41         "SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Time Zones", $basekey)
  42   or die $!;
  43
  44 my @subkeys;
  45 $basekey->GetKeys(\@subkeys);
  46
  47 my @system_zones;
  48
  49 foreach my $keyname (@subkeys)
  50 {
  51         my $subkey;
  52         my %vals;
  53
  54         $basekey->Open($keyname, $subkey) or die $!;
  55         $subkey->GetValues(\%vals) or die $!;
  56         $subkey->Close();
  57
  58         die "Incomplete timezone data for $keyname!\n"
  59           unless ($vals{Std} && $vals{Dlt} && $vals{Display});
  60         push @system_zones,
  61           {
  62                 'std' => $vals{Std}->[2],
  63                 'dlt' => $vals{Dlt}->[2],
  64                 'display' => clean_displayname($vals{Display}->[2]),
  65           };
  66 }
  67
  68 $basekey->Close();
  69
  70 #
  71 # Fetch all timezones currently in the file
  72 #
  73 my @file_zones;
  74 my $pgtz;
  75 open(my $tzfh, '<', $tzfile) or die "Could not open $tzfile!\n";
  76 {
  77         local $/ = undef;
  78         $pgtz = <$tzfh>;
  79 }
  80 close($tzfh);
  81
  82 # Attempt to locate and extract the complete win32_tzmap struct
  83 $pgtz =~ /win32_tzmap\[\] =\s+{\s+\/\*[^\/]+\*\/\s+(.+?)};/gs
  84   or die "Could not locate struct win32_tzmap in $tzfile!";
  85 $pgtz = $1;
  86
  87 # Extract each individual record from the struct
  88 while ($pgtz =~
  89         m/{\s+\/\*(.+?)\*\/\s+"([^"]+)",\s+"([^"]+)",\s+"([^"]+)",?\s+},/gs)
  90 {
  91         push @file_zones,
  92           {
  93                 'display' => clean_displayname($1),
  94                 'std' => $2,
  95                 'dlt' => $3,
  96                 'match' => $4,
  97           };
  98 }
  99
 100 #
 101 # Look for anything that has changed
 102 #
 103 my @add;
 104
 105 for my $sys (@system_zones)
 106 {
 107         my $match = 0;
 108         for my $file (@file_zones)
 109         {
 110                 if ($sys->{std} eq $file->{std})
 111                 {
 112                         $match = 1;
 113                         if ($sys->{dlt} ne $file->{dlt})
 114                         {
 115                                 print
 116                                   "Timezone $sys->{std}, changed name of daylight zone!\n";
 117                         }
 118                         if ($sys->{display} ne $file->{display})
 119                         {
 120                                 print
 121                                   "Timezone $sys->{std} changed displayname ('$sys->{display}' from '$file->{display}')!\n";
 122                         }
 123                         last;
 124                 }
 125         }
 126         unless ($match)
 127         {
 128                 push @add, $sys;
 129         }
 130 }
 131
 132 if (@add)
 133 {
 134         print "\n\nOther than that, add the following timezones:\n";
 135         for my $z (@add)
 136         {
 137                 print
 138                   "\t{\n\t\t/* $z->{display} */\n\t\t\"$z->{std}\", \"$z->{dlt}\",\n\t\t\"FIXME\"\n\t},\n";
 139         }
 140 }
 141
 142 sub clean_displayname
 143 {
 144         my $dn = shift;
 145
 146         $dn =~ s/\*//gs;
 147         $dn =~ s/\s+/ /gs;
 148         $dn =~ s/^\s+//gs;
 149         $dn =~ s/\s+$//gs;
 150         return $dn;
 151 }