#----------------------------------------------------------------------
#
# 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/clock/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.3 2004/11/02 15:16:38 kennykb Exp $
#
#----------------------------------------------------------------------
# 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
}
# Temporary scaffolding - load up the new 'clock' package.
source [file join [file dirname [info script]] .. library clock.tcl]
# 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 { $MAXWIDE + $MAXWIDE + 1}]
if { $next < 0 } {
break
}
set MAXWIDE $next
}
set MINWIDE [expr { - $MAXWIDE - 1 }]
#----------------------------------------------------------------------
#
# K --
#
# The K combinator returns its first argument. It's used for
# reference count management.
#
# Parameters:
# x - Argument to be unreferenced.
# y - Unused.
#
# Results:
# Returns the first argument.
#
# Side effects:
# None.
#
# The K combinator is used for its effect that [K $x [set x {}]]
# reads out the value of x destructively, giving an unshared Tcl
# object and avoiding 'copy on write'
#
#----------------------------------------------------------------------
proc K {x y} {return $x}
#----------------------------------------------------------------------
#
# 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 {[[:space:]]*(\#.*)?$} $line {} line
if { $line eq {} } {
continue
}
set words {}
if { [regexp {^[[:space:]]+(.*)} $line -> l] } {
lappend words {}
set line $l
}
while {[regexp {^([^[:space:]]+)[[:space:]]*(.*)} $line -> \
word line]} {
lappend words $word
}
# 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]
}
{} { # Continuation of a Zone
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
foreach { Rule name from to type in on at save letter } $words {}
# Handle the 'only' keyword
if { $to eq {only} } {
set to $from
}
# Process the start year
set l [string length $from]
if { ![string is integer $from] } {
if { $from ne [string range {minumum} 0 [expr { $l - 1 }]] } {
puts stderr "$fileName:$lno:FROM field \"$from\" not an integer."
incr errorCount
return
} else {
set from minimum
}
}
# Process the end year
set l [string length $to]
if { ![string is integer $to] } {
if { $to ne [string range {maximum} 0 [expr { $l - 1 }]] } {
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 } {
set date [dict create era CE year $year month $month dayOfMonth $day]
set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
[K $date [set date {}]]]
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 [dict create \
era CE year $year month $month dayOfMonth $dayOfMonth]
set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
[K $date [set date {}]]]
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 [dict create \
era CE year $year month $month dayOfMonth 0]
set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
[K $date [set date {}]]]
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 {
^
# field 1 - hour
([[:digit:]]{1,2})
(?:
# field 2 - minute
:([[:digit:]]{2})
(?:
# field 3 - second
:([[:digit:]]{2})
)?
)?
(?:
# field 4 - type indicator
([wsugz])
)?
} $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
([-+])?
# field 2 - hour
([[:digit:]]{1,2})
(?:
# field 3 - minute
:([[:digit:]]{2})
(?:
# field 4 - second
:([[:digit:]]{2})
)?
)?
} $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
foreach { gmtoff save format } $words break
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]
} else {
if { [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]
}
#----------------------------------------------------------------------
#
# applyNoRule --
#
# 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.
foreach {
currentRules nSunsetRules
} [divideRules $ruleSet $year] break
# 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 {} } {
foreach {
untilYear untilMonth untilDaySpec untilTimeOfDay
} $until break
lappend untilDaySpec $untilYear $untilMonth
set untilJCD [eval $untilDaySpec]
set untilBaseSecs [expr {
wide(86400) * wide($untilJCD)
- 210866803200 }]
set untilSecs [eval [linsert $untilTimeOfDay 0 convertTimeOfDay \
$untilBaseSecs $stdGMTOffset $DSTOffset]]
}
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.
foreach {
earliestSecs earliestIndex
} [findEarliestRule $remainingRules $year \
$stdGMTOffset $DSTOffset] break
set endi [expr {$earliestIndex + 7}]
set rule [lrange $remainingRules $earliestIndex $endi]
foreach {
fromYear toYear yearType monthIn daySpecOn timeAt save letter
} $rule break
# 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 \
[K $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 [eval [linsert $untilTimeOfDay 0 \
convertTimeOfDay $untilBaseSecs \
$stdGMTOffset $DSTOffset]]
}
}
# Advance to the next year
incr year
set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
[dict create era CE year $year month 1 dayOfMonth 1]]
set startSecs [expr { [dict get $date julianDay] * wide(86400) \
-210866803200 }]
set startSecs [expr { $startSecs - $stdGMTOffset - $DSTOffset }]
# Get rules in effect in the new year.
foreach {
currentRules nSunsetRules
} [divideRules $ruleSet $year] break
}
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 [eval [linsert $timeAt 0 convertTimeOfDay \
$secs $stdGMTOffset $DSTOffset]]
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 }]
}
z {
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 {
foreach { year month dayRule timeOfDay } $startTime break
lappend dayRule $year $month
set startDay [eval $dayRule]
set secs [expr {
wide(86400) * wide($startDay)
-210866803200}]
set secs [eval [linsert $timeOfDay 0 convertTimeOfDay \
$secs $stdGMTOffset $DSTOffset]]
}
lappend dstRule \
$year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \
$namePattern $until points
foreach {stdGMTOffset DSTOffset} [eval $dstRule] break
}
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]
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]
puts $f "\# created by $::argv0 - do not edit"
puts $f $ifCmd
puts $f $setCmd
close $f
}
return
}
#----------------------------------------------------------------------
#
# MAIN PROGRAM
#
#----------------------------------------------------------------------
# Determine directories
foreach { inDir outDir } $argv break
# 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