#----------------------------------------------------------------------
#
# 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
|
