diff options
Diffstat (limited to 'tools/tclZIC.tcl')
| -rwxr-xr-x | tools/tclZIC.tcl | 1375 |
1 files changed, 1375 insertions, 0 deletions
diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl new file mode 100755 index 0000000..1b19d82 --- /dev/null +++ b/tools/tclZIC.tcl @@ -0,0 +1,1375 @@ +#---------------------------------------------------------------------- +# +# tclZIC.tcl -- +# +# Take the time zone data source files from Arthur Olson's +# repository at elsie.nci.nih.gov, and prepare time zone +# information files for Tcl. +# +# Usage: +# tclsh tclZIC.tcl inputDir outputDir +# +# Parameters: +# inputDir - Directory (e.g., tzdata2003e) where Olson's source +# files are to be found. +# outputDir - Directory (e.g., ../library/tzdata) where +# the time zone information files are to be placed. +# +# Results: +# May produce error messages on the standard error. An exit +# code of zero denotes success; any other exit code is failure. +# +# This program parses the timezone data in a means analogous to the +# 'zic' command, and produces Tcl time zone information files suitable +# for loading into the 'clock' namespace. +# +#---------------------------------------------------------------------- +# +# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +#---------------------------------------------------------------------- + +package require Tcl 8.5 + +# Define the names of the Olson files that we need to load. +# We avoid the solar time files and the leap seconds. + +set olsonFiles { + africa antarctica asia australasia + backward etcetera europe northamerica + pacificnew southamerica systemv +} + +# Define the year at which the DST information will stop. + +set maxyear 2100 + +# Determine how big a wide integer is. + +set MAXWIDE [expr {wide(1)}] +while 1 { + set next [expr {wide($MAXWIDE + $MAXWIDE + 1)}] + if {$next < 0} { + break + } + set MAXWIDE $next +} +set MINWIDE [expr {-$MAXWIDE-1}] + +#---------------------------------------------------------------------- +# +# loadFiles -- +# +# Loads the time zone files for each continent into memory +# +# Parameters: +# dir - Directory where the time zone source files are found +# +# Results: +# None. +# +# Side effects: +# Calls 'loadZIC' for each continent's data file in turn. +# Reports progress on stdout. +# +#---------------------------------------------------------------------- + +proc loadFiles {dir} { + variable olsonFiles + foreach file $olsonFiles { + puts "loading: [file join $dir $file]" + loadZIC [file join $dir $file] + } + return +} + +#---------------------------------------------------------------------- +# +# checkForwardRuleRefs -- +# +# Checks to make sure that all references to Daylight Saving +# Time rules designate defined rules. +# +# Parameters: +# None. +# +# Results: +# None. +# +# Side effects: +# Produces an error message and increases the error count if +# any undefined rules are present. +# +#---------------------------------------------------------------------- + +proc checkForwardRuleRefs {} { + variable forwardRuleRefs + variable rules + + foreach {rule where} [array get forwardRuleRefs] { + if {![info exists rules($rule)]} { + foreach {fileName lno} $where { + puts stderr "$fileName:$lno:can't locate rule \"$rule\"" + incr errorCount + } + } + } +} + +#---------------------------------------------------------------------- +# +# loadZIC -- +# +# Load one continent's data into memory. +# +# Parameters: +# fileName -- Name of the time zone source file. +# +# Results: +# None. +# +# Side effects: +# The global variable, 'errorCount' counts the number of errors. +# The global array, 'links', contains a distillation of the +# 'Link' directives in the file. The keys are 'links to' and +# the values are 'links from'. The 'parseRule' and 'parseZone' +# procedures are called to handle 'Rule' and 'Zone' directives. +# +#---------------------------------------------------------------------- + +proc loadZIC {fileName} { + variable errorCount + variable links + + # Suck the text into memory. + + set f [open $fileName r] + set data [read $f] + close $f + + # Break the input into lines, and count line numbers. + + set lno 0 + foreach line [split $data \n] { + incr lno + + # Break a line of input into words. + + regsub {\s*(\#.*)?$} $line {} line + if {$line eq ""} { + continue + } + set words {} + if {[regexp {^\s} $line]} { + # Detect continuations of a zone and flag the list appropriately + lappend words "" + } + lappend words {*}[regexp -all -inline {\S+} $line] + + # Switch on the directive + + switch -exact -- [lindex $words 0] { + Rule { + parseRule $fileName $lno $words + } + Link { + set links([lindex $words 2]) [lindex $words 1] + } + Zone { + set lastZone [lindex $words 1] + set until [parseZone $fileName $lno \ + $lastZone [lrange $words 2 end] "minimum"] + } + {} { + set i 0 + foreach word $words { + if {[lindex $words $i] ne ""} { + break + } + incr i + } + set words [lrange $words $i end] + set until [parseZone $fileName $lno $lastZone $words $until] + } + default { + incr errorCount + puts stderr "$fileName:$lno:unknown line type \"[lindex $words 0]\"" + } + } + } + + return +} + +#---------------------------------------------------------------------- +# +# parseRule -- +# +# Parses a Rule directive in an Olson file. +# +# Parameters: +# fileName -- Name of the file being parsed. +# lno - Line number within the file +# words - The line itself, broken into words. +# +# Results: +# None. +# +# Side effects: +# The rule is analyzed and added to the 'rules' array. +# Errors are reported and counted. +# +#---------------------------------------------------------------------- + +proc parseRule {fileName lno words} { + variable rules + variable errorCount + + # Break out the columns + + lassign $words Rule name from to type in on at save letter + + # Handle the 'only' keyword + + if {$to eq "only"} { + set to $from + } + + # Process the start year + + if {![string is integer $from]} { + if {![string equal -length [string length $from] $from "minimum"]} { + puts stderr "$fileName:$lno:FROM field \"$from\" not an integer." + incr errorCount + return + } else { + set from "minimum" + } + } + + # Process the end year + + if {![string is integer $to]} { + if {![string equal -length [string length $to] $to "maximum"]} { + puts stderr "$fileName:$lno:TO field \"$to\" not an integer." + incr errorCount + return + } else { + set to "maximum" + } + } + + # Process the type of year in which the rule applies + + if {$type ne "-"} { + puts stderr "$fileName:$lno:year types are not yet supported." + incr errorCount + return + } + + # Process the month in which the rule starts + + if {[catch {lookupMonth $in} in]} { + puts stderr "$fileName:$lno:$in" + incr errorCount + return + } + + # Process the day of the month on which the rule starts + + if {[catch {parseON $on} on]} { + puts stderr "$fileName:$lno:$on" + incr errorCount + return + } + + # Process the time of day on which the rule starts + + if {[catch {parseTOD $at} at]} { + puts stderr "$fileName:$lno:$at" + incr errorCount + return + } + + # Process the DST adder + + if {[catch {parseOffsetTime $save} save]} { + puts stderr "$fileName:$lno:$save" + incr errorCount + return + } + + # Process the letter to use for summer time + + if {$letter eq "-"} { + set letter "" + } + + # Accumulate all the data. + + lappend rules($name) $from $to $type $in $on $at $save $letter + return + +} + +#---------------------------------------------------------------------- +# +# parseON -- +# +# Parse a specification for a day of the month +# +# Parameters: +# on - the ON field from a line in an Olson file. +# +# Results: +# Returns a partial Tcl command. When the year and number of the +# month are appended, the command will return the Julian Day Number +# of the desired date. +# +# Side effects: +# None. +# +# The specification can be: +# - a simple number, which designates a constant date. +# - The name of a weekday, followed by >= or <=, followed by a number. +# This designates the nearest occurrence of the given weekday on +# or before (on or after) the given day of the month. +# - The word 'last' followed by a weekday name with no intervening +# space. This designates the last occurrence of the given weekday +# in the month. +# +#---------------------------------------------------------------------- + +proc parseON {on} { + if {![regexp -expanded { + ^(?: + # first possibility - simple number - field 1 + ([[:digit:]]+) + | + # second possibility - weekday >= (or <=) number + # field 2 - weekday + ([[:alpha:]]+) + # field 3 - direction + ([<>]=) + # field 4 - number + ([[:digit:]]+) + | + # third possibility - lastWeekday - field 5 + last([[:alpha:]]+) + )$ + } $on -> dom1 wday2 dir2 num2 wday3]} then { + error "can't parse ON field \"$on\"" + } + if {$dom1 ne ""} { + return [list onDayOfMonth $dom1] + } elseif {$wday2 ne ""} { + set wday2 [lookupDayOfWeek $wday2] + return [list onWeekdayInMonth $wday2 $dir2 $num2] + } elseif {$wday3 ne ""} { + set wday3 [lookupDayOfWeek $wday3] + return [list onLastWeekdayInMonth $wday3] + } else { + error "in parseOn \"$on\": can't happen" + } +} + +#---------------------------------------------------------------------- +# +# onDayOfMonth -- +# +# Find a given day of a given month +# +# Parameters: +# day - Day of the month +# year - Gregorian year +# month - Number of the month (1-12) +# +# Results: +# Returns the Julian Day Number of the desired day. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc onDayOfMonth {day year month} { + scan $day %d day + scan $year %d year + scan $month %d month + set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ + [dict create era CE year $year month $month dayOfMonth $day] \ + 2361222] + return [dict get $date julianDay] +} + +#---------------------------------------------------------------------- +# +# onWeekdayInMonth -- +# +# Find the weekday falling on or after (on or before) a +# given day of the month +# +# Parameters: +# dayOfWeek - Day of the week (Monday=1, Sunday=7) +# relation - <= for the weekday on or before a given date, >= for +# the weekday on or after the given date. +# dayOfMonth - Day of the month +# year - Gregorian year +# month - Number of the month (1-12) +# +# Results: +# Returns the Juloan Day Number of the desired day. +# +# Side effects: +# None. +# +# onWeekdayInMonth is used to compute Daylight Saving Time rules +# like 'Sun>=1' (for the nearest Sunday on or after the first of the month) +# or "Mon<=4' (for the Monday on or before the fourth of the month). +# +#---------------------------------------------------------------------- + +proc onWeekdayInMonth {dayOfWeek relation dayOfMonth year month} { + set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \ + era CE year $year month $month dayOfMonth $dayOfMonth] 2361222] + switch -exact -- $relation { + <= { + return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ + [dict get $date julianDay]] + } + >= { + return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ + [expr {[dict get $date julianDay] + 6}]] + } + } +} + +#---------------------------------------------------------------------- +# +# onLastWeekdayInMonth -- +# +# Find the last instance of a given weekday in a month. +# +# Parameters: +# dayOfWeek - Weekday to find (Monday=1, Sunday=7) +# year - Gregorian year +# month - Month (1-12) +# +# Results: +# Returns the Julian Day number of the last instance of +# the given weekday in the given month +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc onLastWeekdayInMonth {dayOfWeek year month} { + incr month + # Find day 0 of the following month, which is the last day of + # the current month. Yes, it works to ask for day 0 of month 13! + set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \ + era CE year $year month $month dayOfMonth 0] 2361222] + return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ + [dict get $date julianDay]] +} + +#---------------------------------------------------------------------- +# +# parseTOD -- +# +# Parses the specification of a time of day in an Olson file. +# +# Parameters: +# tod - Time of day, which may be followed by 'w', 's', 'u', 'g' +# or 'z'. 'w' (or no letter) designates a wall clock time, +# 's' designates Standard Time in the given zone, and +# 'u', 'g', and 'z' all designate UTC. +# +# Results: +# Returns a two element list containing a count of seconds from +# midnight and the letter that followed the time. +# +# Side effects: +# Reports and counts an error if the time cannot be parsed. +# +#---------------------------------------------------------------------- + +proc parseTOD {tod} { + if {![regexp -expanded { + ^ + ([[:digit:]]{1,2}) # field 1 - hour + (?: + :([[:digit:]]{2}) # field 2 - minute + (?: + :([[:digit:]]{2}) # field 3 - second + )? + )? + (?: + ([wsugz]) # field 4 - type indicator + )? + } $tod -> hour minute second ind]} then { + puts stderr "$fileName:$lno:can't parse time field \"$tod\"" + incr errorCount + } + scan $hour %d hour + if {$minute ne ""} { + scan $minute %d minute + } else { + set minute 0 + } + if {$second ne ""} { + scan $second %d second + } else { + set second 0 + } + if {$ind eq ""} { + set ind w + } + return [list [expr {($hour * 60 + $minute) * 60 + $second}] $ind] +} + +#---------------------------------------------------------------------- +# +# parseOffsetTime -- +# +# Parses the specification of an offset time in an Olson file. +# +# Parameters: +# offset - Offset time as [+-]hh:mm:ss +# +# Results: +# Returns the offset time as a count of seconds. +# +# Side effects: +# Reports and counts an error if the time cannot be parsed. +# +#---------------------------------------------------------------------- + +proc parseOffsetTime {offset} { + if {![regexp -expanded { + ^ + ([-+])? # field 1 - signum + ([[:digit:]]{1,2}) # field 2 - hour + (?: + :([[:digit:]]{2}) # field 3 - minute + (?: + :([[:digit:]]{2}) # field 4 - second + )? + )? + } $offset -> signum hour minute second]} then { + puts stderr "$fileName:$lno:can't parse offset time \"$offset\"" + incr errorCount + } + append signum 1 + scan $hour %d hour + if {$minute ne ""} { + scan $minute %d minute + } else { + set minute 0 + } + if {$second ne ""} { + scan $second %d second + } else { + set second 0 + } + return [expr {(($hour * 60 + $minute) * 60 + $second) * $signum}] + +} + +#---------------------------------------------------------------------- +# +# lookupMonth - +# Looks up a month by name +# +# Parameters: +# month - Name of a month. +# +# Results: +# Returns the number of the month. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc lookupMonth {month} { + set indx [lsearch -regexp { + {} January February March April May June + July August September October November December + } ${month}.*] + if {$indx < 1} { + error "unknown month name \"$month\"" + } + return $indx +} + +#---------------------------------------------------------------------- +# +# lookupDayOfWeek -- +# +# Looks up the name of a weekday. +# +# Parameters: +# wday - Weekday name (or a unique prefix). +# +# Results: +# Returns the weekday number (Monday=1, Sunday=7) +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc lookupDayOfWeek {wday} { + set indx [lsearch -regexp { + {} Monday Tuesday Wednesday Thursday Friday Saturday Sunday + } ${wday}.*] + if {$indx < 1} { + error "unknown weekday name \"$wday\"" + } + return $indx +} + +#---------------------------------------------------------------------- +# +# parseZone -- +# +# Parses a Zone directive in an Olson file +# +# Parameters: +# fileName -- Name of the file being parsed. +# lno -- Line number within the file. +# zone -- Name of the time zone +# words -- Remaining words on the line. +# start -- 'Until' time from the previous line if this is a +# continuation line, or 'minimum' if this is the first line. +# +# Results: +# Returns the 'until' field of the current line +# +# Side effects: +# Stores a row in the 'zones' array describing the current zone. +# The row consists of a start time (year month day tod), a Standard +# Time offset from Greenwich, a Daylight Saving Time offset from +# Standard Time, and a format for printing the time zone. +# +# The start time is the result of an earlier call to 'parseUntil' +# or else the keyword 'minimum'. The GMT offset is the +# result of a call to 'parseOffsetTime'. The Daylight Saving +# Time offset is represented as a partial Tcl command. To the +# command will be appended a start time (seconds from epoch) +# the current offset of Standard Time from Greenwich, the current +# offset of Daylight Saving Time from Greenwich, the default +# offset from this line, the name pattern from this line, +# the 'until' field from this line, and a variable name where points +# are to be stored. This command is implemented by the 'applyNoRule', +# 'applyDSTOffset' and 'applyRules' procedures. +# +#---------------------------------------------------------------------- + +proc parseZone {fileName lno zone words start} { + variable zones + variable rules + variable errorCount + variable forwardRuleRefs + + lassign $words gmtoff save format + if {[catch {parseOffsetTime $gmtoff} gmtoff]} { + puts stderr "$fileName:$lno:$gmtoff" + incr errorCount + return + } + if {[info exists rules($save)]} { + set save [list applyRules $save] + } elseif {$save eq "-"} { + set save [list applyNoRule] + } elseif {[catch {parseOffsetTime $save} save2]} { + lappend forwardRuleRefs($save) $fileName $lno + set save [list applyRules $save] + } else { + set save [list applyDSTOffset $save2] + } + lappend zones($zone) $start $gmtoff $save $format + if {[llength $words] >= 4} { + return [parseUntil [lrange $words 3 end]] + } else { + return {} + } +} + +#---------------------------------------------------------------------- +# +# parseUntil -- +# +# Parses the 'UNTIL' part of a 'Zone' directive. +# +# Parameters: +# words - The 'UNTIL' part of the directie. +# +# Results: +# Returns a list comprising the year, the month, the day, and +# the time of day. Time of day is represented as the result of +# 'parseTOD'. +# +#---------------------------------------------------------------------- + +proc parseUntil {words} { + variable firstYear + + if {[llength $words] >= 1} { + set year [lindex $words 0] + if {![string is integer $year]} { + error "can't parse UNTIL field \"$words\"" + } + if {![info exists firstYear] || $year < $firstYear} { + set firstYear $year + } + } else { + set year "maximum" + } + if {[llength $words] >= 2} { + set month [lookupMonth [lindex $words 1]] + } else { + set month 1 + } + if {[llength $words] >= 3} { + set day [parseON [lindex $words 2]] + } else { + set day {onDayOfMonth 1} + } + if {[llength $words] >= 4} { + set tod [parseTOD [lindex $words 3]] + } else { + set tod {0 w} + } + return [list $year $month $day $tod] +} + +#---------------------------------------------------------------------- +# +# applyNoRule -- +# +# Generates time zone data for a zone without Daylight Saving +# Time. +# +# Parameters: +# year - Year in which the rule applies +# startSecs - Time at which the rule starts. +# stdGMTOffset - Offset from Greenwich prior to the start of the +# rule +# DSTOffset - Offset of Daylight from Standard prior to the +# start of the rule. +# nextGMTOffset - Offset from Greenwich when the rule is in effect. +# namePattern - Name of the timezone. +# until - Time at which the rule expires. +# pointsVar - Name of a variable in callers scope that receives +# transition times +# +# Results: +# Returns a two element list comprising 'nextGMTOffset' and +# 0 - the zero indicates that Daylight Saving Time is not +# in effect. +# +# Side effects: +# Appends a row to the 'points' variable comprising the start time, +# the offset from GMT, a zero (indicating that DST is not in effect), +# and the name of the time zone. +# +#---------------------------------------------------------------------- + +proc applyNoRule {year startSecs stdGMTOffset DSTOffset nextGMTOffset + namePattern until pointsVar} { + upvar 1 $pointsVar points + lappend points $startSecs $nextGMTOffset 0 \ + [convertNamePattern $namePattern -] + return [list $nextGMTOffset 0] +} + +#---------------------------------------------------------------------- +# +# applyDSTOffset -- +# +# Generates time zone data for a zone with permanent Daylight +# Saving Time. +# +# Parameters: +# nextDSTOffset - Offset of Daylight from Standard while the +# rule is in effect. +# year - Year in which the rule applies +# startSecs - Time at which the rule starts. +# stdGMTOffset - Offset from Greenwich prior to the start of the +# rule +# DSTOffset - Offset of Daylight from Standard prior to the +# start of the rule. +# nextGMTOffset - Offset from Greenwich when the rule is in effect. +# namePattern - Name of the timezone. +# until - Time at which the rule expires. +# pointsVar - Name of a variable in callers scope that receives +# transition times +# +# Results: +# Returns a two element list comprising 'nextGMTOffset' and +# 'nextDSTOffset'. +# +# Side effects: +# Appends a row to the 'points' variable comprising the start time, +# the offset from GMT, a one (indicating that DST is in effect), +# and the name of the time zone. +# +#---------------------------------------------------------------------- + +proc applyDSTOffset {nextDSTOffset year startSecs + stdGMTOffset DSTOffset nextGMTOffset + namePattern until pointsVar} { + upvar 1 $pointsVar points + lappend points \ + $startSecs \ + [expr {$nextGMTOffset + $nextDSTOffset}] \ + 1 \ + [convertNamePattern $namePattern S] + return [list $nextGMTOffset $nextDSTOffset] +} + +#---------------------------------------------------------------------- +# +# applyRules -- +# +# Applies a rule set to a time zone for a given range of time +# +# Parameters: +# ruleSet - Name of the rule set to apply +# year - Starting year for the rules +# startSecs - Time at which the rules begin to apply +# stdGMTOffset - Offset from Greenwich prior to the start of the +# rules. +# DSTOffset - Offset of Daylight from Standard prior to the +# start of the rules. +# nextGMTOffset - Offset from Greenwich when the rules are in effect. +# namePattern - Name pattern for the time zone. +# until - Time at which the rule set expires. +# pointsVar - Name of a variable in callers scope that receives +# transition times +# +# Results: +# Returns a two element list comprising the offset from GMT +# to Standard and the offset from Standard to Daylight (if DST +# is in effect) at the end of the period in which the rules apply +# +# Side effects: +# Appends one or more rows to the 'points' variable, each of which +# comprises a transition time, the offset from GMT that is +# in effect after the transition, a flag for whether DST is in +# effect, and the name of the time zone. +# +#---------------------------------------------------------------------- + +proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset + namePattern until pointsVar} { + variable done + variable rules + variable maxyear + + upvar 1 $pointsVar points + + # Extract the rules that apply to the current year, and the number + # of rules (now or in future) that will end at a specific year. + # Ignore rules entirely in the past. + + lassign [divideRules $ruleSet $year] currentRules nSunsetRules + + # If the first transition is later than $startSecs, and $stdGMTOffset is + # different from $nextGMTOffset, we will need an initial record like: + # lappend points $startSecs $stdGMTOffset 0 \ + # [convertNamePattern $namePattern -] + + set didTransitionIn false + + # Determine the letter to use in Standard Time + + set prevLetter "" + foreach { + fromYear toYear yearType monthIn daySpecOn timeAt save letter + } $rules($ruleSet) { + if {$save == 0} { + set prevLetter $letter + break + } + } + + # Walk through each year in turn. This loop will break when + # (a) the 'until' time is passed + # or (b) the 'until' time is empty and all remaining rules extend to + # the end of time + + set stdGMTOffset $nextGMTOffset + + # convert "until" to seconds from epoch in current time zone + + if {$until ne ""} { + lassign $until untilYear untilMonth untilDaySpec untilTimeOfDay + lappend untilDaySpec $untilYear $untilMonth + set untilJCD [eval $untilDaySpec] + set untilBaseSecs [expr { + wide(86400) * wide($untilJCD) - 210866803200 }] + set untilSecs [convertTimeOfDay $untilBaseSecs $stdGMTOffset \ + $DSTOffset {*}$untilTimeOfDay] + } + + set origStartSecs $startSecs + + while {($until ne "" && $startSecs < $untilSecs) + || ($until eq "" && ($nSunsetRules > 0 || $year < $maxyear))} { + set remainingRules $currentRules + while {[llength $remainingRules] > 0} { + + # Find the rule with the earliest start time from among the + # active rules that haven't yet been processed. + + lassign [findEarliestRule $remainingRules $year \ + $stdGMTOffset $DSTOffset] earliestSecs earliestIndex + + set endi [expr {$earliestIndex + 7}] + set rule [lrange $remainingRules $earliestIndex $endi] + lassign $rule fromYear toYear \ + yearType monthIn daySpecOn timeAt save letter + + # Test if the rule is in effect. + + if { + $earliestSecs > $startSecs && + ($until eq "" || $earliestSecs < $untilSecs) + } then { + # Test if the initial transition has been done. + # If not, do it now. + + if {!$didTransitionIn && $earliestSecs > $origStartSecs} { + set nm [convertNamePattern $namePattern $prevLetter] + lappend points \ + $origStartSecs \ + [expr {$stdGMTOffset + $DSTOffset}] \ + 0 \ + $nm + set didTransitionIn true + } + + # Add a row to 'points' for the rule + + set nm [convertNamePattern $namePattern $letter] + lappend points \ + $earliestSecs \ + [expr {$stdGMTOffset + $save}] \ + [expr {$save != 0}] \ + $nm + } + + # Remove the rule just applied from the queue + + set remainingRules [lreplace \ + $remainingRules[set remainingRules {}] \ + $earliestIndex $endi] + + # Update current DST offset and time zone letter + + set DSTOffset $save + set prevLetter $letter + + # Reconvert the 'until' time in the current zone. + + if {$until ne ""} { + set untilSecs [convertTimeOfDay $untilBaseSecs \ + $stdGMTOffset $DSTOffset {*}$untilTimeOfDay] + } + } + + # Advance to the next year + + incr year + set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ + [dict create era CE year $year month 1 dayOfMonth 1] 2361222] + set startSecs [expr { + [dict get $date julianDay] * wide(86400) - 210866803200 + - $stdGMTOffset - $DSTOffset + }] + + # Get rules in effect in the new year. + + lassign [divideRules $ruleSet $year] currentRules nSunsetRules + } + + return [list $stdGMTOffset $DSTOffset] +} + +#---------------------------------------------------------------------- +# +# divideRules -- +# Determine what Daylight Saving Time rules may be in effect in +# a given year. +# +# Parameters: +# ruleSet - Set of rules from 'parseRule' +# year - Year to test +# +# Results: +# Returns a two element list comprising the subset of 'ruleSet' +# that is in effect in the given year, and the count of rules +# that expire in the future (as opposed to those that expire in +# the past or not at all). If this count is zero, the rules do +# not change in future years. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc divideRules {ruleSet year} { + variable rules + + set currentRules {} + set nSunsetRules 0 + + foreach { + fromYear toYear yearType monthIn daySpecOn timeAt save letter + } $rules($ruleSet) { + if {$toYear ne "maximum" && $year > $toYear} { + # ignore - rule is in the past + } else { + if {$fromYear eq "minimum" || $fromYear <= $year} { + lappend currentRules $fromYear $toYear $yearType $monthIn \ + $daySpecOn $timeAt $save $letter + } + if {$toYear ne "maximum"} { + incr nSunsetRules + } + } + } + + return [list $currentRules $nSunsetRules] + +} + +#---------------------------------------------------------------------- +# +# findEarliestRule -- +# +# Find the rule in a rule set that has the earliest start time. +# +# Parameters: +# remainingRules -- Rules to search +# year - Year being processed. +# stdGMTOffset - Current offset of standard time from GMT +# DSTOffset - Current offset of daylight time from standard, +# if daylight time is in effect. +# +# Results: +# Returns the index in remainingRules of the next rule to +# go into effect. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc findEarliestRule {remainingRules year stdGMTOffset DSTOffset} { + set earliest $::MAXWIDE + set i 0 + foreach { + fromYear toYear yearType monthIn daySpecOn timeAt save letter + } $remainingRules { + lappend daySpecOn $year $monthIn + set dayIn [eval $daySpecOn] + set secs [expr {wide(86400) * wide($dayIn) - 210866803200}] + set secs [convertTimeOfDay $secs \ + $stdGMTOffset $DSTOffset {*}$timeAt] + if {$secs < $earliest} { + set earliest $secs + set earliestIdx $i + } + incr i 8 + } + + return [list $earliest $earliestIdx] +} + +#---------------------------------------------------------------------- +# +# convertNamePattern -- +# +# Converts a name pattern to the name of the time zone. +# +# Parameters: +# pattern - Patthern to convert +# flag - Daylight Time flag. An empty string denotes Standard +# Time, anything else is Daylight Time. +# +# Results; +# Returns the name of the time zone. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc convertNamePattern {pattern flag} { + if {[regexp {(.*)/(.*)} $pattern -> standard daylight]} { + if {$flag ne ""} { + set pattern $daylight + } else { + set pattern $standard + } + } + return [string map [list %s $flag] $pattern] +} + +#---------------------------------------------------------------------- +# +# convertTimeOfDay -- +# +# Takes a time of day specifier from 'parseAt' and converts +# to seconds from the Epoch, +# +# Parameters: +# seconds -- Time at which the GMT day starts, in seconds +# from the Posix epoch +# stdGMTOffset - Offset of Standard Time from Greenwich +# DSTOffset - Offset of Daylight Time from standard. +# timeOfDay - Time of day to convert, in seconds from midnight +# flag - Flag indicating whether the time is Greenwich, Standard +# or wall-clock. (g, s, or w) +# +# Results: +# Returns the time of day in seconds from the Posix epoch. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc convertTimeOfDay {seconds stdGMTOffset DSTOffset timeOfDay flag} { + incr seconds $timeOfDay + switch -exact $flag { + g - u - z { + } + w { + incr seconds [expr {-$stdGMTOffset}] + incr seconds [expr {-$DSTOffset}] + } + s { + incr seconds [expr {-$stdGMTOffset}] + } + } + return $seconds +} + +#---------------------------------------------------------------------- +# +# processTimeZone -- +# +# Generate the information about all time transitions in a +# time zone. +# +# Parameters: +# zoneName - Name of the time zone +# zoneData - List containing the rows describing the time zone, +# obtained from 'parseZone. +# +# Results: +# Returns a list of rows. Each row consists of a time in +# seconds from the Posix epoch, an offset from GMT to local +# that begins at that time, a flag indicating whether DST +# is in effect after that time, and the printable name of the +# timezone that goes into effect at that time. +# +# Side effects: +# None. +# +#---------------------------------------------------------------------- + +proc processTimeZone {zoneName zoneData} { + set points {} + set i 0 + foreach {startTime nextGMTOffset dstRule namePattern} $zoneData { + incr i 4 + set until [lindex $zoneData $i] + if {![info exists stdGMTOffset]} { + set stdGMTOffset $nextGMTOffset + } + if {![info exists DSTOffset]} { + set DSTOffset 0 + } + if {$startTime eq "minimum"} { + set secs $::MINWIDE + set year 0 + } else { + lassign $startTime year month dayRule timeOfDay + lappend dayRule $year $month + set startDay [eval $dayRule] + set secs [expr {wide(86400) * wide($startDay) -210866803200}] + set secs [convertTimeOfDay $secs \ + $stdGMTOffset $DSTOffset {*}$timeOfDay] + } + lappend dstRule \ + $year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \ + $namePattern $until points + lassign [eval $dstRule] stdGMTOffset DSTOffset + } + return $points +} + +#---------------------------------------------------------------------- +# +# writeZones -- +# +# Writes all the time zone information files. +# +# Parameters: +# outDir - Directory in which to store the files. +# +# Results: +# None. +# +# Side effects: +# Writes the time zone information files; traces what's happening +# on the standard output. +# +#---------------------------------------------------------------------- + +proc writeZones {outDir} { + variable zones + + # Walk the zones + + foreach zoneName [lsort -dictionary [array names zones]] { + puts "calculating: $zoneName" + set fileName [eval [list file join $outDir] [file split $zoneName]] + + # Create directories as needed + + set dirName [file dirname $fileName] + if {![file exists $dirName]} { + puts "creating directory: $dirName" + file mkdir $dirName + } + + # Generate data for a zone + + set data "" + foreach { + time offset dst name + } [processTimeZone $zoneName $zones($zoneName)] { + append data "\n " [list [list $time $offset $dst $name]] + } + append data \n + + # Write the data to the information file + + set f [open $fileName w] + fconfigure $f -translation lf + puts $f "\# created by $::argv0 - do not edit" + puts $f "" + puts $f [list set TZData(:$zoneName) $data] + close $f + } + + return +} + +#---------------------------------------------------------------------- +# +# writeLinks -- +# +# Write files describing time zone synonyms (the Link directives +# from the Olson files) +# +# Parameters: +# outDir - Name of the directory where the output files go. +# +# Results: +# None. +# +# Side effects: +# Creates a file for each link. + +proc writeLinks {outDir} { + variable links + + # Walk the links + + foreach zoneName [lsort -dictionary [array names links]] { + puts "creating link: $zoneName" + set fileName [eval [list file join $outDir] [file split $zoneName]] + + # Create directories as needed + + set dirName [file dirname $fileName] + if {![file exists $dirName]} { + puts "creating directory: $dirName" + file mkdir $dirName + } + + # Create code for the synonym + + set linkTo $links($zoneName) + set sourceCmd "\n [list LoadTimeZoneFile $linkTo]\n" + set ifCmd [list if "!\[info exists TZData($linkTo)\]" $sourceCmd] + set setCmd "set TZData(:$zoneName) \$TZData(:$linkTo)" + + # Write the file + + set f [open $fileName w] + fconfigure $f -translation lf + puts $f "\# created by $::argv0 - do not edit" + puts $f $ifCmd + puts $f $setCmd + close $f + } + + return +} + +#---------------------------------------------------------------------- +# +# MAIN PROGRAM +# +#---------------------------------------------------------------------- + +puts "Compiling time zones -- [clock format [clock seconds] \ + -format {%x %X} -locale system]" + +# Determine directories + +lassign $argv inDir outDir + +puts "Olson files in $inDir" +puts "Tcl files to be placed in $outDir" + +# Initialize count of errors + +set errorCount 0 + +# Parse the Olson files + +loadFiles $inDir +if {$errorCount > 0} { + exit 1 +} + +# Check that all riles appearing in Zone and Link lines actually exist + +checkForwardRuleRefs +if {$errorCount > 0} { + exit 1 +} + +# Write the time zone information files + +writeZones $outDir +writeLinks $outDir +if {$errorCount > 0} { + exit 1 +} + +# All done! + +exit |