'From Squeak3.10.2 of ''5 June 2008'' [latest update: #7179] on 27 June 2009 at 4:54:05 pm'! "Change Set: TimeZoneDatabaseV1-3-2-dtl Date: 27 June 2009 Author: David T. Lewis TimeZoneDatabase is a time zone database for Smalltalk. It answers the number of seconds offset from UTC for any time zone at any point in time in the range of the database rule set, as well as the number of leap seconds for a point in time (for tzfiles which contain the leap second rules). Time zone rules are loaded by reading compiled tzfile files from an external source. Compiled tzfiles files are commonly distributed with Unix and Linux systems. A compiled tzfile is typically generated by the zic(1) compiler distributed as part of the public domain timezone database in the ~ftp/pub directory of elsie.nci.nih.gov FTP server. Source code, documentation, and the full (human readable) rule file source is available from elsie.nci.nih.gov. The tzfile data must be obtained separately. If you have a Unix-like system, look in /usr/share/zoneinfo. This package was written on a Squeak system and also runs on VisualWorks and Smalltalk/X. Some code is conditionally compiled to support platform variations. The OSTimeZone class and TimePlugin class are provided for use on Squeak systems running on Unix like operating systems. They are neither used nor required on other systems. Functionally, they provide a light weight subset of a TimeZoneDatabase."! Object subclass: #LeapSecondRuleSet instanceVariableNames: 'leapSecondTable' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! !LeapSecondRuleSet commentStamp: '' prior: 0! I represent a set of rules for applying leap second offsets to local time. Indirectly, I keep track of the number of seconds in a day, which is usually 86400. Every once in a great while, this number is changed by plus or minus one second in order to compensate for changes in the actual physical rotational speed of the Earth. The entries in my leap second table keep track of the times at which these one second adjustments are made. The effect of leap seconds is the same for all time zones, and is independent of the time zone offsets maintained by a TimeZoneRuleSet. Leap seconds have little practical impact for most applications, and many computer systems simply ignore them in the interest of simplicity. To understand the role of leap seconds on these systems, consider two identical computers side by side in the same time zone, with their local system clocks synchronized. If one of the computers understands time zones and the other does not, the two computers will have a difference of opinion (about 22 seconds worth) about how many seconds have elapsed since January 1, 1970 UTC. In most other respects, they will behave identically. ! Object subclass: #LocalTimeTransform instanceVariableNames: 'timeZoneName' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! !LocalTimeTransform commentStamp: '' prior: 0! I represent a coordinate transformation between a PointInTime (a point on a continuous, monotonically increasing, infinite time line) and a local time line as might be used by a wall clock or by the Time and Date classes. My coordinate transformation is not necessarily a continuous function, because it embodies rules for setting the local clock forward and back in accordance with daylight savings time conventions, rules for applying leap seconds, and doubtless many other calendar oddities. My concrete subclasses represent time zones for various locations in the world. They know how to implement a time coordinate transformation by applying certain rules, or by making inquiries to an operating system which knows about time zone rules.! LocalTimeTransform subclass: #NaiveTimeZone instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! !NaiveTimeZone commentStamp: '' prior: 0! I represent a timezone with no rules. I can be used by simple systems which believe themselves to be at the center of the universe, and which have no interest in the details of time coordinate transformations.! LocalTimeTransform subclass: #OSTimeZone instanceVariableNames: 'secondaryTimeZoneName daylightSavingsInEffect currentLocalOffset' classVariableNames: 'DefaultDaylightSavingsInEffect DefaultLocalOffsetSeconds DefaultSecondaryTimeZoneName DefaultTimeZoneName' poolDictionaries: '' category: 'Time-TimeZones'! !OSTimeZone commentStamp: '' prior: 0! I represent a time zone for a location in the world. I know how to make inquiries to the operating system to determine where I am and what my timezone rules should be.! Magnitude subclass: #PointInTime instanceVariableNames: 'absoluteTime' classVariableNames: 'NumericRepresentationSelector Platform' poolDictionaries: '' category: 'Time-UTC'! !PointInTime commentStamp: 'dtl 10/23/2004 10:28' prior: 0! I represent a single point on an infinite time line. My origin is arbitrarily chosen to be the first instant of the day of January 1, 1970, UTC. My unit of measure is the second, which I may represent as a Float, a Double, or a ScaledDecimal. My class method #numericRepresentationClass: controls the actual data type of the numeric resolution. This is set during class initialization but can be changed at any time. I am based on the naive assumptions that time can be represented as a single continuum which may be experienced identically at different physical locations and velocities, and such that two observers in two different locations can identify a single PointInTime as a simultaneous event. These assumptions are not valid when relativity is taken into account, but are acceptable for use in Newtonian physics and Smalltalk. A Float or Double has sufficient precision to represent a millisecond clock for thousands of years, and can represent a microsecond clock for about the next hundred years. This representation of time is used in order to emphasize the notion of time as an infinite continuum, rather than a discreet integral value as implied by computer hardware clocks. In other words, if there is to be a particle nature to time, it should derive from physics and not from the peculiarities of computer hardware. In the event that a microsecond clock is required for Squeak in the twenty-second century or later, the precision can be increased by shifting the origin of time forward a couple hundred years (and adjusting conversion methods accordingly), by changing to a higher precision numeric represention (LargePositiveInteger or higher precision floating point data type), or by using ScaledDecimal rather than a floating point representation. Platform specific notes: Squeak and Smalltalk/X use double precision floating point for class Float. VisualWorks uses single precision float for Float, and double precision for class Double. Therefore, the magnitude of a PointInTime is represented by a Float or a Double, whichever provides the higher resolution. On Squeak, access to the underlying high precision clock may be provided by a pluggable primitive. See the methods in category primitives for examples, and see the optional class TimePlugin for an implementation of the plugin. Squeak has no built in concept of time zones or location-independent time represention. Smalltalk/X has an excellent implementation of time zones and time in class AbsoluteTime. This should be used for any direct access to the underlying system clock. For most practical applications, it also provides excellent support for time zones using the underlying operating system services. VisualWorks provides access to the underlying operating system clock in class Time, and some support for time zones in class TimeZone. The implementation of TimeZone is portable across operating systems, but is rather simplistic compared to Smalltalk/X. Class PointInTime may be used in conjunction with a TimeZoneDatabase to provide local time representation at any time and in any location for which a TimeZoneRuleSet (time zone data set) is available. This permits a platform independent implementation, but requires loading time zone information into the Smalltalk image rather than accessing it through operating system services. ! PointInTime subclass: #PointInTimeNow instanceVariableNames: 'updateProcess' classVariableNames: 'ThisInstant UpdatePeriod' poolDictionaries: '' category: 'Time-Examples'! !PointInTimeNow commentStamp: '' prior: 0! I represent the current point in time, as reported by the underlying hardware or operating system. There is only one instance of me in the system. My update mechanism is a simple polling loop which updates my view of the system time periodically and notifies any dependents of the change.! LocalTimeTransform subclass: #StxOSTimeZone instanceVariableNames: 'timeZone' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! !StxOSTimeZone commentStamp: '' prior: 0! I provide access to time zone functions provided by the base Smalltalk/X system. ! TestCase subclass: #TimeTransformTest instanceVariableNames: 'saveLocalTimeZone saveLocalTransform saveLastTransitionTime dstTransitionAbsoluteSeconds dstTransitionPosixSeconds leapSeconds' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones-tests'! !TimeTransformTest commentStamp: 'dtl 11/14/2004 18:33' prior: 0! Unit tests for local time transforms (time zone rules), and for integration of time zone rules with date and time classes. Two local time transforms are used, one that makes use of the leap second table (right/America/Detroit), and another that ignores the leap second table (America/Detroit). The tests check for correct time zone offsets before and after the Fall 2004 Daylight Savings transition for Detroit, Michigan USA, and for times before and after a leap second transition. A system time zone database with the necessary time zones must exist prior to running the tests. See method category "documentation" for an explanation of time representations. Some of these tests will fail if the TimePlugin is being used. TimePlugin reports the operating system view of Posix seconds, while TimeZoneDatsbase calculates Posix seconds from local seconds using the time zone offset. The tests that are expected to file have method comments to that effect. With TimePlugin disabled, all tests should pass (but PointInTime will not have access to the millisecond clock provided by TimePlugin). ! Object subclass: #TimeZoneDatabase instanceVariableNames: 'defaultLocation defaultTimeZone timeZones leapSecondRuleSet indexSeparator' classVariableNames: 'OsPathNameSeparator ThisSystemDatabase' poolDictionaries: '' category: 'Time-TimeZones'! !TimeZoneDatabase commentStamp: '' prior: 0! I represent a collection of time zone rules for many time zones. I know how to determine the number of seconds offset from UTC for any of my time zones at any time within the range of my time zone rules, as well as the number of leap seconds since the origin of time for any point in time. I know how to build time zone rules by reading compiled tzfile files from an external source. I store time zone information in a hierarchy of Dictionaries, where each Dictionary contains a group of related TimeZoneRuleSets and possibly other Dictionaries. This organization is similar to that of a tree structured directory of files and is intended to reflect the organization of tzfile time zone files as found on many computer systems. TimeZoneRuleSets are indexed by a path name consisting of a string with separator characters, for example 'right/America/Detroit' or 'right-America-Detroit'. I store leap second information in a single LeapSecondRuleSet which may optionally be referenced by TimeZoneRuleSets which choose to honor leap second conventions. On many systems, time zones which honor leap second conventions are given names which begin with 'right', such as 'right/America/Detroit'. I keep track of two types of rules. First, time zone offset rules are used to determine the difference in seconds between UTC time, and time as represented in a specified time zone. For example, there might be a five hour difference between time as displayed locally and UTC time; this difference is represented by an offset of -18000 seconds from UTC. These time zone offset rules also embody daylight savings time rules, which can cause the offset to change twice annually in accordance with daylight savings time clock setting conventions. Second, leap second rules are used to apply minor offsets to both UTC time and local time. The small offsets are specified such that time as displayed on a wall clock time (in any time zone) stays synchronized with the physical rotation of the Earth. Leap second offsets are frequently ignored in the interest of simplifying the mapping of absolute time (represented as class PointInTime) to the local representation of time (which might appear as a wall clock display, or as the date and time displayed in Smalltalk as Time>>dateAndTimeNow). In any case, the leap second rules are common to all time zones, even though they are redundantly encoded in any tzfile formatted time zone file (this is just an implementation convenience for the time zone software which uses tzfile time zone data). Depending on the way in which a tzfile time zone file was compiled (using the zic(1) program), it may or may not have leap second rules included. Many computer systems will use time zone files without leap seconds in the interest of simplicity, even though the time mapping is not strictly correct. ! Object subclass: #TimeZoneDstTransitionWatcher instanceVariableNames: 'lastTick transitionTick monitorProcess accessProtect' classVariableNames: 'DstMonitor' poolDictionaries: '' category: 'Time-TimeZones'! !TimeZoneDstTransitionWatcher commentStamp: 'dtl 10/31/2004 09:32' prior: 0! Squeak uses a Time>>totalSeconds clock that jumps forward or backward at daylight savings time transitions. During the one hour period following a "fall back" transition, the calculation of DateAndTime>>now is ambiguous. This class provides a monitor to keep track of any recent "fall back" transitions, enabling the correct DateAndTime to be chosen for any value of the Squeak seconds clock. The #fallBackOccurredDuringHourBefore: method provides a test to determine if the fall back transition has occurred withing the last hour. The monitor process runs continuously, and therefore uses a certain amount of CPU that may be noticeable on small systems. It is possible to provide a primitive for system time that answers both the current seconds clock and the current time zone offset. This primitive would make the time zone monitor unnecessary.! Object subclass: #TimeZoneProxy instanceVariableNames: 'abbreviation transform' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! !TimeZoneProxy commentStamp: 'dtl 11/14/2004 13:33' prior: 0! TimeZoneProxy is a TimeZone that obtains its information from an instance of TimeZoneRuleSet. This may be the LocalTimeTransform for the local time zone on this system obtained from a TimeZoneDatabase; or it may be the TimeZoneDatabase itself, in which case the proxy refers to the currently active LocalTimeTransform for the database. To set the system time zone to a proxy for the time zone database: TimeZoneProxy setDynamicTransform To set the local time zone for Detroit using a time zone that understands leap seconds: TimeZoneDatabase setLocalTimeZone: 'right/America/Detroit' Or for a Detroit time zone that ignores leap seconds: TimeZoneDatabase setLocalTimeZone: 'posix/America/Detroit' When configured in this manner, the name of the current local time zone is: DateAndTime localTimeZone transform defaultTimeZone timeZoneName The chain of references is as follows: DateAndTime class>>localTimeZone ==> aTimeZoneProxy aTimeZoneProxy>>transform ==> aTimeZoneDatabase aTimeZoneDatabase>>defaultTimeZone ==> aTimeZoneRuleSet This configuration permits DateAndTime to use UTC offset, daylight savings adjustment, and leap second adjustment for any point in time. When a daylight savings time transition occurs or a leap second adjustment is made, dates and times will automatically be adjusted accordingly. If a different time zone is selected as the current time zone in the database, DateAndTime will automatically refer to the new setting. To undo the above configuration and return DateAndTime to its default configuration: DateAndTime localTimeZone: TimeZone default This default setting may be required for existing DateAndTime test cases to pass, because some of the tests are not aware of leap second adjustments. Notes: To find a suitable time zone for e.g. Detroit, use: TimeZoneDatabase grepFor: 'Detroit' To set the a dynamic time zone proxy for a time zone in one step: TimeZoneProxy setDynamicTransform: 'posix/America/Detroit' If you want to set the time zone abbreviation to a preferred value: TimeZoneProxy setDynamicTransform: 'posix/America/Detroit' abbreviation: 'EST' ! Object subclass: #TimeZoneRule instanceVariableNames: 'transitionTime offsetSeconds isDstFlag abbreviation isStdTimeTransition isUtcTransition' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! !TimeZoneRule commentStamp: '' prior: 0! I represent a record of transition time data in a ZoneRuleSet. One such record is in effect at any point in time in a given time zone, providing the means to calculate seconds offset from UTC.! LocalTimeTransform subclass: #TimeZoneRuleSet instanceVariableNames: 'tzNameAbbreviations transitionTimeTable leapSecondRuleSet posixTzEnvString' classVariableNames: 'DefaultLocation' poolDictionaries: '' category: 'Time-TimeZones'! !TimeZoneRuleSet commentStamp: '' prior: 0! I represent a timezone for a location in the world. I know the rules for determining offsets from UTC, and for applying leap seconds. My rules are constructed from a data set in a tzfile(5) timezone database file. I know how to load these rules from a file, and how to apply them to calculate UTC offsets, daylight savings time, and leap seconds. A tzfile database file is typically generated by the zic(1) compiler distributed as part of the public domain timezone database in the ~ftp/pub directory of elsie.nci.nih.gov FTP server. ! Object subclass: #TzFileLoader instanceVariableNames: 'name fileStream tzNames transitionTable leapSeconds' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! !TzFileLoader commentStamp: '' prior: 0! I understand the format of a tzfile(5) timezone database file. I know how to load data from a tzfile to create instances of TimeZoneRuleSet and LeapSecondRuleSet. A tzfile database file is typically generated by the zic(1) compiler distributed as part of the public domain timezone database in the ~ftp/pub directory of elsie.nci.nih.gov FTP server. ! LocalTimeTransform subclass: #VwOSTimeZone instanceVariableNames: 'timeZone' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! !VwOSTimeZone commentStamp: '' prior: 0! I provide access to time zone functions provided by the base VisualWorks system. ! Object subclass: #WallClock instanceVariableNames: 'now timeZone date time' classVariableNames: '' poolDictionaries: '' category: 'Time-Examples'! !WallClock commentStamp: '' prior: 0! I am a demonstration of how to relate PointInTimeNow to Time and Date classes by means of a TimeZone. Watch an instance of me in a Squeak Morphic inspector (an MVC inspector will not be automatically updated, and is not very interesting to watch). I know how to watch the singleton instance of PointInTimeNow, and to update the current date and time accordingly. Watch me in a Morphic inspector and check if the time conversion methods are working correctly. My date and time should be the same as those answered by Time class>>now and Date class>>today, unless TimeZone>>here is a time zone with leap second compensation, in which case my time will be offset by the number of leap seconds since 1970 (22 seconds as of December 1999).! !DateAndTime methodsFor: '*time-UTC' stamp: 'dtl 11/10/2004 05:43'! asPointInTime "DateAndTime now asPointInTime" ^ self asPointInTimeInTimeZone: LocalTimeZone! ! !DateAndTime methodsFor: '*time-UTC' stamp: 'dtl 11/14/2004 23:01'! asPointInTimeInTimeZone: aTimeZone "The time zone is used only for determining the leap second offset for rotational time versus absolute time. DateAndTime is rotational time (aligned to the rotation of the planet), and PointInTime is absolute time (atomic clock seconds). An iterative method is used to ensure an acceptable result at leap second transitions, for which two PointInTime seconds may correspond to a single DateAndTime second." | pt leap newTime | pt := PointInTime fromAbsoluteSeconds: jdn - SqueakEpoch * SecondsInDay - PointInTime posixOffset + seconds - offset asSeconds + (nanos / 1000000000). (1 to: 10) inject: pt into: [:time :i | leap := aTimeZone leapSecondsAt: time. newTime := PointInTime fromAbsoluteSeconds: pt absoluteTime + leap. (newTime = time) ifTrue: [^ time]. newTime]. self notify: 'algorithm does not converge'. "Lack of convergence may occur if there has been a negative leap second. As of October 2004, there had never been a negative leap second, so if you are reading this now, please check the method and figure out if it is correct. It should be OK to just answer the value of newTime." ^ newTime! ! !DateAndTime methodsFor: '*time-UTC' stamp: 'dtl 3/10/2007 13:58'! inTimeZoneNamed: tzName "DateAndTime now inTimeZoneNamed: #CET " "DateAndTime now inTimeZoneNamed: #PST8PDT " "DateAndTime now inTimeZoneNamed: 'Australia/Perth' " ^ self asPointInTime asDateAndTimeForTimeZoneNamed: tzName ! ! !DateAndTime class methodsFor: '*time-TimeZones' stamp: 'dtl 11/2/2004 15:40'! fromSeconds: seconds offsetSeconds: offset "Answer a DateAndTime since the Squeak epoch: 1 January 1901" | since offsetDuration | since := Duration days: SqueakEpoch hours: 0 minutes: 0 seconds: seconds. offsetDuration := Duration seconds: offset. ^ self basicNew ticks: since ticks offset: offsetDuration; yourself. ! ! !DateAndTime class methodsFor: '*time-TimeZones' stamp: 'dtl 6/20/2009 17:27'! localOffset "Answer the duration we are offset from UTC. Note: In Squeak 3.10 and possibly other images, this method was modified to use a cached value of the local offset. This was an attempt to improve performance, but is incorrect if multiple time zones and DST transitions are to be supported. This version of the method is the original version as implemented in the Squeak Chronology package." ^ self localTimeZone offset ! ! !LeapSecondRuleSet methodsFor: 'testing' stamp: 'dtl 12/28/1999 20:01'! isEmpty ^ leapSecondTable isNil or: [leapSecondTable isEmpty]! ! !LeapSecondRuleSet methodsFor: 'queries' stamp: 'dtl 12/28/1999 20:01'! leapSecondsAt: aPointInTimeOrPosixSeconds "Answer the leap seconds for a point in time (or its integer value)." | rule | rule := self leapSecondsRuleFor: aPointInTimeOrPosixSeconds asInteger. rule isNil ifTrue: [^ 0] ifFalse: [^ rule at: 2] ! ! !LeapSecondRuleSet methodsFor: 'private' stamp: 'dtl 12/31/1999 19:06'! leapSecondsRuleFor: posixSeconds "Answer the leap second data record for a point in time (an Integer). Assuming that elements of leapSecondTable are sorted by transitionTime, this is the last such element for which the transition time is less than posixSeconds." | recordsBeforeThisTime | leapSecondTable isNil ifTrue: [^ nil]. leapSecondTable isEmpty ifTrue: [^ nil]. recordsBeforeThisTime := leapSecondTable select: [:e | (e at: 1) < posixSeconds]. recordsBeforeThisTime isEmpty ifTrue: [^ nil] ifFalse: [^ recordsBeforeThisTime last]! ! !LeapSecondRuleSet methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! leapSecondTable ^ leapSecondTable! ! !LeapSecondRuleSet methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! leapSecondTable: anArrayOfTransitionRules leapSecondTable := anArrayOfTransitionRules! ! !LocalTimeTransform methodsFor: 'leap seconds' stamp: 'dtl 12/28/1999 20:01'! leapSecondsAt: aPointInTime "Answer the number of leap seconds since January 1, 1970 UTC as of aPointInTime" ^ self subclassResponsibility ! ! !LocalTimeTransform methodsFor: 'leap seconds' stamp: 'dtl 12/30/1999 12:06'! leapSecondsForDate: aDate time: aTime "Answer the offset from UTC in this time zone as of aDate and aTime, where aDate and aTime are in the context of this time zone." "LocalTimeTransform here leapSecondsForDate: Date today time: Time now" | seconds t | seconds := aDate asSeconds + aTime asSeconds. t := PointInTime fromSmalltalkSeconds: seconds inTimeZone: self. ^ self leapSecondsAt: t ! ! !LocalTimeTransform methodsFor: 'offsets from UTC' stamp: 'dtl 12/28/1999 20:01'! localOffsetSecondsAt: aPointInTime "Answer the offset from UTC in this time zone as of aPointInTime" ^ self subclassResponsibility ! ! !LocalTimeTransform methodsFor: 'offsets from UTC' stamp: 'dtl 12/30/1999 12:04'! localOffsetSecondsForDate: aDate time: aTime "Answer the offset from UTC in this time zone as of aDate and aTime, where aDate and aTime are in the context of this time zone." "LocalTimeTransform here localOffsetSecondsForDate: Date today time: Time now" | seconds t | seconds := aDate asSeconds + aTime asSeconds. t := PointInTime fromSmalltalkSeconds: seconds inTimeZone: self. ^ self localOffsetSecondsAt: t ! ! !LocalTimeTransform methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! timeZoneName ^ timeZoneName! ! !LocalTimeTransform methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! timeZoneName: aStringOrSymbol timeZoneName := aStringOrSymbol! ! !LocalTimeTransform methodsFor: 'timezone conversion' stamp: 'dtl 11/23/2004 11:40'! transformDate: aDate time: aTime toTimeZone: aTimeZone "For aDate and aTime here, answer the corresponding date and time in aTimeZone." "(LocalTimeTransform for: 'America/Detroit') transformDate: Date today time: Time now toTimeZone: (LocalTimeTransform for: 'America/Los:=Angeles')" ^ (PointInTime date: aDate time: aTime timeZone: self) asDateAndTimeArrayForTimeZone: aTimeZone ! ! !LocalTimeTransform methodsFor: 'timezone conversion' stamp: 'dtl 11/23/2004 19:13'! transformFromTimeZone: aTimeZone date: aDate time: aTime "For aDate and aTime in aTimeZone, answer the corresponding date and time here." "(LocalTimeTransform for: 'America/Detroit') transformFromTimeZone: (LocalTimeTransform for: 'America/Los:=Angeles') date: Date today time: Time now" ^ (PointInTime date: aDate time: aTime timeZone: aTimeZone) asDateAndTimeArrayForTimeZone: self! ! !LocalTimeTransform class methodsFor: 'defaulting' stamp: 'dtl 12/28/1999 20:01'! defaultType ^ self forTzDatabase! ! !LocalTimeTransform class methodsFor: 'concrete subclasses' stamp: 'dtl 1/8/2000 11:07'! forOSServices "Answer the concrete class to use to provide time zone information from the underlying operating system. This approach is suitable for many systems and applications, and can provide good time zone information without the need to maintain a full TimeZoneDatabase in the image." (PointInTime platform == #Squeak) ifTrue: [^ OSTimeZone]. (PointInTime platform == #VisualWorks) ifTrue: [^ VwOSTimeZone]. (PointInTime platform == #'Smalltalk/X') ifTrue: [^ StxOSTimeZone]. ^ OSTimeZone! ! !LocalTimeTransform class methodsFor: 'concrete subclasses' stamp: 'dtl 12/28/1999 20:01'! forSmalltalk ^ NaiveTimeZone! ! !LocalTimeTransform class methodsFor: 'concrete subclasses' stamp: 'dtl 12/28/1999 20:01'! forTzDatabase ^ TimeZoneRuleSet! ! !LocalTimeTransform class methodsFor: 'instance creation' stamp: 'dtl 12/30/1999 12:06'! for: aTimeZoneNameString "LocalTimeTransform for: 'America/Detroit'" "LocalTimeTransform for: 'right/America/Detroit'" "LocalTimeTransform for: 'nowhere/noplace'" ^ self for: aTimeZoneNameString pathSeparator: nil ! ! !LocalTimeTransform class methodsFor: 'instance creation' stamp: 'dtl 12/30/1999 18:36'! for: aTimeZoneNameString pathSeparator: aCharacter "LocalTimeTransform for: 'America/Detroit' pathSeparator: $/ " "LocalTimeTransform for: 'right/America/Detroit' pathSeparator: $/ " "LocalTimeTransform for: 'right-America-Detroit' pathSeparator: $- " | db | db := TimeZoneDatabase systemDatabase. db isNil ifTrue: [^ nil] ifFalse: [^ db timeZoneFor: aTimeZoneNameString pathSeparator: aCharacter]! ! !LocalTimeTransform class methodsFor: 'instance creation' stamp: 'dtl 11/12/2004 17:53'! forSystem "For Squeak, use the DateAndTime>>localTimeZone, which should normally be configured as a proxy pointing back to the local time tranform in the time zone database. On other platforms, just use the current local transform in the database." "LocalTimeTransform forSystem" | dtClass | ^ (dtClass := Smalltalk at: #DateAndTime ifAbsent: []) isNil ifTrue: [self here] ifFalse: [dtClass perform: #localTimeZone] ! ! !LocalTimeTransform class methodsFor: 'instance creation' stamp: 'dtl 1/3/2000 04:48'! here "Answer the current time zone, or nil if the classes have not been initialized for this system. If you are using the TimeZoneDatabase, please edit TimeZoneDatabase class>>defaultLocation to answer your preferred timezone." "LocalTimeTransform here" | thisZone | thisZone := self defaultType here. thisZone isNil ifTrue: [ self notify: 'default time zone not found, using ', self hereUsingNothing printString. thisZone := self hereUsingNothing]. ^ thisZone! ! !LocalTimeTransform class methodsFor: 'instance creation' stamp: 'dtl 12/30/1999 12:07'! hereUsingDatabase "LocalTimeTransform hereUsingDatabase" ^ self forTzDatabase here! ! !LocalTimeTransform class methodsFor: 'instance creation' stamp: 'dtl 12/30/1999 12:07'! hereUsingNothing "LocalTimeTransform hereUsingNothing" ^ self forSmalltalk here! ! !LocalTimeTransform class methodsFor: 'instance creation' stamp: 'dtl 12/30/1999 12:08'! hereUsingOSServices "LocalTimeTransform hereUsingOSServices" ^ self forOSServices here! ! !NaiveTimeZone methodsFor: 'leap seconds' stamp: 'dtl 12/28/1999 20:01'! leapSecondsAt: aPointInTime "Answer the number of leap seconds since January 1, 1970 UTC as of aPointInTime" ^ 0! ! !NaiveTimeZone methodsFor: 'offsets from UTC' stamp: 'dtl 12/28/1999 20:01'! localOffsetSecondsAt: aPointInTime "Answer the offset from UTC in this time zone as of aPointInTime" ^ 0 ! ! !NaiveTimeZone methodsFor: 'offsets from UTC' stamp: 'dtl 12/28/1999 20:01'! localOffsetSecondsForDate: aDate time: aTime "Answer the offset from UTC in this time zone as of aDate and aTime, where aDate and aTime are in the context of this time zone." ^ 0! ! !NaiveTimeZone methodsFor: 'printing' stamp: 'dtl 12/28/1999 20:01'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' for ', timeZoneName! ! !NaiveTimeZone class methodsFor: 'instance creation' stamp: 'dtl 12/30/1999 11:56'! here "NaiveTimeZone here" ^ self new! ! !NaiveTimeZone class methodsFor: 'instance creation' stamp: 'dtl 12/28/1999 20:01'! new ^ super new timeZoneName: #Smalltalk! ! !OSTimeZone methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! currentLocalOffset "Always update from the primitive if possible." ^ currentLocalOffset := self setCurrentLocalOffset ! ! !OSTimeZone methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! currentLocalOffset: anInteger "Number of seconds offset from UTC at the present time. Note that value changes as a function of the current time, for example when daylight savings time takes effect." currentLocalOffset := anInteger ! ! !OSTimeZone methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! daylightSavingsInEffect "Always update from the primitive if possible." ^ daylightSavingsInEffect := self setDaylightSavingsInEffect ! ! !OSTimeZone methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! daylightSavingsInEffect: aBoolean daylightSavingsInEffect := aBoolean! ! !OSTimeZone methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! secondaryTimeZoneName ^ secondaryTimeZoneName! ! !OSTimeZone methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! secondaryTimeZoneName: aSymbol secondaryTimeZoneName := aSymbol! ! !OSTimeZone methodsFor: 'initialize-release' stamp: 'dtl 12/28/1999 20:01'! initialize self setTimeZoneName. self setSecondaryTimeZoneName. self setCurrentLocalOffset. self setDaylightSavingsInEffect ! ! !OSTimeZone methodsFor: 'leap seconds' stamp: 'dtl 12/28/1999 20:01'! leapSecondsAt: aPointInTime "Answer the number of leap seconds since January 1, 1970 UTC as of aPointInTime. Keep it simple, ignore leap seconds and just answer 0." ^ 0 ! ! !OSTimeZone methodsFor: 'offsets from UTC' stamp: 'dtl 1/8/2000 13:03'! localOffsetSecondsAt: aPointInTime "Answer the offset from UTC in this time zone as of aPointInTime" "OSTimeZone here localOffsetSecondsAt: PointInTime now" | t | t := aPointInTime asInteger. t isNil ifTrue: [^ nil]. ^ (self primLocalOffsetSecondsAt: t) negated! ! !OSTimeZone methodsFor: 'primitives' stamp: 'dtl 12/28/1999 20:01'! primGetDaylightFlag "Answer true if daylight savings is in effect" ^ DefaultDaylightSavingsInEffect! ! !OSTimeZone methodsFor: 'primitives' stamp: 'dtl 12/28/1999 20:01'! primGetDaylightFlagAt: aPosixTimeExpressedAsFloat "Answer true if daylight savings is in effect" ^ DefaultDaylightSavingsInEffect! ! !OSTimeZone methodsFor: 'primitives' stamp: 'dtl 12/28/1999 20:01'! primGetTimeZone "Answer a four element array of two time zone names (primary and secondary), daylight savings time flag, and seconds offset from UTC, for the current time zone at the present time." ^ nil! ! !OSTimeZone methodsFor: 'primitives' stamp: 'dtl 12/28/1999 20:01'! primGetTimeZoneAt: aPosixTimeExpressedAsFloat "Answer a four element array of two time zone names (primary and secondary), daylight savings time flag, and seconds offset from UTC, for the current time zone at the indicated time." ^ nil! ! !OSTimeZone methodsFor: 'primitives' stamp: 'dtl 12/28/1999 20:01'! primGetTimeZoneName "Answer time zone name" ^ DefaultTimeZoneName! ! !OSTimeZone methodsFor: 'primitives' stamp: 'dtl 12/28/1999 20:01'! primGetTimeZoneSecondaryName "Answer secondary time zone name" ^ DefaultSecondaryTimeZoneName! ! !OSTimeZone methodsFor: 'primitives' stamp: 'dtl 12/28/1999 20:01'! primLocalOffsetSeconds ^ DefaultLocalOffsetSeconds! ! !OSTimeZone methodsFor: 'primitives' stamp: 'dtl 12/28/1999 20:01'! primLocalOffsetSecondsAt: aFloat ^ DefaultLocalOffsetSeconds! ! !OSTimeZone methodsFor: 'printing' stamp: 'dtl 12/30/1999 19:03'! printOn: aStream super printOn: aStream. timeZoneName isNil ifFalse: [ aStream nextPut: $ . timeZoneName do: [:e | aStream nextPut: e]]. secondaryTimeZoneName isNil ifFalse: [ aStream nextPut: $ . secondaryTimeZoneName do: [:e | aStream nextPut: e]] ! ! !OSTimeZone methodsFor: 'private' stamp: 'dtl 12/28/1999 20:01'! setCurrentLocalOffset | offset | offset := self primLocalOffsetSeconds. offset notNil ifTrue: [^ currentLocalOffset := offset] ifFalse: [^ currentLocalOffset := DefaultLocalOffsetSeconds] ! ! !OSTimeZone methodsFor: 'private' stamp: 'dtl 12/28/1999 20:01'! setDaylightSavingsInEffect | dst | dst := self primGetDaylightFlag. dst notNil ifTrue: [^ daylightSavingsInEffect := dst] ifFalse: [^ daylightSavingsInEffect := DefaultDaylightSavingsInEffect] ! ! !OSTimeZone methodsFor: 'private' stamp: 'dtl 12/28/1999 20:01'! setSecondaryTimeZoneName | tz | tz := self primGetTimeZoneSecondaryName. tz notNil ifTrue: [^ secondaryTimeZoneName := tz] ifFalse: [^ secondaryTimeZoneName := DefaultSecondaryTimeZoneName]! ! !OSTimeZone methodsFor: 'private' stamp: 'dtl 12/28/1999 20:01'! setTimeZoneName | tz | tz := self primGetTimeZoneName. tz notNil ifTrue: [^ timeZoneName := tz] ifFalse: [^ timeZoneName := DefaultTimeZoneName]! ! !OSTimeZone class methodsFor: 'instance creation' stamp: 'dtl 12/30/1999 11:55'! here "Answer an instance representing the timezone at this location." "OSTimeZone here" ^ super new initialize! ! !OSTimeZone class methodsFor: 'initialize-release' stamp: 'dtl 12/28/1999 20:01'! initialize "Eastern Standard Time, Detroit, Michigan, USA" "OSTimeZone initialize" DefaultLocalOffsetSeconds := 18000. DefaultTimeZoneName := #EST. DefaultSecondaryTimeZoneName := #DST. DefaultDaylightSavingsInEffect := true! ! !PointInTime methodsFor: 'accessing'! absoluteTime ^ absoluteTime! ! !PointInTime methodsFor: 'accessing'! absoluteTime: aNumber absoluteTime := aNumber perform: NumericRepresentationSelector! ! !PointInTime methodsFor: 'accessing' stamp: 'dtl 11/17/2004 20:03'! currentLeapSeconds "Current number of leap seconds since the Posix epoch. This is independent of geographical time zone, but will be reported as zero if the local time transform does not recognize leap seconds." "PointInTime now currentLeapSeconds" ^ LocalTimeTransform forSystem leapSecondsAt: self ! ! !PointInTime methodsFor: 'accessing' stamp: 'dtl 11/17/2004 20:04'! currentOffsetSeconds "Current seconds offset from UTC in the local time zone. For a given time zone, the value will change at daylight savings time transitions." "PointInTime now currentOffsetSeconds" ^ LocalTimeTransform forSystem localOffsetSecondsAt: self ! ! !PointInTime methodsFor: 'converting' stamp: 'dtl 10/23/2004 10:42'! asAbsoluteSeconds "Answer the number of atomic clock seconds elapsed since 01-Jan-1970 UTC." ^ self absoluteTime! ! !PointInTime methodsFor: 'converting' stamp: 'dtl 11/12/2004 17:54'! asDateAndTime "PointInTime now asDateAndTime" ^ self asDateAndTimeForTimeZone: LocalTimeTransform forSystem ! ! !PointInTime methodsFor: 'converting' stamp: 'dtl 11/23/2004 11:40'! asDateAndTimeArrayForTimeZone: aTimeZone "PointInTime now asDateAndTimeArrayForTimeZone: LocalTimeTransform here" | dt | dt := self asDateAndTimeForTimeZone: aTimeZone. ^ Array with: dt asDate with: dt asTime! ! !PointInTime methodsFor: 'converting' stamp: 'dtl 10/11/2004 19:40'! asDateAndTimeForTimeZone: aTimeZone "PointInTime now asDateAndTimeForTimeZone: LocalTimeTransform here" | s offsetSeconds | s := self asSmalltalkSecondsForTimeZone: aTimeZone. offsetSeconds := aTimeZone localOffsetSecondsAt: self. s isNil ifTrue: [^ nil] ifFalse: [^ DateAndTime fromSeconds: s offsetSeconds: offsetSeconds]! ! !PointInTime methodsFor: 'converting' stamp: 'dtl 3/10/2007 13:51'! asDateAndTimeForTimeZoneNamed: tzName "PointInTime now asDateAndTimeForTimeZoneNamed: 'CET' " (TimeZoneDatabase systemDatabase timeZoneFor: tzName) ifNotNilDo: [:tz | ^ (self asDateAndTimeForTimeZone: tz) asDateAndTime]. self notify: 'no time zone entry for ', tzName asString. ^ self asDateAndTime ! ! !PointInTime methodsFor: 'converting' stamp: 'dtl 9/21/2004 06:49'! asFloat ^ absoluteTime asFloat! ! !PointInTime methodsFor: 'converting'! asInteger ^ absoluteTime asInteger! ! !PointInTime methodsFor: 'converting'! asLocalDateAndTime "PointInTime now asLocalDateAndTime" ^ self class dateAndTimeFromSmalltalkSeconds: self asLocalSmalltalkSeconds! ! !PointInTime methodsFor: 'converting' stamp: 'dtl 11/12/2004 17:54'! asLocalSmalltalkSeconds "Answer the number of seconds since January 1, 1901 in the local time zone. This number is suitable for creating instances of Time and Date." ^ self asSmalltalkSecondsForTimeZone: LocalTimeTransform forSystem! ! !PointInTime methodsFor: 'converting' stamp: 'dtl 10/27/2004 20:01'! asNumber ^ absoluteTime! ! !PointInTime methodsFor: 'converting' stamp: 'dtl 11/12/2004 17:54'! asPosixSeconds "Answer the number of Posix seconds since 01 January, 1970 UTC. The count of Posix seconds varies from absolute seconds as leap seconds are applied to the calendar." "Array with: PointInTime now asAbsoluteSeconds with: PointInTime now asPosixSeconds" ^ self asPosixSecondsForTimeZone: LocalTimeTransform forSystem! ! !PointInTime methodsFor: 'converting' stamp: 'dtl 10/23/2004 11:23'! asPosixSecondsForTimeZone: aTimeZone "Answer the number of Posix seconds since 01 January, 1970 UTC. The count of Posix seconds varies from absolute seconds as leap seconds are applied to the calendar." ^ self absoluteTime - (aTimeZone leapSecondsAt: self) ! ! !PointInTime methodsFor: 'converting' stamp: 'dtl 10/26/2004 20:41'! asSmalltalkSecondsForTimeZone: aTimeZone "Answer the number of seconds since January 1, 1901 in aTimeZone. This number is suitable for creating instances of Time and Date." | offset leap | self absoluteTime isNil ifTrue: [^ nil]. aTimeZone isNil ifTrue: [self notify: 'nil TimeZone'. ^ nil]. offset := aTimeZone localOffsetSecondsAt: self. leap := aTimeZone leapSecondsAt: self. ^ self absoluteTime + self class posixOffset + offset - leap! ! !PointInTime methodsFor: 'converting'! asUtcDateAndTime "PointInTime now asUtcDateAndTime" ^ self class dateAndTimeFromSmalltalkSeconds: self asUtcSmalltalkSeconds! ! !PointInTime methodsFor: 'converting'! asUtcSmalltalkSeconds "Answer the number of seconds since January 1, 1901 in aTimeZone with zero offset from UTC. This number is suitable for creating instances of Time and Date as they might appear in a Smalltalk system which happened to be located near longitude 0." "Time dateAndTimeFromSeconds: (PointInTime now asUtcSmalltalkSeconds)" self absoluteTime isNil ifTrue: [^ nil]. ^ (self absoluteTime asInteger) + self class posixOffset! ! !PointInTime methodsFor: 'comparing' stamp: 'dtl 10/26/2004 20:04'! < aPointInTime ^ (aPointInTime species == self species) and: [self absoluteTime < aPointInTime absoluteTime]! ! !PointInTime methodsFor: 'comparing' stamp: 'dtl 10/23/2004 13:16'! = aPointInTime ^ (aPointInTime species == self species) and: [aPointInTime absoluteTime = self absoluteTime]! ! !PointInTime methodsFor: 'comparing' stamp: 'dtl 10/23/2004 13:17'! hash ^ self absoluteTime hash! ! !PointInTime methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' at '. absoluteTime printOn: aStream. aStream nextPutAll: ' seconds'! ! !PointInTime methodsFor: 'arithmetic' stamp: 'dtl 10/26/2004 20:48'! - aPointInTime "Answer the difference in seconds between two points in time. The result may be converted to a Duration with #asDuration, but this method answers seconds in order to avoid loss of precision." ^ absoluteTime - aPointInTime absoluteTime! ! !PointInTime class methodsFor: 'general inquiries' stamp: 'dtl 11/20/2004 11:58'! absoluteSecondsAtPosixSeconds: posixSeconds inTimeZone: aTimeZone "Answer the count of absolute seconds corresponding to posixSeconds. If the local time zone does not account for leap seconds, then the result is posixSeconds. There is no direct mapping of Posix seconds to absolute seconds, because when a leap second is added to the calendar, there will be a Posix second that corresponds to two absolute seconds. For this reason an interative method is used to converge on the correct value. During a period of time after a leap second is inserted into the calendar, there may be two distinct values of PointInTime with the same local Posix seconds value. This method will answer only one of possibly two valid results. See also absoluteTimeAtSmalltalkSeconds:inTimeZone:, which has a similar problem with ambiguous conversion." "PointInTime absoluteSecondsAtPosixSeconds: 1098500000 inTimeZone: LocalTimeTransform here" | leap newTime | aTimeZone ifNil: [self notify: 'nil TimeZone'. ^ nil]. (1 to: 10) inject: posixSeconds into: [:time :i | leap := aTimeZone leapSecondsAt: time. newTime := posixSeconds + leap. (newTime = time) ifTrue: [^ time]. newTime]. self error: 'algorithm does not converge'. ^ nil! ! !PointInTime class methodsFor: 'general inquiries' stamp: 'dtl 11/21/2000 19:00'! absoluteSecondsAtSmalltalkSeconds: seconds inTimeZone: aTimeZone "PointInTime absoluteSecondsAtSmalltalkSeconds: Time totalSeconds inTimeZone: LocalTimeTransform here" | possibleValues | possibleValues := self allAbsoluteSecondsCorrespondingTo: seconds inTimeZone: aTimeZone. (possibleValues size == 1) ifTrue: [^ possibleValues at: 1]. (possibleValues size == 2) ifTrue: [(TimeZoneDstTransitionWatcher clockWatcher fallBackOccurredDuringHourBefore: seconds) ifFalse: [^ possibleValues at: 1] ifTrue: [^ possibleValues at: 2]]. self error: 'expected either one or two valid absolute time values' ! ! !PointInTime class methodsFor: 'general inquiries' stamp: 'dtl 11/20/2004 12:02'! absoluteTimeAtSmalltalkSeconds: smalltalkSeconds inTimeZone: aTimeZone "Find an absolute time for which the Smalltalk seconds clock is smalltalkSeconds. Answer an array with absolute seconds, UTC offset, and leap seconds for this time in aTimeZone. There is no direct mapping of local Smalltalk seconds to PointInTime, because time zone offset is a function of PointInTime rather than local Smalltalk time. For this reason an interative method is used to converge on a correct value. During a period of time after a daylight savings time transition, there may be two distinct values of PointInTime with the same local Smalltalk seconds value. This method will answer only one of possibly two valid results. See also absoluteSecondsAtPosixSeconds:inTimeZone:, which has a similar problem with ambiguous conversion." "PointInTime absoluteTimeAtSmalltalkSeconds: Time totalSeconds inTimeZone: LocalTimeTransform here" | leap offset newTime | aTimeZone ifNil: [self notify: 'nil TimeZone'. ^ nil]. (1 to: 10) inject: smalltalkSeconds - self posixOffset into: [:time :i | leap := aTimeZone leapSecondsAt: time. offset := aTimeZone localOffsetSecondsAt: time. newTime := smalltalkSeconds - self posixOffset - offset + leap. (newTime = time) ifTrue: [^ Array with: time with: offset with: leap]. newTime]. self error: 'algorithm does not converge'. ^ nil! ! !PointInTime class methodsFor: 'general inquiries' stamp: 'dtl 11/18/2004 19:20'! allAbsoluteSecondsCorrespondingTo: aLocalSmalltalkSecondsCount inTimeZone: aTimeZone "Answer all values of absolute seconds that correspond to aLocalSmalltalkSecondsCount. Assume that the daylight savings time transition for the local time zone involves setting the clock forward or backward by exactly 3600 seconds (one hour). Assume that any leap second transitions involve setting the clock forward or back by one second." "self allAbsoluteSecondsCorrespondingTo: 3276637199 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')" "self allAbsoluteSecondsCorrespondingTo: 3276637200 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')" "self allAbsoluteSecondsCorrespondingTo: 3276640799 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')" "self allAbsoluteSecondsCorrespondingTo: 3276640800 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')" | s | s := self firstAbsoluteSecondsAtSmalltalkSeconds: aLocalSmalltalkSecondsCount inTimeZone: aTimeZone. ^ (Array with: s - 3600 with: s - 1 with: s with: s + 1 with: s + 3600) select: [:absoluteSecs | ((PointInTime fromAbsoluteSeconds: absoluteSecs) asSmalltalkSecondsForTimeZone: aTimeZone) = aLocalSmalltalkSecondsCount] ! ! !PointInTime class methodsFor: 'general inquiries' stamp: 'dtl 11/18/2004 19:20'! allAbsoluteTimesCorrespondingTo: aLocalSmalltalkSecondsCount inTimeZone: aTimeZone "Answer all values of PointInTime that correspond to aLocalSmalltalkSecondsCount. Assume that the daylight savings time transition for the local time zone involves setting the clock forward or backward by exactly 3600 seconds (one hour). Assume that any leap second transitions involve setting the clock forward or back by one second." "self allAbsoluteTimesCorrespondingTo: 3276637199 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')" "self allAbsoluteTimesCorrespondingTo: 3276637200 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')" "self allAbsoluteTimesCorrespondingTo: 3276640799 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')" "self allAbsoluteTimesCorrespondingTo: 3276640800 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')" | s | s := self firstAbsoluteSecondsAtSmalltalkSeconds: aLocalSmalltalkSecondsCount inTimeZone: aTimeZone. ^ (Array with: s - 3600 with: s - 1 with: s with: s + 1 with: s + 3600) select: [:absoluteSecs | ((PointInTime fromAbsoluteSeconds: absoluteSecs) asSmalltalkSecondsForTimeZone: aTimeZone) = aLocalSmalltalkSecondsCount] thenCollect: [:abs | PointInTime fromAbsoluteSeconds: abs] ! ! !PointInTime class methodsFor: 'general inquiries' stamp: 'dtl 10/31/2004 02:00'! dateAndTimeArrayFromSmalltalkSeconds: seconds "This is from the Time class>>dateAndTimeFromSeconds method in Squeak, provided here for compability on other Smalltalk systems." "PointInTime dateAndTimeArrayFromSmalltalkSeconds: Time totalSeconds" | dt | dt := (self fromSmalltalkSeconds: seconds) asDateAndTime. ^ Array with: dt asDate with: dt asTime! ! !PointInTime class methodsFor: 'general inquiries'! dateAndTimeFromSmalltalkSeconds: seconds "This is from the Time class>>dateAndTimeFromSeconds method in Squeak, provided here for compability on other Smalltalk systems." ^ Array with: (self dateFromSmalltalkSeconds: seconds) with: (Time fromSeconds: seconds \\ 86400)! ! !PointInTime class methodsFor: 'general inquiries'! dateAndTimeNow "Answer the local representation of the current time as a Date and Time." "PointInTime dateAndTimeNow" ^ self dateAndTimeFromSmalltalkSeconds: self now asLocalSmalltalkSeconds! ! !PointInTime class methodsFor: 'general inquiries'! dateFromSmalltalkSeconds: seconds "Answer an instance of Date which is 'seconds' seconds after January 1, 1901. This is a copy of the Date class>>fromSeconds method in Squeak, provided here for compability on other Smalltalk systems." ^ Date fromDays: seconds // 86400! ! !PointInTime class methodsFor: 'general inquiries' stamp: 'dtl 11/18/2004 19:20'! firstAbsoluteSecondsAtSmalltalkSeconds: localSeconds inTimeZone: aTimeZone "Answer the first of the possibly two values of absolute seconds corresponding to localSeconds." "PointInTime firstAbsoluteSecondsAtSmalltalkSeconds: Time totalSeconds inTimeZone: LocalTimeTransform here" ^ (self absoluteTimeAtSmalltalkSeconds: localSeconds inTimeZone: aTimeZone) first! ! !PointInTime class methodsFor: 'general inquiries' stamp: 'dtl 11/20/2004 13:23'! posixSecondsAtSmalltalkSeconds: seconds "Answer the count of Posix seconds corresponding to local seconds in the local time zone." "PointInTime posixSecondsAtSmalltalkSeconds: Time totalSeconds" ^ self posixSecondsAtSmalltalkSeconds: seconds inTimeZone: DateAndTime localTimeZone ! ! !PointInTime class methodsFor: 'general inquiries' stamp: 'dtl 11/20/2004 13:23'! posixSecondsAtSmalltalkSeconds: seconds inTimeZone: aTimeZone "Answer the count of Posix seconds corresponding to local seconds in aTimeZone." "PointInTime posixSecondsAtSmalltalkSeconds: Time totalSeconds inTimeZone: LocalTimeTransform here" | abs | abs := self absoluteTimeAtSmalltalkSeconds: seconds inTimeZone: aTimeZone. ^ abs first + abs second ! ! !PointInTime class methodsFor: 'general inquiries' stamp: 'dtl 10/23/2004 09:52'! tzOffsetAtSmalltalkSeconds: seconds inTimeZone: aTimeZone "PointInTime tzOffsetAtSmalltalkSeconds: Time totalSeconds inTimeZone: LocalTimeTransform here" ^ (self absoluteTimeAtSmalltalkSeconds: seconds inTimeZone: aTimeZone) second! ! !PointInTime class methodsFor: 'private-system clock' stamp: 'dtl 12/24/2008 13:19'! absoluteSecondsNow "Answer the current time in absolute seconds" "PointInTime absoluteSecondsNow" | platform | platform := Platform ifNil: [self initialize. Platform]. platform == #Squeak ifTrue: [^ self getAbsoluteSecondsFromPluginOrLocalSecondsClock]. platform == #VisualWorks ifTrue: [^ self getAbsoluteSecondsFromLocalSecondsClock]. platform == #'Smalltalk/X' ifTrue: [^ self getAbsoluteSecondsForStx]! ! !PointInTime class methodsFor: 'private-system clock' stamp: 'dtl 11/21/2004 11:03'! getAbsoluteSecondsForStx "This method is platform dependent, intended for Smalltalk/X only. Assume that the operating system provides UTC Posix seconds (this assumption may not be correct)." | osClass posixSeconds | osClass := Smalltalk at: #OperatingSystem. posixSeconds := osClass getOSTime. ^ self absoluteSecondsAtPosixSeconds: posixSeconds inTimeZone: LocalTimeTransform here ! ! !PointInTime class methodsFor: 'private-system clock' stamp: 'dtl 6/27/2009 09:28'! getAbsoluteSecondsFromLocalSecondsClock "PointInTime getAbsoluteSecondsFromLocalSecondsClock" | t | t := self totalLocalMilliseconds / 1000. "Force update to DST transition watcher, may be required if close to transition time." TimeZoneDstTransitionWatcher clockWatcher updateLastTick: t. ^ self absoluteSecondsAtSmalltalkSeconds: t inTimeZone: DateAndTime localTimeZone ! ! !PointInTime class methodsFor: 'private-system clock' stamp: 'dtl 11/21/2004 10:46'! getAbsoluteSecondsFromPluginOrLocalSecondsClock "Use a plugin if available, otherwise derive absolute seconds from the local seconds clock." "PointInTime getAbsoluteSecondsFromPluginOrLocalSecondsClock" | primTime | (primTime := self primPosixTimeMicrosecondResolution) isNil ifTrue: [^ self getAbsoluteSecondsFromLocalSecondsClock] ifFalse: [^ self absoluteSecondsAtPosixSeconds: primTime inTimeZone: DateAndTime localTimeZone] ! ! !PointInTime class methodsFor: 'private-system clock' stamp: 'dtl 11/17/2004 06:26'! getStxSeconds "This method is platform dependent, intended for Smalltalk/X only. Note that 'AbsoluteTime now asSeconds' produces correct results for Unix based Smalltalk/X. However, the asSeconds method is documented as strictly private, hence this (hopefully) safer implementation. An additional adjustment may be required to accommodate leap seconds." | classAbsoluteTime now | classAbsoluteTime := Smalltalk at: #AbsoluteTime. now := classAbsoluteTime now. ^ now - (classAbsoluteTime secondsSince1970: 0) + now utcOffset ! ! !PointInTime class methodsFor: 'private-system clock' stamp: 'dtl 6/27/2009 09:28'! totalLocalMilliseconds "Answer total local milliseconds as estimated by combining the results of the current total seconds clock with the value of the millisecond clock. Loop to avoid sampling at a millisecond clock rollover time." | t1 s t2 d millis | [t1 := Time primMillisecondClock. s := Time primSecondsClock. t2 := Time primMillisecondClock. d := t2 - t1. d < 0] whileTrue. millis := t2 rem: 1000. ^ s * 1000 + millis ! ! !PointInTime class methodsFor: 'instance creation' stamp: 'dtl 11/12/2004 17:55'! date: aDate time: aTime "Answer a PointInTime corresponding to the aDate and aTime in the local time zone." "PointInTime date: Date today time: Time now" ^ self date: aDate time: aTime timeZone: LocalTimeTransform forSystem ! ! !PointInTime class methodsFor: 'instance creation' stamp: 'dtl 11/23/2004 11:41'! date: aDate time: aTime timeZone: aTimeZone "Answer a PointInTime corresponding to the aDate and aTime in the context of aTimeZone." "PointInTime date: Date today time: Time now timeZone: LocalTimeTransform here" ^ self fromSmalltalkSeconds: aDate asSeconds + aTime asSeconds inTimeZone: aTimeZone! ! !PointInTime class methodsFor: 'instance creation' stamp: 'dtl 10/21/2004 05:31'! fromAbsoluteSeconds: seconds "Answer aPointInTime at a number of seconds after 1-Jan-1970 UTC" "PointInTime fromPosixSeconds: ((Date today asSeconds) + (Time now asSeconds) + 14400)" ^ super new absoluteTime: seconds! ! !PointInTime class methodsFor: 'instance creation' stamp: 'dtl 11/12/2004 17:55'! fromPosixSeconds: seconds "Answer aPointInTime at a number of seconds after 1-Jan-1970 UTC. The count of Posix seconds varies from absolute seconds as leap seconds are applied to the calendar." "PointInTime fromPosixSeconds: ((Date today asSeconds) + (Time now asSeconds) + 14400)" ^ self fromPosixSeconds: seconds inTimeZone: LocalTimeTransform forSystem! ! !PointInTime class methodsFor: 'instance creation' stamp: 'dtl 11/20/2004 12:00'! fromPosixSeconds: seconds inTimeZone: aTimeZone "Answer aPointInTime at a number of seconds after 1-Jan-1970 UTC. The count of Posix seconds varies from absolute seconds as leap seconds are applied to the calendar." ^ super new absoluteTime: (self absoluteSecondsAtPosixSeconds: seconds inTimeZone: aTimeZone)! ! !PointInTime class methodsFor: 'instance creation' stamp: 'dtl 10/23/2004 12:10'! fromSeconds: seconds "Answer aPointInTime at a number of seconds after 1-Jan-1901 in the local time zone." "PointInTime fromSeconds: Time totalSeconds" ^ self fromSmalltalkSeconds: seconds ! ! !PointInTime class methodsFor: 'instance creation' stamp: 'dtl 11/12/2004 17:55'! fromSmalltalkSeconds: seconds "Answer aPointInTime at a number of seconds after 1-Jan-1901." "PointInTime fromSmalltalkSeconds: Time totalSeconds" ^ self fromSmalltalkSeconds: seconds inTimeZone: LocalTimeTransform forSystem! ! !PointInTime class methodsFor: 'instance creation' stamp: 'dtl 10/23/2004 09:54'! fromSmalltalkSeconds: seconds inTimeZone: aTimeZone "Answer aPointInTime at a number of seconds after 1-Jan-1901 in a time zone. The time zone offset is calculated as of aPointInTime, which may not be the same offset as is currently in effect for aTimeZone. Both time zone offsets and leap seconds are used in the conversion. There is no direct mapping of local Smalltalk seconds to PointInTime, because time zone offset is a function of PointInTime rather than local Smalltalk time. For this reason an interative method is used to converge on the correct value." "PointInTime fromSmalltalkSeconds: Time totalSeconds inTimeZone: LocalTimeTransform here" ^ self fromAbsoluteSeconds: (self absoluteSecondsAtSmalltalkSeconds: seconds inTimeZone: aTimeZone)! ! !PointInTime class methodsFor: 'instance creation' stamp: 'dtl 10/23/2004 13:33'! fromUtcSmalltalkSeconds: seconds "Answer aPointInTime at a number of seconds after 1-Jan-1901 UTC, with no leap second compensation. This is equivalent to #fromSmalltalkSeconds: for a Smalltalk system located in Greenwich, England with its time zone set to a Posix time zone that ignores leap seconds." "PointInTime fromUtcSmalltalkSeconds: Time totalSeconds" ^ super new absoluteTime: (seconds - self posixOffset) ! ! !PointInTime class methodsFor: 'instance creation' stamp: 'dtl 11/21/2004 10:33'! now "PointInTime now" ^ self fromAbsoluteSeconds: self absoluteSecondsNow ! ! !PointInTime class methodsFor: 'initialize-release' stamp: 'dtl 11/12/2004 19:17'! initialize "Set the selector to use to provide a floating point representation with adequate precision. Some systems make a distinction between Float and Double, and others simply use a double precision implementation of Float for all cases. If available, ScaledDecimal may also be used." "PointInTime initialize" Platform := self platformSymbol. " (Platform == #Squeak) ifTrue: [self numericRepresentationSelector: #asFloat]." (Platform == #Squeak) ifTrue: [self numericRepresentationSelector: #asScaledDecimal]. (Platform == #VisualWorks) ifTrue: [self numericRepresentationSelector: #asDouble]. (Platform == #'Smalltalk/X') ifTrue: [PointInTime numericRepresentationSelector: #asFloat]! ! !PointInTime class methodsFor: 'initialize-release' stamp: 'dtl 11/21/2004 08:37'! numericRepresentationSelector: aClassSelector "This method is normally called during class initialization. A double precision floating point representation may be used (either Double or Float, depending on the Smalltalk platform). ScaledDecimal also may be used where availabile. To change the representation to an Integer (for example), inspect the following: PointInTime numericRepresentationSelector: #asInteger; now And to change back to normal for this platform, inspect this: PointInTime initialize; now" NumericRepresentationSelector := aClassSelector! ! !PointInTime class methodsFor: 'private' stamp: 'dtl 9/19/2004 23:50'! platform "Answer what version of Smalltalk we are using." "PointInTime platform" ^ Platform ! ! !PointInTime class methodsFor: 'private' stamp: 'dtl 9/19/2004 23:56'! platformSymbol "Answer what version of Smalltalk we are using." | versionString versionClass | (versionClass := Smalltalk at: #SystemVersion ifAbsent: []) isNil ifTrue: [versionString := Smalltalk version] ifFalse: [versionString := versionClass current version]. ('Squeak*' match: versionString) ifTrue: [^ #Squeak]. ('VisualWorks*' match: versionString) ifTrue: [^ #VisualWorks]. ('*Smalltalk.st*' match: versionString) ifTrue: [^ #'Smalltalk/X']. ^ #unknown! ! !PointInTime class methodsFor: 'private'! posixOffset "Logic is lifted from Ian's Unix support code. Squeak epoc h is Jan 1, 1901. Unix epoch is Jan 1, 1970: 17 leap years and 52 non-leap years later than Squeak." "52 * 365 + (17 * 366) * 24 * 60 * 60" ^ 2177452800! ! !PointInTime class methodsFor: 'private' stamp: 'dtl 11/12/2004 17:56'! testFromSmalltalkSeconds "Answer 'OK' if PointInTime>>fromSmalltalkSeconds gives the right result, plus or minus one second to allow for clock updates while this test is running." "PointInTime testFromSmalltalkSeconds" | t1 t2 diff | t1 := Time totalSeconds. t2 := (PointInTime fromSmalltalkSeconds: t1 inTimeZone: LocalTimeTransform forSystem) asLocalSmalltalkSeconds. diff := t1 - t2. (diff abs < 1) ifTrue: [^ 'OK'] ifFalse: [self notify: 'test failed'. ^ 'Failed']! ! !PointInTime class methodsFor: 'private'! testLocalSeconds "Answer 'OK' if PointInTime>>now>>asLocalSeconds gives the right result, plus or minus one second to allow for clock updates while this test is running. Put up a notifier if there is a discrepancy due to leap second handling. Time>>totalSeconds does not contain leap second compensation, but if the current time zone (TimeZone>>here) has leap second compensation, the value of PointInTime>>now>>asLocalSmalltalkSeconds will vary by the number of leap seconds. Both results can be considered valid, since leap seconds are commonly ignored." "PointInTime testLocalSeconds" | now currentSeconds diff | now := PointInTime now asLocalSmalltalkSeconds. currentSeconds := Time totalSeconds. diff := (currentSeconds - now) abs. now isNil ifFalse: [(diff < 1) ifTrue: [^ 'OK'] ifFalse: [(diff < 40) ifTrue: [self notify: diff printString, ' leap second offset for this timezone versus OS timezone settings'. ^ 'OK']]]. self notify: 'test failed'. ^ 'Failed'! ! !PointInTime class methodsFor: 'primitives' stamp: 'dtl 11/17/2004 19:50'! primLocalSecondsClockWithOffset "Array of two integers, with number of seconds since since Jan 1, 1970 UTC, and the local offset for the time zone in effect for this system." | result | result := Array new: 2. result at: 1 put: Time primSecondsClock. result at: 2 put: 0. ^ result! ! !PointInTime class methodsFor: 'primitives' stamp: 'dtl 11/17/2004 19:51'! primPosixTime "Number of seconds, expressed as a float, since since Jan 1, 1970 UTC." ^ nil! ! !PointInTime class methodsFor: 'primitives' stamp: 'dtl 11/17/2004 19:51'! primPosixTimeAndLocalOffset "Array of two integers, with number of seconds since since Jan 1, 1970 UTC, and the local offset for the time zone in effect for this system." ^ nil! ! !PointInTime class methodsFor: 'primitives' stamp: 'dtl 11/17/2004 06:21'! primPosixTimeMicrosecondResolution "Number of seconds, expressed as a float, since since Jan 1, 1970 UTC." ^ nil! ! !PointInTime class methodsFor: 'documentation' stamp: 'dtl 11/9/2004 22:09'! squeakSecondsClockInfo "(StringHolder new acceptContents: self squeakSecondsClockInfo; yourself) openLabel: 'Squeak seconds clock' " ^ 'The Squeak seconds clock represents the number of seconds since the Smalltalk epoch. The Smalltalk epoch is defined as 1 January 1901. The current value of this clock is available by evaluating Time class>>totalSeconds, which calls the ioSeconds() function in the Squeak virtual machine to obtain the current local time from the underlying operating system. This is a wall-clock time, in the sense that the Squeak seconds clock corresponds to the setting of a clock on the wall located (geographically) in the current time zone. When a daylight savings time (DST) transition occurs, the hands on the wall clock are moved either forward or backward. Similarly, the Squeak seconds clock will jump forward or backward whenever a DST transition occurs. The current Time in Squeak will also jump forward and backward when DST transitions occur. Of course actual time proceeds forward relentlessly, but the display of time on the wall clock will have changed in order to make timekeeping more meaningful in the local time zone. Likewise, the displayed value of DateAndTime in Squeak will have suddenly adjusted itself to match the wall clock display. In addition to DST transitions, leap seconds are occasionally added to or removed from the world calendar. In principle, the seconds hand on the wall clock is moved forward or back by one second whenever a leap second is defined. Likewise, the Squeak seconds clock is (or should be) adjusted forward or back when leap seconds occur. It is also possible to define a notion of time as a magnitude, independent of all of the adjustments that are made to wall clocks in various locations around the world. Class PointInTime represents this universal clock, and uses the convention of describing a point in time as the total elapsed seconds since 1 January 1, 1970 in the UTC time zone. These are seconds as would be reported by a very accurate Caesium clock located in Greenwich, England. These seconds increase continuously without regard for geographic time zones, daylight savings time changes, or leap second adjustments used for local displays of time on wall clocks. It is always possible to derive the value of the Squeak seconds clock from a PointInTime, given information about the local time zone offset and leap seconds that are in effect as of that PointIntTime. The TimeZoneDatabase provides this information. For any PointInTime and LocalTimeTransform (time zone), the local time zone offset and leap second count are known, and the Squeak seconds clock can be calculated. However, the reverse transformation (Squeak seconds clock to PointInTime) is not possible in the general case. To understand why, consider the case of a Squeak system at 150 minutes (2 1/2 hours) after midnight on Sunday, 31 October, 2004 in an Eastern Standard Time time zone. This is a half hour after the "fall back" time zone change at the end of summer. Assuming that we have kept track of our local time zone and leap seconds, this occurs at the PointInTime 1099204222 seconds after 1 January, 1970. If we check the Squeak seconds clock at this point in time, it reports 3276639000 seconds. This is all well and good, but exactly one hour earlier the DST transition had not yet happened. The PointInTime was 1099200622 seconds, and the Squeak seconds clock was 3276639000, exactly the same value as the Squeak seconds one hour later. Thus the Squeak seconds clock had the same value at two completely different points in time. Therefore there are periods of time during which it is not possible to determine which of two points in time is the correct PointInTime for the Squeak seconds clock. It is of course possible to add a primitive to Squeak that makes the current PointInTime available directly. This, in conjunction with the information in the TimeZoneDatabase, provides enough information to do transformations from PointInTime to Squeak seconds and back without ambiguity. Alternatively, a primitive that reports current time (either UTC or local) along with current time zone offset provides the required information. As a related note, operating systems may not report time zone offset correctly for points in time that occur outside of the current DST setting. But if TimeZoneDatabase is available in the Squeak image and a UTC seconds primitive is added, then Date and Time transformations can be reliably calculated for any PointInTime within the domain of the TimeZoneDatabase transforms. '! ! !PointInTime class methodsFor: 'documentation' stamp: 'dtl 11/9/2004 22:01'! utcClockInfo "(StringHolder new acceptContents: self utcClockInfo; yourself) openLabel: 'UTC seconds clock' " ^ 'UTC is a measure of time corresponding to the angular rotation of the earth. As such, it is not a measure of time as measured by an atomic clock. UTC time is kept in synchronization with atomic time by the occasional insertion (or removal) of leap seconds in the UTC clock, although historically other methods of adjusting the clock (e.g. "elastic seconds") have been used, and the term "UTC" has had various definitions over the years. The distinction between rotational time (UTC) and atomic time can often be ignored. However, for purposes of physics and astronomy, they are different concepts and the small numerical differences between the two are significant. Posix seconds are similar to UTC seconds, but are defined in such a way that leap seconds are ignored. The Posix seconds clock is thus effectively a "wall clock" representation of seconds, for which the Posix clock is adjusted forward or back when a leap second occurs. This is similar to the seconds clock in early Unix systems, which were designed prior to the invention of leap seconds. Class PointInTime is intended to represent atomic time, such that time can be treated as a magnitude. Posix time varies from an atomic seconds clock as leap seconds are applied. For this reason, the conversion from PointInTime to and from Posix seconds should show a difference corresponding to the number of leap seconds that have been applied since 1 January, 1970. If leap seconds are ignored, then Posix time and PointInTime seconds produce the same count of seconds. Many time zone tables ignore leap seconds, and many computer operating systems likewise ignore the issue. For example, the LocalTimeTransform for "right/America/Detroit" in a TimeZoneDatabase contains leap second rules, while the "posix/America/Detroit" transform always answers zero leap seconds. Both refer to the same geographical time zone, and for practical purposes the "posix/America/Detroit" transform is an appropriate choice to describe the time zone rules for Detroit, Michigan. The LocalTimeTransforms in the TimeZoneDatabase contain transforms with or without leap second tables. The "posix/America/Detroit" transform ignores leap seconds, and is appropriate for a platform that is configured according to Posix specifications, while the "right/America/Detroit" transform accounts for leap seconds and provided a more realistic count of actual elapsed seconds since the Posix epoch. It should not be assumed that the operatings system on which Squeak is hosted will handle leap seconds consistently. BSD Unix systems (including FreeBSD and Mac OSX) define the time_t system clock to represent atomic clock seconds and providing time2posix() and posix2time() functions for converting to and from Posix seconds. This allows correct counting of actual seconds since the Posix epoch. Other Unix and Linux systems may ignore leap seconds, and other operating systems may also handle leap seconds differently. For purposes of converting Time and Date in Squeak to and from PointInTime seconds, we assume that Squeak will report its second clock as Posix seconds offset by the current time zone offset, regardless of the operating system and virtual machine on which it is running. '! ! !PointInTimeNow methodsFor: 'converting' stamp: 'dtl 12/28/1999 20:01'! asPointInTime "Answer a snapshot of myself at the current time." "PointInTimeNow thisInstant asPointInTime" | now | now := self absoluteTime. ^ PointInTime new absoluteTime: now! ! !PointInTimeNow methodsFor: 'initialize-release' stamp: 'dtl 1/9/2000 12:35'! initialize "PointInTime initialize" self addDependent: self. self updateFromSystemClock! ! !PointInTimeNow methodsFor: 'initialize-release' stamp: 'dtl 1/9/2000 13:52'! release "PointInTime release" self dependents release. ^ super release ! ! !PointInTimeNow methodsFor: 'updating' stamp: 'dtl 11/21/2004 11:07'! setAbsoluteTime "PointInTime new setAbsoluteTime asLocalDateAndTime" self absoluteTime: (self class absoluteSecondsNow) ! ! !PointInTimeNow methodsFor: 'updating' stamp: 'dtl 12/28/1999 20:01'! update: aParameter self setAbsoluteTime ! ! !PointInTimeNow methodsFor: 'system clock' stamp: 'dtl 12/30/1999 19:47'! terminateProcess updateProcess isNil ifFalse: [updateProcess terminate]. ! ! !PointInTimeNow methodsFor: 'system clock' stamp: 'dtl 1/7/2000 19:47'! updateFromSystemClock "Start a polling loop to periodically update my view of the system time." self terminateProcess. updateProcess := [[true] whileTrue: [ (Delay forMilliseconds: UpdatePeriod) wait. self changed: self]] forkAt: Processor userInterruptPriority ! ! !PointInTimeNow class methodsFor: 'initialize-release' stamp: 'dtl 1/7/2000 19:47'! initialize "PointInTimeNow initialize" self updatePeriod: 200. "milliseconds" ThisInstant isNil ifFalse: [ ThisInstant release. ThisInstant terminateProcess. ThisInstant := nil]! ! !PointInTimeNow class methodsFor: 'initialize-release' stamp: 'dtl 1/7/2000 19:46'! updatePeriod: milliseconds UpdatePeriod := milliseconds! ! !PointInTimeNow class methodsFor: 'instance creation' stamp: 'dtl 12/28/1999 20:01'! new self notify: 'use PointInTimeNow>>thisInstant to access my single instance'! ! !PointInTimeNow class methodsFor: 'instance creation' stamp: 'dtl 1/5/2000 20:07'! thisInstant "PointInTimeNow thisInstant" ThisInstant isNil ifTrue: [ThisInstant := super new initialize]. ^ ThisInstant! ! !StxOSTimeZone methodsFor: 'initialize'! initialize self timeZoneName ! ! !StxOSTimeZone methodsFor: 'leap seconds'! leapSecondsAt: aPointInTime "Answer the number of leap seconds since January 1, 1970 UTC as of aPointInTime. Keep it simple, ignore leap seconds and just answer 0." ^ 0! ! !StxOSTimeZone methodsFor: 'leap seconds'! leapSecondsForDate: aDate time: aTime "Answer the offset from UTC in this time zone as of aDate and aTime, where aDate and aTime are in the context of this time zone." "StxOSTimeZone here leapSecondsForDate: Date today time: Time now" | seconds t | seconds := aDate asSeconds + aTime asSeconds. t := PointInTime fromSmalltalkSeconds: seconds inTimeZone: self. ^ self leapSecondsAt: t! ! !StxOSTimeZone methodsFor: 'offsets from UTC'! localOffsetSecondsAt: aPointInTime "Answer the offset from UTC in this time zone as of aPointInTime" "StxOSTimeZone here localOffsetSecondsAt: PointInTime now" ^ ((Smalltalk at: #AbsoluteTime) now) utcOffset negated ! ! !StxOSTimeZone methodsFor: 'offsets from UTC'! localOffsetSecondsForDate: aDate time: aTime "Answer the offset from UTC in this time zone as of aDate and aTime, where aDate and aTime are in the context of this time zone." "StxOSTimeZone here localOffsetSecondsForDate: Date today time: Time now" ^ ((Smalltalk at: #AbsoluteTime) fromDate:aDate andTime:aTime) utcOffset negated ! ! !StxOSTimeZone methodsFor: 'accessing'! timeZoneName "I do not know my name, so just answer the name of my class." timeZoneName isNil ifTrue: [timeZoneName := self class name]. ^ timeZoneName! ! !StxOSTimeZone class methodsFor: 'instance creation'! here "Answer the current time zone, or nil if the classes have not been initialized for this system." "StxOSTimeZone here" ^ super new initialize! ! !TimeStamp class methodsFor: '*time-UTC' stamp: 'dtl 2/12/2007 05:42'! current | ts ticks | ts := super now asTimeStamp. ticks _ ts ticks. ticks at: 3 put: 0. ts ticks: ticks offset: ts offset. ^ ts ! ! !TimeTransformTest methodsFor: 'private' stamp: 'dtl 10/23/2004 16:01'! absoluteDstTransition "The first UTC second for the next daylight savings transition in absolute seconds. Search the actual time zone table, just in case someone changes the table retroactively." "self new absoluteDstTransition" | secs tz summerOffset dayAfterTransition hourAfterTransition secondAfterTransition minuteAfterTransition | secs := 1096831000. "A time during October 2004" tz := LocalTimeTransform here. summerOffset := tz localOffsetSecondsAt: (PointInTime fromAbsoluteSeconds: secs). dayAfterTransition := (secs to: secs + 3600 * 24 * 100 by: 3600 * 24) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromAbsoluteSeconds: s)) == summerOffset) not]. hourAfterTransition := (dayAfterTransition - (3600 * 24) to: dayAfterTransition by: 3600) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromAbsoluteSeconds: s)) == summerOffset) not]. minuteAfterTransition := (hourAfterTransition - 3600 to: hourAfterTransition by: 60) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromAbsoluteSeconds: s)) == summerOffset) not]. secondAfterTransition := (minuteAfterTransition - 60 to: minuteAfterTransition by: 1) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromAbsoluteSeconds: s)) == summerOffset) not]. ^ secondAfterTransition ! ! !TimeTransformTest methodsFor: 'private' stamp: 'dtl 10/23/2004 17:08'! localSmalltalkDstTransition "The first local Smalltalk second for the next daylight savings transition in the local time zone." "self new localSmalltalkDstTransition" | secs tz summerOffset dayAfterTransition hourAfterTransition secondAfterTransition minuteAfterTransition | secs := 1096831000 + self posixOffset. "A time during October 2004" tz := LocalTimeTransform here. summerOffset := tz localOffsetSecondsAt: (PointInTime fromSeconds: secs). dayAfterTransition := (secs to: secs + 3600 * 24 * 100 by: 3600 * 24) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromSeconds: s)) == summerOffset) not]. hourAfterTransition := (dayAfterTransition - (3600 * 24) to: dayAfterTransition by: 3600) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromSeconds: s)) == summerOffset) not]. minuteAfterTransition := (hourAfterTransition - 3600 to: hourAfterTransition by: 60) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromSeconds: s)) == summerOffset) not]. secondAfterTransition := (minuteAfterTransition - 60 to: minuteAfterTransition by: 1) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromSeconds: s)) == summerOffset) not]. ^ secondAfterTransition ! ! !TimeTransformTest methodsFor: 'private' stamp: 'dtl 10/3/2004 17:18'! posixDstTransition "The first UTC Posix second for the next daylight savings transition. Search the actual time zone table, just in case someone changes the table retroactively." "self new posixDstTransition" | secs tz summerOffset dayAfterTransition hourAfterTransition secondAfterTransition minuteAfterTransition | secs := 1096831000. "A time during October 2004" tz := LocalTimeTransform here. summerOffset := tz localOffsetSecondsAt: (PointInTime fromPosixSeconds: secs). dayAfterTransition := (secs to: secs + 3600 * 24 * 100 by: 3600 * 24) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromPosixSeconds: s)) == summerOffset) not]. hourAfterTransition := (dayAfterTransition - (3600 * 24) to: dayAfterTransition by: 3600) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromPosixSeconds: s)) == summerOffset) not]. minuteAfterTransition := (hourAfterTransition - 3600 to: hourAfterTransition by: 60) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromPosixSeconds: s)) == summerOffset) not]. secondAfterTransition := (minuteAfterTransition - 60 to: minuteAfterTransition by: 1) detect: [:s | ((tz localOffsetSecondsAt: (PointInTime fromPosixSeconds: s)) == summerOffset) not]. ^ secondAfterTransition ! ! !TimeTransformTest methodsFor: 'private' stamp: 'dtl 10/23/2004 12:59'! posixOffset "Difference in seconds between Smalltalk epoch and Posix epoch." "52 * 365 + (17 * 366) * 24 * 60 * 60" ^ 2177452800! ! !TimeTransformTest methodsFor: 'private' stamp: 'dtl 11/14/2004 17:22'! primPosixTimeAndLocalOffset "Array of two integers, with number of seconds since since Jan 1, 1970 UTC, and the local offset for the time zone in effect for this system." ^ nil! ! !TimeTransformTest methodsFor: 'private' stamp: 'dtl 11/14/2004 17:15'! primSecondsClock "Answer the number of seconds since 00:00 on the morning of January 1, 1901 (a 32-bit unsigned number). Essential. See Object documentation whatIsAPrimitive. " self primitiveFailed! ! !TimeTransformTest methodsFor: 'private' stamp: 'dtl 11/23/2004 21:14'! setDstTransitionWatcherFall2004 "Set the DST transition watcher to think that the last DST transition happened in the Fall of 2004. This will permit tests that rely on the DST transition watcher to work properly in the future. This method must be called after the time zone setting is changed, because the DST transition watcher is automatically reset whenever such a change occurs." | lateFall2004 newLastTransitionTick | lateFall2004 := PointInTime fromAbsoluteSeconds: 1100000000. newLastTransitionTick := TimeZoneDstTransitionWatcher clockWatcher probableLastTransitionTickBefore: lateFall2004. TimeZoneDstTransitionWatcher clockWatcher transitionTick: newLastTransitionTick. ! ! !TimeTransformTest methodsFor: 'private' stamp: 'dtl 11/23/2004 21:14'! setDstTransitionWatcherSpring2004 "Set the DST transition watcher to think that the last DST transition happened in the Spring of 2004. This will permit tests that rely on the DST transition watcher to work properly in the future. This method must be called after the time zone setting is changed, because the DST transition watcher is automatically reset whenever such a change occurs." | earlySummer2004 newLastTransitionTick | earlySummer2004 := PointInTime fromAbsoluteSeconds: 1084440000. newLastTransitionTick := TimeZoneDstTransitionWatcher clockWatcher probableLastTransitionTickBefore: earlySummer2004. TimeZoneDstTransitionWatcher clockWatcher transitionTick: newLastTransitionTick. ! ! !TimeTransformTest methodsFor: 'running' stamp: 'dtl 11/14/2004 16:33'! setUp "Save the system time zone setting" saveLocalTransform := TimeZoneDatabase systemDatabase defaultTimeZone. saveLocalTimeZone := DateAndTime localTimeZone. saveLastTransitionTime := TimeZoneDstTransitionWatcher clockWatcher transitionTick. "Configure for time zone proxy to the database" TimeZoneProxy setDynamicTransform. "Fall 2004 DST transition for right/America/Detroit, in atomic clock seconds" dstTransitionAbsoluteSeconds := 1099202422. "Fall 2004 DST transition for posix/America/Detroit, in Posix seconds, ignoring leap seconds" dstTransitionPosixSeconds := 1099202400. "Number of leap seconds as of the transition time" leapSeconds := 22. ! ! !TimeTransformTest methodsFor: 'running' stamp: 'dtl 11/14/2004 16:21'! tearDown "Restore the default time zone" TimeZoneDatabase systemDatabase defaultLocation: saveLocalTransform timeZoneName. DateAndTime localTimeZone: saveLocalTimeZone. TimeZoneDstTransitionWatcher clockWatcher transitionTick: saveLastTransitionTime ! ! !TimeTransformTest methodsFor: 'documentation' stamp: 'dtl 6/14/2009 19:20'! hasBrokenDateAndTimeConversion "The constructors for DateAndTime and other Squeak Chronology classes do not handle time zone offsets correctly. They use whatever offset is currently in effect, which may or may not be the same as the offset in effect as of the date and time for the DateAndTime instance to be created." self flag: #FIXME. ^ true! ! !TimeTransformTest methodsFor: 'documentation' stamp: 'dtl 11/9/2004 21:57'! squeakSecondsClockInfo "(StringHolder new acceptContents: self new squeakSecondsClockInfo; yourself) openLabel: 'Squeak seconds clock' " ^ PointInTime squeakSecondsClockInfo ! ! !TimeTransformTest methodsFor: 'documentation' stamp: 'dtl 11/9/2004 21:58'! utcClockInfo "(StringHolder new acceptContents: self new utcClockInfo; yourself) openLabel: 'UTC seconds clock' " ^ PointInTime utcClockInfo ! ! !TimeTransformTest methodsFor: 'testing-PointInTime seconds' stamp: 'dtl 8/5/2008 22:08'! testAbsoluteTimeToDateAndTime "Check conversion from absolute time to DateAndTime local seconds as we cross a DST transition." "(self new setTestSelector: #testAbsoluteTimeToDateAndTime) debug" | interval expectedStrings dateAndTimeStrings | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. interval := dstTransitionAbsoluteSeconds - 2 to: dstTransitionAbsoluteSeconds + 1. expectedStrings := #( '2004-10-31T01:59:58-04:00' '2004-10-31T01:59:59-04:00' '2004-10-31T01:00:00-05:00' '2004-10-31T01:00:01-05:00'). dateAndTimeStrings := interval collect: [:abs | (PointInTime fromAbsoluteSeconds: abs) asDateAndTime printString]. self assert: dateAndTimeStrings = expectedStrings! ! !TimeTransformTest methodsFor: 'testing-PointInTime seconds' stamp: 'dtl 6/14/2009 20:13'! testAbsoluteTimeToDateAndTimeSeconds "Check conversion from absolute time to DateAndTime local seconds as we cross a DST transition." "(self new setTestSelector: #testAbsoluteTimeToDateAndTimeSeconds) debug" | interval dateAndTimes dateAndTimeSeconds validCombinationsOfExpectedSecondsValues | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. interval := dstTransitionAbsoluteSeconds - 2 to: dstTransitionAbsoluteSeconds + 1. validCombinationsOfExpectedSecondsValues := Array with: #(3276640798 3276640799 3276637200 3276637201) "current DST offset 4 hours, contiguous local seconds" with: #(3276640798 3276640799 3276640800 3276640801) "current DST offset 4 hours, skipped an hour" with: #(3276637198 3276637199 3276637200 3276637201) "current DST offset 5 hours, contiguous local seconds" with: #(3276637198 3276637199 3276633600 3276633601). "current DST offset 5 hours, skipped an hour" dateAndTimes := interval collect: [:abs | (PointInTime fromAbsoluteSeconds: abs) asDateAndTime]. "This conversion is ambiguous for the hour following DST transition" dateAndTimeSeconds := dateAndTimes collect: [:dt | dt asSeconds]. "The third and fourth elements of the array are ambiguous, may be off by 1 hour" self assert: (validCombinationsOfExpectedSecondsValues includes: dateAndTimeSeconds) ! ! !TimeTransformTest methodsFor: 'testing-PointInTime seconds' stamp: 'dtl 8/5/2008 22:09'! testAbsoluteTimeToLocalSmalltalkSeconds "Check conversion from absolute time to local seconds count as we cross a DST transition." "(self new setTestSelector: #testAbsoluteTimeToLocalSmalltalkSeconds) debug" | interval localSmalltalkSeconds expectedLocalSmalltalkSeconds | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. interval := dstTransitionAbsoluteSeconds - 2 to: dstTransitionAbsoluteSeconds + 1. localSmalltalkSeconds := interval collect: [:abs | (PointInTime fromAbsoluteSeconds: abs) asLocalSmalltalkSeconds]. expectedLocalSmalltalkSeconds := #(3276640798 3276640799 3276637200 3276637201). self assert: localSmalltalkSeconds = expectedLocalSmalltalkSeconds. ! ! !TimeTransformTest methodsFor: 'testing-PointInTime seconds' stamp: 'dtl 8/5/2008 22:10'! testConversionToLocalSmalltalkSeconds "Check conversion of PointInTime to local Smalltalk wall clock seconds. The Smalltalk seconds clock reports seconds in wall clock time in the local time zone, and is unaware of time zone offsets and leap seconds. The PointInTime clock reports actual elapsed Caesium clock seconds since the Posix epoch. As leap seconds occur, the two clocks become out of sync. If the local time transform is aware of leap seconds, the difference between the two clocks will appear in the conversion between PointInTime seconds and Smalltalk seconds." "This test will FAIL if the TimePlugin is being used. TimePlugin reports the operating system view of Posix seconds, while TimeZoneDatsbase calculates Posix seconds from local seconds using the time zone offset." "(self new setTestSelector: #testConversionToLocalSmalltalkSeconds) debug" | pt tSec tpSec absoluteSeconds leap posixSeconds offset calculatedSmalltalkSeconds | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. pt := PointInTime now. tSec := Time totalSeconds. tpSec :=pt asLocalSmalltalkSeconds. self assert: (tSec - tpSec) abs < 1. absoluteSeconds := pt asAbsoluteSeconds. leap := LocalTimeTransform here leapSecondsAt: pt. posixSeconds := absoluteSeconds + PointInTime posixOffset - leap. offset := LocalTimeTransform here localOffsetSecondsAt: pt. calculatedSmalltalkSeconds := posixSeconds + offset. self assert: (tSec - calculatedSmalltalkSeconds) abs < 1. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. pt := PointInTime now. tSec := Time totalSeconds. tpSec :=pt asLocalSmalltalkSeconds. self assert: (tSec - tpSec) abs < 1. absoluteSeconds := pt asAbsoluteSeconds. leap := LocalTimeTransform here leapSecondsAt: pt. posixSeconds := absoluteSeconds + PointInTime posixOffset - leap. offset := LocalTimeTransform here localOffsetSecondsAt: pt. calculatedSmalltalkSeconds := posixSeconds + offset. self assert: (tSec - calculatedSmalltalkSeconds) abs < 1 ! ! !TimeTransformTest methodsFor: 'testing-PointInTime seconds' stamp: 'dtl 8/5/2008 22:10'! testConversionToLocalSmalltalkSeconds2 "Check conversion of PointInTime to local Smalltalk wall clock seconds. The Smalltalk seconds clock reports seconds in wall clock time in the local time zone, and is unaware of time zone offsets and leap seconds. The PointInTime clock reports actual elapsed Caesium clock seconds since the Posix epoch. As leap seconds occur, the two clocks become out of sync. If the local time transform is aware of leap seconds, the difference between the two clocks will appear in the conversion between PointInTime seconds and Smalltalk seconds." | tpSec leap | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. tpSec := 1098000000. "2004-10-17T04:00:00-04:00" leap := LocalTimeTransform here leapSecondsAt: tpSec. self assert: leap == 22 ! ! !TimeTransformTest methodsFor: 'testing-PointInTime seconds' stamp: 'dtl 11/14/2004 16:25'! testConversionToLocalSmalltalkSecondsNoLeapSeconds "Check conversion of PointInTime to local Smalltalk wall clock seconds. This test uses a time zone with no leap second table, so the conversion is expected to be exact." "(self new setTestSelector: #testConversionToLocalSmalltalkSecondsNoLeapSeconds) debug" | tpSec tSec | TimeZoneDatabase systemDatabase defaultLocation: 'America/Detroit'. tpSec := PointInTime now asLocalSmalltalkSeconds. tSec := Time totalSeconds. "The values may be slightly different, but less than one second" self assert: (tSec - tpSec) < 1. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. tpSec := PointInTime now asLocalSmalltalkSeconds. tSec := Time totalSeconds. "The values may be slightly different, but less than one second" self assert: (tSec - tpSec) < 1. ! ! !TimeTransformTest methodsFor: 'testing-PointInTime seconds' stamp: 'dtl 8/5/2008 22:10'! testConvertLocalSecondsToPointInTime "Verify offset between UTC and America/Detroit, and leap second difference between America/Detroit and right/America/Detroit." | s pt1 pt2 pt3 | s := 3275329734. "2004-10-15T17:48:54-04:00" "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. pt1 := PointInTime fromSeconds: s. self assert: s = pt1 asLocalSmalltalkSeconds. TimeZoneDatabase systemDatabase defaultLocation: 'America/Detroit'. pt2 := PointInTime fromSeconds: s. self assert: s = pt2 asLocalSmalltalkSeconds. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. pt3 := PointInTime fromSeconds: s. self assert: s = pt3 asLocalSmalltalkSeconds. self assert: (pt2 absoluteTime - pt3 absoluteTime) = 14400. "time zone offset" self assert: (pt1 absoluteTime - pt2 absoluteTime) = 22. "leap seconds"! ! !TimeTransformTest methodsFor: 'testing-PointInTime seconds' stamp: 'dtl 8/5/2008 22:12'! testDateAndTimeSummer2004EST "Check 2004-09-05T12:00:00-04:00 using Posix seconds, absolute seconds, and local Smalltalk seconds." "(self new setTestSelector: #testDateAndTimeSummer2004EST) debug" | posixSeconds absoluteSeconds ptPosix ptAbsolute offset leap smalltalkSeconds ptSmalltalk | "Test with a time transform that includes leap seconds" "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. offset := -4 * 3600. leap := 22. "2004-09-05T16:00:00+00:00 Posix time, ignoring leap seconds" posixSeconds := 1094400000. "Add leap seconds for the number of elapsed atomic clock seconds" absoluteSeconds := posixSeconds + leap. "Adjust by difference in Posix epoch versus Smalltalk epoch, plus time zone offset" smalltalkSeconds := posixSeconds + self posixOffset + offset. ptPosix := PointInTime fromPosixSeconds: posixSeconds. ptAbsolute := PointInTime fromAbsoluteSeconds: absoluteSeconds. ptSmalltalk := PointInTime fromSmalltalkSeconds: smalltalkSeconds. "The absolute times should all be the same" self assert: ptPosix absoluteTime = ptAbsolute absoluteTime. self assert: ptSmalltalk absoluteTime = ptAbsolute absoluteTime. "Check commutative conversions" self assert: ptAbsolute = (PointInTime fromAbsoluteSeconds: ptAbsolute asAbsoluteSeconds). self assert: ptAbsolute = (PointInTime fromPosixSeconds: ptAbsolute asPosixSeconds). self assert: ptAbsolute = (PointInTime fromSmalltalkSeconds: ptAbsolute asLocalSmalltalkSeconds). "Run the same tests for a time transform that ignores leap seconds" TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. offset := -4 * 3600. leap := 0. "2004-09-05T16:00:00+00:00 Posix time, ignoring leap seconds" posixSeconds := 1094400000. "Add leap seconds for the number of elapsed atomic clock seconds" absoluteSeconds := posixSeconds + leap. "Adjust by difference in Posix epoch versus Smalltalk epoch, plus time zone offset" smalltalkSeconds := posixSeconds + self posixOffset + offset. ptPosix := PointInTime fromPosixSeconds: posixSeconds. ptAbsolute := PointInTime fromAbsoluteSeconds: absoluteSeconds. ptSmalltalk := PointInTime fromSmalltalkSeconds: smalltalkSeconds. "The absolute times should all be the same" self assert: ptPosix absoluteTime = ptAbsolute absoluteTime. self assert: ptSmalltalk absoluteTime = ptAbsolute absoluteTime. "Check commutative conversions" self assert: ptAbsolute = (PointInTime fromAbsoluteSeconds: ptAbsolute asAbsoluteSeconds). self assert: ptAbsolute = (PointInTime fromPosixSeconds: ptAbsolute asPosixSeconds). self assert: ptAbsolute = (PointInTime fromSmalltalkSeconds: ptAbsolute asLocalSmalltalkSeconds). ! ! !TimeTransformTest methodsFor: 'testing-PointInTime seconds' stamp: 'dtl 8/5/2008 22:14'! testLeapSecondCount "Count of leap seconds as of 17 Oct, 2004 should be 22 for a time zone with leap second table. The UTC time zone does not have a leap second table, so the leap second count is zero." | tpSec leap | tpSec := 1098000000. "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. leap := LocalTimeTransform here leapSecondsAt: tpSec. self assert: ((PointInTime fromPosixSeconds: tpSec) asDateAndTime year) = 2004. self assert: leap == 22. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. leap := LocalTimeTransform here leapSecondsAt: tpSec. self assert: ((PointInTime fromPosixSeconds: tpSec) asDateAndTime year) = 2004. self assert: leap == 0. ! ! !TimeTransformTest methodsFor: 'testing-PointInTime seconds' stamp: 'dtl 8/5/2008 22:14'! testPointInTimeNowSeconds "Check consistency of various views on the current time" "This test will FAIL if the TimePlugin is being used. TimePlugin reports the operating system view of Posix seconds, while TimeZoneDatsbase calculates Posix seconds from local seconds using the time zone offset." "(self new setTestSelector: #testPointInTimeNowSeconds) debug" | clockSeconds pt1 pt2 ptSeconds1 ptSeconds2 pt3 pt4 ptSeconds3 ptSeconds4 | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. clockSeconds := Time totalSeconds. pt1 := PointInTime now. pt2 := PointInTime fromSmalltalkSeconds: clockSeconds. ptSeconds1 := pt1 asLocalSmalltalkSeconds. ptSeconds2 := pt2 asLocalSmalltalkSeconds. self assert: (clockSeconds - ptSeconds1) abs < 1. self assert: (ptSeconds2 - ptSeconds1) abs < 1. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. clockSeconds := Time totalSeconds. pt3 := PointInTime now. pt4 := PointInTime fromSmalltalkSeconds: clockSeconds. ptSeconds3 := pt3 asLocalSmalltalkSeconds. ptSeconds4 := pt4 asLocalSmalltalkSeconds. self assert: (clockSeconds - ptSeconds3) abs < 1. self assert: (ptSeconds4 - ptSeconds3) abs < 1. self assert: (ptSeconds4 - ptSeconds2) abs < 1. self assert: (ptSeconds3 - ptSeconds1) abs < 1. ! ! !TimeTransformTest methodsFor: 'testing-PointInTime seconds' stamp: 'dtl 5/31/2009 14:41'! testSmalltalkEpoch "Confirm that Smalltalk seconds are interpreted as wall clock time in the local time zone." "(self new setTestSelector: #testSmalltalkEpoch) debug" | smalltalkOriginDetroit smalltalkOriginUtc difference currentDetroitOffsetSeconds | TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. currentDetroitOffsetSeconds := DateAndTime now offset asSeconds. self assert: currentDetroitOffsetSeconds < 0. "ensure nonzero" smalltalkOriginDetroit := DateAndTime fromSeconds: 0. TimeZoneDatabase systemDatabase defaultLocation: 'posix/UTC'. smalltalkOriginUtc := DateAndTime fromSeconds: 0. self assert: smalltalkOriginDetroit > smalltalkOriginUtc. difference := smalltalkOriginUtc - smalltalkOriginDetroit. self assert: difference asSeconds = currentDetroitOffsetSeconds ! ! !TimeTransformTest methodsFor: 'testing-arithmetic' stamp: 'dtl 8/5/2008 22:09'! testAddDurationAcrossDstTransition "(self new setTestSelector: #testAddDurationAcrossDstTransition) debug" | midnight fourHoursLater duration | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. midnight := '2004-10-31T00:00:00-04:00' asDateAndTime. fourHoursLater := '2004-10-31T03:00:00-05:00' asDateAndTime. duration := Duration seconds: (4 * 3600). self assert: midnight + duration = fourHoursLater ! ! !TimeTransformTest methodsFor: 'testing-arithmetic' stamp: 'dtl 8/5/2008 22:10'! testAddDurationAcrossLeapSecondTransition "(self new setTestSelector: #testAddDurationAcrossLeapSecondTransition) debug" | aLeapSecondTransitionTime ptFirst ptTenSecondsLater | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. aLeapSecondTransitionTime := 915148821. "From the leap second table in right/America/Detroit" ptFirst := PointInTime fromAbsoluteSeconds: aLeapSecondTransitionTime - 2. ptTenSecondsLater := PointInTime fromAbsoluteSeconds: aLeapSecondTransitionTime - 2 + 10. self assert: (ptTenSecondsLater asAbsoluteSeconds - ptFirst asAbsoluteSeconds) = 10. self assert: (ptTenSecondsLater asPosixSeconds - ptFirst asPosixSeconds) = 9. self assert: (ptTenSecondsLater asLocalSmalltalkSeconds - ptFirst asLocalSmalltalkSeconds) = 9. self assert: (ptFirst asDateAndTime + (Duration seconds: 9)) = ptTenSecondsLater ! ! !TimeTransformTest methodsFor: 'testing-arithmetic' stamp: 'dtl 11/6/2004 22:32'! testSubtractDateAndTime "Test DateAndTime>>- " "(self new setTestSelector: #testSubtractDateAndTime) debug" | dtOne dtTwo twoMinusOne dtThree threeMinusOne dtFour dtFive fiveMinusFour dtSix dtSeven sevenMinusSix | "One day duration" dtOne := '2004-11-27T23:59:37-05:00' asDateAndTime. dtTwo := '2004-11-28T23:59:37-05:00' asDateAndTime. twoMinusOne := dtTwo - dtOne. self assert: twoMinusOne asSeconds = (24 * 3600). "dtThree is the same wall clock display, but one hour to the east, hence it represents one hour earlier in absolute time." dtThree := '2004-11-27T23:59:37-04:00' asDateAndTime. threeMinusOne := dtThree - dtOne. self assert: threeMinusOne asSeconds = -3600. "At the same real time, the wall clock shows one hour less as we move westward by one hour of Earth angle." dtFour := '2004-11-27T23:59:37-04:00' asDateAndTime. dtFive := '2004-11-27T22:59:37-05:00' asDateAndTime. fiveMinusFour := dtFive - dtFour. self assert: fiveMinusFour asSeconds = 0. dtSix := '2004-11-27T22:59:37-04:00' asDateAndTime. dtSeven := '2004-11-27T23:59:37-05:00' asDateAndTime. sevenMinusSix := dtSeven - dtSix. self assert: sevenMinusSix asSeconds = (3600 * 2). ! ! !TimeTransformTest methodsFor: 'testing-arithmetic' stamp: 'dtl 8/5/2008 22:15'! testSubtractDateAndTimeAcrossDstTransition "(self new setTestSelector: #testSubtractDateAndTimeAcrossDstTransition) debug" | ptMidnight ptMidnightFourHoursLater midnight fourHoursLater difference | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. ptMidnight := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds - (2 * 3600). ptMidnightFourHoursLater := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + (2 * 3600). midnight := '2004-10-31T00:00:00-04:00' asDateAndTime. fourHoursLater := '2004-10-31T03:00:00-05:00' asDateAndTime. self assert: (ptMidnight asDateAndTime - midnight) asSeconds abs < 1. self assert: (ptMidnightFourHoursLater asDateAndTime - fourHoursLater) asSeconds abs < 1. difference := fourHoursLater - midnight. self assert: 4 * 3600 = difference asSeconds ! ! !TimeTransformTest methodsFor: 'testing-arithmetic' stamp: 'dtl 8/5/2008 22:15'! testSubtractDurationAcrossDstTransition "(self new setTestSelector: #testSubtractDurationAcrossDstTransition) debug" | midnight fourHoursLater duration | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. midnight := '2004-10-31T00:00:00-04:00' asDateAndTime. fourHoursLater := '2004-10-31T03:00:00-05:00' asDateAndTime. duration := Duration seconds: (4 * 3600). self assert: fourHoursLater - duration = midnight ! ! !TimeTransformTest methodsFor: 'testing-arithmetic' stamp: 'dtl 8/5/2008 22:16'! testSubtractDurationAcrossLeapSecondTransition "(self new setTestSelector: #testSubtractDurationAcrossLeapSecondTransition) debug" | aLeapSecondTransitionTime ptFirst ptTenSecondsLater | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. aLeapSecondTransitionTime := 915148821. "From the leap second table in right/America/Detroit" ptFirst := PointInTime fromAbsoluteSeconds: aLeapSecondTransitionTime - 2. ptTenSecondsLater := PointInTime fromAbsoluteSeconds: aLeapSecondTransitionTime - 2 + 10. self assert: (ptTenSecondsLater asAbsoluteSeconds - ptFirst asAbsoluteSeconds) = 10. self assert: (ptTenSecondsLater asPosixSeconds - ptFirst asPosixSeconds) = 9. self assert: (ptTenSecondsLater asLocalSmalltalkSeconds - ptFirst asLocalSmalltalkSeconds) = 9. self assert: (ptTenSecondsLater asDateAndTime - (Duration seconds: 9)) = ptFirst ! ! !TimeTransformTest methodsFor: 'testing-local conversion' stamp: 'dtl 8/5/2008 22:10'! testAmbiguousConversionAfterDst "Demonstrate ambiguity of translation from PointInTime to Smalltalk seconds during the DST transition." "(self new setTestSelector: #testAmbiguousConversionAfterDst) debug" | halfHourBefore halfHourAfter smalltalkSecondsBefore smalltalkSecondsAfter | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. halfHourBefore := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds - 1800. halfHourAfter := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + 1800. self setDstTransitionWatcherSpring2004. smalltalkSecondsBefore := halfHourBefore asLocalSmalltalkSeconds. self setDstTransitionWatcherFall2004. smalltalkSecondsAfter := halfHourAfter asLocalSmalltalkSeconds. self deny: halfHourBefore = halfHourAfter. self assert: smalltalkSecondsBefore = smalltalkSecondsAfter ! ! !TimeTransformTest methodsFor: 'testing-local conversion' stamp: 'dtl 8/5/2008 22:10'! testAmbiguousConversionForLeapSeconds "Demonstrate ambiguity of translation from PointInTime to Smalltalk seconds during a leap second transition." "(self new setTestSelector: #testAmbiguousConversionForLeapSeconds) debug" | tz leapSecondTransition oneSecondBeforeTransition ptArray twoSecondsAfterTransition | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). tz := TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'. leapSecondTransition := (PointInTime fromAbsoluteSeconds: 915148821) asSmalltalkSecondsForTimeZone: tz. "One second before a leap second transition, conversion to local seconds is unambiguous." oneSecondBeforeTransition := leapSecondTransition - 1. ptArray := PointInTime allAbsoluteTimesCorrespondingTo: oneSecondBeforeTransition inTimeZone: tz. self assert: ptArray size == 1. self assert: (ptArray first asSmalltalkSecondsForTimeZone: tz) = oneSecondBeforeTransition. "During the two second duration of the leap second transition, conversion to local seconds is ambiguous. There are two atomic clock PointInTime seconds corresponding to a single wall clock second." ptArray := PointInTime allAbsoluteTimesCorrespondingTo: leapSecondTransition inTimeZone: tz. self assert: ptArray size == 2. self deny: ptArray first = ptArray second. "But both of the PointInTime values translate back to the same local Smalltalk second count." self assert: (ptArray first asSmalltalkSecondsForTimeZone: tz) = leapSecondTransition. self assert: (ptArray second asSmalltalkSecondsForTimeZone: tz) = leapSecondTransition. "Two seconds after the leap seconds transition, conversion to local seconds is unambiguous again." twoSecondsAfterTransition := leapSecondTransition + 1. ptArray := PointInTime allAbsoluteTimesCorrespondingTo: twoSecondsAfterTransition inTimeZone: tz. self assert: ptArray size == 1. self assert: (ptArray first asSmalltalkSecondsForTimeZone: tz) = twoSecondsAfterTransition. ! ! !TimeTransformTest methodsFor: 'testing-local conversion' stamp: 'dtl 10/30/2004 18:41'! testAmbiguousConversionToLocalSeconds "Demonstrate ambiguity of translation from PointInTime to Smalltalk seconds during the DST transition." "(self new setTestSelector: #testAmbiguousConversionToLocalSeconds) debug" "One second before the fall 2004 DST transition, conversion to local seconds is unambiguous." self assert: (PointInTime allAbsoluteTimesCorrespondingTo: 3276637199 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')) size == 1. "During the hour after the fall 2004 DST transition, conversion to local seconds is ambiguous." "There are two PointInTime values for a Smalltalk second count." self assert: (PointInTime allAbsoluteTimesCorrespondingTo: 3276637200 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')) size == 2. "But both of the PointInTime values translate back to the same local Smalltalk second count." self assert: ((PointInTime allAbsoluteTimesCorrespondingTo: 3276637200 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')) collect: [:e | e asSmalltalkSecondsForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')]) asSet size == 1. "This continues to be the case for the next hour." self assert: (PointInTime allAbsoluteTimesCorrespondingTo: 3276640799 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')) size == 2. self assert: ((PointInTime allAbsoluteTimesCorrespondingTo: 3276640799 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')) collect: [:e | e asSmalltalkSecondsForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')]) asSet size == 1. "One hour after the fall 2004 DST transition, conversion to local seconds is unambiguous again." self assert: (PointInTime allAbsoluteTimesCorrespondingTo: 3276640800 inTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit')) size == 1. ! ! !TimeTransformTest methodsFor: 'testing-Time' stamp: 'dtl 8/5/2008 22:10'! testAsTime "Ensure that a Time created from a DateAndTime is the right magnitude." "(self new setTestSelector: #testAsTime) debug" | dt t dtSecs tSecs | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. dt := DateAndTime now. t := dt asTime. dtSecs := (dt hour * 3600) + (dt minute * 60) + dt second. tSecs := (t hour * 3600) + (t minute * 60) + t second. "dtSecs is a whole integer, so values are expected to match to within one second" self assert: (dtSecs - tSecs) abs < 1. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. dt := DateAndTime now. t := dt asTime. dtSecs := (dt hour * 3600) + (dt minute * 60) + dt second. tSecs := (t hour * 3600) + (t minute * 60) + t second. "dtSecs is a whole integer, so values are expected to match to within one second" self assert: (dtSecs - tSecs) abs < 1 ! ! !TimeTransformTest methodsFor: 'testing-Time' stamp: 'dtl 8/5/2008 22:11'! testDateAndTimeFromSeconds "Test conversion using a time zone with a leap second table." | s dt dta | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. s := Time totalSeconds. dt := DateAndTime fromSeconds: s. dta := Time dateAndTimeFromSeconds: s. self assert: dt asDate = dta first. self assert: dt asTime = dta last. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. s := Time totalSeconds. dt := DateAndTime fromSeconds: s. dta := Time dateAndTimeFromSeconds: s. self assert: dt asDate = dta first. self assert: dt asTime = dta last ! ! !TimeTransformTest methodsFor: 'testing-Time' stamp: 'dtl 11/14/2004 16:30'! testDateAndTimeFromSecondsNoLeapSeconds "Test conversion using a time zone with no leap second table." | s dt dta | TimeZoneDatabase systemDatabase defaultLocation: 'America/Detroit'. s := Time totalSeconds. dt := DateAndTime fromSeconds: s. dta := Time dateAndTimeFromSeconds: s. self assert: dt asDate = dta first. self assert: dt asTime = dta last. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. s := Time totalSeconds. dt := DateAndTime fromSeconds: s. dta := Time dateAndTimeFromSeconds: s. self assert: dt asDate = dta first. self assert: dt asTime = dta last ! ! !TimeTransformTest methodsFor: 'testing-Time' stamp: 'dtl 8/5/2008 22:16'! testTimeAsDateAndTime "This test will FAIL if the TimePlugin is being used. TimePlugin reports the operating system view of Posix seconds, while TimeZoneDatsbase calculates Posix seconds from local seconds using the time zone offset." "(self new setTestSelector: #testTimeAsDateAndTime) debug" | dtNow ptNow timeNow | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. timeNow := Time dateAndTimeNow. dtNow := DateAndTime now. ptNow := PointInTime now asDateAndTime. self assert: (dtNow - ptNow) asSeconds abs < 1. self assert: ptNow asDate = timeNow first. self assert: (ptNow asTime asSeconds - timeNow last asSeconds) abs < 1. self assert: dtNow asDate = timeNow first. self assert: (dtNow asTime asSeconds - timeNow last asSeconds) abs < 1. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. timeNow := Time dateAndTimeNow. dtNow := DateAndTime now. ptNow := PointInTime now asDateAndTime. self assert: (dtNow - ptNow) asSeconds abs < 1. self assert: ptNow asDate = timeNow first. self assert: (ptNow asTime asSeconds - timeNow last asSeconds) abs < 1. self assert: dtNow asDate = timeNow first. self assert: (dtNow asTime asSeconds - timeNow last asSeconds) abs < 1. ! ! !TimeTransformTest methodsFor: 'testing-Time' stamp: 'dtl 8/5/2008 22:16'! testTimeNow "Make sure DateAndTime>>now and Time>>now show the same time. Allow one second of variance in the test to account for difference in precision of DateAndTime seconds and the integer seconds clock." "This test will FAIL if the TimePlugin is being used. TimePlugin reports the operating system view of Posix seconds, while TimeZoneDatsbase calculates Posix seconds from local seconds using the time zone offset." "(self new setTestSelector: #testTimeNow) debug" | dt t dtSecs tSecs diff | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. dt := DateAndTime now. t := Time now. dtSecs := (dt hour * 3600) + (dt minute * 60) + dt second. tSecs := (t hour * 3600) + (t minute * 60) + t second. diff := (dtSecs - tSecs) abs. self assert: diff < 1. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. dt := DateAndTime now. t := Time now. dtSecs := (dt hour * 3600) + (dt minute * 60) + dt second. tSecs := (t hour * 3600) + (t minute * 60) + t second. diff := (dtSecs - tSecs) abs. self assert: diff < 1! ! !TimeTransformTest methodsFor: 'testing-Time' stamp: 'dtl 8/5/2008 22:16'! testTimeNowSeconds "Check consistency of various views on the current time" "This test will FAIL if the TimePlugin is being used. TimePlugin reports the operating system view of Posix seconds, while TimeZoneDatsbase calculates Posix seconds from local seconds using the time zone offset. This test may also fail intermittently if it is interrupted by the process scheduler between calls to obtain the current time; these failures may be disregarded." "(self new setTestSelector: #testTimeNowSeconds) debug" | clockSeconds dtArray dt offset dateSeconds timeSeconds dtArraySeconds pt ptSeconds delta | delta := 1.5. "Number of seconds of error to allow to accomodate scheduler jitter" "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. clockSeconds := Time totalSeconds. dtArray := Time dateAndTimeNow. dt := DateAndTime now. pt := PointInTime now. offset := LocalTimeTransform here localOffsetSecondsAt: PointInTime now. dateSeconds := dtArray first asSeconds + offset. "local squeak seconds clock" timeSeconds := dtArray last asSeconds. dtArraySeconds := (dateSeconds + timeSeconds - offset). ptSeconds := pt asLocalSmalltalkSeconds. self assert: (clockSeconds - dt asSeconds) abs < delta. self assert: (clockSeconds - dtArraySeconds) abs < delta. self assert: (clockSeconds - ptSeconds) abs < delta. self assert: clockSeconds = (DateAndTime fromSeconds: clockSeconds) asSeconds. self assert: clockSeconds = (PointInTime fromSmalltalkSeconds: clockSeconds) asLocalSmalltalkSeconds. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. clockSeconds := Time totalSeconds. dtArray := Time dateAndTimeNow. dt := DateAndTime now. pt := PointInTime now. offset := LocalTimeTransform here localOffsetSecondsAt: PointInTime now. dateSeconds := dtArray first asSeconds + offset. "local squeak seconds clock" timeSeconds := dtArray last asSeconds. dtArraySeconds := (dateSeconds + timeSeconds - offset). ptSeconds := pt asLocalSmalltalkSeconds. self assert: (clockSeconds - dt asSeconds) abs < delta. self assert: (clockSeconds - dtArraySeconds) abs < delta. self assert: (clockSeconds - ptSeconds) abs < delta. self assert: clockSeconds = (DateAndTime fromSeconds: clockSeconds) asSeconds. self assert: clockSeconds = (PointInTime fromSmalltalkSeconds: clockSeconds) asLocalSmalltalkSeconds. ! ! !TimeTransformTest methodsFor: 'testing-Date and Time array' stamp: 'dtl 8/5/2008 22:10'! testCreateDateAndTimeArray "(self new setTestSelector: #testCreateDateAndTimeArray) debug" | date time z1 z2 z3 pt1 pt2 pt3 dt1 dt2 dt3 | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. date _ '23 Nov, 2004' asDate. time _ '12:00' asTime. z1 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'. z2 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Chicago'. z3 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Los_Angeles'. pt1 _ PointInTime date: date time: time timeZone: z1. pt2 _ PointInTime date: date time: time timeZone: z2. pt3 _ PointInTime date: date time: time timeZone: z3. dt1 _ pt1 asDateAndTimeForTimeZone: z1. dt2 _ pt2 asDateAndTimeForTimeZone: z2. dt3 _ pt3 asDateAndTimeForTimeZone: z3. self assert: dt1 = '2004-11-23T12:00:00-05:00' asDateAndTime. self assert: dt2 = '2004-11-23T12:00:00-06:00' asDateAndTime. self assert: dt3 = '2004-11-23T12:00:00-08:00' asDateAndTime. date _ '23 Aug, 2004' asDate. "Daylight savings time is in effect" time _ '12:00' asTime. z1 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'. z2 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Chicago'. z3 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Los_Angeles'. pt1 _ PointInTime date: date time: time timeZone: z1. pt2 _ PointInTime date: date time: time timeZone: z2. pt3 _ PointInTime date: date time: time timeZone: z3. dt1 _ pt1 asDateAndTimeForTimeZone: z1. dt2 _ pt2 asDateAndTimeForTimeZone: z2. dt3 _ pt3 asDateAndTimeForTimeZone: z3. self assert: dt1 = '2004-08-23T12:00:00-04:00' asDateAndTime. self assert: dt2 = '2004-08-23T12:00:00-05:00' asDateAndTime. self assert: dt3 = '2004-08-23T12:00:00-07:00' asDateAndTime. ! ! !TimeTransformTest methodsFor: 'testing-Date and Time array' stamp: 'dtl 8/5/2008 22:16'! testTransformADateAndATimeFromTimeZone "(self new setTestSelector: #testTransformADateAndATimeFromTimeZone) debug" | date time z1 z2 z3 a | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. date _ '23 Nov, 2004' asDate. time _ '12:00' asTime. z1 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'. z2 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Chicago'. z3 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Los_Angeles'. a _ z1 transformFromTimeZone: z2 date: date time: time. self assert: a first = date. self assert: (a second asSeconds - time asSeconds) = 3600. a _ z1 transformFromTimeZone: z3 date: date time: time. self assert: a first = date. self assert: (a second asSeconds - time asSeconds) = (3 * 3600). a _ z2 transformFromTimeZone: z3 date: date time: time. self assert: a first = date. self assert: (a second asSeconds - time asSeconds) = (2 * 3600). ! ! !TimeTransformTest methodsFor: 'testing-Date and Time array' stamp: 'dtl 8/5/2008 22:16'! testTransformADateAndATimeToTimeZone "(self new setTestSelector: #testTransformADateAndATimeToTimeZone) debug" | date time z1 z2 z3 a | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. date _ '23 Nov, 2004' asDate. time _ '12:00' asTime. z1 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'. z2 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Chicago'. z3 _ TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Los_Angeles'. a _ z1 transformDate: date time: time toTimeZone: z2. self assert: a first = date. self assert: (time asSeconds - a second asSeconds) = 3600. a _ z1 transformDate: date time: time toTimeZone: z3. self assert: a first = date. self assert: (time asSeconds - a second asSeconds) = (3 * 3600). a _ z2 transformDate: date time: time toTimeZone: z3. self assert: a first = date. self assert: (time asSeconds - a second asSeconds) = (2 * 3600). ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:20'! testDateAndTimeAtDstTransition "Check DateAndTime at the first second of the Fall 2004 DST period in right/America/Detroit. The first Smalltalk second count for the transition occurs two hours after midnight, at which time the wall clock is set back to 1:00am." "(self new setTestSelector: #testDateAndTimeAtDstTransition) debug" | dt localSecondCount pt | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. self setDstTransitionWatcherFall2004. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromSeconds: self localSmalltalkDstTransition. self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -5 * 60 * 60). self assert: dt printString = '2004-10-31T01:00:00-05:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." localSecondCount := self localSmalltalkDstTransition. dt := DateAndTime fromSeconds: localSecondCount. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: localSecondCount = (PointInTime fromSmalltalkSeconds: localSecondCount) asLocalSmalltalkSeconds] ifFalse: [self assert: dt offset = (Duration seconds: -5 * 60 * 60)]. self assert: (PointInTime fromSmalltalkSeconds: localSecondCount) asLocalSmalltalkSeconds = localSecondCount. self assert: dt asSeconds = localSecondCount ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:20'! testDateAndTimeAtDstTransitionNoLeapSeconds "Check DateAndTime at the first second of the Fall 2004 DST period in posix/America/Detroit. The first Smalltalk second count for the transition occurs two hours after midnight, at which time the wall clock is set back to 1:00am." "(self new setTestSelector: #testDateAndTimeAtDstTransitionNoLeapSeconds) debug" | dt localSecondCount pt | TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. localSecondCount := self localSmalltalkDstTransition. self setDstTransitionWatcherFall2004. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromSeconds: self localSmalltalkDstTransition. self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -5 * 60 * 60). self assert: dt printString = '2004-10-31T01:00:00-05:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." localSecondCount := self localSmalltalkDstTransition. dt := DateAndTime fromSeconds: localSecondCount. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: localSecondCount = (PointInTime fromSmalltalkSeconds: localSecondCount) asLocalSmalltalkSeconds] ifFalse: [self assert: dt offset = (Duration seconds: -5 * 60 * 60)]. self assert: (PointInTime fromSmalltalkSeconds: localSecondCount) asLocalSmalltalkSeconds = localSecondCount. self assert: dt asSeconds = localSecondCount ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:55'! testDateAndTimeConversion "Check DateAndTime at midnight before the Fall 2004 DST period in right/America/Detroit." "(self new setTestSelector: #testDateAndTimeConversion) debug" | midnight s dt1 dt2 | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. midnight := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds - (3600 * 2). s := midnight asLocalSmalltalkSeconds. dt1 := DateAndTime fromSeconds: s. dt2 := midnight asDateAndTime. self assert: dt1 seconds = dt2 seconds. self assert: dt1 minutes = dt2 minutes. self assert: dt1 hours = dt2 hours. self assert: dt1 day = dt2 day. self assert: dt1 julianDayNumber = dt2 julianDayNumber. self assert: dt1 month = dt2 month. self assert: dt1 year = dt2 year. self assert: dt1 nanoSecond = dt2 nanoSecond. self hasBrokenDateAndTimeConversion ifTrue: ["offset may be incorrect, DateAndTime does not understand DST transition"] ifFalse: [self assert: dt1 offset = dt2 offset. self assert: dt1 = dt2] ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:20'! testDateAndTimeImmediatelyAfter "Check DateAndTime for the first second after the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testDateAndTimeImmediatelyAfter) debug" | dt pt | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. self setDstTransitionWatcherFall2004. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromSeconds: self localSmalltalkDstTransition + 1. self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 1. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -5 * 60 * 60). self assert: dt printString = '2004-10-31T01:00:01-05:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." dt := DateAndTime fromSeconds: self localSmalltalkDstTransition + 1. self assert: dt seconds == 1. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -5 * 60 * 60)]. ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:20'! testDateAndTimeImmediatelyAfterNoLeapSeconds "Check DateAndTime for the first second after the Fall 2004 DST transition in America/Detroit." "(self new setTestSelector: #testDateAndTimeImmediatelyAfterNoLeapSeconds) debug" | dt pt | TimeZoneDatabase systemDatabase defaultLocation: 'America/Detroit'. self setDstTransitionWatcherFall2004. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromSeconds: self localSmalltalkDstTransition + 1. self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 1. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -5 * 60 * 60). self assert: dt printString = '2004-10-31T01:00:01-05:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." dt := DateAndTime fromSeconds: self localSmalltalkDstTransition + 1. self assert: dt seconds == 1. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -5 * 60 * 60)]. ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:21'! testDateAndTimeImmediatelyBefore "Check DateAndTime for the second immediately prior to the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testDateAndTimeImmediatelyBefore) debug" | dt pt | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. self setDstTransitionWatcherSpring2004. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromSeconds: self localSmalltalkDstTransition - 1. self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 59. self assert: dt minutes == 59. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -4 * 60 * 60). self assert: dt printString = '2004-10-31T01:59:59-04:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." dt := DateAndTime fromSeconds: self localSmalltalkDstTransition - 1. self assert: dt seconds == 59. self assert: dt minutes == 59. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -4 * 60 * 60)]. ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:21'! testDateAndTimeImmediatelyBeforeNoLeapSeconds "Check DateAndTime for the second immediately prior to the Fall 2004 DST transition in posix/America/Detroit." "(self new setTestSelector: #testDateAndTimeImmediatelyBeforeNoLeapSeconds) debug" | dt pt | TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. self setDstTransitionWatcherSpring2004. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromSeconds: self localSmalltalkDstTransition - 1. self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 59. self assert: dt minutes == 59. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -4 * 60 * 60). self assert: dt printString = '2004-10-31T01:59:59-04:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." dt := DateAndTime fromSeconds: self localSmalltalkDstTransition - 1. self assert: dt seconds == 59. self assert: dt minutes == 59. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -4 * 60 * 60)]. ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 8/5/2008 22:11'! testDateAndTimeNowSeconds "(self new setTestSelector: #testDateAndTimeNowSeconds) debug" "This test will FAIL if the TimePlugin is being used. TimePlugin reports the operating system view of Posix seconds, while TimeZoneDatsbase calculates Posix seconds from local seconds using the time zone offset." | clockSeconds dt dtSeconds | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. clockSeconds := Time totalSeconds. dt := DateAndTime now. dtSeconds := dt asSeconds. self assert: (clockSeconds - dtSeconds) abs < 1. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. clockSeconds := Time totalSeconds. dt := DateAndTime now. dtSeconds := dt asSeconds. self assert: (clockSeconds - dtSeconds) abs < 1! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:21'! testDateAndTimeOffsetDuration "(self new setTestSelector: #testDateAndTimeOffsetDuration) debug" | tt pt local utc offsetSeconds tzOffsetSeconds | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. self setDstTransitionWatcherFall2004. tt := self localSmalltalkDstTransition. pt := PointInTime fromSeconds: tt. local := pt asDateAndTime. utc := local asUTC. offsetSeconds := local offset asSeconds - utc offset asSeconds. tzOffsetSeconds := LocalTimeTransform here localOffsetSecondsAt: (PointInTime fromSmalltalkSeconds: tt). self assert: offsetSeconds = tzOffsetSeconds. local := DateAndTime fromSeconds: tt. utc := local asUTC. offsetSeconds := local offset asSeconds - utc offset asSeconds. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" offsetSeconds := local offset asSeconds - utc offset asSeconds] ifFalse: [self assert: offsetSeconds = tzOffsetSeconds]. ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:21'! testDateAndTimeOneDayAfter "Check DateAndTime for 24 hours after the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testDateAndTimeOneDayAfter) debug" | oneDay dt pt s | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. oneDay := 3600 * 24. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromAbsoluteSeconds: (dstTransitionAbsoluteSeconds + oneDay). self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 11. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453311. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -5 * 60 * 60). self assert: dt printString = '2004-11-01T01:00:00-05:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." s := pt asLocalSmalltalkSeconds. dt := DateAndTime fromSeconds: s. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 11. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453311. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -5 * 60 * 60)]. ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:21'! testDateAndTimeOneDayBefore "Check DateAndTime for 24 hours prior to the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testDateAndTimeOneDayBefore) debug" | oneDay dt pt s | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. oneDay := 3600 * 24. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromAbsoluteSeconds: (dstTransitionAbsoluteSeconds - oneDay). self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 2. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453309. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -4 * 60 * 60). self assert: dt printString = '2004-10-30T02:00:00-04:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." s := pt asLocalSmalltalkSeconds. dt := DateAndTime fromSeconds: s. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 2. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453309. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -4 * 60 * 60)]. ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:21'! testDateAndTimeOneHalfHourAfter "Check DateAndTime for one half hour after the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testDateAndTimeOneHalfHourAfter) debug" | dt pt s | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. self setDstTransitionWatcherFall2004. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + 1800. self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 0. self assert: dt minutes == 30. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -5 * 60 * 60). self assert: dt printString = '2004-10-31T01:30:00-05:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." s := pt asLocalSmalltalkSeconds. dt := DateAndTime fromSeconds: s. self assert: dt seconds == 0. self assert: dt minutes == 30. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -5 * 60 * 60)] ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:21'! testDateAndTimeOneHourAfter "Check DateAndTime for one hour after the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testDateAndTimeOneHourAfter) debug" | dt pt s | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. self setDstTransitionWatcherFall2004. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + 3600. self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 2. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -5 * 60 * 60). self assert: dt printString = '2004-10-31T02:00:00-05:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." pt := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + 3600. s := pt asLocalSmalltalkSeconds. dt := DateAndTime fromSeconds: s. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 2. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -5 * 60 * 60)] ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:21'! testDateAndTimeOneHourBefore "Check DateAndTime for one hour prior to the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testDateAndTimeOneHourBefore) debug" | dt pt s | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. self setDstTransitionWatcherSpring2004. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds - 3600. self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -4 * 60 * 60). self assert: dt printString = '2004-10-31T01:00:00-04:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." pt := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds - 3600. s := pt asLocalSmalltalkSeconds. dt := DateAndTime fromSeconds: s. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 1. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -4 * 60 * 60)] ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:21'! testDateAndTimeThreeHoursAfter "Check DateAndTime at three hours after the Fall 2004 DST period in right/America/Detroit." "(self new setTestSelector: #testDateAndTimeThreeHoursAfter) debug" | dt pt s | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + (3600 * 3). self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 4. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -5 * 60 * 60). self assert: dt printString = '2004-10-31T04:00:00-05:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." pt := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + (3600 * 3). s := pt asLocalSmalltalkSeconds. dt := DateAndTime fromSeconds: s. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 4. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -5 * 60 * 60)] ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:21'! testDateAndTimeTwoHoursAfter "Check DateAndTime at two hours after the Fall 2004 DST period in right/America/Detroit." "(self new setTestSelector: #testDateAndTimeTwoHoursAfter) debug" | dt pt s | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + (3600 * 2). self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 3. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -5 * 60 * 60). self assert: dt printString = '2004-10-31T03:00:00-05:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." pt := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + (3600 * 2). s := pt asLocalSmalltalkSeconds. dt := DateAndTime fromSeconds: s. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 3. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -5 * 60 * 60)] ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:21'! testDateAndTimeTwoHoursBefore "Check DateAndTime at midnight before the Fall 2004 DST period in right/America/Detroit." "(self new setTestSelector: #testDateAndTimeTwoHoursBefore) debug" | dt midnight s pt | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. "Convert directly from a PointInTime. Expect offset to be correct." pt := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds - (3600 * 2). self assert: pt = pt asDateAndTime asPointInTime. dt := pt asDateAndTime. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 0. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self assert: dt offset = (Duration seconds: -4 * 60 * 60). self assert: dt printString = '2004-10-31T00:00:00-04:00'. "Instantiate indirectly using local Smalltalk seconds. Offset may be incorrect." midnight := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds - (3600 * 2). s := midnight asLocalSmalltalkSeconds. dt := DateAndTime fromSeconds: s. self assert: dt seconds == 0. self assert: dt minutes == 0. self assert: dt hours == 0. self assert: dt month == 10. self assert: dt year == 2004. self assert: dt julianDayNumber = 2453310. self assert: dt nanoSecond == 0. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: dt offset = DateAndTime now offset] ifFalse: [self assert: dt offset = (Duration seconds: -4 * 60 * 60)] ! ! !TimeTransformTest methodsFor: 'testing-DateAndTime' stamp: 'dtl 6/14/2009 19:22'! testDateFromYearMonthDay "Check DateAndTime creation in different DST periods." "(self new setTestSelector: #testDateFromYearMonthDay) debug" | dt1 dt2 | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. dt1 := DateAndTime year: 2004 month: 'Nov' day: 9. self assert: dt1 year = 2004. self assert: dt1 month = 11. self assert: dt1 dayOfMonth = 9. self assert: dt1 hour = 0. self assert: dt1 minute = 0. self assert: dt1 second = 0. self hasBrokenDateAndTimeConversion ifTrue: ["Squeak DateAndTime just uses current offset (this is incorrect)" self assert: dt1 offset asSeconds = DateAndTime now offset asSeconds] ifFalse: ["This is how it should work" self assert: dt1 offset asSeconds = (3600 * -5)]. dt2 := DateAndTime year: 2004 month: 'Aug' day: 9. self assert: dt2 year = 2004. self assert: dt2 month = 8. self assert: dt2 dayOfMonth = 9. self assert: dt2 hour = 0. self assert: dt2 minute = 0. self assert: dt2 second = 0. self hasBrokenDateAndTimeConversion ifTrue: ["Squeak DateAndTime just uses current offset (this is incorrect)" self assert: dt2 offset asSeconds = DateAndTime now offset asSeconds] ifFalse: ["This is how it should work" self assert: dt2 offset asSeconds = (3600 * -4)] ! ! !TimeTransformTest methodsFor: 'testing-Date' stamp: 'dtl 8/5/2008 22:12'! testDateAtDstTransition "Check Date at a DST transition in right/America/Detroit." "(self new setTestSelector: #testDateAtDstTransition) debug" | dt | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. dt := Date fromSeconds: self localSmalltalkDstTransition. self assert: dt yyyymmdd = '2004-10-31'! ! !TimeTransformTest methodsFor: 'testing-Date' stamp: 'dtl 10/23/2004 22:51'! testDateAtDstTransitionNoLeapSeconds "Check Date at a DST transition in posix/America/Detroit." "(self new setTestSelector: #testDateAtDstTransitionNoLeapSeconds) debug" | dt | TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. dt := Date fromSeconds: self localSmalltalkDstTransition. self assert: dt yyyymmdd = '2004-10-31'! ! !TimeTransformTest methodsFor: 'testing-Date' stamp: 'dtl 8/5/2008 22:12'! testDateFirstSecondOfDayOfDstTransition "Check Date at the first second of the day on which a DST transition occurs in right/America/Detroit." "(self new setTestSelector: #testDateFirstSecondOfDayOfDstTransition) debug" | dt s | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. self setDstTransitionWatcherSpring2004. s := self localSmalltalkDstTransition - (2 * 3600). dt := Date fromSeconds: s. self assert: dt yyyymmdd = '2004-10-31'! ! !TimeTransformTest methodsFor: 'testing-Date' stamp: 'dtl 11/23/2004 22:07'! testDateFirstSecondOfDayOfDstTransitionNoLeapSeconds "Check Date at the first second of the day on which a DST transition occurs in posix/America/Detroit." "(self new setTestSelector: #testDateFirstSecondOfDayOfDstTransitionNoLeapSeconds) debug" | dt s | TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. self setDstTransitionWatcherSpring2004. s := self localSmalltalkDstTransition - (2 * 3600). dt := Date fromSeconds: s. self assert: dt yyyymmdd = '2004-10-31'! ! !TimeTransformTest methodsFor: 'testing-Date' stamp: 'dtl 6/14/2009 19:22'! testDateInDstPeriods "Check the format of a Date posix/America/Detroit, before and after DST transition. The start times should show different UTC offsets before and after a DST transition. This is required for correct calculation of Date>>asSeconds." "(self new setTestSelector: #testDateInDstPeriods) debug" | d secondCount1 secondCount2 pt1 pt2 hourOffsetSmalltalkSeconds hourOffsetAbsoluteSeconds | self hasBrokenDateAndTimeConversion ifTrue: [self flag: #FIXME. "Date and DateAndTime broken for DST conversions" ^ self "bypass this test entirely until Date can be fixed"]. TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. d := Date fromString: '23 Nov, 2004'. self assert: d start asString = '2004-11-23T00:00:00-05:00'. self assert: d duration asSeconds = (3600 * 24). pt1 := d start asPointInTime. secondCount1 := d asSeconds. d := Date fromString: '23 Aug, 2004'. self assert: d start asString = '2004-08-23T00:00:00-04:00'. self assert: d duration asSeconds = (3600 * 24). pt2 := d start asPointInTime. secondCount2 := d asSeconds. hourOffsetSmalltalkSeconds := (secondCount2 - secondCount1) \\ (24 * 3600). self assert: hourOffsetSmalltalkSeconds = 0. hourOffsetAbsoluteSeconds := (pt1 asAbsoluteSeconds - pt2 asAbsoluteSeconds) \\ (24 * 3600). self assert: hourOffsetAbsoluteSeconds = 3600. d := Date fromString: '23 Nov, 2003'. self assert: d start asString = '2003-11-23T00:00:00-05:00'. self assert: d duration asSeconds = (3600 * 24). d := Date fromString: '23 Aug, 2003'. self assert: d start asString = '2003-08-23T00:00:00-04:00'. self assert: d duration asSeconds = (3600 * 24). ! ! !TimeTransformTest methodsFor: 'testing-Date' stamp: 'dtl 8/5/2008 22:13'! testDateLastSecondOfDayBeforeDstTransition "Check Date at the last second of the day before DST transition in right/America/Detroit." "(self new setTestSelector: #testDateLastSecondOfDayBeforeDstTransition) debug" | dt s | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. s := self localSmalltalkDstTransition - (2 * 3600) - 1. dt := Date fromSeconds: s. self assert: dt yyyymmdd = '2004-10-30'! ! !TimeTransformTest methodsFor: 'testing-Date' stamp: 'dtl 10/23/2004 22:54'! testDateLastSecondOfDayBeforeDstTransitionNoLeapSeconds "Check Date at the last second of the day before DST transition in posix/America/Detroit." "(self new setTestSelector: #testDateLastSecondOfDayBeforeDstTransitionNoLeapSeconds) debug" | dt s | TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. s := self localSmalltalkDstTransition - (2 * 3600) - 1. dt := Date fromSeconds: s. self assert: dt yyyymmdd = '2004-10-30'! ! !TimeTransformTest methodsFor: 'testing-TZ offset at DST transition' stamp: 'dtl 6/14/2009 19:22'! testDaylightSavingsTimeOffset "Test the offset during a time period when DST is effect" "(self new setTestSelector: #testDaylightSavingsTimeOffset) debug" | secs dt offset expectedOffset pt | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. secs := 3273571904. "A time during summer 2004" pt := PointInTime fromSeconds: secs. dt := pt asDateAndTime. self assert: ('2004-09-2*' match: dt printString). offset := dt offset. expectedOffset := Duration days: 0 hours: -4 minutes: 0 seconds: 00. self assert: offset = expectedOffset. dt := DateAndTime fromSeconds: secs. self assert: ('2004-09-2*' match: dt printString). offset := dt offset. self hasBrokenDateAndTimeConversion ifTrue: ["Offset possibly wrong, limitation of DateAndTime from local Smalltalk seconds" self assert: offset = DateAndTime now offset] ifFalse: [self assert: offset = expectedOffset] ! ! !TimeTransformTest methodsFor: 'testing-TZ offset at DST transition' stamp: 'dtl 8/5/2008 22:13'! testDaylightSavingsTimeOffsetAtTransitionTime "Test the offset at the exact second of the DST transition time" "(self new setTestSelector: #testDaylightSavingsTimeOffsetAtTransitionTime) debug" | pt offsetSeconds | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. pt := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds. offsetSeconds := LocalTimeTransform here localOffsetSecondsAt: pt. self assert: offsetSeconds = (-5 * 3600). self assert: pt asDateAndTime offset asSeconds = offsetSeconds ! ! !TimeTransformTest methodsFor: 'testing-TZ offset at DST transition' stamp: 'dtl 8/5/2008 22:13'! testDaylightSavingsTimeOffsetImmediatelyAfter "Test the offset during a time period when DST is no longer in effect" "(self new setTestSelector: #testDaylightSavingsTimeOffsetImmediatelyAfter) debug" | pt offsetSeconds | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. pt := PointInTime fromAbsoluteSeconds: (dstTransitionAbsoluteSeconds + 1). offsetSeconds := LocalTimeTransform here localOffsetSecondsAt: pt. self assert: offsetSeconds = (-5 * 3600). self assert: pt asDateAndTime offset asSeconds = offsetSeconds ! ! !TimeTransformTest methodsFor: 'testing-TZ offset at DST transition' stamp: 'dtl 8/5/2008 22:13'! testDaylightSavingsTimeOffsetImmediatelyBefore "Test the offset during a time period when DST is effect" "(self new setTestSelector: #testDaylightSavingsTimeOffsetImmediatelyBefore) debug" | pt offsetSeconds | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. pt := PointInTime fromAbsoluteSeconds: (dstTransitionAbsoluteSeconds - 1). offsetSeconds := LocalTimeTransform here localOffsetSecondsAt: pt. self assert: offsetSeconds = (-4 * 3600). self assert: pt asDateAndTime offset asSeconds = offsetSeconds ! ! !TimeTransformTest methodsFor: 'testing-TZ offset at DST transition' stamp: 'dtl 8/5/2008 22:13'! testDaylightSavingsTimeOffsetLongAfter "Test the offset during a time period when DST is no longer in effect" "(self new setTestSelector: #testDaylightSavingsTimeOffsetLongAfter) debug" | pt offsetSeconds | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. pt := PointInTime fromAbsoluteSeconds: (dstTransitionAbsoluteSeconds + (3600 * 24 * 7)). offsetSeconds := LocalTimeTransform here localOffsetSecondsAt: pt. self assert: offsetSeconds = (-5 * 3600). self assert: pt asDateAndTime offset asSeconds = offsetSeconds ! ! !TimeTransformTest methodsFor: 'testing-TZ offset at DST transition' stamp: 'dtl 8/5/2008 22:13'! testDaylightSavingsTimeOffsetLongBefore "Test the offset during a time period when DST is effect" "(self new setTestSelector: #testDaylightSavingsTimeOffsetLongBefore) debug" | pt offsetSeconds | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. pt := PointInTime fromAbsoluteSeconds: (dstTransitionAbsoluteSeconds - (3600 * 24 * 7)). offsetSeconds := LocalTimeTransform here localOffsetSecondsAt: pt. self assert: offsetSeconds = (-4 * 3600). self assert: pt asDateAndTime offset asSeconds = offsetSeconds ! ! !TimeTransformTest methodsFor: 'testing-Duration DST' stamp: 'dtl 8/5/2008 22:13'! testDurationAcrossDstTransition "Test DateAndTime>>- across a DST transition." "(self new setTestSelector: #testDurationAcrossDstTransition) debug" | ptMidnight ptAfterDstTransition dtMidnight dtAfterDstTransition duration secondsDifference durationSeconds | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. ptMidnight := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds - (3600 * 2). ptAfterDstTransition := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + (3600 * 6). secondsDifference := ptAfterDstTransition asAbsoluteSeconds - ptMidnight asAbsoluteSeconds. self assert: secondsDifference = (3600 * 8). dtMidnight := ptMidnight asDateAndTime. dtAfterDstTransition := ptAfterDstTransition asDateAndTime. self assert: (dtAfterDstTransition asPointInTime asPosixSeconds - dtMidnight asPointInTime asPosixSeconds) = (3600 * 8). duration := dtAfterDstTransition - dtMidnight. durationSeconds := duration asSeconds. self assert: durationSeconds = secondsDifference. ! ! !TimeTransformTest methodsFor: 'testing-Duration DST' stamp: 'dtl 8/5/2008 22:15'! testSecondsCountAcrossDstTransition "(self new setTestSelector: #testSecondsCountAcrossDstTransition) debug" | ptMidnight ptAfterDstTransition secondsDifference localSecsMidnight localSecsAfterDstTransition | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. ptMidnight := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds - (3600 * 2). ptAfterDstTransition := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + (3600 * 6). secondsDifference := ptAfterDstTransition asAbsoluteSeconds - ptMidnight asAbsoluteSeconds. self assert: secondsDifference = (3600 * 8). localSecsMidnight := ptMidnight asLocalSmalltalkSeconds. localSecsAfterDstTransition := ptAfterDstTransition asLocalSmalltalkSeconds. self assert: (localSecsAfterDstTransition - localSecsMidnight) = (secondsDifference - 3600). ! ! !TimeTransformTest methodsFor: 'testing-Duration DST' stamp: 'dtl 11/2/2004 13:54'! testSecondsCountAcrossDstTransitionNoLeapSeconds "(self new setTestSelector: #testSecondsCountAcrossDstTransitionNoLeapSeconds) debug" | ptMidnight ptAfterDstTransition secondsDifference localSecsMidnight localSecsAfterDstTransition | TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. ptMidnight := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds - (3600 * 2). ptAfterDstTransition := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds + (3600 * 6). secondsDifference := ptAfterDstTransition asAbsoluteSeconds - ptMidnight asAbsoluteSeconds. self assert: secondsDifference = (3600 * 8). localSecsMidnight := ptMidnight asLocalSmalltalkSeconds. localSecsAfterDstTransition := ptAfterDstTransition asLocalSmalltalkSeconds. self assert: (localSecsAfterDstTransition - localSecsMidnight) = (secondsDifference - 3600). ! ! !TimeTransformTest methodsFor: 'testing-Duration' stamp: 'dtl 11/2/2004 15:46'! testDurationForSamePointInTimeIsZero "The same PointInTime expressed as DateInTime for two different time zones should have a Duration difference of zero." "(self new setTestSelector: #testDurationForSamePointInTimeIsZero) debug" | aPointInTime est mdt estDateAndTime mdtDateAndTime duration | aPointInTime := PointInTime fromAbsoluteSeconds: 1100000000. est := TimeZoneDatabase systemDatabase timeZoneFor: 'posix/America/Detroit'. mdt := TimeZoneDatabase systemDatabase timeZoneFor: 'posix/America/Phoenix'. estDateAndTime := aPointInTime asDateAndTimeForTimeZone: est. mdtDateAndTime := aPointInTime asDateAndTimeForTimeZone: mdt. self assert: (estDateAndTime asPointInTime asAbsoluteSeconds = mdtDateAndTime asPointInTime asAbsoluteSeconds). duration := mdtDateAndTime - estDateAndTime. self assert: duration asSeconds = 0. ! ! !TimeTransformTest methodsFor: 'testing-Duration' stamp: 'dtl 8/5/2008 22:14'! testDurationWithNoTransition "Just a normal duration, no DST or leap seconds to worry about. This tests the DateAndTime>>- method." "(self new setTestSelector: #testDurationWithNoTransition) debug" | ptMidnight ptAfterDstTransition dtMidnight dtAfterDstTransition duration secondsDifference durationSeconds anArbitrarySecondsCount | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. anArbitrarySecondsCount := 1100000000. ptMidnight := PointInTime fromAbsoluteSeconds: anArbitrarySecondsCount - 1. ptAfterDstTransition := PointInTime fromAbsoluteSeconds: anArbitrarySecondsCount + 1. secondsDifference := ptAfterDstTransition asAbsoluteSeconds - ptMidnight asAbsoluteSeconds. self assert: secondsDifference = 2. dtMidnight := ptMidnight asDateAndTime. dtAfterDstTransition := ptAfterDstTransition asDateAndTime. duration := dtAfterDstTransition - dtMidnight. durationSeconds := duration asSeconds. self assert: durationSeconds = secondsDifference. ! ! !TimeTransformTest methodsFor: 'testing-Duration' stamp: 'dtl 11/6/2004 19:37'! testTwoDateAndTimesTheSame "(self new setTestSelector: #testTwoDateAndTimesTheSame) debug" | dtOne dtTwo duration ptOne ptTwo | "At the same real time, the wall clock shows one hour less as we move westward by one hour of Earth angle." dtOne := '2004-11-27T22:00:00-04:00' asDateAndTime. dtTwo := '2004-11-27T21:00:00-05:00' asDateAndTime. duration := dtTwo - dtOne. self assert: duration asSeconds = 0. "Verify that they are the same point in time." ptOne := dtOne asPointInTime. ptTwo := dtTwo asPointInTime. self assert: ptOne asAbsoluteSeconds = ptTwo asAbsoluteSeconds ! ! !TimeTransformTest methodsFor: 'testing-Duration' stamp: 'dtl 11/6/2004 22:33'! testTwoDateAndTimesWithDifferentOffset "Two DateAndTimes with the same wall clock display, but with different time zone offsets. The one with the larger offset corresponds to a more westerly location on the planet, and thus represents a PointInTime of greater magnitude." "(self new setTestSelector: #testTwoDateAndTimesWithDifferentOffset) debug" | dtOne dtTwo duration ptOne ptTwo | "dtTwo is the same wall clock time, but one hour to the west, hence is a time that occurs one hour later than dtOne." dtOne := '2004-11-27T22:00:00-04:00' asDateAndTime. dtTwo := '2004-11-27T22:00:00-05:00' asDateAndTime. ptOne := dtOne asPointInTime. ptTwo := dtTwo asPointInTime. self assert: (ptTwo asAbsoluteSeconds - ptOne asAbsoluteSeconds) = 3600. duration := dtTwo - dtOne. self assert: duration asSeconds = 3600. ! ! !TimeTransformTest methodsFor: 'testing-misc' stamp: 'dtl 8/5/2008 22:14'! testLocalDetroitEpoch "Check DateAndTime for the beginning of the Posix epoch expressed as time in the local time zone (see #setUp)." | p | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. p := (PointInTime fromPosixSeconds: 0) asDateAndTime. self assert: p julianDayNumber = 2440587. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -5 * 60 * 60). self assert: p year = 1969. self assert: p month = 12. self assert: p hour = 19. self assert: p minute = 0. self assert: p second = 0 ! ! !TimeTransformTest methodsFor: 'testing-misc' stamp: 'dtl 10/11/2004 22:33'! testPosixEpoch "Check DateAndTime for the beginning of the Posix epoch expressed as UTC." | p | p := (PointInTime fromPosixSeconds: 0) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'UTC'). self assert: p seconds == 0. self assert: p julianDayNumber = 2440588. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: 0) ! ! !TimeTransformTest methodsFor: 'testing-misc' stamp: 'dtl 8/5/2008 22:16'! testTimeZoneTransitionSecond "This test just makes sure that the time zone tables contain the expected transition seconds. If the test fails, then either the tables do not contain the expected transition times, or there is something wrong with the offset lookup. Neither of these things should ever happen, so you'll have to figure it out on your own ;-)" "self new testTimeZoneTransitionSecond" "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. self assert: self absoluteDstTransition = 1099202422. TimeZoneDatabase systemDatabase defaultLocation: 'America/Detroit'. self assert: self posixDstTransition = 1099202400. TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. self assert: self absoluteDstTransition = 1099202400. TimeZoneDatabase systemDatabase defaultLocation: 'America/Detroit'. self assert: self posixDstTransition = 1099202400. ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 8/5/2008 22:14'! testOffsetAsUtc "Check the right/America/Detroit transition time expressed as UTC (where UTC does not account for leap seconds)." "(self new setTestSelector: #testOffsetAsUtc) debug" | p | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'UTC'). "transition time should be '31 October 2004 6:00:22 am UTC'" self assert: p printString = '2004-10-31T06:00:22+00:00'. self assert: p offset = (Duration seconds: 0). ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 8/5/2008 22:14'! testOffsetAsUtcWithLeapSeconds "Check the right/America/Detroit and posix/America/Detroit transition time expressed as UTC. The transition time should be '31 October 2004 6:00:00 UTC.'" "(self new setTestSelector: #testOffsetAsUtcWithLeapSeconds) debug" | p1 p2 dt | "Test with a leap second aware local time zone" "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. p1 := PointInTime fromPosixSeconds: dstTransitionPosixSeconds. dt := p1 asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'right/UTC'). self assert: dt printString = '2004-10-31T06:00:00+00:00'. self assert: dt offset = (Duration seconds: 0). dt := p1 asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'posix/UTC'). self assert: dt printString = '2004-10-31T06:00:22+00:00'. self assert: dt offset = (Duration seconds: 0). "Test with a local time zone that ignores leap seconds" TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. p2 := PointInTime fromPosixSeconds: dstTransitionPosixSeconds. self assert: (p1 absoluteTime - p2 absoluteTime) = 22. dt := p2 asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'posix/UTC'). self assert: dt printString = '2004-10-31T06:00:00+00:00'. self assert: dt offset = (Duration seconds: 0). dt := p2 asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'right/UTC'). self assert: dt printString = '2004-10-31T05:59:38+00:00'. self assert: dt offset = (Duration seconds: 0). ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 8/5/2008 22:14'! testPointInTimeAtDstTransition "Check DateAndTime at the first second of the Fall 2004 DST period in right/America/Detroit." "(self new setTestSelector: #testPointInTimeAtDstTransition) debug" | p | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'). self assert: p seconds == 0. self assert: p minutes == 0. self assert: p hours == 1. self assert: p month == 10. self assert: p year == 2004. self assert: p julianDayNumber = 2453310. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -5 * 60 * 60). self assert: p printString = '2004-10-31T01:00:00-05:00' ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 11/6/2004 22:41'! testPointInTimeAtDstTransitionNoLeapSeconds "Check DateAndTime at the first second of the Fall 2004 DST period in America/Detroit." "(self new setTestSelector: #testPointInTimeAtDstTransitionNoLeapSeconds) debug" | p | TimeZoneDatabase systemDatabase defaultLocation: 'America/Detroit'. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit'). self assert: p seconds == 0. self assert: p minutes == 0. self assert: p hours == 1. self assert: p month == 10. self assert: p year == 2004. self assert: p julianDayNumber = 2453310. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -5 * 60 * 60). self assert: p printString = '2004-10-31T01:00:00-05:00' ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 8/5/2008 22:14'! testPointInTimeImmediatelyAfter "Check DateAndTime for the first second after the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testPointInTimeImmediatelyAfter) debug" | p | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds + 1) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'). self assert: p seconds == 1. self assert: p minutes == 0. self assert: p hours == 1. self assert: p month == 10. self assert: p year == 2004. self assert: p julianDayNumber = 2453310. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -5 * 60 * 60). self assert: p printString = '2004-10-31T01:00:01-05:00' ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 11/6/2004 22:41'! testPointInTimeImmediatelyAfterNoLeapSeconds "Check DateAndTime for the first second after the Fall 2004 DST transition in America/Detroit." "(self new setTestSelector: #testPointInTimeImmediatelyAfterNoLeapSeconds) debug" | p | TimeZoneDatabase systemDatabase defaultLocation: 'America/Detroit'. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds + 1) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit'). self assert: p seconds == 1. self assert: p minutes == 0. self assert: p hours == 1. self assert: p month == 10. self assert: p year == 2004. self assert: p julianDayNumber = 2453310. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -5 * 60 * 60). self assert: p printString = '2004-10-31T01:00:01-05:00' ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 8/5/2008 22:14'! testPointInTimeImmediatelyBefore "Check DateAndTime for the second immediately prior to the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testPointInTimeImmediatelyBefore) debug" | p | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds - 1) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'). self assert: p seconds == 59. self assert: p minutes == 59. self assert: p hours == 1. self assert: p month == 10. self assert: p year == 2004. self assert: p julianDayNumber = 2453310. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -4 * 60 * 60). self assert: p printString = '2004-10-31T01:59:59-04:00' ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 11/6/2004 22:42'! testPointInTimeImmediatelyBeforeNoLeapSeconds "Check DateAndTime for the second immediately prior to the Fall 2004 DST transition in America/Detroit." "(self new setTestSelector: #testPointInTimeImmediatelyBeforeNoLeapSeconds) debug" | p | TimeZoneDatabase systemDatabase defaultLocation: 'America/Detroit'. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds - 1) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit'). self assert: p seconds == 59. self assert: p minutes == 59. self assert: p hours == 1. self assert: p month == 10. self assert: p year == 2004. self assert: p julianDayNumber = 2453310. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -4 * 60 * 60). self assert: p printString = '2004-10-31T01:59:59-04:00' ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 8/5/2008 22:14'! testPointInTimeOneDayAfter "Check DateAndTime for 24 hours after the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testPointInTimeOneDayAfter) debug" | p oneDay | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. oneDay := 3600 * 24. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds + oneDay) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'). self assert: p seconds == 0. self assert: p minutes == 0. self assert: p hours == 1. self assert: p month == 11. self assert: p year == 2004. self assert: p julianDayNumber = 2453311. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -5 * 60 * 60). self assert: p printString = '2004-11-01T01:00:00-05:00' ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 8/5/2008 22:14'! testPointInTimeOneDayBefore "Check DateAndTime for 24 hours prior to the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testPointInTimeOneDayBefore) debug" | p oneDay | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. oneDay := 3600 * 24. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds - oneDay) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'). self assert: p seconds == 0. self assert: p minutes == 0. self assert: p hours == 2. self assert: p month == 10. self assert: p year == 2004. self assert: p julianDayNumber = 2453309. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -4 * 60 * 60). self assert: p printString = '2004-10-30T02:00:00-04:00' ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 8/5/2008 22:14'! testPointInTimeOneHalfHourAfter "Check DateAndTime for one half hour after the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testPointInTimeOneHalfHourAfter) debug" | p | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds + 1800) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'). self assert: p seconds == 0. self assert: p minutes == 30. self assert: p hours == 1. self assert: p month == 10. self assert: p year == 2004. self assert: p julianDayNumber = 2453310. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -5 * 60 * 60). self assert: p printString = '2004-10-31T01:30:00-05:00' ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 8/5/2008 22:14'! testPointInTimeOneHourAfter "Check DateAndTime for one hour after the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testPointInTimeOneHourAfter) debug" | p | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds + 3600) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'). self assert: p seconds == 0. self assert: p minutes == 0. self assert: p hours == 2. self assert: p month == 10. self assert: p year == 2004. self assert: p julianDayNumber = 2453310. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -5 * 60 * 60). self assert: p printString = '2004-10-31T02:00:00-05:00' ! ! !TimeTransformTest methodsFor: 'testing-PointInTime TZ offset' stamp: 'dtl 8/5/2008 22:15'! testPointInTimeOneHourBefore "Check DateAndTime for one hour prior to the Fall 2004 DST transition in right/America/Detroit." "(self new setTestSelector: #testPointInTimeOneHourBefore) debug" | p | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. p := (PointInTime fromPosixSeconds: dstTransitionPosixSeconds - 3600) asDateAndTimeForTimeZone: (TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit'). self assert: p seconds == 0. self assert: p minutes == 0. self assert: p hours == 1. self assert: p month == 10. self assert: p year == 2004. self assert: p julianDayNumber = 2453310. self assert: p nanoSecond == 0. self assert: p offset = (Duration seconds: -4 * 60 * 60). self assert: p printString = '2004-10-31T01:00:00-04:00' ! ! !TimeTransformTest methodsFor: 'testing-Posix seconds' stamp: 'dtl 10/23/2004 13:31'! testPointInTimePosixOffset "Verify difference in seconds between Posix epoch and Smalltalk epoch GMT." | tp ts diff | tp := PointInTime fromPosixSeconds: 0. ts := PointInTime fromUtcSmalltalkSeconds: 0. self assert: PointInTime posixOffset = self posixOffset. diff := tp asInteger - ts asInteger. self assert: self posixOffset = diff ! ! !TimeTransformTest methodsFor: 'testing-Posix seconds' stamp: 'dtl 8/5/2008 22:15'! testPosixSecondsVersusAtomicSeconds "Test elapsed atomic clock seconds versus elapsed Posix seconds." "(self new setTestSelector: #testPosixSecondsVersusAtomicSeconds) debug" | absoluteSeconds posixSeconds pt1 pt2 diff | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. absoluteSeconds := 1099202422. "Atomic clock seconds since January 1, 1970 UTC" posixSeconds := 1099202400. "Posix clock seconds since January 1, 1970 UTC" pt1 := PointInTime fromAbsoluteSeconds: absoluteSeconds. pt2 := PointInTime fromPosixSeconds: posixSeconds. diff := pt1 - pt2. self assert: diff abs < 1. self assert: pt1 asAbsoluteSeconds = absoluteSeconds. self assert: pt2 asPosixSeconds = posixSeconds. absoluteSeconds := 0. "Atomic clock seconds at January 1, 1970 UTC" posixSeconds := 0. "Posix clock seconds at January 1, 1970 UTC" pt1 := PointInTime fromAbsoluteSeconds: absoluteSeconds. pt2 := PointInTime fromPosixSeconds: posixSeconds. diff := pt1 - pt2. self assert: diff abs < 1. self assert: pt1 asAbsoluteSeconds = absoluteSeconds. self assert: pt2 asPosixSeconds = posixSeconds. ! ! !TimeTransformTest methodsFor: 'testing-Posix seconds' stamp: 'dtl 8/5/2008 22:15'! testPosixToPointInTimeConversion "Posix seconds should differ from PointInTime seconds by the number of leap seconds since the Posix epoch." "(self new setTestSelector: #testPosixToPointInTimeConversion) debug" | ptFromPosix ptFromAbsolute ptSec | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. ptFromPosix := PointInTime fromPosixSeconds: dstTransitionPosixSeconds - (2 * 3600). "midnight" ptFromAbsolute := PointInTime fromAbsoluteSeconds: dstTransitionAbsoluteSeconds - (2 * 3600). "midnight" self assert: ptFromPosix = ptFromAbsolute. ptSec := ptFromAbsolute absoluteTime. self assert: 2 * 3600 + ptSec = dstTransitionAbsoluteSeconds ! ! !TimeTransformTest methodsFor: 'testing-Posix seconds' stamp: 'dtl 10/23/2004 14:41'! testPosixToPointInTimeConversionNoLeapSeconds "Posix seconds should differ from PointInTime seconds by the number of leap seconds since the Posix epoch, zero for a time zone with no leap second table." | pt ptSec | TimeZoneDatabase systemDatabase defaultLocation: 'America/Detroit'. pt := PointInTime fromPosixSeconds: dstTransitionPosixSeconds - (2 * 3600). "midnight" ptSec := pt absoluteTime. self assert: (dstTransitionPosixSeconds - ptSec) = (2 * 3600) ! ! !TimeTransformTest methodsFor: 'testing-time plugin' stamp: 'dtl 8/5/2008 22:15'! testPrimPosixTimeMicrosecondResolution "Make sure that local time is reported similarly with and without the plugin. The #assert: is only evaluated if the plugin is available, otherwise this test skips the #assert: passes." "This test will FAIL if the TimePlugin is being used. TimePlugin reports the operating system view of Posix seconds, while TimeZoneDatsbase calculates Posix seconds from local seconds using the time zone offset." "(self new setTestSelector: #testPrimPosixTimeMicrosecondResolution) debug" | primSeconds expectedSeconds | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. primSeconds := PointInTime primPosixTimeMicrosecondResolution. expectedSeconds := Time totalSeconds - PointInTime posixOffset - (LocalTimeTransform here localOffsetSecondsAt: Time totalSeconds). primSeconds ifNotNil: [self assert: (primSeconds - expectedSeconds) abs < 1]. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. primSeconds := PointInTime primPosixTimeMicrosecondResolution. expectedSeconds := Time totalSeconds - PointInTime posixOffset - (LocalTimeTransform here localOffsetSecondsAt: Time totalSeconds). primSeconds ifNotNil: [self assert: (primSeconds - expectedSeconds) abs < 1] ! ! !TimeTransformTest methodsFor: 'testing-time plugin' stamp: 'dtl 11/17/2004 19:52'! testPrimPosixTimeMicrosecondResolutionOffset "(self new setTestSelector: #testPrimPosixTimeMicrosecondResolutionOffset) debug" | primSecs offset smalltalkSeconds | primSecs := PointInTime primPosixTimeMicrosecondResolution. primSecs ifNotNil: [offset := PointInTime primPosixTimeAndLocalOffset second. smalltalkSeconds := Time totalSeconds. self assert: (primSecs - (smalltalkSeconds - PointInTime posixOffset + offset)) abs < 1] ! ! !TimeTransformTest methodsFor: 'testing-time plugin' stamp: 'dtl 8/5/2008 22:15'! testPrimSecondsClock "Compare the default Squeak clock prim seconds to what is reported by the plugin." "(self new setTestSelector: #testPrimSecondsClock) debug" | primSecondsClock primPosixTime secondsFromPosixTime diff offset | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. primSecondsClock := self primSecondsClock. (primPosixTime := PointInTime primPosixTimeMicrosecondResolution) ifNotNil: [secondsFromPosixTime := primPosixTime + PointInTime posixOffset. offset := self primPosixTimeAndLocalOffset last. diff := secondsFromPosixTime - primSecondsClock - offset. self assert: diff abs < 1] ! ! !TimeTransformTest methodsFor: 'testing-time plugin' stamp: 'dtl 8/5/2008 22:15'! testPrimVersusApproximateTimeNow "Compare the default Squeak clock prim seconds to what is reported by the plugin." "This test will FAIL if the TimePlugin is being used. TimePlugin reports the operating system view of Posix seconds, while TimeZoneDatsbase calculates Posix seconds from local seconds using the time zone offset." "(self new setTestSelector: #testPrimVersusApproximateTimeNow) debug" | approxTime primPosixTime diff | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. approxTime := Time totalSeconds - PointInTime posixOffset - (LocalTimeTransform here localOffsetSecondsAt: Time totalSeconds). (primPosixTime := PointInTime primPosixTimeMicrosecondResolution) ifNotNil: [diff := primPosixTime - approxTime. self assert: diff abs < 1]. TimeZoneDatabase systemDatabase defaultLocation: 'posix/America/Detroit'. approxTime := Time totalSeconds - PointInTime posixOffset - (LocalTimeTransform here localOffsetSecondsAt: Time totalSeconds). (primPosixTime := PointInTime primPosixTimeMicrosecondResolution) ifNotNil: [diff := primPosixTime - approxTime. self assert: diff abs < 1]. TimeZoneDatabase systemDatabase defaultLocation: 'UTC'. approxTime := Time totalSeconds - PointInTime posixOffset - (LocalTimeTransform here localOffsetSecondsAt: Time totalSeconds). (primPosixTime := PointInTime primPosixTimeMicrosecondResolution) ifNotNil: [diff := primPosixTime - approxTime. self assert: diff abs < 1] ! ! !TimeTransformTest methodsFor: 'testing-Duration leap seconds' stamp: 'dtl 8/5/2008 22:15'! testSecondsCountAcrossLeapSecondTransition "PointInTime seconds are atomic clock seconds. Posix seconds and Smalltalk seconds are both rotational seconds. Leap seconds are added so that rotational seconds counting stays aligned with the rotation of the Earth." "(self new setTestSelector: #testSecondsCountAcrossLeapSecondTransition) debug" | ptBefore ptAfter secondsDifference localSecsBefore localSecsAfter aLeapSecondTransitionTime posixSecsBefore posixSecsAfter | "Ensure that zoneinfo tables with leap seconds have been loaded" self assert: (TimeZoneDatabase systemDatabase timeZoneNames includes: #'right/America/Detroit'). TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit'. aLeapSecondTransitionTime := 915148821. "From the leap second table in right/America/Detroit" "Set up an absolute time duration of two seconds, spanning the leap second transition" ptBefore := PointInTime fromAbsoluteSeconds: aLeapSecondTransitionTime - 1. ptAfter := PointInTime fromAbsoluteSeconds: aLeapSecondTransitionTime + 1. secondsDifference := ptAfter asAbsoluteSeconds - ptBefore asAbsoluteSeconds. self assert: secondsDifference = 2. "Local seconds should count two absolute seconds as the same local second" localSecsBefore := ptBefore asLocalSmalltalkSeconds. localSecsAfter := ptAfter asLocalSmalltalkSeconds. self assert: (localSecsAfter - localSecsBefore) = 1. "Posix seconds also count two absolute seconds as the same Posix second" posixSecsBefore := ptBefore asPosixSeconds. posixSecsAfter := ptAfter asPosixSeconds. self assert: (posixSecsAfter - posixSecsBefore) = 1. ! ! !TimeZone methodsFor: '*time-TimeZones' stamp: 'dtl 11/13/2004 12:18'! dstTransitionTimes ^ #()! ! !TimeZone methodsFor: '*time-TimeZones' stamp: 'dtl 11/8/2004 21:23'! leapSecondsAt: aPointInTime "Ignore leap seconds" ^ 0 ! ! !TimeZone methodsFor: '*time-TimeZones' stamp: 'dtl 11/12/2004 10:31'! localOffsetSecondsAt: aPointInTime ^ self offset asSeconds! ! !TimeZone class methodsFor: '*time-TimeZones' stamp: 'dtl 8/21/2007 23:14'! setLocal: tzName "Set the local time zone to a time zone identified by tzName. To identify suitable time zone names for e.g. Detriot, search the database using: TimeZoneDatabase systemDatabase grepFor: 'Detroit'" "TimeZone setLocal: 'CET'" "TimeZone setLocal: 'EST'" "TimeZone setLocal: 'America/Detroit'" "TimeZone setLocal: 'no such name'" (TimeZoneDatabase systemDatabase timeZoneFor: tzName) ifNil: [self notify: '''', tzName asString, ''' not found in TimeZoneDatabase class>>systemDatabase'] ifNotNil: [TimeZoneProxy setDynamicTransform: tzName]. ^ TimeZoneDatabase systemDatabase timeZoneFor: tzName ! ! !TimeZoneDatabase methodsFor: 'time zone proxy' stamp: 'dtl 11/14/2004 13:13'! abbreviation "Answer one of possibly several abbreviations for the current time zone setting" | abbreviations | abbreviations := self tzNameAbbreviations. ^ abbreviations isEmpty ifTrue: [] ifFalse: [abbreviations anyOne asString] ! ! !TimeZoneDatabase methodsFor: 'time zone proxy' stamp: 'dtl 11/13/2004 15:06'! dstTransitionTimes ^ self defaultTimeZone isNil ifTrue: [#()] ifFalse: [defaultTimeZone dstTransitionTimes]! ! !TimeZoneDatabase methodsFor: 'time zone proxy' stamp: 'dtl 11/13/2004 22:43'! name "The name of the active time zone, when the database is used as a TimeZone." ^ (self defaultLocation ifNil: [super name]) asString! ! !TimeZoneDatabase methodsFor: 'time zone proxy' stamp: 'dtl 11/13/2004 22:45'! offset ^ Duration seconds: (self localOffsetSecondsAt: PointInTime now)! ! !TimeZoneDatabase methodsFor: 'private' stamp: 'dtl 1/3/2000 23:18'! addZone: aTimeZoneRuleSet toHierarchy: dict withKeys: keys "Store aTimeZoneRule in the dictionary hierarchy." | car cdr | car := (keys at: 1) asSymbol. (keys size == 1) ifTrue: [dict at: car put: aTimeZoneRuleSet] ifFalse: [ cdr := keys copyFrom: 2 to: keys size. dict at: car ifAbsent: [dict at: car put: Dictionary new]. self addZone: aTimeZoneRuleSet toHierarchy: (dict at: car) withKeys: cdr]. ^ dict ! ! !TimeZoneDatabase methodsFor: 'private' stamp: 'dtl 12/28/1999 20:01'! addZonesTo: aCollection from: aDictionaryOfDictionaries "Recursively add all entries from aDictionaryOfDictionaries to aCollection." aDictionaryOfDictionaries do: [:e | (self isContainerNode: e) ifTrue: [self addZonesTo: aCollection from: e] ifFalse: [(self isTerminalLeaf: e) ifTrue: [aCollection add: e] ifFalse: [self notify: 'empty dictionary perhaps?']]] ! ! !TimeZoneDatabase methodsFor: 'private' stamp: 'dtl 12/28/1999 20:01'! isContainerNode: anObject "Answer true if this is the kind of object which stores other objects in the database." ^ anObject isKindOf: Dictionary! ! !TimeZoneDatabase methodsFor: 'private' stamp: 'dtl 12/30/1999 10:03'! isTerminalLeaf: anObject "Answer true if this is the kind of object which is stored as a leaf node in the database." ^ anObject isKindOf: LocalTimeTransform! ! !TimeZoneDatabase methodsFor: 'private' stamp: 'dtl 12/30/1999 18:57'! leapSecondsRuleFor: posixSeconds "Answer the leap second data record for a point in time (an Integer). Assuming that elements of leapSecondTable are sorted by transitionTime, this is the last such element for which the transition time is less than posixSeconds." | recordsBeforeThisTime | leapSecondRuleSet isNil ifTrue: [^ nil]. leapSecondRuleSet isEmpty ifTrue: [^ nil]. recordsBeforeThisTime := leapSecondRuleSet select: [:e | (e at: 1) < posixSeconds]. recordsBeforeThisTime isEmpty ifTrue: [^ nil] ifFalse: [^ recordsBeforeThisTime last]! ! !TimeZoneDatabase methodsFor: 'private' stamp: 'dtl 12/28/1999 20:01'! timeZoneIndexedBy: anArrayOfKeys inHierarchy: aDictionaryTree "Answer the time zone indexed by anArrayOfKeys, or nil if not found." | car cdr entry | car := (anArrayOfKeys at: 1) asSymbol. entry := aDictionaryTree at: car ifAbsent: [^ nil]. (anArrayOfKeys size == 1) ifTrue: [(self isTerminalLeaf: entry) ifTrue: [^ entry] ifFalse: [^ nil]] ifFalse: [(self isContainerNode: entry) ifFalse: [^ nil] ifTrue: [cdr := anArrayOfKeys copyFrom: 2 to: anArrayOfKeys size. ^ self timeZoneIndexedBy: cdr inHierarchy: entry]] ! ! !TimeZoneDatabase methodsFor: 'private' stamp: 'dtl 12/30/1999 18:51'! tokensFor: aString withSeparator: aCharacter "Answer an array of tokens from aString separated by aCharacter. Note: String>>findTokens is not used because some Smalltalks do not have it." "TimeZoneDatabase new tokensFor: 'right-America-Detroit' withSeparator: $- " | c s sep | c := OrderedCollection new. s := ReadStream on: aString. aCharacter isNil ifTrue: [sep := self indexSeparator] ifFalse: [sep := aCharacter]. [s atEnd] whileFalse: [ [s peek == sep] whileTrue: [s next]. c add: (s upTo: sep)]. ^ c asArray ! ! !TimeZoneDatabase methodsFor: 'querying' stamp: 'dtl 12/28/1999 20:01'! allTimeZones "Answer a collection of all time zones, independent of indexing." "TimeZoneDatabase systemDatabase allTimeZones" | c | c := OrderedCollection new. self addZonesTo: c from: self timeZones. ^ c asArray ! ! !TimeZoneDatabase methodsFor: 'querying' stamp: 'dtl 12/28/1999 20:01'! grepFor: aString "Convenience method to help find time zones for locations, especially if the name of the key city is known." "TimeZoneDatabase systemDatabase grepFor: 'Detroit' " "TimeZoneDatabase systemDatabase grepFor: 'etro' " "TimeZoneDatabase systemDatabase grepFor: 'London' " "TimeZoneDatabase systemDatabase grepFor: 'Perth' " "TimeZoneDatabase systemDatabase grepFor: 'Australia' " "TimeZoneDatabase systemDatabase grepFor: 'right/Australia' " "TimeZoneDatabase systemDatabase grepFor: 'right/Australia/Perth' " ^ self allTimeZones select: [:e | ('*', aString, '*') match: e timeZoneName] ! ! !TimeZoneDatabase methodsFor: 'querying' stamp: 'dtl 9/13/2004 11:36'! hoursFrom: name to: anotherTimeZoneName "Ask the database for the offset in hours between two time zones. The result may be an integer or a fraction." "TimeZoneDatabase systemDatabase hoursFrom: 'Europe/Amsterdam' to: 'America/Detroit'" "(TimeZoneDatabase systemDatabase hoursFrom: 'CET' to: 'Canada/Newfoundland') asFloat" ^ (self offsetFrom: name to: anotherTimeZoneName) / 3600 ! ! !TimeZoneDatabase methodsFor: 'querying' stamp: 'dtl 1/1/2000 14:36'! leapSecondsFor: name at: aPointInTime "Ask the database for the offset seconds for the indicated time zone and time." "TimeZoneDatabase systemDatabase leapSecondsFor: 'right/America/Detroit' at: PointInTime now" "TimeZoneDatabase systemDatabase leapSecondsFor: 'America/Detroit' at: 944798928" "TimeZoneDatabase systemDatabase leapSecondsFor: 'Europe/Amsterdam' at: PointInTime now" "TimeZoneDatabase systemDatabase leapSecondsFor: 'America/Nowhere' at: PointInTime now" | tz | tz := (self timeZoneFor: name). tz isNil ifTrue: [^ nil]. ^ tz leapSecondsAt: aPointInTime! ! !TimeZoneDatabase methodsFor: 'querying' stamp: 'dtl 12/30/1999 18:58'! offsetFor: name at: aPointInTime "Ask the database for the offset seconds for the indicated time zone and time." "TimeZoneDatabase systemDatabase offsetFor: 'America/Detroit' at: 944798928" "TimeZoneDatabase systemDatabase offsetFor: 'Europe/Amsterdam' at: PointInTime now" "TimeZoneDatabase systemDatabase offsetFor: 'America/Nowhere' at: PointInTime now" | tz | tz := (self timeZoneFor: name). tz isNil ifTrue: [^ nil]. ^ tz localOffsetSecondsAt: aPointInTime! ! !TimeZoneDatabase methodsFor: 'querying' stamp: 'dtl 9/20/2004 19:32'! offsetFrom: name to: anotherTimeZoneName "Ask the database for the current offset in seconds between two time zones." "TimeZoneDatabase systemDatabase offsetFrom: 'Europe/Amsterdam' to: 'America/Detroit'" | now | now := PointInTime now. ^ (self offsetFor: name at: now) - (self offsetFor: anotherTimeZoneName at: now) ! ! !TimeZoneDatabase methodsFor: 'querying' stamp: 'dtl 12/28/1999 20:01'! timeZoneFor: name "TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit' " ^ self timeZoneFor: name pathSeparator: nil ! ! !TimeZoneDatabase methodsFor: 'querying' stamp: 'dtl 12/30/1999 18:34'! timeZoneFor: name pathSeparator: aCharacter "Allow the default path separator to be overridden for queries." "TimeZoneDatabase systemDatabase timeZoneFor: 'America/Detroit' pathSeparator: $/ " "TimeZoneDatabase systemDatabase timeZoneFor: 'America%Detroit' pathSeparator: $% " | keys | keys := self tokensFor: name withSeparator: aCharacter. ^ self timeZoneIndexedBy: keys inHierarchy: self timeZones! ! !TimeZoneDatabase methodsFor: 'querying' stamp: 'dtl 11/9/2004 06:48'! timeZoneName "Answer the name of the active local time transform" ^ self defaultLocation asString ! ! !TimeZoneDatabase methodsFor: 'querying' stamp: 'dtl 12/28/1999 20:01'! timeZoneNames "TimeZoneDatabase systemDatabase timeZoneNames" ^ self allTimeZones collect: [:e | e timeZoneName] ! ! !TimeZoneDatabase methodsFor: 'querying' stamp: 'dtl 11/14/2004 13:11'! tzNameAbbreviations "Answer the abbreviations for the active local time transform" | zone | zone := self defaultTimeZone. ^ zone isNil ifTrue: [#()] ifFalse: [zone tzNameAbbreviations] ! ! !TimeZoneDatabase methodsFor: 'normalizing' stamp: 'dtl 12/31/1999 16:24'! combineDuplicateTables: timeZoneCollection "Scan timeZonecollection, combining duplicate copies of transitionTimeTable. If another time zone differs only in its name, then we can share transition time tables to avoid unnecessary duplication." | workingSet nextSet idx ws this that | workingSet := timeZoneCollection. nextSet := OrderedCollection new. idx := 0. self class showProgressFrom: 1 to: timeZoneCollection size withMessage: 'combining timezone rule tables' forBlock: [ :bar | [workingSet size > 1] whileTrue: [ ws := ReadStream on: workingSet. this := ws next. bar value: idx. idx := idx + 1. [ws atEnd] whileFalse: [ that := ws next. (this isEquivalentTo: that) ifTrue: [that transitionTimeTable: this transitionTimeTable. idx := idx + 1] ifFalse: [nextSet add: that]]. workingSet := nextSet. nextSet := OrderedCollection new]] ! ! !TimeZoneDatabase methodsFor: 'normalizing' stamp: 'dtl 12/28/1999 20:01'! normalize "Eliminate duplication of rule sets where possible." | allEntries | allEntries := self allTimeZones. self setLeapSecondRulesFrom: allEntries. self combineDuplicateTables: allEntries! ! !TimeZoneDatabase methodsFor: 'normalizing' stamp: 'dtl 12/28/1999 20:01'! setLeapSecondRulesFrom: timeZoneCollection "Scan timeZoneCollection looking for leap second rule sets. Replace the individual leap second rule sets with a single common LeapSecondRuleSet which I hold on behalf of all the time zones. For time zones with no leap second compensation, ensure that leapSecondRuleSet is nil." | notEmpty | notEmpty := [:e | (e leapSecondRuleSet isNil) or: [e leapSecondRuleSet isEmpty]]. (timeZoneCollection reject: notEmpty) do: [:e | self updateLeapSecondRulesFrom: e leapSecondRuleSet. e leapSecondRuleSet: self leapSecondRuleSet]. (timeZoneCollection select: notEmpty) do: [:e | e leapSecondRuleSet: nil] ! ! !TimeZoneDatabase methodsFor: 'accessing' stamp: 'dtl 12/30/1999 18:56'! defaultLocation "If the variable has not been set, use the class default." defaultLocation isNil ifTrue: [^ defaultLocation := self class defaultLocation]. ^ defaultLocation! ! !TimeZoneDatabase methodsFor: 'accessing' stamp: 'dtl 11/13/2004 13:50'! defaultLocation: aString "TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit' " defaultLocation := aString. defaultTimeZone := nil. self changed: #timeZoneDatabaseDefaultZone ! ! !TimeZoneDatabase methodsFor: 'accessing' stamp: 'dtl 11/9/2004 06:31'! defaultTimeZone "TimeZoneDatabase systemDatabase defaultTimeZone" ^ defaultTimeZone ifNil: [defaultTimeZone := self timeZoneFor: self defaultLocation]! ! !TimeZoneDatabase methodsFor: 'accessing' stamp: 'dtl 12/30/1999 18:56'! indexSeparator indexSeparator isNil ifTrue: [indexSeparator := self class indexSeparator]. ^ indexSeparator! ! !TimeZoneDatabase methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! indexSeparator: aString "Answer the substring which is used as a path separator for the time zone names." indexSeparator := aString ! ! !TimeZoneDatabase methodsFor: 'accessing' stamp: 'dtl 12/30/1999 18:56'! leapSecondRuleSet leapSecondRuleSet isNil ifTrue: [leapSecondRuleSet := LeapSecondRuleSet new]. ^ leapSecondRuleSet! ! !TimeZoneDatabase methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! leapSecondRuleSet: aLeapSecondRuleSet leapSecondRuleSet := aLeapSecondRuleSet! ! !TimeZoneDatabase methodsFor: 'accessing' stamp: 'dtl 12/30/1999 18:58'! timeZones timeZones isNil ifTrue: [timeZones := Dictionary new]. ^ timeZones! ! !TimeZoneDatabase methodsFor: 'adding' stamp: 'dtl 1/1/2000 14:33'! indexAt: key put: aTimeZoneRuleSet "Store aTimeZoneRuleSet using hierarchical index key. Use default path separator." "TimeZoneDatabase new indexAt: 'right/America/Detroit' put: TimeZoneRuleSet here" ^ self indexAt: key withSeparator: nil put: aTimeZoneRuleSet ! ! !TimeZoneDatabase methodsFor: 'adding' stamp: 'dtl 1/1/2000 14:34'! indexAt: key withSeparator: aCharacter put: aTimeZoneRuleSet "Store aTimeZoneRuleSet using hierarchical index key." "TimeZoneDatabase new indexAt: 'right-America-Detroit' withSeparator: $- put: TimeZoneRuleSet here" | keys | keys := self tokensFor: key withSeparator: aCharacter. self addZone: aTimeZoneRuleSet toHierarchy: self timeZones withKeys: keys ! ! !TimeZoneDatabase methodsFor: 'adding' stamp: 'dtl 12/28/1999 20:01'! loadDataFrom: aFileName ^ self loadDataFrom: aFileName prefixPath: nil! ! !TimeZoneDatabase methodsFor: 'adding' stamp: 'dtl 12/28/1999 20:01'! loadDataFrom: aFileName prefixPath: pathName "Load with condenseDuplicates true, assuming that this method is called to load an individual tzfile files into an existing database." ^ self loadDataFrom: aFileName prefixPath: pathName pathSeparator: nil condenseDuplicates: true ! ! !TimeZoneDatabase methodsFor: 'adding' stamp: 'dtl 5/31/2009 12:46'! loadDataFrom: aFileName prefixPath: pathName pathSeparator: aCharacter condenseDuplicates: aBoolean "If aBoolean is true, attempt to avoid duplicate copies of leap second tables and time zone transition tables. Set true only if loading an individual file; otherwise is is more efficient to use TimeZoneDatabase>>normalize after all files are loaded." | condense name tzArray timeZone leap matchingTimeZone | (aBoolean == true) ifTrue: [condense := true] ifFalse: [condense := false]. "Default to false" aCharacter isNil ifTrue: [name := aFileName] ifFalse: [name := self class changeSeparatorFrom: aCharacter to: self class indexSeparator in: aFileName]. tzArray := (TzFileLoader forFile: aFileName prefixPath: pathName name: name) load. tzArray isNil ifTrue: [^ nil]. timeZone := tzArray at: 1. leap := tzArray at: 2. "Notes: tzArray at: 3 is a possibly nil TZ environment string, from a version 2 tzfile, currently unused. tzArray at: 4 is a possibly nil copy of version 1 format data (if parsing a version 2 file) available for debugging." self indexAt: timeZone timeZoneName put: timeZone. "Normally, all time zones which honor leap second rules can share a common LeapSecondRuleSet." condense ifTrue: [ leap isNil ifFalse: [ self updateLeapSecondRulesFrom: leap. (self leapSecondRuleSet = leap) ifTrue: [ timeZone leapSecondRuleSet: leap]]]. "If another time zone differs only in its name, then we can share transition time tables to avoid unnecessary duplication." condense ifTrue: [ matchingTimeZone := self allTimeZones detect: [:e | timeZone isEquivalentTo: e] ifNone: [nil]. matchingTimeZone isNil ifFalse: [timeZone transitionTimeTable: matchingTimeZone transitionTimeTable]] ! ! !TimeZoneDatabase methodsFor: 'adding' stamp: 'dtl 12/28/1999 20:01'! updateLeapSecondRulesFrom: aLeapSecondRuleSet "If my leapSecondRuleSet is nil or empty, update it with aLeapSecondRuleSet. Normally, all leap second rule sets will be identical system-wide. Therefore, if my leapSecondRuleSet is not empty, and aLeapSecondRuleSet is also not empty, check to see if they are equal. If not, warn the user." ((leapSecondRuleSet isNil) or: [leapSecondRuleSet isEmpty]) ifTrue: [self leapSecondRuleSet: aLeapSecondRuleSet] ifFalse: [aLeapSecondRuleSet isEmpty not ifTrue: [(leapSecondRuleSet leapSecondTable ~= aLeapSecondRuleSet leapSecondTable) ifTrue: [self notify: ('Leap second rules differ. ', 'This may OK if you are updating with newer tzfile files.'). self leapSecondRuleSet: aLeapSecondRuleSet]]]! ! !TimeZoneDatabase methodsFor: 'leap seconds' stamp: 'dtl 11/13/2004 15:04'! leapSecondsAt: aPointInTimeOrPosixSeconds "Answer the leap seconds for a point in time (or its integer value) for the active local time transform." ^ self defaultTimeZone isNil ifTrue: [0] ifFalse: [defaultTimeZone leapSecondsAt: aPointInTimeOrPosixSeconds]! ! !TimeZoneDatabase methodsFor: 'offsets from UTC' stamp: 'dtl 11/13/2004 15:05'! localOffsetSecondsAt: aPointInTimeOrPosixSeconds "Answer the offset seconds for a point in time (or its integer value) for the active local time transform." ^ self defaultTimeZone isNil ifTrue: [0] ifFalse: [defaultTimeZone localOffsetSecondsAt: aPointInTimeOrPosixSeconds] ! ! !TimeZoneDatabase class methodsFor: 'instance creation' stamp: 'dtl 2/15/2007 21:31'! buildDefaultUTCDatabase "Build a minimal timezone database and install it as ThisSystemDatabase." "TimeZoneDatabase buildDefaultUTCDatabase" | db | db _ TimeZoneDatabase basicNew instVarAt: 1 put: 'UTC'; instVarAt: 2 put: nil; instVarAt: 3 put: (Dictionary new add: #UTC -> (TimeZoneRuleSet basicNew instVarAt: 1 put: #UTC; instVarAt: 2 put: #(#UTC ); instVarAt: 3 put: #(); instVarAt: 4 put: nil; yourself); yourself); instVarAt: 4 put: nil; instVarAt: 5 put: $/; yourself. self thisSystemDatabase: db. ^ ThisSystemDatabase! ! !TimeZoneDatabase class methodsFor: 'instance creation' stamp: 'dtl 11/13/2004 13:31'! buildSystemDatabase "Build a full timezone database and install it as ThisSystemDatabase. Load the database from any tzfile files found in the default location for this system." "TimeZoneDatabase buildSystemDatabase" self thisSystemDatabase: (self fromZoneinfoDirectory: self tzPrefixPath). ^ ThisSystemDatabase ! ! !TimeZoneDatabase class methodsFor: 'instance creation' stamp: 'dtl 9/13/2004 20:33'! buildSystemDatabaseForSqueak "Build a full timezone database and install it as ThisSystemDatabase. Load the database from any tzfile files found in the default location for this system. Check first to determine if the time zone files exist, and issue a warning if the files are not available." "TimeZoneDatabase buildSystemDatabaseForSqueak" ^ (FileDirectory on: self tzPrefixPath) entries isEmpty ifTrue: [self notify: 'no time zone files found in ', self tzPrefixPath] ifFalse: [self buildSystemDatabase] ! ! !TimeZoneDatabase class methodsFor: 'instance creation' stamp: 'dtl 11/13/2004 13:32'! buildSystemDatabaseFromExamples "Build a full timezone database and install it as ThisSystemDatabase" "TimeZoneDatabase buildSystemDatabaseFromExamples" self thisSystemDatabase: (self fromExampleFiles). ^ ThisSystemDatabase ! ! !TimeZoneDatabase class methodsFor: 'instance creation' stamp: 'dtl 12/30/1999 20:11'! fromExampleFiles "Build a full timezone database from a small set of example tzfile files. Attempt to save space to avoiding duplicate entries for leap second rules and time zone offset rule sets." "TimeZoneDatabase fromExampleFiles" ^ self fromFiles: self exampleTzFiles prefixPath: self tzExamplesPrefixPath pathSeparator: $- ! ! !TimeZoneDatabase class methodsFor: 'instance creation' stamp: 'dtl 12/28/1999 20:01'! fromFiles: aCollectionOfNames prefixPath: aPathName "TimeZoneDatabase fromFiles: TimeZoneDatabase exampleTzFiles prefixPath: TimeZoneDatabase tzExamplesPrefixPath" ^ self fromFiles: aCollectionOfNames prefixPath: aPathName pathSeparator: nil ! ! !TimeZoneDatabase class methodsFor: 'instance creation' stamp: 'dtl 12/31/1999 18:47'! fromFiles: aCollectionOfNames prefixPath: aPathName pathSeparator: aCharacter "Build a full timezone database from a set of tzfile files. The path names have aPathName prepended in order to permit the names (without aPathName) to be used as the names of the TimeZoneRuleSets. Attempt to save space by avoiding duplicate entries for leap second rules and time zone offset rule sets. The path separator (aCharacter) is always replaced by self>>indexSeparator for purposes of naming the time zones in the database. This enforces a consistent time zone path name independent of the system platform." "TimeZoneDatabase fromFiles: TimeZoneDatabase exampleTzFiles prefixPath: TimeZoneDatabase tzExamplesPrefixPath pathSeparator: $- " | db idx | db := super new. idx := 0. self showProgressFrom: 1 to: aCollectionOfNames size withMessage: 'loading timezone data files' forBlock: [ :bar | aCollectionOfNames do: [:e | idx := idx + 1. bar value: idx. db loadDataFrom: e prefixPath: aPathName pathSeparator: aCharacter condenseDuplicates: false]]. ^ db normalize ! ! !TimeZoneDatabase class methodsFor: 'instance creation' stamp: 'dtl 1/2/2000 17:01'! fromZoneinfoDirectory: aPathName "Build a full timezone database for a compiled set of timezone files as found in the directory named aPathName." "Time millisecondsToRun: [(TimeZoneDatabase fromZoneinfoDirectory: '/usr/share/zoneinfo') inspect]" | path names | path := aPathName, (String with: self separator). names := self tzFilesInDirectoryTree: path. ^ self fromFiles: names prefixPath: path ! ! !TimeZoneDatabase class methodsFor: 'instance creation' stamp: 'dtl 2/14/2007 07:53'! systemDatabase "Always answer a database, even if uninitialized, in order to permit dependencies to be initialized. When the database is updated or replaced, the dependents will be notified." "TimeZoneDatabase systemDatabase" ^ ThisSystemDatabase ifNil: [ThisSystemDatabase := self basicNew]! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/8/2000 18:45'! changeSeparatorFrom: aCharacter to: anotherCharacter in: aString "Replace the path separator aCharacter with anotherCharacter in aString." (self platform == #Squeak) ifTrue: [^ aString copyReplaceAll: (String with: aCharacter) with: (String with: anotherCharacter)]. (self platform == #VisualWorks) ifTrue: [^ aString copyReplaceAll: (String with: aCharacter) with: (String with: anotherCharacter)]. (self platform == #'Smalltalk/X') ifTrue: [^ aString copy replaceAll: aCharacter with: anotherCharacter]. ! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/1/2000 13:12'! dateFromString: aString "Answer an instance of created from a string with format DD.MM.YYYY." (self platform == #Squeak) ifTrue: [^ Date fromString: aString]. (self platform == #VisualWorks) ifTrue: [^ Date readFrom: (ReadStream on: aString)]. (self platform == #'Smalltalk/X') ifTrue: [^ Date readFrom: (ReadStream on: aString)]. ! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/8/2000 20:14'! directoryContents: aDirectoryPathName "Answer the contents of a directory named aDirectoryPathName, in the form of a two element array. The first element of the result array is a collection of all non-directory elements in aDirectoryPathName (usually regular files), and the second element of the result array is a collection of names of directories contained in aDirectoryPathName. Implementation is Smalltalk platform specific, so the method is compiled into a block which can be evaluated with aDirectoryPathName as its argument." "TimeZoneDatabase directoryContents: '/usr/share/zoneinfo' " | path result | result := Array with: (OrderedCollection new) with: (OrderedCollection new). (aDirectoryPathName last == self separator) ifTrue: [path := aDirectoryPathName] ifFalse: [path := aDirectoryPathName, (String with: self separator)]. (self platform == #Squeak) ifTrue: [ ((Smalltalk at: #FileDirectory) forFileName: path) entries do: [:e | e isDirectory ifTrue: [(result at: 2) add: e name] ifFalse: [(result at: 1) add: e name]]] ifFalse: [ ((Smalltalk at: #Filename) named: path) directoryContents do: [:e | ((Smalltalk at: #Filename) named: (path, (String with: TimeZoneDatabase separator), e)) isDirectory ifTrue: [(result at: 2) add: e] ifFalse: [(result at: 1) add: e]]]. ^ result ! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/2/2000 18:20'! directoryFilesIn: aPathName inBasePath: prefixPath "Search a directory recursively and answer a collection of all directory files." "TimeZoneDatabase directoryFilesIn: '' inBasePath: '/usr/share/zoneinfo/'" | initialPath contents result relativeName | initialPath := self pathFromPrefix: prefixPath andName: aPathName. contents := self directoryContents: initialPath. result := OrderedCollection new: (contents at: 1) size. (contents at: 2) do: [:e | relativeName := (self pathFromPrefix: aPathName andName: e). result add: relativeName. result addAll: (self directoryFilesIn: relativeName inBasePath: prefixPath)]. ^ result ! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/2/2000 22:23'! isTzFileType: aPathName "TimeZoneDatabase isTzFileType: '/usr/share/zoneinfo/America/Detroit' " | stream | stream := (TzFileLoader readStreamFor: aPathName) binary. ((stream next: 4) = 'TZif' asByteArray) ifTrue: [stream close. ^ true] ifFalse: [stream close. ^ false] ! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/2/2000 13:03'! pathFromPrefix: prefixString andName: aString "Construct a path name, adding path separator if needed." ^ (prefixString isNil or: [prefixString size == 0]) ifTrue: [aString] ifFalse: [(prefixString last == self separator) ifTrue: [prefixString, aString] ifFalse: [prefixString, (String with: self separator), aString]] ! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/3/2000 05:28'! platform "Answer what version of Smalltalk we are using." "TimeZoneDatabase platform" ^ PointInTime platform ! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/8/2000 19:49'! separator "Answer the platform-specific file path name separator" "TimeZoneDatabase separator" OsPathNameSeparator isNil ifTrue: [ (self platform == #Squeak) ifTrue: [OsPathNameSeparator := (Smalltalk at: #FileDirectory) pathNameDelimiter] ifFalse: [OsPathNameSeparator := (Smalltalk at: #Filename) separator]]. ^ OsPathNameSeparator ! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/2/2000 23:09'! showProgressFrom: begin to: end withMessage: aString forBlock: aBlock "Evaluate aBlock using a progress bar display if available on this platform. The block receives one argument, and the argument must be a one argument block. If this platform does not support the progress display, use a dummy block and do not show the progress bar." self supportsProgressBar ifTrue: [aString displayProgressAt: Sensor cursorPoint from: begin to: end during: aBlock] ifFalse: [Transcript show: aString; cr. aBlock value: [ :bar | "do nothing"]] ! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/1/2000 13:13'! supportsProgressBar "Answer true if this platform knows how to display a progress bar." ^ self platform == #Squeak! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/2/2000 18:34'! tzFilesInDirectory: aPathName inBasePath: prefixPath "Answer a collection of names of files in the specified directory which are tzfile format time zone data files. Do not search subdirectories. Do not include the prefixPath in the collection of answered names." "TimeZoneDatabase tzFilesInDirectory: 'America' inBasePath: '/usr/share/zoneinfo'" | fullPath dirEntries result idx relativePath | fullPath := self pathFromPrefix: prefixPath andName: aPathName. dirEntries := self directoryContents: fullPath. result := OrderedCollection new. self showProgressFrom: 1 to: (dirEntries at: 1) size withMessage: ('scanning ', fullPath) forBlock: [ :bar | idx := 0. (dirEntries at: 1) do: [:file | bar value: (idx := idx + 1). relativePath := (self pathFromPrefix: aPathName andName: file). (self isTzFileType: (self pathFromPrefix: fullPath andName: file)) ifTrue: [result add: relativePath]]]. ^ result asArray ! ! !TimeZoneDatabase class methodsFor: 'private' stamp: 'dtl 1/2/2000 18:26'! tzFilesInDirectoryTree: aPathName "Search a directory recursively and answer an array of all the tzfile time zone files in the subtree." "TimeZoneDatabase tzFilesInDirectoryTree: '/usr/share/zoneinfo/'" | directories result idx | directories := OrderedCollection with: ''. directories addAll: (self directoryFilesIn: '' inBasePath: aPathName). result := OrderedCollection new. self showProgressFrom: 1 to: (directories size) withMessage: 'selecting timezone files' forBlock: [ :bar | idx := 0. directories do: [:e | bar value: (idx := idx + 1). result addAll: (self tzFilesInDirectory: e inBasePath: aPathName)]]. ^ result ! ! !TimeZoneDatabase class methodsFor: 'examples' stamp: 'dtl 1/1/2000 11:45'! convertDate: aDate time: aTime fromTimeZone: aTimeZone toTimeZone: anotherTimeZone "For aDate at aTime in aTimeZone, answer the Date and Time in anotherTimeZone." "TimeZoneDatabase convertDate: (TimeZoneDatabase dateFromString: '01.01.2000') time: (Time fromSeconds: 0) fromTimeZone: (LocalTimeTransform for: 'Europe/Paris') toTimeZone: (LocalTimeTransform for: 'America/Detroit')" "TimeZoneDatabase convertDate: (TimeZoneDatabase dateFromString: '01.01.2000') time: (Time fromSeconds: 0) fromTimeZone: (LocalTimeTransform for: 'America/Detroit') toTimeZone: (LocalTimeTransform for: 'Australia/Perth')" | pointInTime | pointInTime := PointInTime date: aDate time: aTime timeZone: aTimeZone. pointInTime isNil ifTrue: [^ nil] ifFalse: [^ pointInTime asDateAndTimeForTimeZone: anotherTimeZone] ! ! !TimeZoneDatabase class methodsFor: 'examples' stamp: 'dtl 12/21/2002 11:16'! partyTimes "Answer the times, in my own time zone, at which the New Year's Eve celebration for Year 2000 will occur for all time zones in the database. Sort the results so as to facilitate recognition of the grand events by committed revelers in my own time zone." "TimeZoneDatabase partyTimes" ^ self partyTimesForNewYear: 2000 ! ! !TimeZoneDatabase class methodsFor: 'examples' stamp: 'dtl 11/23/2004 19:18'! partyTimesForNewYear: newYear "Answer the times, in my own time zone, at which the New Year's Eve celebration for the newYear will occur for all time zones in the database. Sort the results so as to facilitate recognition of the grand events by committed revelers in my own time zone." "TimeZoneDatabase partyTimesForNewYear: 2005" | db allZones myTimeZone c idx dateAndTime seconds result | db := TimeZoneDatabase systemDatabase. db isNil ifTrue: [ self notify: 'no system time zone database'. ^ nil]. allZones := db allTimeZones. myTimeZone := LocalTimeTransform here. c := SortedCollection sortBlock: [:x :y | (x at: 3) <= (y at: 3)]. idx := 0. self showProgressFrom: 1 to: allZones size withMessage: 'checking times' forBlock: [ :bar | allZones do: [:e | idx := idx + 1. bar value: idx. dateAndTime := e transformDate: (self dateFromString: '01.01.', newYear asString) time: (Time fromSeconds: 0) toTimeZone: myTimeZone. seconds := (dateAndTime at: 1) asSeconds + (dateAndTime at: 2) asSeconds. c add: (Array with: e with: (dateAndTime) with: seconds)]]. result := OrderedCollection new. c do: [:e | result add: (Array with: (e at: 1) timeZoneName with: (e at: 2))]. ^ result asArray ! ! !TimeZoneDatabase class methodsFor: 'examples' stamp: 'dtl 1/1/2000 11:47'! sortedArrayOfWorldTimesAtPointInTime: aPointInTime "For the indicated time, answer a sorted array with the values of this time in each local time zone." "TimeZoneDatabase sortedArrayOfWorldTimesAtPointInTime: PointInTime now" "TimeZoneDatabase sortedArrayOfWorldTimesAtPointInTime: (PointInTime fromSmalltalkSeconds: 0)" "TimeZoneDatabase sortedArrayOfWorldTimesAtPointInTime: (PointInTime fromSmalltalkSeconds: ((TimeZoneDatabase dateFromString: '01.01.2000') asSeconds) inTimeZone: LocalTimeTransform here)" | db zones sc idx seconds result | db := TimeZoneDatabase systemDatabase. db isNil ifTrue: [ self notify: 'no system time zone database'. ^ nil]. zones := db allTimeZones. sc := SortedCollection sortBlock: [:x :y | (x at: 3) <= (y at: 3)]. idx := 0. self showProgressFrom: 1 to: zones size withMessage: 'checking times' forBlock: [ :bar | zones do: [:e | idx := idx + 1. bar value: idx. seconds := aPointInTime asSmalltalkSecondsForTimeZone: e. sc add: (Array with: e timeZoneName with: (aPointInTime asDateAndTimeForTimeZone: e) with: seconds)]]. result := OrderedCollection new. sc do: [:e | result add: (Array with: (e at: 1) with: (e at: 2))]. ^ result asArray ! ! !TimeZoneDatabase class methodsFor: 'examples' stamp: 'dtl 12/28/1999 20:01'! worldTimes "For the current time, answer a dictionary with the values of this time in each local time zone." "TimeZoneDatabase worldTimes" ^ TimeZoneDatabase worldTimesAtPointInTime: PointInTime now ! ! !TimeZoneDatabase class methodsFor: 'examples' stamp: 'dtl 12/31/1999 16:22'! worldTimesAtPointInTime: aPointInTime "For the indicated time, answer a dictionary with the values of this time in each local time zone." "TimeZoneDatabase worldTimesAtPointInTime: (PointInTime fromSmalltalkSeconds: 0)" | db zones d idx | db := TimeZoneDatabase systemDatabase. db isNil ifTrue: [ self notify: 'no system time zone database'. ^ nil]. zones := db allTimeZones. d := Dictionary new. idx := 0. self showProgressFrom: 1 to: zones size withMessage: 'checking times' forBlock: [ :bar | zones do: [:e | idx := idx + 1. bar value: idx. d at: e timeZoneName put: (aPointInTime asDateAndTimeForTimeZone: e)]]. ^ d ! ! !TimeZoneDatabase class methodsFor: 'examples' stamp: 'dtl 1/1/2000 11:48'! worldTimesForDate: aDate time: aTime inTimeZone: aTimeZone "For aDate at aTime in aTimeZone, answer a dictionary with the values of this time in each local time zone in the system time zone database." "TimeZoneDatabase worldTimesForDate: (TimeZoneDatabase dateFromString: '01.01.2000') time: (Time fromSeconds: 0) inTimeZone: LocalTimeTransform here" "TimeZoneDatabase worldTimesForDate: (TimeZoneDatabase dateFromString: '01.01.2000') time: (Time fromSeconds: 0) inTimeZone: (LocalTimeTransform for: 'Australia/Perth')" | pointInTime | pointInTime := PointInTime date: aDate time: aTime timeZone: aTimeZone. pointInTime isNil ifTrue: [^ nil] ifFalse: [^ TimeZoneDatabase worldTimesAtPointInTime: pointInTime] ! ! !TimeZoneDatabase class methodsFor: 'defaulting' stamp: 'dtl 8/2/2008 12:17'! defaultLocation "Default name string to use as the key for the system timezone database. The system default timezone can be set explicitly with TimeZoneDatabase>>defaultLocation: This class side method is used only if the database is not explicitly initialized to the correct local time zone name. Edit this to suit your system." ^ 'UTC' "Detroit time zone with leap second table" ! ! !TimeZoneDatabase class methodsFor: 'defaulting' stamp: 'dtl 1/8/2000 18:36'! exampleTzFiles "Answer an array of names of some compiled timezone files, provided as examples. The names here use a naming convention similar to that used on systems which support tzfile timezone databases, except that the path separator is changed such that 'America/Detroit' becomes 'America-Detroit'. By convention, a timezone file name which begins with 'right', such as 'right-America-Detroit', is the version which contains leap second rules. The 'posix-America-Detroit' and 'America-Detroit' versions are identical, and contain no leap second rules." ^ #('America-Buenos_Aires' 'America-Detroit' 'America-Los_Angeles' 'Europe-Berlin' 'Europe-London' 'Europe-Paris' 'posix-America-Buenos_Aires' 'posix-America-Detroit' 'posix-America-Los_Angeles' 'posix-Europe-Berlin' 'posix-Europe-London' 'posix-Europe-Paris' 'right-America-Buenos_Aires' 'right-America-Detroit' 'right-America-Los_Angeles' 'right-Europe-Berlin' 'right-Europe-London' 'right-Europe-Paris') ! ! !TimeZoneDatabase class methodsFor: 'defaulting' stamp: 'dtl 12/30/1999 18:40'! indexSeparator "Answer the character which is used as a path separator for the time zone names. The default is to a Unix style path separator, which happens to coincide with the naming convention for tzfile time zone files distributed with may Unix type systems." ^ $/! ! !TimeZoneDatabase class methodsFor: 'defaulting' stamp: 'dtl 12/28/1999 20:01'! tzExamplesPrefixPath "Answer the location of the timezone example database files. Assume that they are in the current default directory." ^ nil ! ! !TimeZoneDatabase class methodsFor: 'defaulting' stamp: 'dtl 12/28/1999 20:01'! tzPrefixPath "Answer the location of the timezone database files as found on a SuSE Linux 6.2 distribution. Modify as needed for your own system." ^ '/usr/share/zoneinfo' ! ! !TimeZoneDatabase class methodsFor: 'database verification' stamp: 'dtl 1/3/2000 21:37'! dumpRulesToFilesIn: aDirectoryName "Dump timezone rules into external files in a format which allows them to be compared to the output of the zdump(1) reference program. The file 'America.Detroit' (for example) in the dump directory can then be compared with the output of the '/usr/sbin/zdump -v America/Detroit' command." "Time millisecondsToRun: [TimeZoneDatabase dumpRulesToFilesIn: '/tmp/zonedump/']" | f n zones idx | idx := 0. zones := self systemDatabase allTimeZones. ('dumping zone data to ', aDirectoryName) displayProgressAt: Sensor cursorPoint from: 1 to: zones size during: [ :bar | zones do: [:ruleSet | idx := idx + 1. bar value: idx. n := self changeSeparatorFrom: $/ to: $. in: ruleSet name. f := FileStream fileNamed: (aDirectoryName, n). ruleSet transitionTimeTable do: [:e | e printVerboseOn: f withLeapSeconds: (ruleSet leapSecondsAt: e transitionTime). f nextPut: Character lf]. f close]] ! ! !TimeZoneDatabase class methodsFor: 'fileIn/Out' stamp: 'dtl 1/8/2000 20:17'! fileOutClasses "File out the classes required for a non-Squeak distribution." "TimeZoneDatabase fileOutClasses" #(LeapSecondRuleSet LocalTimeTransform NaiveTimeZone OSTimeZone VwOSTimeZone StxOSTimeZone PointInTime PointInTimeNow TimeZoneDatabase TimeZoneRule TimeZoneRuleSet TzFileLoader WallClock TimePlugin) do: [:e | (Smalltalk at: e) fileOut]! ! !TimeZoneDatabase class methodsFor: 'setting local time zone' stamp: 'dtl 11/9/2004 19:23'! grepFor: aString "Convenience method to help find time zones for locations, especially if the name of the key city is known." "TimeZoneDatabase grepFor: 'Moscow' " "TimeZoneDatabase grepFor: 'Detroit' " "TimeZoneDatabase grepFor: 'UTC' " "TimeZoneDatabase grepFor: 'GMT' " ^ self systemDatabase grepFor: aString ! ! !TimeZoneDatabase class methodsFor: 'setting local time zone' stamp: 'dtl 11/14/2004 12:35'! setLocalTimeZone: tzName "To find a time zone for Detroit: TimeZoneDatabase grepFor: 'Detroit' Then use this method to set the desired time zone." "TimeZoneDatabase setLocalTimeZone: 'Europe/Moscow' " "TimeZoneDatabase setLocalTimeZone: 'right/America/Detroit' " "TimeZoneDatabase setLocalTimeZone: 'posix/America/Detroit' " "TimeZoneDatabase setLocalTimeZone: 'America/Detroit' " "TimeZoneDatabase setLocalTimeZone: 'UTC' " "TimeZoneDatabase setLocalTimeZone: 'GMT' " "TimeZoneDatabase setLocalTimeZone: 'Europe/London' " "TimeZoneDatabase setLocalTimeZone: 'Africa/Johannesburg' " "TimeZoneDatabase setLocalTimeZone: 'America/Los:=Angeles' " self systemDatabase defaultLocation: tzName. ^ self systemDatabase defaultTimeZone ! ! !TimeZoneDatabase class methodsFor: 'initialize-release' stamp: 'dtl 2/15/2007 22:21'! initialize "Attempt to load some sample database files in order to provide a system database. Different flavors of Smalltalk require different initialization routines, so the required code is compiled for each supported platform." "TimeZoneDatabase initialize" | smalltalkFlavor contents | smalltalkFlavor := self platform. smalltalkFlavor == #Squeak ifTrue: [self initializeForSqueak]. smalltalkFlavor == #VisualWorks ifTrue: [ contents := ((Smalltalk at: #Filename) currentDirectory directoryContents). (TimeZoneDatabase exampleTzFiles select: [:e | (contents includes: e) not]) isEmpty ifTrue: [TimeZoneDatabase buildSystemDatabaseFromExamples] ifFalse: [TimeZoneDatabase buildDefaultUTCDatabase]]. smalltalkFlavor == #'Smalltalk/X' ifTrue: [ contents := ((Smalltalk at: #Filename) currentDirectory directoryContents). (TimeZoneDatabase exampleTzFiles select: [:e | (contents includes: e) not]) isEmpty ifTrue: [TimeZoneDatabase buildSystemDatabaseFromExamples] ifFalse: [TimeZoneDatabase buildDefaultUTCDatabase]] ! ! !TimeZoneDatabase class methodsFor: 'initialize-release' stamp: 'dtl 12/23/2008 17:00'! initializeForSqueak "If time zone files are installed on this system, load them into a system database, otherwise use a minimal UTC database." | fd | [fd := FileDirectory on: TimeZoneDatabase tzPrefixPath] on: Error do: ["no such directory"]. (fd isNil or: [fd entries isEmpty]) ifTrue: [TimeZoneDatabase buildDefaultUTCDatabase] ifFalse: [TimeZoneDatabase buildSystemDatabaseForSqueak]. self readme! ! !TimeZoneDatabase class methodsFor: 'initialize-release' stamp: 'dtl 8/22/2007 00:01'! readme "TimeZoneDatabase readme" StringHolder new acceptContents: 'TimeZoneDatabase is a time zone database for Smalltalk. It answers the number of seconds offset from UTC for any time zone at any point in time in the range of the database rule set, as well as the number of leap seconds for a point in time (for tzfiles that contain the leap second rules). TimeZoneProxy provides a dynamic time zone to calculate DateAndTime at any point in time in any time zone. Dynamic corrections for daylight savings time and leap seconds are made according to the local time zone setting. Time zone rules are provided by TimeZoneDatabase. A TimeZoneDstTransitionWatcher detects "fall back" daylight savings time transitions, and maintains correct conversions from the Squeak seconds clock to absolute time. A full time zone database requires access to tzfile data files, typically distributed with Unix (Linux) systems, and often located in the /usr/share/zoneinfo directory. When TimeZoneDatabase is initially installed, the system time zone (DateAndTime class>>localTimeZone) is set to ''UTC'' (no UTC offset, no daylight savings offset, no leap seconds). Here is how to set a new default time zone for Squeak: 1) Look for a suitable time zone to use. For example, if you live in Detroit, Michigan in the USA, you can find several valid time zone entries for Detroit by evaluating the following expression: TimeZoneDatabase grepFor: ''Detroit'' 2) Set a time zone to use as the system default. For example, if you have decided to use ''America/Detroit'', tell Squeak to use this as its dynamic time zone setting: TimeZone setLocal: ''America/Detroit'' Time zones with names that begin with ''right'' include the rules for leap second adjustments, while time zones with names beginning with ''posix'' will ignore leap seconds. You may need to experiment with your system to find which time zone settings best match your requirements. If in doubt, use a time zone that does not include leap second tables. The time zone database can be rebuilt or updated by reloading from files in the /usr/share/zoneinfo directory (a typical location for a Unix/Linux system). If your system does not have these files available, they may be copied from another system or obtained on the internet. TimeZoneDatabase buildSystemDatabaseForSqueak If you want to stop using TimeZoneDatabase for your Squeak time zone settings and go back to a default TimeZone: DateAndTime localTimeZone: TimeZone default For an explanation of the Squeak seconds clock and how it relates to various representations of time, see the "documentation" method category in class PointInTime.'; openLabel: 'README' ! ! !TimeZoneDatabase class methodsFor: 'initialize-release' stamp: 'dtl 11/13/2004 13:50'! thisSystemDatabase: anObject ThisSystemDatabase := anObject. self changed: #timeZoneDatabaseForSystem! ! !TimeZoneDatabase class methodsFor: 'version' stamp: 'dtl 6/27/2009 16:43'! versionString "TimeZoneDatabase versionString" ^ '1.3.2'! ! !TimeZoneDstTransitionWatcher methodsFor: 'accessing' stamp: 'dtl 11/21/2000 18:59'! accessProtect ^ accessProtect ifNil: [accessProtect := Semaphore forMutualExclusion]! ! !TimeZoneDstTransitionWatcher methodsFor: 'accessing' stamp: 'dtl 10/31/2004 08:47'! lastTick "Answer the value of lastTick" ^ lastTick! ! !TimeZoneDstTransitionWatcher methodsFor: 'accessing' stamp: 'dtl 10/31/2004 08:47'! lastTick: anObject "Set the value of lastTick" lastTick := anObject! ! !TimeZoneDstTransitionWatcher methodsFor: 'accessing' stamp: 'dtl 10/31/2004 09:05'! monitorProcess "Answer the value of monitorProcess" ^ monitorProcess! ! !TimeZoneDstTransitionWatcher methodsFor: 'accessing' stamp: 'dtl 10/31/2004 08:47'! monitorProcess: anObject "Set the value of monitorProcess" monitorProcess := anObject! ! !TimeZoneDstTransitionWatcher methodsFor: 'accessing' stamp: 'dtl 10/31/2004 08:47'! transitionTick "Answer the value of transitionTick" ^ transitionTick! ! !TimeZoneDstTransitionWatcher methodsFor: 'accessing' stamp: 'dtl 10/31/2004 08:47'! transitionTick: anObject "Set the value of transitionTick" transitionTick := anObject! ! !TimeZoneDstTransitionWatcher methodsFor: 'testing' stamp: 'dtl 11/22/2000 09:46'! fallBackOccurredDuringHourBefore: aLocalSecondsCount "Answer true if a daylight savings time fall back transition has occured within the last hour prior to aLocalSecondsCount, which is assumed to represent the time now." "TimeZoneDstTransitionWatcher clockWatcher fallBackOccurredDuringHourBefore: Time totalSeconds" ^ self transitionTick notNil and: [(aLocalSecondsCount - transitionTick) < 3600] ! ! !TimeZoneDstTransitionWatcher methodsFor: 'initialize-release' stamp: 'dtl 11/13/2004 13:34'! initialize DateAndTime addDependent: self. TimeZoneDatabase addDependent: self. TimeZoneDatabase systemDatabase addDependent: self. self start! ! !TimeZoneDstTransitionWatcher methodsFor: 'initialize-release' stamp: 'dtl 10/31/2004 09:07'! start self stop. self monitorProcess: self monitorProcessBlock fork! ! !TimeZoneDstTransitionWatcher methodsFor: 'initialize-release' stamp: 'dtl 10/31/2004 09:06'! stop self monitorProcess ifNotNilDo: [:p | p terminate. self monitorProcess: nil]! ! !TimeZoneDstTransitionWatcher methodsFor: 'monitor' stamp: 'dtl 10/31/2004 09:12'! isFallBack: secondsCount "True if secondsCount is between 0 and 3600 seconds less than the previously observed seconds clock tick, non-inclusive. This situation occurs when the clock is set back at a fall daylight savings time transition." | diff | self lastTick ifNil: [^ false]. diff := secondsCount - self lastTick. ^ (diff < 0) and: [diff > -3600]! ! !TimeZoneDstTransitionWatcher methodsFor: 'monitor' stamp: 'dtl 11/23/2004 11:46'! monitorProcessBlock "The monitor process needs to wake up only occasionally to keep the last tick reasonably up to date. PointInTime>>now calls #updateLastTick: with the current Smalltalk seconds clock in order to force an immediate update. This ensures that the DST monitor is up to date as of the call to PointInTime>>now, as required for a correct result at times very close to DST transition times." | delay | delay := Delay forMilliseconds: 3000. ^ [[self updateLastTick: Time totalSeconds. delay wait] repeat]! ! !TimeZoneDstTransitionWatcher methodsFor: 'monitor' stamp: 'dtl 11/22/2000 09:49'! updateLastTick: currentLocalSmalltalkSeconds "Update the value of lastTick, and set transitionTick if a DST boundary has been crossed." self accessProtect critical: [(self isFallBack: currentLocalSmalltalkSeconds) ifTrue: [self transitionTick: currentLocalSmalltalkSeconds]. self lastTick: currentLocalSmalltalkSeconds] ! ! !TimeZoneDstTransitionWatcher methodsFor: 'updating' stamp: 'dtl 11/13/2004 14:28'! lastDstTransitionBefore: aPointInTime "self new lastDstTransitionBefore: PointInTime now" DateAndTime localTimeZone dstTransitionTimes inject: nil into: [:last :pt | (aPointInTime <= pt) ifTrue: [^ last]. pt]. ^ nil ! ! !TimeZoneDstTransitionWatcher methodsFor: 'updating' stamp: 'dtl 11/13/2004 14:26'! probableLastTransitionTick "If possible, answer the last Smalltalk seconds DST transition for the current time zone." "self new probableLastTransitionTick" ^ self probableLastTransitionTickBefore: PointInTime now ! ! !TimeZoneDstTransitionWatcher methodsFor: 'updating' stamp: 'dtl 11/13/2004 14:25'! probableLastTransitionTickBefore: aPointInTime "If possible, answer the last Smalltalk seconds DST transition before aPointInTime for the current time zone. This method permits unit tests to trick the DST transition watcher into working for a different time setting than the current system time." "self new probableLastTransitionTickBefore: PointInTime now" ^ (self lastDstTransitionBefore: aPointInTime) ifNotNilDo: [:pt | pt asLocalSmalltalkSeconds] ! ! !TimeZoneDstTransitionWatcher methodsFor: 'updating' stamp: 'dtl 11/13/2004 14:03'! update: aParameter "If the system time zone setting has changed, then the last recorded transition tick is no longer valid." aParameter == #timeZoneForDateAndTime ifTrue: [self transitionTick: self probableLastTransitionTick]. aParameter == #timeZoneDatabaseDefaultZone ifTrue: [self transitionTick: self probableLastTransitionTick]. aParameter == #timeZoneDatabaseForSystem ifTrue: [self transitionTick: self probableLastTransitionTick. TimeZoneDatabase systemDatabase addDependent: self].! ! !TimeZoneDstTransitionWatcher class methodsFor: 'instance creation' stamp: 'dtl 10/31/2004 09:10'! clockWatcher "TimeZoneDstTransitionWatcher clockWatcher" ^ DstMonitor ifNil: [DstMonitor := self new]! ! !TimeZoneDstTransitionWatcher class methodsFor: 'class initialization' stamp: 'dtl 10/31/2004 09:36'! initialize "self initialize" ^ self startMonitoring! ! !TimeZoneDstTransitionWatcher class methodsFor: 'class initialization' stamp: 'dtl 10/31/2004 09:16'! startMonitoring "self startMonitoring" ^ self clockWatcher! ! !TimeZoneDstTransitionWatcher class methodsFor: 'class initialization' stamp: 'dtl 10/31/2004 09:17'! stopMonitoring "self stopMonitoring" DstMonitor ifNotNilDo: [:m | m stop. DstMonitor := nil. ^ m]. ^ nil! ! !TimeZoneDstTransitionWatcher class methodsFor: 'tests' stamp: 'dtl 11/21/2000 22:02'! verifyDstTransition "Log time info during the Fall 2004 DST transition. Set the operating system clock to 00:58am on Sunday October 31, 2004 (or some other convenient fall back transition). Then run this method (three hours run time). Look that the DST.log file to verify that the clock was set back as expected. Note that it is not possible to do this test without actually setting the operating system clock, since we want to ensure that Squeak is tracking the actual behavior of the operating system." "[self verifyDstTransition] forkAt: Processor userBackgroundPriority" | fileName delay f t dt str fallTransitionTime shortDelay endTime now | fileName := 'DST.log'. fallTransitionTime := 1099202422. "Fall 2004 in Detroit" "Match time zone to the OS time zone setting" TimeZoneDatabase setLocalTimeZone: 'right/America/Detroit'. delay := Delay forMilliseconds: 9600. "Just under 10 seconds" shortDelay := Delay forMilliseconds: 1000. [f := FileStream fileNamed: fileName. "Wait for a 10 second boundary" [(Time totalSeconds \\ 10) = 0] whileFalse: [(Delay forMilliseconds: 100) wait]. "Run for three hours (six times per minute)" endTime := PointInTime now asAbsoluteSeconds + (3600 * 3). [(now := PointInTime now asAbsoluteSeconds) < endTime] whileTrue: [t := Time totalSeconds. dt := DateAndTime now. str := 'Squeak seconds: ', t printString, ', DateAndTime: ', dt printString. f nextPutAll: str; nextPut: Character lf; flush. ((now - fallTransitionTime) abs < 21) ifTrue: [shortDelay wait] ifFalse: [delay wait. [(Time totalSeconds \\ 10) = 0] whileFalse: [(Delay forMilliseconds: 100) wait]]]. ] ensure: [f close] ! ! !TimeZoneProxy methodsFor: 'accessing' stamp: 'dtl 11/14/2004 13:17'! abbreviation "Answer the value of abbreviation" ^ abbreviation ifNil: [abbreviation := self transform abbreviation]! ! !TimeZoneProxy methodsFor: 'accessing' stamp: 'dtl 11/14/2004 13:14'! abbreviation: newAbbrev "Set the value of abbreviation" ^ self abbreviation: newAbbrev ifNotValid: [self notify: '"', newAbbrev asString, '" is not a valid abbreviation for this time zone'] ! ! !TimeZoneProxy methodsFor: 'accessing' stamp: 'dtl 11/14/2004 12:30'! abbreviation: anObject ifNotValid: errorBlock "Set the value of abbreviation. If the abbreviation is not valid for the current time zone, evaluate errorBlock." | newAbbrev possibleValues | newAbbrev := anObject asString. possibleValues := (self transform isNil ifTrue: [Array with: newAbbrev] ifFalse: [transform tzNameAbbreviations]) collect: [:e | e asString]. (possibleValues includes: newAbbrev) ifTrue: [abbreviation := newAbbrev] ifFalse: [errorBlock value] ! ! !TimeZoneProxy methodsFor: 'accessing' stamp: 'dtl 11/14/2004 07:33'! name ^ transform isNil ifTrue: [transform name] ifFalse: [super name]! ! !TimeZoneProxy methodsFor: 'accessing' stamp: 'dtl 9/13/2004 12:31'! transform "Answer the value of transform" ^ transform! ! !TimeZoneProxy methodsFor: 'accessing' stamp: 'dtl 9/13/2004 12:31'! transform: anObject "Set the value of transform" transform := anObject! ! !TimeZoneProxy methodsFor: 'time zone offset' stamp: 'dtl 11/13/2004 12:20'! dstTransitionTimes ^ self transform dstTransitionTimes! ! !TimeZoneProxy methodsFor: 'time zone offset' stamp: 'dtl 11/23/2004 12:05'! localOffsetSecondsAt: aPointInTime ^ self transform localOffsetSecondsAt: aPointInTime! ! !TimeZoneProxy methodsFor: 'time zone offset' stamp: 'dtl 11/11/2004 20:01'! offset ^ Duration seconds: (self transform localOffsetSecondsAt: PointInTime now)! ! !TimeZoneProxy methodsFor: 'initialize-release' stamp: 'dtl 11/14/2004 12:47'! initialize self name; abbreviation. self transform addDependent: self. TimeZoneDatabase addDependent: self ! ! !TimeZoneProxy methodsFor: 'leap seconds' stamp: 'dtl 11/7/2004 20:42'! leapSecondsAt: aPointInTime ^ self transform leapSecondsAt: aPointInTime! ! !TimeZoneProxy methodsFor: 'printing' stamp: 'dtl 11/14/2004 13:17'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' for ', self transform name, ' (', self abbreviation asString, ')' ! ! !TimeZoneProxy methodsFor: 'updating' stamp: 'dtl 8/2/2008 11:54'! update: aParameter "If a new system time zone database has been created, update my reference to it. If the default transform has changed, update my abbreviation if necessary." aParameter == #timeZoneDatabaseForSystem ifTrue: [(self transform isKindOf: TimeZoneDatabase) ifTrue: [transform removeDependent: self. self transform: TimeZoneDatabase systemDatabase. transform addDependent: self. abbreviation := transform abbreviation]]. aParameter == #timeZoneDatabaseDefaultZone ifTrue: [self abbreviation: self abbreviation ifNotValid: [self abbreviation: self transform abbreviation ifNotValid: []]]! ! !TimeZoneProxy class methodsFor: 'instance creation' stamp: 'dtl 11/10/2004 05:24'! dynamicTransform "Answer a proxy that uses the system time zone database. This in turn will refer to the currently active local time transform in the database." "TimeZoneProxy dynamicTransform" ^ (self basicNew transform: TimeZoneDatabase systemDatabase) initialize! ! !TimeZoneProxy class methodsFor: 'initialize-release' stamp: 'dtl 2/15/2007 22:17'! initialize "Configure the system for a time zone proxy, and select UTC as the default time zone. The user is expected to set the correct default following installation." self setDynamicTransform. self setLocalTimeZone: 'UTC' ! ! !TimeZoneProxy class methodsFor: 'private' stamp: 'dtl 11/8/2004 21:13'! setDynamicLocalTransform: aTimeZoneRuleSet abbreviation: abbreviation "Set the local time zone to a proxy for the TimeZoneRuleSet that describes this time zone. The time zone offset value will be dynamically calculated for any point in time. This causes the time zone offset to be dynamically corrected for daylight savings time and other time zone anomolies. Using a time zone proxy causes methods such as DateAndTime class>>now and Time class>>now to run more slowly, which could be a concern in applications that do a very large number of system time queries." "TimeZoneProxy setDynamicLocalTransform: (TimeZoneDatabase systemDatabase timeZoneFor: 'right/America/Detroit') abbreviation: 'EST'" | proxy | proxy := self transform: aTimeZoneRuleSet abbreviation: abbreviation. DateAndTime localTimeZone: proxy. ^ proxy! ! !TimeZoneProxy class methodsFor: 'private' stamp: 'dtl 9/20/2004 19:40'! setStaticLocalTransform: aTimeZoneRuleSet abbreviation: abbreviation "Set the local time zone to a TimeZone with an offset corresponding to the offset of the local time zone at the present time. Time zone offsets will not be dynamically calculated, and this TimeZone will not be valid across daylight savings time changes. Unless the speed of system time queries is a serious concern, the #setDynamicLocalTransform:abbreviation: method is preferred." "TimeZoneProxy setStaticLocalTransform: TimeZoneDatabase systemDatabase defaultTimeZone abbreviation: 'EST'" | proxy tz | proxy := self transform: aTimeZoneRuleSet abbreviation: abbreviation. tz := TimeZone offset: proxy offset name: proxy name abbreviation: proxy abbreviation. DateAndTime localTimeZone: tz. ^ proxy! ! !TimeZoneProxy class methodsFor: 'private' stamp: 'dtl 11/10/2004 05:23'! transform: aTimeZoneRuleSet "Answer a proxy that uses aTimeZoneRuleSet. The time zone abbreviation will be the first of possibly many valid abbreviations provided in the time zone rules." "TimeZoneProxy transform: TimeZoneDatabase systemDatabase defaultTimeZone" ^ (self basicNew transform: aTimeZoneRuleSet) initialize! ! !TimeZoneProxy class methodsFor: 'private' stamp: 'dtl 9/13/2004 12:59'! transform: aTimeZoneRuleSet abbreviation: abbreviation "A time zone rule set typically has more than one abbreviation. This allows a specific abbreviation to be used. The abbreviation must be one of the abbreviations listed in the rule set." "TimeZoneProxy transform: TimeZoneDatabase systemDatabase defaultTimeZone abbreviation: 'EST'" "TimeZoneProxy transform: TimeZoneDatabase systemDatabase defaultTimeZone abbreviation: 'XXX'" (aTimeZoneRuleSet tzNameAbbreviations includes: abbreviation asSymbol) ifTrue: [^ (self basicNew transform: aTimeZoneRuleSet; abbreviation: abbreviation asString) initialize] ifFalse: [self notify: abbreviation, ' not valid, must be one of ', aTimeZoneRuleSet tzNameAbbreviations asString] ! ! !TimeZoneProxy class methodsFor: 'set local time zone' stamp: 'dtl 11/10/2004 05:22'! setDynamicTransform "Set the proxy to use the system time zone database. When the default time zone for the database is changed, the change is automatically reflected in this proxy. The time zone abbreviation for the active time zone is selected from one of possibly many valid abbreviations for that time zone, and will not in general be an expected value. This configuration should be used in applications where the system time zone may be reset in the time zone database, and where the time zone abbreviation is relatively unimportant." "TimeZoneProxy setDynamicTransform" | proxy | proxy := self dynamicTransform. DateAndTime localTimeZone: proxy. ^ proxy! ! !TimeZoneProxy class methodsFor: 'set local time zone' stamp: 'dtl 11/14/2004 13:06'! setDynamicTransform: timeZoneName "Set the proxy to use the system time zone database, and set the database to use timeZoneName as the default time zone." "TimeZoneProxy setDynamicTransform: '/right/America/Detroit'" | proxy | proxy := self setDynamicTransform. self setLocalTimeZone: timeZoneName. ^ proxy ! ! !TimeZoneProxy class methodsFor: 'set local time zone' stamp: 'dtl 11/14/2004 13:09'! setDynamicTransform: timeZoneName abbreviation: abbreviation "Set the proxy to use the system time zone database, and set the database to use timeZoneName as the default time zone. Set the time zone abbreviation to one of the possibly several valid abbreviations for timeZoneName." "TimeZoneProxy setDynamicTransform: '/right/America/Detroit' abbreviation: 'EST'" ^ (self setDynamicTransform: timeZoneName) abbreviation: abbreviation ! ! !TimeZoneProxy class methodsFor: 'set local time zone' stamp: 'dtl 11/14/2004 12:58'! setLocalTimeZone: tzName "To find a time zone for Detroit: TimeZoneDatabase grepFor: 'Detroit' Then use this method to set the desired time zone." "TimeZoneProxy setLocalTimeZone: 'Europe/Moscow' " "TimeZoneProxy setLocalTimeZone: 'right/America/Detroit' " "TimeZoneProxy setLocalTimeZone: 'posix/America/Detroit' " "TimeZoneProxy setLocalTimeZone: 'America/Detroit' " "TimeZoneProxy setLocalTimeZone: 'UTC' " "TimeZoneProxy setLocalTimeZone: 'GMT' " "TimeZoneProxy setLocalTimeZone: 'Europe/London' " "TimeZoneProxy setLocalTimeZone: 'Africa/Johannesburg' " "TimeZoneProxy setLocalTimeZone: 'America/Los:=Angeles' " TimeZoneDatabase setLocalTimeZone: tzName ! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! abbreviation ^ abbreviation! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! abbreviation: aString abbreviation := aString! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! isDstFlag ^ isDstFlag! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! isDstFlag: anInteger isDstFlag := anInteger! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! isStdTimeTransition ^ isStdTimeTransition! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! isStdTimeTransition: aBoolean isStdTimeTransition := aBoolean! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! isUtcTransition ^ isUtcTransition! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! isUtcTransition: aBoolean isUtcTransition := aBoolean! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! offsetSeconds ^ offsetSeconds! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! offsetSeconds: anInteger offsetSeconds := anInteger! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! transitionTime ^ transitionTime! ! !TimeZoneRule methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! transitionTime: anInteger transitionTime := anInteger! ! !TimeZoneRule methodsFor: 'comparing' stamp: 'dtl 12/28/1999 20:01'! = aTimeZoneRule "Assumes that transitionTime is a LargePositiveInteger, offsetSeconds is a SmallInteger, abbreviation is a Symbol." ^ (self species == aTimeZoneRule species) and: [ (offsetSeconds == aTimeZoneRule offsetSeconds) and: [ (abbreviation == aTimeZoneRule abbreviation) and: [ (transitionTime = aTimeZoneRule transitionTime) and: [ (isDstFlag == aTimeZoneRule isDstFlag) and: [ (isStdTimeTransition == aTimeZoneRule isStdTimeTransition) and: [ (isUtcTransition == aTimeZoneRule isUtcTransition)]]]]]] ! ! !TimeZoneRule methodsFor: 'comparing' stamp: 'dtl 12/28/1999 20:01'! hash "Hash is reimplemented because = is implemented." ^ (((((transitionTime hash + offsetSeconds hash) + isDstFlag hash) + abbreviation hash) + isStdTimeTransition hash) + isUtcTransition hash) ! ! !TimeZoneRule methodsFor: 'printing' stamp: 'dtl 11/20/2004 12:47'! printOn: aStream "^ self printSimplyOn: aStream" ^ self printVerboseOn: aStream ! ! !TimeZoneRule methodsFor: 'printing' stamp: 'dtl 12/28/1999 20:01'! printSimplyOn: aStream super printOn: aStream. aStream nextPutAll: ' ('. transitionTime printOn: aStream. aStream nextPutAll: ', '. offsetSeconds printOn: aStream. aStream nextPutAll: ', '; nextPutAll: abbreviation; nextPut: $)! ! !TimeZoneRule methodsFor: 'printing' stamp: 'dtl 11/20/2004 12:16'! printVerboseOn: aStream "Print enough detail to allow the output to be compared with the output of the zdump test utility, as found on may Unix-like systems." (PointInTime fromAbsoluteSeconds: self transitionTime) asDateAndTime printOn: aStream. aStream nextPutAll: (' ', self abbreviation, ' ('). transitionTime printOn: aStream. aStream nextPutAll: ', '. offsetSeconds printOn: aStream. aStream nextPutAll: ', '. isDstFlag printOn: aStream. aStream nextPutAll: ', '. abbreviation printOn: aStream. aStream nextPutAll: ', '. isStdTimeTransition printOn: aStream. aStream nextPutAll: ', '. isUtcTransition printOn: aStream. aStream nextPut: $)! ! !TimeZoneRule methodsFor: 'printing' stamp: 'dtl 12/28/1999 20:01'! printVerboseOn: aStream withLeapSeconds: anInteger "Print enough detail to allow the output to be compared with the output of the zdump test utility, as found on may Unix-like systems. This rule does not know about leap seconds, which are maintained in a separate rule table, so any leap second compensation must be provided as a parameter." | dt dtUtc leap timeWithLeapOffset | anInteger isNil ifTrue: [leap := 0] ifFalse: [leap := anInteger]. timeWithLeapOffset := self transitionTime - leap. dt := (PointInTime fromPosixSeconds: timeWithLeapOffset) asUtcDateAndTime. dtUtc := (PointInTime fromPosixSeconds: (timeWithLeapOffset + self offsetSeconds)) asUtcDateAndTime. (dt at: 1) printOn: aStream. aStream nextPut: $ . (dt at: 2) printOn: aStream. aStream nextPutAll: ' UTC = '. (dtUtc at: 1) printOn: aStream. aStream nextPut: $ . (dtUtc at: 2) printOn: aStream. aStream nextPutAll: (' ', self abbreviation, ' ('). transitionTime printOn: aStream. aStream nextPutAll: ', '. offsetSeconds printOn: aStream. aStream nextPutAll: ', '. isDstFlag printOn: aStream. aStream nextPutAll: ', '. abbreviation printOn: aStream. aStream nextPutAll: ', '. isStdTimeTransition printOn: aStream. aStream nextPutAll: ', '. isUtcTransition printOn: aStream. aStream nextPut: $)! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 11/14/2004 07:39'! abbreviation "Answer one of possibly several abbreviations for this time zone" ^ self tzNameAbbreviations anyOne asString! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 11/13/2004 12:09'! dstTransitionTimes ^ self transitionTimeTable collect: [:rule | PointInTime fromAbsoluteSeconds: rule transitionTime]! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! leapSecondRuleSet ^ leapSecondRuleSet! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! leapSecondRuleSet: aLeapSecondRuleSet "aLeapSecondRuleSet answers leap seconds at a PointInTime. Normally, there is one LeapSecondRuleSet which applies to all time zones, and this LeapSecondRuleSet is held by the system TimeZoneDatabase." leapSecondRuleSet := aLeapSecondRuleSet! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 11/13/2004 12:15'! leapSecondTransitionTimes self leapSecondRuleSet ifNil: [^ #()]. ^ (self leapSecondRuleSet leapSecondTable collect: [:r | PointInTime fromAbsoluteSeconds: r first]) asArray! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 11/13/2004 22:59'! name "Name when used as a TimeZone" ^ (self timeZoneName ifNil: [super name]) asString! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 5/31/2009 13:19'! posixTzEnvString "Answer a newline-enclosed, POSIX-TZ-environment-variable-style string for use in handling instants after the last transition time stored in the file (an empty string if there is no POSIX representation for such instants). This variable is set only in version 2 or greater tzinfo files, so may be nil for older tzfile inputs, or an empty string if using newer format tzinfo when there is no POSIX representation for such instants for this rule set." ^ posixTzEnvString! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 5/31/2009 13:15'! posixTzEnvString: aByteString posixTzEnvString := aByteString! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! transitionTimeTable ^ transitionTimeTable! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! transitionTimeTable: anArrayOfArrays transitionTimeTable := anArrayOfArrays! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! tzNameAbbreviations ^ tzNameAbbreviations! ! !TimeZoneRuleSet methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! tzNameAbbreviations: anArrayOfStrings tzNameAbbreviations := anArrayOfStrings! ! !TimeZoneRuleSet methodsFor: 'comparing' stamp: 'dtl 12/30/1999 10:02'! isEquivalentTo: aTimeZoneRuleSet "Answer true if aTimeZoneRuleSet has a transition table the same as that of the receiver." (aTimeZoneRuleSet isKindOf: LocalTimeTransform) ifTrue: [^ self transitionTimeTable = aTimeZoneRuleSet transitionTimeTable] ifFalse: [^ false]! ! !TimeZoneRuleSet methodsFor: 'leap seconds' stamp: 'dtl 12/28/1999 20:01'! leapSecondsAt: aPointInTimeOrPosixSeconds "Answer the leap seconds for a point in time (or its integer value)." leapSecondRuleSet isNil ifTrue: [^ 0] ifFalse: [^ leapSecondRuleSet leapSecondsAt: aPointInTimeOrPosixSeconds] ! ! !TimeZoneRuleSet methodsFor: 'offsets from UTC' stamp: 'dtl 1/8/2000 13:52'! localOffsetSecondsAt: aPointInTimeOrPosixSeconds "Answer the offset seconds for a point in time (or its integer value)." "TimeZoneRuleSet here localOffsetSecondsAt: PointInTime now" | rule | rule := self zoneRuleFor: aPointInTimeOrPosixSeconds asInteger. rule isNil ifTrue: ["no timezone rules, default to zero offset" ^ 0] ifFalse: [^ rule offsetSeconds] ! ! !TimeZoneRuleSet methodsFor: 'printing' stamp: 'dtl 12/28/1999 20:01'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' for '. aStream nextPutAll: self timeZoneName! ! !TimeZoneRuleSet methodsFor: 'private' stamp: 'dtl 10/3/2004 15:53'! zoneRuleFor: posixSeconds "Answer the zone data record for a point in time (an Integer). Assuming that elements of transitionTimeTable are sorted by transitionTime, this is the last such element for which transitionTime is less than posixSeconds." | recordsBeforeThisTime | transitionTimeTable isNil ifTrue: [^ nil]. transitionTimeTable isEmpty ifTrue: [^ nil]. recordsBeforeThisTime := transitionTimeTable select: [:e | e transitionTime <= posixSeconds]. recordsBeforeThisTime isEmpty ifTrue: [^ transitionTimeTable first] "Default to first rule in the list" ifFalse: [^ recordsBeforeThisTime last]! ! !TimeZoneRuleSet class methodsFor: 'instance creation' stamp: 'dtl 1/3/2000 04:36'! here "Answer an existing instance from the system time zone database" "TimeZoneRuleSet here" | db | db := TimeZoneDatabase systemDatabase. db isNil ifTrue: [^ nil] ifFalse: [^ TimeZoneDatabase systemDatabase defaultTimeZone]! ! !TimeZoneRuleSet class methodsFor: 'instance creation' stamp: 'dtl 12/28/1999 20:01'! loadFrom: aTzFileName "Load an instance of me from a tzfile file." ^ self loadFrom: aTzFileName prefixPath: nil ! ! !TimeZoneRuleSet class methodsFor: 'instance creation' stamp: 'dtl 1/1/2000 14:31'! loadFrom: aTzFileName prefixPath: aString "Load an instance of me from a tzfile file. Warning: Must use a StandardFileStream, because CrLrFileStream gets confused and tries to treat the file as binary." "TimeZoneRuleSet loadFrom: 'America/Detroit' prefixPath: '/usr/share/zoneinfo/'" "TimeZoneRuleSet loadFrom: 'right/America/Detroit' prefixPath: '/usr/share/zoneinfo/'" "TimeZoneRuleSet loadFrom: 'America/Barbados' prefixPath: '/usr/share/zoneinfo/'" "TimeZoneRuleSet loadFrom: 'America/Chicago' prefixPath: '/usr/share/zoneinfo/'" "TimeZoneRuleSet loadFrom: 'Europe/Zurich' prefixPath: '/usr/share/zoneinfo/'" ^ (TzFileLoader forFile: aTzFileName prefixPath: aString) load at: 1 ! ! !TzFileLoader methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! fileStream ^ fileStream! ! !TzFileLoader methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! fileStream: aFileStream fileStream := aFileStream! ! !TzFileLoader methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! name ^ name! ! !TzFileLoader methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! name: aString name := aString! ! !TzFileLoader methodsFor: 'tzfile decoding' stamp: 'dtl 1/1/2000 13:59'! getTzNameAbbreviationsFrom: aString "Read null-terminated time zone name abbreviations" | names strm | names := OrderedCollection new. strm := ReadStream on: aString. [strm atEnd] whileFalse: [names add: ((strm upTo: 0) asString asSymbol)]. ^ names ! ! !TzFileLoader methodsFor: 'tzfile decoding' stamp: 'dtl 5/31/2009 12:56'! leapSecondStruct64From: aStream ^ Array with: (self nextInt64FromNetworkOrderedBytes: aStream) with: (self nextIntFromNetworkOrderedBytes: aStream) ! ! !TzFileLoader methodsFor: 'tzfile decoding' stamp: 'dtl 12/28/1999 20:01'! leapSecondStructFrom: aStream ^ Array with: (self nextIntFromNetworkOrderedBytes: aStream) with: (self nextIntFromNetworkOrderedBytes: aStream) ! ! !TzFileLoader methodsFor: 'tzfile decoding' stamp: 'dtl 12/31/1999 18:21'! magic: aStream "Answer the first four characters, which are the magic number for the tzfile file." aStream atEnd ifTrue: [self error: 'unexpected end of file']. ^ (aStream next: 4) asString ! ! !TzFileLoader methodsFor: 'tzfile decoding' stamp: 'dtl 12/31/1999 17:12'! nextBooleanCharFrom: aStream aStream atEnd ifTrue: [self error: 'unexpected end of file']. ^ (aStream next asInteger) ~= 0 ! ! !TzFileLoader methodsFor: 'tzfile decoding' stamp: 'dtl 5/31/2009 09:15'! nextInt64FromNetworkOrderedBytes: aStream "Convert the next eight characters, read in network order, into an Integer. Logic is derived from ByteArray>>longAt:bigEndian:" | b0 b1 b2 b3 b4 b5 b6 w h | b0 := aStream next asInteger. b1 := aStream next asInteger. b2 := aStream next asInteger. b3 := aStream next asInteger. b4 := aStream next asInteger. b5 := aStream next asInteger. b6 := aStream next asInteger. w := aStream next asInteger. h := ((b0 bitAnd: 16r7F) - (b0 bitAnd: 16r80) bitShift: 8) + b1. b6 = 0 ifFalse:[w := (b6 bitShift: 8) + w]. b5 = 0 ifFalse:[w := (b5 bitShift: 16) + w]. b4 = 0 ifFalse:[w := (b4 bitShift: 24) + w]. b3 = 0 ifFalse:[w := (b3 bitShift: 32) + w]. b2 = 0 ifFalse:[w := (b2 bitShift: 40) + w]. h = 0 ifFalse:[w := (h bitShift: 48) + w]. ^w ! ! !TzFileLoader methodsFor: 'tzfile decoding' stamp: 'dtl 12/31/1999 17:10'! nextIntFromNetworkOrderedBytes: aStream "Convert the next four characters, read in network order, into an Integer. Logic is copied from ByteArray>>longAt:bigEndian:" | b0 b1 b2 w h | b0 := aStream next asInteger. b1 := aStream next asInteger. b2 := aStream next asInteger. w := aStream next asInteger. "Minimize LargeInteger arithmetic" h := ((b0 bitAnd: 16r7F) - (b0 bitAnd: 16r80) bitShift: 8) + b1. b2 = 0 ifFalse:[w := (b2 bitShift: 8) + w]. h = 0 ifFalse:[w := (h bitShift: 16) + w]. ^w ! ! !TzFileLoader methodsFor: 'tzfile decoding' stamp: 'dtl 12/31/1999 17:12'! nextUnsignedCharFrom: aStream aStream atEnd ifTrue: [self error: 'unexpected end of file']. ^ aStream next asInteger ! ! !TzFileLoader methodsFor: 'tzfile decoding' stamp: 'dtl 12/31/1999 17:08'! nextUnsignedIntFromNetworkOrderedBytes: aStream "Convert the next four characters, read in network order, into an Integer" aStream atEnd ifTrue: [self error: 'unexpected end of file']. ^ (aStream next asInteger * 16777216) + (aStream next asInteger * 65536) + (aStream next asInteger * 256) + aStream next asInteger ! ! !TzFileLoader methodsFor: 'tzfile decoding' stamp: 'dtl 12/28/1999 20:01'! ttinfoStructFrom: aStream | result | result := Array new: 5. result at: 1 put: (self nextIntFromNetworkOrderedBytes: aStream). result at: 2 put: (self nextUnsignedCharFrom: aStream). aStream atEnd ifTrue: [self error: 'unexpected end of file']. result at: 3 put: (self nextUnsignedCharFrom: aStream). ^ result ! ! !TzFileLoader methodsFor: 'tzfile loading' stamp: 'dtl 5/31/2009 13:13'! load "Load from my fileStream, and answer an array of a TimeZoneRuleSet, a LeapSecondRuleSet, and a possibly nil copy of tzfile format 1 data (non-nil only when parsing a version 2 file). The name and fileStream instance variables should already be set. Close fileStream when the file load is complete." | tzfileVersion result | "Check magic ID for the file" ((self magic: fileStream) = 'TZif') ifFalse: [ self notify: 'bad magic for zoneinfo file'. fileStream close. ^ nil]. "The tzfile format version, either null or $2. Version 2 format is a backward compatible extension." tzfileVersion := fileStream next. "Skip remaining 15 unused characters" fileStream next: 15. tzfileVersion = 0 ifTrue: [result := self loadVersion1tzfile] ifFalse: [tzfileVersion = $2 asciiValue ifTrue: [result := self loadVersion2tzfile] ifFalse: [self notify: 'unsupported tzfile format version ', tzfileVersion asString. "assume backward compatibility, use version 1 file format" result := self loadVersion1tzfile]]. fileStream atEnd ifFalse: [ self notify: 'zoneinfo parse error, should be at end of file'. fileStream close. ^ nil]. fileStream close. ^ result ! ! !TzFileLoader methodsFor: 'tzfile loading' stamp: 'dtl 5/31/2009 13:12'! loadVersion1tzfile "This is the original tzfile format. Load remaining data from fileStream." | ttisgmtcnt ttisstdcnt leapcnt timecnt typecnt charcnt transitionTimes ttinfoIndices ttinfoStructs abbreviations isStd isGmt rec timeZoneRuleSet leapSecondRuleSet | "Read header information" ttisgmtcnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. ttisstdcnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. leapcnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. timecnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. typecnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. charcnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. "Read data for transition times" transitionTimes := OrderedCollection new. timecnt timesRepeat: [transitionTimes add: (self nextIntFromNetworkOrderedBytes: fileStream)]. ttinfoIndices := OrderedCollection new. timecnt timesRepeat: [ttinfoIndices add: (self nextUnsignedCharFrom: fileStream)]. "Read ttinfo data structures" ttinfoStructs := OrderedCollection new. typecnt timesRepeat: [ttinfoStructs add: (self ttinfoStructFrom: fileStream)]. "Read time zone name abbreviations" fileStream atEnd ifTrue: [self error: 'unexpected end of file']. abbreviations := fileStream next: charcnt. "Note: tzNames is redundant, as the same information will be saved in the transitionTimeTable. The names are stored separately here as a convenience for browsing time zones." tzNames := self getTzNameAbbreviationsFrom: abbreviations. "Read leap second information" leapSeconds := OrderedCollection new. leapcnt timesRepeat: [leapSeconds add: (self leapSecondStructFrom: fileStream)]. "Flags for standard/wall indicators, to indicate if transition times associated with local time types were specified as standard time or wall clock time, used when a time zone file is used in handling POSIX-style time zone environment variables." isStd := OrderedCollection new: typecnt. ttisstdcnt timesRepeat: [isStd add: (self nextBooleanCharFrom: fileStream)]. "Store the flags as element 4 of the corresponding ttinfoStruct" (1 to: ttisstdcnt) do: [:e | (ttinfoStructs at: e) at: 4 put: (isStd at: e)]. "Flags for UTC/local indicators, tell whether the transition times associated with local time types were specified as UTC or local time, used when a time zone file is used in handling POSIX-style time zone environment variables." isGmt := OrderedCollection new: typecnt. ttisgmtcnt timesRepeat: [isGmt add: (self nextBooleanCharFrom: fileStream)]. "Store the flags as element 5 of the corresponding ttinfoStruct" (1 to: ttisstdcnt) do: [:e | (ttinfoStructs at: e) at: 5 put: (isGmt at: e)]. "Relate the transition times to the ttinfoStruct data" transitionTable := Array new: timecnt. (1 to: timecnt) do: [:idx | rec := ttinfoStructs at: ((ttinfoIndices at: idx) + 1). transitionTable at: idx put: (TimeZoneRule new transitionTime: (transitionTimes at: idx); offsetSeconds: (rec at: 1); isDstFlag: (rec at: 2); abbreviation: (((ReadStream on: abbreviations) next: (rec at: 3); yourself) upTo: 0) asString asSymbol; isStdTimeTransition: (rec at: 4); isUtcTransition: (rec at: 5))]. "Create an instance of LeapSecondRuleSet, or nil if no rules were found in this tzfile." (leapSeconds size = 0) ifTrue: [leapSecondRuleSet := nil] ifFalse: [leapSecondRuleSet := LeapSecondRuleSet new leapSecondTable: leapSeconds]. "Create an instance of TimeZoneRuleSet" timeZoneRuleSet := TimeZoneRuleSet new. timeZoneRuleSet timeZoneName: name. timeZoneRuleSet transitionTimeTable: transitionTable. timeZoneRuleSet leapSecondRuleSet: leapSecondRuleSet. timeZoneRuleSet tzNameAbbreviations: tzNames asArray. ^ Array with: timeZoneRuleSet with: leapSecondRuleSet with: nil! ! !TzFileLoader methodsFor: 'tzfile loading' stamp: 'dtl 5/31/2009 13:12'! loadVersion2tzfile "This is version 2 tzfile format. Load remaining data from fileStream." | ttisgmtcnt ttisstdcnt leapcnt timecnt typecnt charcnt transitionTimes ttinfoIndices ttinfoStructs abbreviations isStd isGmt rec timeZoneRuleSet leapSecondRuleSet posixTzEnvString versionOneData | "Read the version 1 compatible initial section, ignoring the results" versionOneData := self loadVersion1tzfile. "From the tzfile man page: For version-2-format time zone files, the above header and data is followed by a second header and data, identical in format except that eight bytes are used for each transition time or leap second time. After the second header and data comes a newline-enclosed, POSIX-TZ-environment-variable-style string for use in handling instants after the last transition time stored in the file (with nothing between the newlines if there is no POSIX representation for such instants)." "Read header information (this is a second copy of the file header, and can be ignored)" "Check magic ID for the file" ((self magic: fileStream) = 'TZif') ifFalse: [ self notify: 'bad magic for zoneinfo file'. ^ nil]. "The tzfile format version, either null or $2. Version 2 format is a backward compatible extension." fileStream next = $2 asciiValue ifFalse: [ self notify: 'expected version number 2 in embedded header portion of file'. ^ nil]. "Skip remaining 15 unused characters" fileStream next: 15. ttisgmtcnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. ttisstdcnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. leapcnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. timecnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. typecnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. charcnt := self nextUnsignedIntFromNetworkOrderedBytes: fileStream. "Read data for transition times" transitionTimes := OrderedCollection new. timecnt timesRepeat: [transitionTimes add: (self nextInt64FromNetworkOrderedBytes: fileStream)]. ttinfoIndices := OrderedCollection new. timecnt timesRepeat: [ttinfoIndices add: (self nextUnsignedCharFrom: fileStream)]. "Read ttinfo data structures" ttinfoStructs := OrderedCollection new. typecnt timesRepeat: [ttinfoStructs add: (self ttinfoStructFrom: fileStream)]. "typecnt timesRepeat: [ttinfoStructs add: (self ttinfoStruct64From: fileStream)]." "Read time zone name abbreviations" fileStream atEnd ifTrue: [self error: 'unexpected end of file']. abbreviations := fileStream next: charcnt. "Note: tzNames is redundant, as the same information will be saved in the transitionTimeTable. The names are stored separately here as a convenience for browsing time zones." tzNames := self getTzNameAbbreviationsFrom: abbreviations. "Read leap second information" leapSeconds := OrderedCollection new. leapcnt timesRepeat: [leapSeconds add: (self leapSecondStruct64From: fileStream)]. "Flags for standard/wall indicators, to indicate if transition times associated with local time types were specified as standard time or wall clock time, used when a time zone file is used in handling POSIX-style time zone environment variables." isStd := OrderedCollection new: typecnt. ttisstdcnt timesRepeat: [isStd add: (self nextBooleanCharFrom: fileStream)]. "Store the flags as element 4 of the corresponding ttinfoStruct" (1 to: ttisstdcnt) do: [:e | (ttinfoStructs at: e) at: 4 put: (isStd at: e)]. "Flags for UTC/local indicators, tell whether the transition times associated with local time types were specified as UTC or local time, used when a time zone file is used in handling POSIX-style time zone environment variables." isGmt := OrderedCollection new: typecnt. ttisgmtcnt timesRepeat: [isGmt add: (self nextBooleanCharFrom: fileStream)]. "Store the flags as element 5 of the corresponding ttinfoStruct" (1 to: ttisstdcnt) do: [:e | (ttinfoStructs at: e) at: 5 put: (isGmt at: e)]. "Read a newline-enclosed, POSIX-TZ-environment-variable-style string for use in handling instants after the last transition time stored in the file (an empty string if there is no POSIX representation for such instants)." posixTzEnvString := fileStream upToEnd. posixTzEnvString ifNotNil: [(posixTzEnvString first = Character lf asciiValue and: [posixTzEnvString last = Character lf asciiValue]) ifFalse: [self notify: 'expected TZ environment string surrounded by Character lf'. ^ nil]. posixTzEnvString := posixTzEnvString asString allButFirst allButLast]. "Relate the transition times to the ttinfoStruct data" transitionTable := Array new: timecnt. (1 to: timecnt) do: [:idx | rec := ttinfoStructs at: ((ttinfoIndices at: idx) + 1). transitionTable at: idx put: (TimeZoneRule new transitionTime: (transitionTimes at: idx); offsetSeconds: (rec at: 1); isDstFlag: (rec at: 2); abbreviation: (((ReadStream on: abbreviations) next: (rec at: 3); yourself) upTo: 0) asString asSymbol; isStdTimeTransition: (rec at: 4); isUtcTransition: (rec at: 5))]. "Create an instance of LeapSecondRuleSet, or nil if no rules were found in this tzfile." (leapSeconds size = 0) ifTrue: [leapSecondRuleSet := nil] ifFalse: [leapSecondRuleSet := LeapSecondRuleSet new leapSecondTable: leapSeconds]. "Create an instance of TimeZoneRuleSet" timeZoneRuleSet := TimeZoneRuleSet new. timeZoneRuleSet timeZoneName: name. timeZoneRuleSet transitionTimeTable: transitionTable. timeZoneRuleSet leapSecondRuleSet: leapSecondRuleSet. timeZoneRuleSet tzNameAbbreviations: tzNames asArray. timeZoneRuleSet posixTzEnvString: posixTzEnvString. ^ Array with: timeZoneRuleSet with: leapSecondRuleSet with: versionOneData ! ! !TzFileLoader class methodsFor: 'instance creation' stamp: 'dtl 12/28/1999 20:01'! forFile: aTzFileName prefixPath: aString "Load an instance of TimeZoneRuleSet from a tzfile file. Set the time zone name to be the same as the file name." "(TzFileLoader forFile: 'right/America/Detroit' prefixPath: '/usr/share/zoneinfo/') load" "(TzFileLoader forFile: 'right-America-Detroit' prefixPath: nil) load" "(TzFileLoader forFile: 'America/Barbados' prefixPath: '/usr/share/zoneinfo/') load" "(TzFileLoader forFile: 'America/Chicago' prefixPath: '/usr/share/zoneinfo/') load" "(TzFileLoader forFile: 'America/Goose:=Bay' prefixPath: '/usr/share/zoneinfo/') load" "(TzFileLoader forFile: 'Europe/Zurich' prefixPath: '/usr/share/zoneinfo/') load" ^ self forFile: aTzFileName prefixPath: aString name: aTzFileName ! ! !TzFileLoader class methodsFor: 'instance creation' stamp: 'dtl 12/31/1999 18:13'! forFile: aTzFileName prefixPath: aString name: aName "Load an instance of TimeZoneRuleSet from a tzfile file." "(TzFileLoader forFile: 'right/America/Detroit' prefixPath: '/usr/share/zoneinfo/') load" "(TzFileLoader forFile: 'right-America-Detroit' prefixPath: nil name: 'right/America/Detroit') load" | path fileStream | aString isNil ifTrue: [path := aTzFileName] ifFalse: [path := aString, aTzFileName]. fileStream := self readStreamFor: path. ^ super new fileStream: fileStream; name: aName asSymbol ! ! !TzFileLoader class methodsFor: 'private' stamp: 'dtl 12/31/1999 16:50'! platform "Answer what version of Smalltalk we are using." ^ TimeZoneDatabase platform! ! !TzFileLoader class methodsFor: 'private' stamp: 'dtl 1/8/2000 19:48'! readStreamFor: aFileName "Answer a binary FileStream for reading a tzfile data file." "TzFileLoader readStreamFor: '/tmp'" (self platform == #Squeak) ifTrue: [ ^ ((Smalltalk at: #FileStream) readOnlyFileNamed: aFileName) binary]. (self platform == #VisualWorks) ifTrue: [ ^ ((Smalltalk at: #Filename) named: aFileName) readStream binary]. (self platform == #'Smalltalk/X') ifTrue: [ | s | s := ((Smalltalk at: #Filename) named: aFileName) readStream. s isNil ifTrue: [^ nil] ifFalse: [^ s binary]] ! ! !VwOSTimeZone methodsFor: 'initialize' stamp: 'dtl 1/8/2000 20:25'! initialize "Be the proxy for the default TimeZone for this system image." self timeZone: (Smalltalk at: #TimeZone) default. self timeZoneName! ! !VwOSTimeZone methodsFor: 'leap seconds'! leapSecondsAt: aPointInTime "Answer the number of leap seconds since January 1, 1970 UTC as of aPointInTime. Keep it simple, ignore leap seconds and just answer 0." ^ 0! ! !VwOSTimeZone methodsFor: 'leap seconds'! leapSecondsForDate: aDate time: aTime "Answer the offset from UTC in this time zone as of aDate and aTime, where aDate and aTime are in the context of this time zone." "VwOSTimeZone here leapSecondsForDate: Date today time: Time now" | seconds t | seconds := aDate asSeconds + aTime asSeconds. t := PointInTime fromSmalltalkSeconds: seconds inTimeZone: self. ^ self leapSecondsAt: t! ! !VwOSTimeZone methodsFor: 'offsets from UTC'! localOffsetSecondsAt: aPointInTime "Answer the offset from UTC in this time zone as of aPointInTime" "VwOSTimeZone here localOffsetSecondsAt: PointInTime now" | sec | sec := aPointInTime asLocalSmalltalkSeconds. ^ sec - (self timeZone convertLocalSecondsToGMT: (sec))! ! !VwOSTimeZone methodsFor: 'offsets from UTC'! localOffsetSecondsForDate: aDate time: aTime "Answer the offset from UTC in this time zone as of aDate and aTime, where aDate and aTime are in the context of this time zone." "VwOSTimeZone here localOffsetSecondsForDate: Date today time: Time now" | seconds t | seconds := aDate asSeconds + aTime asSeconds. t := PointInTime fromSmalltalkSeconds: seconds inTimeZone: self. ^ self localOffsetSecondsAt: t! ! !VwOSTimeZone methodsFor: 'accessing'! timeZone ^ timeZone! ! !VwOSTimeZone methodsFor: 'accessing'! timeZone: aTimeZone timeZone := aTimeZone! ! !VwOSTimeZone methodsFor: 'accessing' stamp: 'dtl 1/8/2000 20:29'! timeZoneName "I do not know my name, but I am normally the system default time zone." timeZoneName isNil ifTrue: [timeZoneName := #default]. ^ timeZoneName! ! !VwOSTimeZone class methodsFor: 'instance creation'! here "Answer the current time zone, or nil if the classes have not been initialized for this system." "VwOSTimeZone here" ^ super new initialize! ! !WallClock methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! date ^ date! ! !WallClock methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! now ^ now! ! !WallClock methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! time ^ time! ! !WallClock methodsFor: 'accessing' stamp: 'dtl 12/28/1999 20:01'! timeZone ^ timeZone! ! !WallClock methodsFor: 'accessing' stamp: 'dtl 1/5/2000 19:48'! timeZone: aLocalTimeTransform timeZone := aLocalTimeTransform! ! !WallClock methodsFor: 'initialize-release' stamp: 'dtl 1/5/2000 19:53'! initialize now := PointInTimeNow thisInstant. now addDependent: self! ! !WallClock methodsFor: 'initialize-release' stamp: 'dtl 12/30/1999 19:04'! release now isNil ifFalse: [ now removeDependent: self. now := nil]! ! !WallClock methodsFor: 'printing' stamp: 'dtl 1/5/2000 20:43'! printOn: aStream | abs | now isNil ifTrue: [abs := nil] ifFalse: [abs := now absoluteTime]. aStream nextPutAll: 'a '. abs isNil ifTrue: [aStream nextPutAll: 'stopped ']. self class printOn: aStream. abs isNil ifFalse: [ aStream nextPutAll: ' with date '. date printOn: aStream. aStream nextPutAll: ' and time '. time printOn: aStream. timeZone isNil ifFalse: [ aStream nextPutAll: ' '. timeZone timeZoneName do: [:e | aStream nextPut: e]]. aStream nextPutAll: ' from absoluteTime '. aStream nextPutAll: abs asInteger printString. aStream nextPutAll: ' ('. abs printOn: aStream. aStream nextPutAll: ')']! ! !WallClock methodsFor: 'updating' stamp: 'dtl 11/12/2004 17:00'! update: aParameter | dt | now isNil ifFalse: [ dt := self now asDateAndTimeArrayForTimeZone: self timeZone. date := dt at: 1. time := dt at: 2] ! ! !WallClock class methodsFor: 'instance creation' stamp: 'dtl 11/12/2004 17:32'! for: aLocalTimeTransformName "Answer a WallClock in the specified time zone. Note that names beginning with 'right' include leap second tables, while names beginning with 'posix' do not. Select the type of time zone that matches the time setting for your computer's operating system." "WallClock for: 'right/America/Detroit'" "WallClock for: 'posix/America/Detroit'" "WallClock for: 'right/Europe/Berlin'" "WallClock for: 'right/Europe/Moscow'" | transform | transform := TimeZoneDatabase systemDatabase timeZoneFor: aLocalTimeTransformName. ^ transform isNil ifTrue: [nil] ifFalse: [self forTimeZone: transform] ! ! !WallClock class methodsFor: 'instance creation' stamp: 'dtl 1/5/2000 19:56'! forTimeZone: aLocalTimeTransform "WallClock forTimeZone: (LocalTimeTransform for: 'Europe/Berlin')" ^ super new initialize timeZone: aLocalTimeTransform! ! !WallClock class methodsFor: 'instance creation' stamp: 'dtl 1/5/2000 19:56'! new "WallClock new" ^ self forTimeZone: (LocalTimeTransform here)! ! TimeZoneProxy initialize! TimeZoneDstTransitionWatcher initialize! TimeZoneDatabase initialize! PointInTimeNow initialize! PointInTime initialize! OSTimeZone initialize! "Postscript: Load the time zone database and set default time zone for DateAndTime." TimeZoneDatabase initialize. TimeZoneProxy initialize !