granicus.if.org Git - postgresql/blob - src/tools/win32tzlist.pl

   1 #################################################################
   2 #
   3 # win32tzlist.pl -- compare Windows timezone information
   4 #
   5 # Copyright (c) 2008-2019, 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 open(my $tzfh, '<', $tzfile) or die "Could not open $tzfile!\n";
  64 my $t = $/;
  65 undef $/;
  66 my $pgtz = <$tzfh>;
  67 close($tzfh);
  68 $/ = $t;
  69
  70 # Attempt to locate and extract the complete win32_tzmap struct
  71 $pgtz =~ /win32_tzmap\[\] =\s+{\s+\/\*[^\/]+\*\/\s+(.+?)};/gs
  72   or die "Could not locate struct win32_tzmap in $tzfile!";
  73 $pgtz = $1;
  74
  75 # Extract each individual record from the struct
  76 while ($pgtz =~
  77         m/{\s+"([^"]+)",\s+"([^"]+)",\s+"([^"]+)",?\s+},\s+\/\*(.+?)\*\//gs)
  78 {
  79         push @file_zones,
  80           {
  81                 'std'     => $1,
  82                 'dlt'     => $2,
  83                 'match'   => $3,
  84                 'display' => clean_displayname($4),
  85           };
  86 }
  87
  88 #
  89 # Look for anything that has changed
  90 #
  91 my @add;
  92
  93 for my $sys (@system_zones)
  94 {
  95         my $match = 0;
  96         for my $file (@file_zones)
  97         {
  98                 if ($sys->{std} eq $file->{std})
  99                 {
 100                         $match = 1;
 101                         if ($sys->{dlt} ne $file->{dlt})
 102                         {
 103                                 print
 104                                   "Timezone $sys->{std}, changed name of daylight zone!\n";
 105                         }
 106                         if ($sys->{display} ne $file->{display})
 107                         {
 108                                 print
 109                                   "Timezone $sys->{std} changed displayname ('$sys->{display}' from '$file->{display}')!\n";
 110                         }
 111                         last;
 112                 }
 113         }
 114         unless ($match)
 115         {
 116                 push @add, $sys;
 117         }
 118 }
 119
 120 if (@add)
 121 {
 122         print "\n\nOther than that, add the following timezones:\n";
 123         for my $z (@add)
 124         {
 125                 print
 126                   "\t{\n\t\t\"$z->{std}\", \"$z->{dlt}\",\n\t\t\"FIXME\"\n\t},\t\t\t\t\t\t\t/* $z->{display} */\n";
 127         }
 128 }
 129
 130 sub clean_displayname
 131 {
 132         my $dn = shift;
 133
 134         $dn =~ s/\s+/ /gs;
 135         $dn =~ s/\*//gs;
 136         $dn =~ s/^\s+//gs;
 137         $dn =~ s/\s+$//gs;
 138         return $dn;
 139 }