#---------------------------------------------------------------------- # # 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. # # RCS: @(#) $Id: tclZIC.tcl,v 1.9.4.1 2009/04/09 20:12:10 kennykb Exp $ # #---------------------------------------------------------------------- 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} { 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