--- /dev/null
+#----------------------------------------------------------------------
+#
+# 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 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.
+#----------------------------------------------------------------------
+
+# 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
+ southamerica
+}
+
+# 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]} {
+ 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]} {
+ 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]} {
+ 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)
+ } {
+ # 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
OSDN Git Service
