src/tools/win32tzlist.pl

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