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

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