1#---------------------------------------------------------------------- 2# 3# tclZIC.tcl -- 4# 5# Take the time zone data source files from Arthur Olson's 6# repository at elsie.nci.nih.gov, and prepare time zone 7# information files for Tcl. 8# 9# Usage: 10# tclsh tclZIC.tcl inputDir outputDir 11# 12# Parameters: 13# inputDir - Directory (e.g., tzdata2003e) where Olson's source 14# files are to be found. 15# outputDir - Directory (e.g., ../library/tzdata) where 16# the time zone information files are to be placed. 17# 18# Results: 19# May produce error messages on the standard error. An exit 20# code of zero denotes success; any other exit code is failure. 21# 22# This program parses the timezone data in a means analogous to the 23# 'zic' command, and produces Tcl time zone information files suitable 24# for loading into the 'clock' namespace. 25# 26#---------------------------------------------------------------------- 27# 28# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. 29# See the file "license.terms" for information on usage and redistribution 30# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 31# 32# RCS: @(#) $Id: tclZIC.tcl,v 1.9.4.1 2009/04/09 20:12:10 kennykb Exp $ 33# 34#---------------------------------------------------------------------- 35 36package require Tcl 8.5 37 38# Define the names of the Olson files that we need to load. 39# We avoid the solar time files and the leap seconds. 40 41set olsonFiles { 42 africa antarctica asia australasia 43 backward etcetera europe northamerica 44 pacificnew southamerica systemv 45} 46 47# Define the year at which the DST information will stop. 48 49set maxyear 2100 50 51# Determine how big a wide integer is. 52 53set MAXWIDE [expr {wide(1)}] 54while 1 { 55 set next [expr {wide($MAXWIDE + $MAXWIDE + 1)}] 56 if {$next < 0} { 57 break 58 } 59 set MAXWIDE $next 60} 61set MINWIDE [expr {-$MAXWIDE-1}] 62 63#---------------------------------------------------------------------- 64# 65# loadFiles -- 66# 67# Loads the time zone files for each continent into memory 68# 69# Parameters: 70# dir - Directory where the time zone source files are found 71# 72# Results: 73# None. 74# 75# Side effects: 76# Calls 'loadZIC' for each continent's data file in turn. 77# Reports progress on stdout. 78# 79#---------------------------------------------------------------------- 80 81proc loadFiles {dir} { 82 variable olsonFiles 83 foreach file $olsonFiles { 84 puts "loading: [file join $dir $file]" 85 loadZIC [file join $dir $file] 86 } 87 return 88} 89 90#---------------------------------------------------------------------- 91# 92# checkForwardRuleRefs -- 93# 94# Checks to make sure that all references to Daylight Saving 95# Time rules designate defined rules. 96# 97# Parameters: 98# None. 99# 100# Results: 101# None. 102# 103# Side effects: 104# Produces an error message and increases the error count if 105# any undefined rules are present. 106# 107#---------------------------------------------------------------------- 108 109proc checkForwardRuleRefs {} { 110 variable forwardRuleRefs 111 variable rules 112 113 foreach {rule where} [array get forwardRuleRefs] { 114 if {![info exists rules($rule)]} { 115 foreach {fileName lno} $where { 116 puts stderr "$fileName:$lno:can't locate rule \"$rule\"" 117 incr errorCount 118 } 119 } 120 } 121} 122 123#---------------------------------------------------------------------- 124# 125# loadZIC -- 126# 127# Load one continent's data into memory. 128# 129# Parameters: 130# fileName -- Name of the time zone source file. 131# 132# Results: 133# None. 134# 135# Side effects: 136# The global variable, 'errorCount' counts the number of errors. 137# The global array, 'links', contains a distillation of the 138# 'Link' directives in the file. The keys are 'links to' and 139# the values are 'links from'. The 'parseRule' and 'parseZone' 140# procedures are called to handle 'Rule' and 'Zone' directives. 141# 142#---------------------------------------------------------------------- 143 144proc loadZIC {fileName} { 145 variable errorCount 146 variable links 147 148 # Suck the text into memory. 149 150 set f [open $fileName r] 151 set data [read $f] 152 close $f 153 154 # Break the input into lines, and count line numbers. 155 156 set lno 0 157 foreach line [split $data \n] { 158 incr lno 159 160 # Break a line of input into words. 161 162 regsub {\s*(\#.*)?$} $line {} line 163 if {$line eq ""} { 164 continue 165 } 166 set words {} 167 if {[regexp {^\s} $line]} { 168 # Detect continuations of a zone and flag the list appropriately 169 lappend words "" 170 } 171 lappend words {*}[regexp -all -inline {\S+} $line] 172 173 # Switch on the directive 174 175 switch -exact -- [lindex $words 0] { 176 Rule { 177 parseRule $fileName $lno $words 178 } 179 Link { 180 set links([lindex $words 2]) [lindex $words 1] 181 } 182 Zone { 183 set lastZone [lindex $words 1] 184 set until [parseZone $fileName $lno \ 185 $lastZone [lrange $words 2 end] "minimum"] 186 } 187 {} { 188 set i 0 189 foreach word $words { 190 if {[lindex $words $i] ne ""} { 191 break 192 } 193 incr i 194 } 195 set words [lrange $words $i end] 196 set until [parseZone $fileName $lno $lastZone $words $until] 197 } 198 default { 199 incr errorCount 200 puts stderr "$fileName:$lno:unknown line type \"[lindex $words 0]\"" 201 } 202 } 203 } 204 205 return 206} 207 208#---------------------------------------------------------------------- 209# 210# parseRule -- 211# 212# Parses a Rule directive in an Olson file. 213# 214# Parameters: 215# fileName -- Name of the file being parsed. 216# lno - Line number within the file 217# words - The line itself, broken into words. 218# 219# Results: 220# None. 221# 222# Side effects: 223# The rule is analyzed and added to the 'rules' array. 224# Errors are reported and counted. 225# 226#---------------------------------------------------------------------- 227 228proc parseRule {fileName lno words} { 229 variable rules 230 variable errorCount 231 232 # Break out the columns 233 234 lassign $words Rule name from to type in on at save letter 235 236 # Handle the 'only' keyword 237 238 if {$to eq "only"} { 239 set to $from 240 } 241 242 # Process the start year 243 244 if {![string is integer $from]} { 245 if {![string equal -length [string length $from] $from "minimum"]} { 246 puts stderr "$fileName:$lno:FROM field \"$from\" not an integer." 247 incr errorCount 248 return 249 } else { 250 set from "minimum" 251 } 252 } 253 254 # Process the end year 255 256 if {![string is integer $to]} { 257 if {![string equal -length [string length $to] $to "maximum"]} { 258 puts stderr "$fileName:$lno:TO field \"$to\" not an integer." 259 incr errorCount 260 return 261 } else { 262 set to "maximum" 263 } 264 } 265 266 # Process the type of year in which the rule applies 267 268 if {$type ne "-"} { 269 puts stderr "$fileName:$lno:year types are not yet supported." 270 incr errorCount 271 return 272 } 273 274 # Process the month in which the rule starts 275 276 if {[catch {lookupMonth $in} in]} { 277 puts stderr "$fileName:$lno:$in" 278 incr errorCount 279 return 280 } 281 282 # Process the day of the month on which the rule starts 283 284 if {[catch {parseON $on} on]} { 285 puts stderr "$fileName:$lno:$on" 286 incr errorCount 287 return 288 } 289 290 # Process the time of day on which the rule starts 291 292 if {[catch {parseTOD $at} at]} { 293 puts stderr "$fileName:$lno:$at" 294 incr errorCount 295 return 296 } 297 298 # Process the DST adder 299 300 if {[catch {parseOffsetTime $save} save]} { 301 puts stderr "$fileName:$lno:$save" 302 incr errorCount 303 return 304 } 305 306 # Process the letter to use for summer time 307 308 if {$letter eq "-"} { 309 set letter "" 310 } 311 312 # Accumulate all the data. 313 314 lappend rules($name) $from $to $type $in $on $at $save $letter 315 return 316 317} 318 319#---------------------------------------------------------------------- 320# 321# parseON -- 322# 323# Parse a specification for a day of the month 324# 325# Parameters: 326# on - the ON field from a line in an Olson file. 327# 328# Results: 329# Returns a partial Tcl command. When the year and number of the 330# month are appended, the command will return the Julian Day Number 331# of the desired date. 332# 333# Side effects: 334# None. 335# 336# The specification can be: 337# - a simple number, which designates a constant date. 338# - The name of a weekday, followed by >= or <=, followed by a number. 339# This designates the nearest occurrence of the given weekday on 340# or before (on or after) the given day of the month. 341# - The word 'last' followed by a weekday name with no intervening 342# space. This designates the last occurrence of the given weekday 343# in the month. 344# 345#---------------------------------------------------------------------- 346 347proc parseON {on} { 348 if {![regexp -expanded { 349 ^(?: 350 # first possibility - simple number - field 1 351 ([[:digit:]]+) 352 | 353 # second possibility - weekday >= (or <=) number 354 # field 2 - weekday 355 ([[:alpha:]]+) 356 # field 3 - direction 357 ([<>]=) 358 # field 4 - number 359 ([[:digit:]]+) 360 | 361 # third possibility - lastWeekday - field 5 362 last([[:alpha:]]+) 363 )$ 364 } $on -> dom1 wday2 dir2 num2 wday3]} then { 365 error "can't parse ON field \"$on\"" 366 } 367 if {$dom1 ne ""} { 368 return [list onDayOfMonth $dom1] 369 } elseif {$wday2 ne ""} { 370 set wday2 [lookupDayOfWeek $wday2] 371 return [list onWeekdayInMonth $wday2 $dir2 $num2] 372 } elseif {$wday3 ne ""} { 373 set wday3 [lookupDayOfWeek $wday3] 374 return [list onLastWeekdayInMonth $wday3] 375 } else { 376 error "in parseOn \"$on\": can't happen" 377 } 378} 379 380#---------------------------------------------------------------------- 381# 382# onDayOfMonth -- 383# 384# Find a given day of a given month 385# 386# Parameters: 387# day - Day of the month 388# year - Gregorian year 389# month - Number of the month (1-12) 390# 391# Results: 392# Returns the Julian Day Number of the desired day. 393# 394# Side effects: 395# None. 396# 397#---------------------------------------------------------------------- 398 399proc onDayOfMonth {day year month} { 400 set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ 401 [dict create era CE year $year month $month dayOfMonth $day] \ 402 2361222] 403 return [dict get $date julianDay] 404} 405 406#---------------------------------------------------------------------- 407# 408# onWeekdayInMonth -- 409# 410# Find the weekday falling on or after (on or before) a 411# given day of the month 412# 413# Parameters: 414# dayOfWeek - Day of the week (Monday=1, Sunday=7) 415# relation - <= for the weekday on or before a given date, >= for 416# the weekday on or after the given date. 417# dayOfMonth - Day of the month 418# year - Gregorian year 419# month - Number of the month (1-12) 420# 421# Results: 422# Returns the Juloan Day Number of the desired day. 423# 424# Side effects: 425# None. 426# 427# onWeekdayInMonth is used to compute Daylight Saving Time rules 428# like 'Sun>=1' (for the nearest Sunday on or after the first of the month) 429# or "Mon<=4' (for the Monday on or before the fourth of the month). 430# 431#---------------------------------------------------------------------- 432 433proc onWeekdayInMonth {dayOfWeek relation dayOfMonth year month} { 434 set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \ 435 era CE year $year month $month dayOfMonth $dayOfMonth] 2361222] 436 switch -exact -- $relation { 437 <= { 438 return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ 439 [dict get $date julianDay]] 440 } 441 >= { 442 return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ 443 [expr {[dict get $date julianDay] + 6}]] 444 } 445 } 446} 447 448#---------------------------------------------------------------------- 449# 450# onLastWeekdayInMonth -- 451# 452# Find the last instance of a given weekday in a month. 453# 454# Parameters: 455# dayOfWeek - Weekday to find (Monday=1, Sunday=7) 456# year - Gregorian year 457# month - Month (1-12) 458# 459# Results: 460# Returns the Julian Day number of the last instance of 461# the given weekday in the given month 462# 463# Side effects: 464# None. 465# 466#---------------------------------------------------------------------- 467 468proc onLastWeekdayInMonth {dayOfWeek year month} { 469 incr month 470 # Find day 0 of the following month, which is the last day of 471 # the current month. Yes, it works to ask for day 0 of month 13! 472 set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \ 473 era CE year $year month $month dayOfMonth 0] 2361222] 474 return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ 475 [dict get $date julianDay]] 476} 477 478#---------------------------------------------------------------------- 479# 480# parseTOD -- 481# 482# Parses the specification of a time of day in an Olson file. 483# 484# Parameters: 485# tod - Time of day, which may be followed by 'w', 's', 'u', 'g' 486# or 'z'. 'w' (or no letter) designates a wall clock time, 487# 's' designates Standard Time in the given zone, and 488# 'u', 'g', and 'z' all designate UTC. 489# 490# Results: 491# Returns a two element list containing a count of seconds from 492# midnight and the letter that followed the time. 493# 494# Side effects: 495# Reports and counts an error if the time cannot be parsed. 496# 497#---------------------------------------------------------------------- 498 499proc parseTOD {tod} { 500 if {![regexp -expanded { 501 ^ 502 ([[:digit:]]{1,2}) # field 1 - hour 503 (?: 504 :([[:digit:]]{2}) # field 2 - minute 505 (?: 506 :([[:digit:]]{2}) # field 3 - second 507 )? 508 )? 509 (?: 510 ([wsugz]) # field 4 - type indicator 511 )? 512 } $tod -> hour minute second ind]} then { 513 puts stderr "$fileName:$lno:can't parse time field \"$tod\"" 514 incr errorCount 515 } 516 scan $hour %d hour 517 if {$minute ne ""} { 518 scan $minute %d minute 519 } else { 520 set minute 0 521 } 522 if {$second ne ""} { 523 scan $second %d second 524 } else { 525 set second 0 526 } 527 if {$ind eq ""} { 528 set ind w 529 } 530 return [list [expr {($hour * 60 + $minute) * 60 + $second}] $ind] 531} 532 533#---------------------------------------------------------------------- 534# 535# parseOffsetTime -- 536# 537# Parses the specification of an offset time in an Olson file. 538# 539# Parameters: 540# offset - Offset time as [+-]hh:mm:ss 541# 542# Results: 543# Returns the offset time as a count of seconds. 544# 545# Side effects: 546# Reports and counts an error if the time cannot be parsed. 547# 548#---------------------------------------------------------------------- 549 550proc parseOffsetTime {offset} { 551 if {![regexp -expanded { 552 ^ 553 ([-+])? # field 1 - signum 554 ([[:digit:]]{1,2}) # field 2 - hour 555 (?: 556 :([[:digit:]]{2}) # field 3 - minute 557 (?: 558 :([[:digit:]]{2}) # field 4 - second 559 )? 560 )? 561 } $offset -> signum hour minute second]} then { 562 puts stderr "$fileName:$lno:can't parse offset time \"$offset\"" 563 incr errorCount 564 } 565 append signum 1 566 scan $hour %d hour 567 if {$minute ne ""} { 568 scan $minute %d minute 569 } else { 570 set minute 0 571 } 572 if {$second ne ""} { 573 scan $second %d second 574 } else { 575 set second 0 576 } 577 return [expr {(($hour * 60 + $minute) * 60 + $second) * $signum}] 578 579} 580 581#---------------------------------------------------------------------- 582# 583# lookupMonth - 584# Looks up a month by name 585# 586# Parameters: 587# month - Name of a month. 588# 589# Results: 590# Returns the number of the month. 591# 592# Side effects: 593# None. 594# 595#---------------------------------------------------------------------- 596 597proc lookupMonth {month} { 598 set indx [lsearch -regexp { 599 {} January February March April May June 600 July August September October November December 601 } ${month}.*] 602 if {$indx < 1} { 603 error "unknown month name \"$month\"" 604 } 605 return $indx 606} 607 608#---------------------------------------------------------------------- 609# 610# lookupDayOfWeek -- 611# 612# Looks up the name of a weekday. 613# 614# Parameters: 615# wday - Weekday name (or a unique prefix). 616# 617# Results: 618# Returns the weekday number (Monday=1, Sunday=7) 619# 620# Side effects: 621# None. 622# 623#---------------------------------------------------------------------- 624 625proc lookupDayOfWeek {wday} { 626 set indx [lsearch -regexp { 627 {} Monday Tuesday Wednesday Thursday Friday Saturday Sunday 628 } ${wday}.*] 629 if {$indx < 1} { 630 error "unknown weekday name \"$wday\"" 631 } 632 return $indx 633} 634 635#---------------------------------------------------------------------- 636# 637# parseZone -- 638# 639# Parses a Zone directive in an Olson file 640# 641# Parameters: 642# fileName -- Name of the file being parsed. 643# lno -- Line number within the file. 644# zone -- Name of the time zone 645# words -- Remaining words on the line. 646# start -- 'Until' time from the previous line if this is a 647# continuation line, or 'minimum' if this is the first line. 648# 649# Results: 650# Returns the 'until' field of the current line 651# 652# Side effects: 653# Stores a row in the 'zones' array describing the current zone. 654# The row consists of a start time (year month day tod), a Standard 655# Time offset from Greenwich, a Daylight Saving Time offset from 656# Standard Time, and a format for printing the time zone. 657# 658# The start time is the result of an earlier call to 'parseUntil' 659# or else the keyword 'minimum'. The GMT offset is the 660# result of a call to 'parseOffsetTime'. The Daylight Saving 661# Time offset is represented as a partial Tcl command. To the 662# command will be appended a start time (seconds from epoch) 663# the current offset of Standard Time from Greenwich, the current 664# offset of Daylight Saving Time from Greenwich, the default 665# offset from this line, the name pattern from this line, 666# the 'until' field from this line, and a variable name where points 667# are to be stored. This command is implemented by the 'applyNoRule', 668# 'applyDSTOffset' and 'applyRules' procedures. 669# 670#---------------------------------------------------------------------- 671 672proc parseZone {fileName lno zone words start} { 673 variable zones 674 variable rules 675 variable errorCount 676 variable forwardRuleRefs 677 678 lassign $words gmtoff save format 679 if {[catch {parseOffsetTime $gmtoff} gmtoff]} { 680 puts stderr "$fileName:$lno:$gmtoff" 681 incr errorCount 682 return 683 } 684 if {[info exists rules($save)]} { 685 set save [list applyRules $save] 686 } elseif {$save eq "-"} { 687 set save [list applyNoRule] 688 } elseif {[catch {parseOffsetTime $save} save2]} { 689 lappend forwardRuleRefs($save) $fileName $lno 690 set save [list applyRules $save] 691 } else { 692 set save [list applyDSTOffset $save2] 693 } 694 lappend zones($zone) $start $gmtoff $save $format 695 if {[llength $words] >= 4} { 696 return [parseUntil [lrange $words 3 end]] 697 } else { 698 return {} 699 } 700} 701 702#---------------------------------------------------------------------- 703# 704# parseUntil -- 705# 706# Parses the 'UNTIL' part of a 'Zone' directive. 707# 708# Parameters: 709# words - The 'UNTIL' part of the directie. 710# 711# Results: 712# Returns a list comprising the year, the month, the day, and 713# the time of day. Time of day is represented as the result of 714# 'parseTOD'. 715# 716#---------------------------------------------------------------------- 717 718proc parseUntil {words} { 719 variable firstYear 720 721 if {[llength $words] >= 1} { 722 set year [lindex $words 0] 723 if {![string is integer $year]} { 724 error "can't parse UNTIL field \"$words\"" 725 } 726 if {![info exists firstYear] || $year < $firstYear} { 727 set firstYear $year 728 } 729 } else { 730 set year "maximum" 731 } 732 if {[llength $words] >= 2} { 733 set month [lookupMonth [lindex $words 1]] 734 } else { 735 set month 1 736 } 737 if {[llength $words] >= 3} { 738 set day [parseON [lindex $words 2]] 739 } else { 740 set day {onDayOfMonth 1} 741 } 742 if {[llength $words] >= 4} { 743 set tod [parseTOD [lindex $words 3]] 744 } else { 745 set tod {0 w} 746 } 747 return [list $year $month $day $tod] 748} 749 750#---------------------------------------------------------------------- 751# 752# applyNoRule -- 753# 754# Generates time zone data for a zone without Daylight Saving 755# Time. 756# 757# Parameters: 758# year - Year in which the rule applies 759# startSecs - Time at which the rule starts. 760# stdGMTOffset - Offset from Greenwich prior to the start of the 761# rule 762# DSTOffset - Offset of Daylight from Standard prior to the 763# start of the rule. 764# nextGMTOffset - Offset from Greenwich when the rule is in effect. 765# namePattern - Name of the timezone. 766# until - Time at which the rule expires. 767# pointsVar - Name of a variable in callers scope that receives 768# transition times 769# 770# Results: 771# Returns a two element list comprising 'nextGMTOffset' and 772# 0 - the zero indicates that Daylight Saving Time is not 773# in effect. 774# 775# Side effects: 776# Appends a row to the 'points' variable comprising the start time, 777# the offset from GMT, a zero (indicating that DST is not in effect), 778# and the name of the time zone. 779# 780#---------------------------------------------------------------------- 781 782proc applyNoRule {year startSecs stdGMTOffset DSTOffset nextGMTOffset 783 namePattern until pointsVar} { 784 upvar 1 $pointsVar points 785 lappend points $startSecs $nextGMTOffset 0 \ 786 [convertNamePattern $namePattern -] 787 return [list $nextGMTOffset 0] 788} 789 790#---------------------------------------------------------------------- 791# 792# applyDSTOffset -- 793# 794# Generates time zone data for a zone with permanent Daylight 795# Saving Time. 796# 797# Parameters: 798# nextDSTOffset - Offset of Daylight from Standard while the 799# rule is in effect. 800# year - Year in which the rule applies 801# startSecs - Time at which the rule starts. 802# stdGMTOffset - Offset from Greenwich prior to the start of the 803# rule 804# DSTOffset - Offset of Daylight from Standard prior to the 805# start of the rule. 806# nextGMTOffset - Offset from Greenwich when the rule is in effect. 807# namePattern - Name of the timezone. 808# until - Time at which the rule expires. 809# pointsVar - Name of a variable in callers scope that receives 810# transition times 811# 812# Results: 813# Returns a two element list comprising 'nextGMTOffset' and 814# 'nextDSTOffset'. 815# 816# Side effects: 817# Appends a row to the 'points' variable comprising the start time, 818# the offset from GMT, a one (indicating that DST is in effect), 819# and the name of the time zone. 820# 821#---------------------------------------------------------------------- 822 823proc applyDSTOffset {nextDSTOffset year startSecs 824 stdGMTOffset DSTOffset nextGMTOffset 825 namePattern until pointsVar} { 826 upvar 1 $pointsVar points 827 lappend points \ 828 $startSecs \ 829 [expr {$nextGMTOffset + $nextDSTOffset}] \ 830 1 \ 831 [convertNamePattern $namePattern S] 832 return [list $nextGMTOffset $nextDSTOffset] 833} 834 835#---------------------------------------------------------------------- 836# 837# applyRules -- 838# 839# Applies a rule set to a time zone for a given range of time 840# 841# Parameters: 842# ruleSet - Name of the rule set to apply 843# year - Starting year for the rules 844# startSecs - Time at which the rules begin to apply 845# stdGMTOffset - Offset from Greenwich prior to the start of the 846# rules. 847# DSTOffset - Offset of Daylight from Standard prior to the 848# start of the rules. 849# nextGMTOffset - Offset from Greenwich when the rules are in effect. 850# namePattern - Name pattern for the time zone. 851# until - Time at which the rule set expires. 852# pointsVar - Name of a variable in callers scope that receives 853# transition times 854# 855# Results: 856# Returns a two element list comprising the offset from GMT 857# to Standard and the offset from Standard to Daylight (if DST 858# is in effect) at the end of the period in which the rules apply 859# 860# Side effects: 861# Appends one or more rows to the 'points' variable, each of which 862# comprises a transition time, the offset from GMT that is 863# in effect after the transition, a flag for whether DST is in 864# effect, and the name of the time zone. 865# 866#---------------------------------------------------------------------- 867 868proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset 869 namePattern until pointsVar} { 870 variable done 871 variable rules 872 variable maxyear 873 874 upvar 1 $pointsVar points 875 876 # Extract the rules that apply to the current year, and the number 877 # of rules (now or in future) that will end at a specific year. 878 # Ignore rules entirely in the past. 879 880 lassign [divideRules $ruleSet $year] currentRules nSunsetRules 881 882 # If the first transition is later than $startSecs, and $stdGMTOffset is 883 # different from $nextGMTOffset, we will need an initial record like: 884 # lappend points $startSecs $stdGMTOffset 0 \ 885 # [convertNamePattern $namePattern -] 886 887 set didTransitionIn false 888 889 # Determine the letter to use in Standard Time 890 891 set prevLetter "" 892 foreach { 893 fromYear toYear yearType monthIn daySpecOn timeAt save letter 894 } $rules($ruleSet) { 895 if {$save == 0} { 896 set prevLetter $letter 897 break 898 } 899 } 900 901 # Walk through each year in turn. This loop will break when 902 # (a) the 'until' time is passed 903 # or (b) the 'until' time is empty and all remaining rules extend to 904 # the end of time 905 906 set stdGMTOffset $nextGMTOffset 907 908 # convert "until" to seconds from epoch in current time zone 909 910 if {$until ne ""} { 911 lassign $until untilYear untilMonth untilDaySpec untilTimeOfDay 912 lappend untilDaySpec $untilYear $untilMonth 913 set untilJCD [eval $untilDaySpec] 914 set untilBaseSecs [expr { 915 wide(86400) * wide($untilJCD) - 210866803200 }] 916 set untilSecs [convertTimeOfDay $untilBaseSecs $stdGMTOffset \ 917 $DSTOffset {*}$untilTimeOfDay] 918 } 919 920 set origStartSecs $startSecs 921 922 while {($until ne "" && $startSecs < $untilSecs) 923 || ($until eq "" && ($nSunsetRules > 0 || $year < $maxyear))} { 924 set remainingRules $currentRules 925 while {[llength $remainingRules] > 0} { 926 927 # Find the rule with the earliest start time from among the 928 # active rules that haven't yet been processed. 929 930 lassign [findEarliestRule $remainingRules $year \ 931 $stdGMTOffset $DSTOffset] earliestSecs earliestIndex 932 933 set endi [expr {$earliestIndex + 7}] 934 set rule [lrange $remainingRules $earliestIndex $endi] 935 lassign $rule fromYear toYear \ 936 yearType monthIn daySpecOn timeAt save letter 937 938 # Test if the rule is in effect. 939 940 if { 941 $earliestSecs > $startSecs && 942 ($until eq "" || $earliestSecs < $untilSecs) 943 } then { 944 # Test if the initial transition has been done. 945 # If not, do it now. 946 947 if {!$didTransitionIn && $earliestSecs > $origStartSecs} { 948 set nm [convertNamePattern $namePattern $prevLetter] 949 lappend points \ 950 $origStartSecs \ 951 [expr {$stdGMTOffset + $DSTOffset}] \ 952 0 \ 953 $nm 954 set didTransitionIn true 955 } 956 957 # Add a row to 'points' for the rule 958 959 set nm [convertNamePattern $namePattern $letter] 960 lappend points \ 961 $earliestSecs \ 962 [expr {$stdGMTOffset + $save}] \ 963 [expr {$save != 0}] \ 964 $nm 965 } 966 967 # Remove the rule just applied from the queue 968 969 set remainingRules [lreplace \ 970 $remainingRules[set remainingRules {}] \ 971 $earliestIndex $endi] 972 973 # Update current DST offset and time zone letter 974 975 set DSTOffset $save 976 set prevLetter $letter 977 978 # Reconvert the 'until' time in the current zone. 979 980 if {$until ne ""} { 981 set untilSecs [convertTimeOfDay $untilBaseSecs \ 982 $stdGMTOffset $DSTOffset {*}$untilTimeOfDay] 983 } 984 } 985 986 # Advance to the next year 987 988 incr year 989 set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ 990 [dict create era CE year $year month 1 dayOfMonth 1] 2361222] 991 set startSecs [expr { 992 [dict get $date julianDay] * wide(86400) - 210866803200 993 - $stdGMTOffset - $DSTOffset 994 }] 995 996 # Get rules in effect in the new year. 997 998 lassign [divideRules $ruleSet $year] currentRules nSunsetRules 999 } 1000 1001 return [list $stdGMTOffset $DSTOffset] 1002} 1003 1004#---------------------------------------------------------------------- 1005# 1006# divideRules -- 1007# Determine what Daylight Saving Time rules may be in effect in 1008# a given year. 1009# 1010# Parameters: 1011# ruleSet - Set of rules from 'parseRule' 1012# year - Year to test 1013# 1014# Results: 1015# Returns a two element list comprising the subset of 'ruleSet' 1016# that is in effect in the given year, and the count of rules 1017# that expire in the future (as opposed to those that expire in 1018# the past or not at all). If this count is zero, the rules do 1019# not change in future years. 1020# 1021# Side effects: 1022# None. 1023# 1024#---------------------------------------------------------------------- 1025 1026proc divideRules {ruleSet year} { 1027 variable rules 1028 1029 set currentRules {} 1030 set nSunsetRules 0 1031 1032 foreach { 1033 fromYear toYear yearType monthIn daySpecOn timeAt save letter 1034 } $rules($ruleSet) { 1035 if {$toYear ne "maximum" && $year > $toYear} { 1036 # ignore - rule is in the past 1037 } else { 1038 if {$fromYear eq "minimum" || $fromYear <= $year} { 1039 lappend currentRules $fromYear $toYear $yearType $monthIn \ 1040 $daySpecOn $timeAt $save $letter 1041 } 1042 if {$toYear ne "maximum"} { 1043 incr nSunsetRules 1044 } 1045 } 1046 } 1047 1048 return [list $currentRules $nSunsetRules] 1049 1050} 1051 1052#---------------------------------------------------------------------- 1053# 1054# findEarliestRule -- 1055# 1056# Find the rule in a rule set that has the earliest start time. 1057# 1058# Parameters: 1059# remainingRules -- Rules to search 1060# year - Year being processed. 1061# stdGMTOffset - Current offset of standard time from GMT 1062# DSTOffset - Current offset of daylight time from standard, 1063# if daylight time is in effect. 1064# 1065# Results: 1066# Returns the index in remainingRules of the next rule to 1067# go into effect. 1068# 1069# Side effects: 1070# None. 1071# 1072#---------------------------------------------------------------------- 1073 1074proc findEarliestRule {remainingRules year stdGMTOffset DSTOffset} { 1075 set earliest $::MAXWIDE 1076 set i 0 1077 foreach { 1078 fromYear toYear yearType monthIn daySpecOn timeAt save letter 1079 } $remainingRules { 1080 lappend daySpecOn $year $monthIn 1081 set dayIn [eval $daySpecOn] 1082 set secs [expr {wide(86400) * wide($dayIn) - 210866803200}] 1083 set secs [convertTimeOfDay $secs \ 1084 $stdGMTOffset $DSTOffset {*}$timeAt] 1085 if {$secs < $earliest} { 1086 set earliest $secs 1087 set earliestIdx $i 1088 } 1089 incr i 8 1090 } 1091 1092 return [list $earliest $earliestIdx] 1093} 1094 1095#---------------------------------------------------------------------- 1096# 1097# convertNamePattern -- 1098# 1099# Converts a name pattern to the name of the time zone. 1100# 1101# Parameters: 1102# pattern - Patthern to convert 1103# flag - Daylight Time flag. An empty string denotes Standard 1104# Time, anything else is Daylight Time. 1105# 1106# Results; 1107# Returns the name of the time zone. 1108# 1109# Side effects: 1110# None. 1111# 1112#---------------------------------------------------------------------- 1113 1114proc convertNamePattern {pattern flag} { 1115 if {[regexp {(.*)/(.*)} $pattern -> standard daylight]} { 1116 if {$flag ne ""} { 1117 set pattern $daylight 1118 } else { 1119 set pattern $standard 1120 } 1121 } 1122 return [string map [list %s $flag] $pattern] 1123} 1124 1125#---------------------------------------------------------------------- 1126# 1127# convertTimeOfDay -- 1128# 1129# Takes a time of day specifier from 'parseAt' and converts 1130# to seconds from the Epoch, 1131# 1132# Parameters: 1133# seconds -- Time at which the GMT day starts, in seconds 1134# from the Posix epoch 1135# stdGMTOffset - Offset of Standard Time from Greenwich 1136# DSTOffset - Offset of Daylight Time from standard. 1137# timeOfDay - Time of day to convert, in seconds from midnight 1138# flag - Flag indicating whether the time is Greenwich, Standard 1139# or wall-clock. (g, s, or w) 1140# 1141# Results: 1142# Returns the time of day in seconds from the Posix epoch. 1143# 1144# Side effects: 1145# None. 1146# 1147#---------------------------------------------------------------------- 1148 1149proc convertTimeOfDay {seconds stdGMTOffset DSTOffset timeOfDay flag} { 1150 incr seconds $timeOfDay 1151 switch -exact $flag { 1152 g - u - z { 1153 } 1154 w { 1155 incr seconds [expr {-$stdGMTOffset}] 1156 incr seconds [expr {-$DSTOffset}] 1157 } 1158 s { 1159 incr seconds [expr {-$stdGMTOffset}] 1160 } 1161 } 1162 return $seconds 1163} 1164 1165#---------------------------------------------------------------------- 1166# 1167# processTimeZone -- 1168# 1169# Generate the information about all time transitions in a 1170# time zone. 1171# 1172# Parameters: 1173# zoneName - Name of the time zone 1174# zoneData - List containing the rows describing the time zone, 1175# obtained from 'parseZone. 1176# 1177# Results: 1178# Returns a list of rows. Each row consists of a time in 1179# seconds from the Posix epoch, an offset from GMT to local 1180# that begins at that time, a flag indicating whether DST 1181# is in effect after that time, and the printable name of the 1182# timezone that goes into effect at that time. 1183# 1184# Side effects: 1185# None. 1186# 1187#---------------------------------------------------------------------- 1188 1189proc processTimeZone {zoneName zoneData} { 1190 set points {} 1191 set i 0 1192 foreach {startTime nextGMTOffset dstRule namePattern} $zoneData { 1193 incr i 4 1194 set until [lindex $zoneData $i] 1195 if {![info exists stdGMTOffset]} { 1196 set stdGMTOffset $nextGMTOffset 1197 } 1198 if {![info exists DSTOffset]} { 1199 set DSTOffset 0 1200 } 1201 if {$startTime eq "minimum"} { 1202 set secs $::MINWIDE 1203 set year 0 1204 } else { 1205 lassign $startTime year month dayRule timeOfDay 1206 lappend dayRule $year $month 1207 set startDay [eval $dayRule] 1208 set secs [expr {wide(86400) * wide($startDay) -210866803200}] 1209 set secs [convertTimeOfDay $secs \ 1210 $stdGMTOffset $DSTOffset {*}$timeOfDay] 1211 } 1212 lappend dstRule \ 1213 $year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \ 1214 $namePattern $until points 1215 lassign [eval $dstRule] stdGMTOffset DSTOffset 1216 } 1217 return $points 1218} 1219 1220#---------------------------------------------------------------------- 1221# 1222# writeZones -- 1223# 1224# Writes all the time zone information files. 1225# 1226# Parameters: 1227# outDir - Directory in which to store the files. 1228# 1229# Results: 1230# None. 1231# 1232# Side effects: 1233# Writes the time zone information files; traces what's happening 1234# on the standard output. 1235# 1236#---------------------------------------------------------------------- 1237 1238proc writeZones {outDir} { 1239 variable zones 1240 1241 # Walk the zones 1242 1243 foreach zoneName [lsort -dictionary [array names zones]] { 1244 puts "calculating: $zoneName" 1245 set fileName [eval [list file join $outDir] [file split $zoneName]] 1246 1247 # Create directories as needed 1248 1249 set dirName [file dirname $fileName] 1250 if {![file exists $dirName]} { 1251 puts "creating directory: $dirName" 1252 file mkdir $dirName 1253 } 1254 1255 # Generate data for a zone 1256 1257 set data "" 1258 foreach { 1259 time offset dst name 1260 } [processTimeZone $zoneName $zones($zoneName)] { 1261 append data "\n " [list [list $time $offset $dst $name]] 1262 } 1263 append data \n 1264 1265 # Write the data to the information file 1266 1267 set f [open $fileName w] 1268 fconfigure $f -translation lf 1269 puts $f "\# created by $::argv0 - do not edit" 1270 puts $f "" 1271 puts $f [list set TZData(:$zoneName) $data] 1272 close $f 1273 } 1274 1275 return 1276} 1277 1278#---------------------------------------------------------------------- 1279# 1280# writeLinks -- 1281# 1282# Write files describing time zone synonyms (the Link directives 1283# from the Olson files) 1284# 1285# Parameters: 1286# outDir - Name of the directory where the output files go. 1287# 1288# Results: 1289# None. 1290# 1291# Side effects: 1292# Creates a file for each link. 1293 1294proc writeLinks {outDir} { 1295 variable links 1296 1297 # Walk the links 1298 1299 foreach zoneName [lsort -dictionary [array names links]] { 1300 puts "creating link: $zoneName" 1301 set fileName [eval [list file join $outDir] [file split $zoneName]] 1302 1303 # Create directories as needed 1304 1305 set dirName [file dirname $fileName] 1306 if {![file exists $dirName]} { 1307 puts "creating directory: $dirName" 1308 file mkdir $dirName 1309 } 1310 1311 # Create code for the synonym 1312 1313 set linkTo $links($zoneName) 1314 set sourceCmd "\n [list LoadTimeZoneFile $linkTo]\n" 1315 set ifCmd [list if "!\[info exists TZData($linkTo)\]" $sourceCmd] 1316 set setCmd "set TZData(:$zoneName) \$TZData(:$linkTo)" 1317 1318 # Write the file 1319 1320 set f [open $fileName w] 1321 fconfigure $f -translation lf 1322 puts $f "\# created by $::argv0 - do not edit" 1323 puts $f $ifCmd 1324 puts $f $setCmd 1325 close $f 1326 } 1327 1328 return 1329} 1330 1331#---------------------------------------------------------------------- 1332# 1333# MAIN PROGRAM 1334# 1335#---------------------------------------------------------------------- 1336 1337puts "Compiling time zones -- [clock format [clock seconds] \ 1338 -format {%x %X} -locale system]" 1339 1340# Determine directories 1341 1342lassign $argv inDir outDir 1343 1344puts "Olson files in $inDir" 1345puts "Tcl files to be placed in $outDir" 1346 1347# Initialize count of errors 1348 1349set errorCount 0 1350 1351# Parse the Olson files 1352 1353loadFiles $inDir 1354if {$errorCount > 0} { 1355 exit 1 1356} 1357 1358# Check that all riles appearing in Zone and Link lines actually exist 1359 1360checkForwardRuleRefs 1361if {$errorCount > 0} { 1362 exit 1 1363} 1364 1365# Write the time zone information files 1366 1367writeZones $outDir 1368writeLinks $outDir 1369if {$errorCount > 0} { 1370 exit 1 1371} 1372 1373# All done! 1374 1375exit 1376