'From Squeak2.6 of 11 October 1999 [latest update: #1559] on 9 January 2000 at 3:17:39 pm'! "Change Set: TimeZoneDatabase Date: 9 January 2000 Author: David T. Lewis This 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 runing 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'! Object subclass: #LocalTimeTransform instanceVariableNames: 'timeZoneName ' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! LocalTimeTransform class instanceVariableNames: ''! LocalTimeTransform subclass: #NaiveTimeZone instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! NaiveTimeZone class instanceVariableNames: ''! LocalTimeTransform subclass: #OSTimeZone instanceVariableNames: 'secondaryTimeZoneName daylightSavingsInEffect currentLocalOffset ' classVariableNames: 'DefaultDaylightSavingsInEffect DefaultLocalOffsetSeconds DefaultSecondaryTimeZoneName DefaultTimeZoneName ' poolDictionaries: '' category: 'Time-TimeZones'! OSTimeZone class instanceVariableNames: ''! Object subclass: #PointInTime instanceVariableNames: 'absoluteTime ' classVariableNames: 'NumericRepresentationSelector ' poolDictionaries: '' category: 'Time-UTC'! PointInTime class instanceVariableNames: ''! PointInTime subclass: #PointInTimeNow instanceVariableNames: 'updateProcess ' classVariableNames: 'ThisInstant UpdatePeriod ' poolDictionaries: '' category: 'Time-UTC'! PointInTimeNow class instanceVariableNames: ''! LocalTimeTransform subclass: #StxOSTimeZone instanceVariableNames: 'timeZone ' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! StxOSTimeZone class instanceVariableNames: ''! InterpreterPlugin subclass: #TimePlugin instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Squeak-Plugins'! TimePlugin class instanceVariableNames: ''! Object subclass: #TimeZoneDatabase instanceVariableNames: 'defaultLocation timeZones leapSecondRuleSet indexSeparator ' classVariableNames: 'OsPathNameSeparator ThisSystemDatabase ' poolDictionaries: '' category: 'Time-TimeZones'! TimeZoneDatabase class instanceVariableNames: ''! Object subclass: #TimeZoneRule instanceVariableNames: 'transitionTime offsetSeconds isDstFlag abbreviation isStdTimeTransition isUtcTransition ' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! LocalTimeTransform subclass: #TimeZoneRuleSet instanceVariableNames: 'tzNameAbbreviations transitionTimeTable leapSecondRuleSet ' classVariableNames: 'DefaultLocation ' poolDictionaries: '' category: 'Time-TimeZones'! TimeZoneRuleSet class instanceVariableNames: ''! Object subclass: #TzFileLoader instanceVariableNames: 'name fileStream tzNames transitionTable leapSeconds ' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! TzFileLoader class instanceVariableNames: ''! LocalTimeTransform subclass: #VwOSTimeZone instanceVariableNames: 'timeZone ' classVariableNames: '' poolDictionaries: '' category: 'Time-TimeZones'! VwOSTimeZone class instanceVariableNames: ''! Object subclass: #WallClock instanceVariableNames: 'now timeZone date time ' classVariableNames: '' poolDictionaries: '' category: 'Time-UTC'! WallClock class instanceVariableNames: ''! !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. ! !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! ! !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: 'testing' stamp: 'dtl 12/28/1999 20:01'! isEmpty ^ leapSecondTable isNil or: [leapSecondTable isEmpty]! ! !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]! ! !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 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: '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: 'timezone conversion' stamp: 'dtl 1/1/2000 14:24'! 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) asDateAndTimeForTimeZone: aTimeZone ! ! !LocalTimeTransform methodsFor: 'timezone conversion' stamp: 'dtl 1/1/2000 14:24'! 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) asDateAndTimeForTimeZone: self! ! !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 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 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! ! !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! ! !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.! !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: '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: '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 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.! !OSTimeZone methodsFor: 'initialize-release' stamp: 'dtl 12/28/1999 20:01'! initialize self setTimeZoneName. self setSecondaryTimeZoneName. self setCurrentLocalOffset. self setDaylightSavingsInEffect ! ! !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: '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: '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: '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 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 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 commentStamp: '' 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 represent as a Float or a Double, whichever provides the higher numeric resolution on this Smalltalk system. 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 either by shifting the origin of time forward a couple hundred years (and adjusting conversion methods accordingly), or by changing to a higher precision numeric represention (LargePositiveInteger or higher precision floating point data type). 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. The permits a platform independent implementation, but requires loading time zone information into the Smalltalk image rather than accessing it through operating system services. ! !PointInTime methodsFor: 'accessing'! absoluteTime ^ absoluteTime! ! !PointInTime methodsFor: 'accessing'! absoluteTime: aNumber absoluteTime _ aNumber perform: NumericRepresentationSelector! ! !PointInTime methodsFor: 'converting'! asDateAndTimeForTimeZone: aTimeZone "PointInTime now asDateAndTimeForTimeZone: LocalTimeTransform here" | s | s _ self asSmalltalkSecondsForTimeZone: aTimeZone. s isNil ifTrue: [^ nil] ifFalse: [^ self class dateAndTimeFromSmalltalkSeconds: s]! ! !PointInTime methodsFor: 'converting'! asFloat ^ absoluteTime! ! !PointInTime methodsFor: 'converting'! asInteger ^ absoluteTime asInteger! ! !PointInTime methodsFor: 'converting'! asLocalDateAndTime "PointInTime now asLocalDateAndTime" ^ self class dateAndTimeFromSmalltalkSeconds: self asLocalSmalltalkSeconds! ! !PointInTime methodsFor: 'converting'! 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 here! ! !PointInTime methodsFor: 'converting'! 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 asInteger + 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: 'private'! approximateTimeNow "Estimate of current time, used if primPosixTimeMicrosecondResolution is not available." "(PointInTime fromPosixSeconds: (PointInTime new approximateTimeNow)) asLocalDateAndTime" | sec offset | sec _ Time totalSeconds - self class posixOffset. offset _ LocalTimeTransform here localOffsetSecondsAt: sec. ^ sec - offset! ! !PointInTime methodsFor: 'private'! currentLeapSeconds ^ LocalTimeTransform here leapSecondsAt: self ! ! !PointInTime methodsFor: 'private'! 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 methodsFor: 'private' stamp: 'dtl 1/9/2000 14:34'! setAbsoluteTime "PointInTime new setAbsoluteTime asLocalDateAndTime" | platform | platform _ self class platform. (platform == #Squeak) ifTrue: [ | primTime | primTime _ self primPosixTimeMicrosecondResolution. primTime isNil ifTrue: [self absoluteTime: self approximateTimeNow] ifFalse: [self absoluteTime: primTime]]. (platform == #VisualWorks) ifTrue: [ self absoluteTime: self approximateTimeNow]. (platform == #'Smalltalk/X') ifTrue: [ self absoluteTime: self getStxSeconds. "Approximate time, ignoring leap seconds" self absoluteTime: self absoluteTime + self currentLeapSeconds] "Add leap seconds" ! ! !PointInTime methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' at '. absoluteTime printOn: aStream. aStream nextPutAll: ' seconds'! ! !PointInTime methodsFor: 'primitives'! 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 methodsFor: 'primitives'! primPosixTime "Number of seconds, expressed as a float, since since Jan 1, 1970 UTC." ^ nil! ! !PointInTime methodsFor: 'primitives'! 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 methodsFor: 'primitives'! primPosixTimeMicrosecondResolution "Number of seconds, expressed as a float, since since Jan 1, 1970 UTC." ^ nil! ! !PointInTime class methodsFor: 'instance creation'! date: aDate time: aTime timeZone: aTimeZone "Answer a PointInTime corresponding to the aDate and aTime in the context of aTimeZone." "PointInTime date: (Date fromString: '23.11.1999') time: (Time fromSeconds: 1700) timeZone: LocalTimeTransform here" | s offset leap | aTimeZone isNil ifTrue: [self notify: 'nil TimeZone'. ^ nil]. s _ aDate asSeconds + aTime asSeconds. offset _ aTimeZone localOffsetSecondsAt: s. leap _ aTimeZone leapSecondsAt: s. ^ self fromSmalltalkSeconds: (s - offset + leap)! ! !PointInTime class methodsFor: 'instance creation'! fromPosixSeconds: 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'! 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." "PointInTime fromSmalltalkSeconds: Time totalSeconds inTimeZone: LocalTimeTransform here" | time offset newOffset leap | aTimeZone isNil ifTrue: [self notify: 'nil TimeZone'. ^ nil]. offset _ 0. (1 to: 10) do: [:e | "Loop until convergence, or exit with error" time _ PointInTime fromSmalltalkSeconds: (seconds - offset). leap _ aTimeZone leapSecondsAt: time. time absoluteTime: time absoluteTime + leap. newOffset _ aTimeZone localOffsetSecondsAt: time. (newOffset = offset) ifTrue: [^ time]. offset _ newOffset]. self error: 'algorithm does not converge'. ^ nil! ! !PointInTime class methodsFor: 'instance creation'! now "PointInTime now" ^ super new setAbsoluteTime! ! !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: 'initialize-release'! 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." "PointInTime initialize" | platform | platform _ self platform. (platform == #Squeak) ifTrue: [self numericRepresentationSelector: #asFloat]. (platform == #VisualWorks) ifTrue: [self numericRepresentationSelector: #asDouble]. (platform == #'Smalltalk/X') ifTrue: [PointInTime numericRepresentationSelector: #asFloat]! ! !PointInTime class methodsFor: 'initialize-release'! numericRepresentationSelector: aClassSelector "This method is normally called during class initialization. Usually, a double precision floating point representation is used. 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: 'testing'! 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 here) asLocalSmalltalkSeconds. diff _ t1 - t2. (diff abs < 1) ifTrue: [^ 'OK'] ifFalse: [self notify: 'test failed'. ^ 'Failed']! ! !PointInTime class methodsFor: 'testing'! 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: 'private'! fromSmalltalkSeconds: seconds "Answer aPointInTime at a number of seconds after 1-Jan-1901 UTC, with no leap second compensation." "PointInTime fromSmalltalkSeconds: Time totalSeconds" ^ super new absoluteTime: (seconds - self posixOffset)! ! !PointInTime class methodsFor: 'private'! platform "Answer what version of Smalltalk we are using." "PointInTime platform" | versionString | versionString _ Smalltalk 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! ! !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.! !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 12/28/1999 20:01'! update: aParameter self setAbsoluteTime ! ! !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: '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: '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! ! !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! ! !StxOSTimeZone commentStamp: '' prior: 0! I provide access to time zone functions provided by the base Smalltalk/X system. ! !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 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 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! ! !TimePlugin commentStamp: '' prior: 0! I contain source code for Squeak pluggable primitives for time functions on Unix-like systems, and possibly other operating systems (not tested).! !TimePlugin methodsFor: 'primitives - time' stamp: 'dtl 11/28/1999 19:05'! primitivePosixTime "Answer Posix time in seconds expressed as a Float." | dt | self var: #dt declareC: 'double dt'. dt _ self cCode: '(double) time(NULL)'. interpreterProxy pop: 1; pushFloat: dt! ! !TimePlugin methodsFor: 'primitives - time' stamp: 'dtl 12/12/1999 08:19'! primitivePosixTimeAndLocalOffset "Answer an array with the Posix time and the current local offset, with Posix time expressed as a Float, and local offset expressed as an Integer. The two values are obtained simultaneously." | t timeStruct result timezone floatTimeOop offsetOop | self var: #t declareC: 'time_t t'. self var: #timeStruct declareC: 'struct tm *timeStruct'. self var: #timezone declareC: 'extern long int timezone'. t _ self cCode: 'time(NULL)'. timeStruct _ self cCode: 'localtime(&t)'. "External variable timezone is set as side effect of localtime(3)" floatTimeOop _ interpreterProxy floatObjectOf: t. offsetOop _ interpreterProxy integerObjectOf: timezone. interpreterProxy pushRemappableOop: offsetOop. interpreterProxy pushRemappableOop: floatTimeOop. result _ interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2. floatTimeOop _ interpreterProxy popRemappableOop. offsetOop _ interpreterProxy popRemappableOop. interpreterProxy stObject: result at: 1 put: floatTimeOop. interpreterProxy stObject: result at: 2 put: offsetOop. interpreterProxy pop: 1; push: result ! ! !TimePlugin methodsFor: 'primitives - time' stamp: 'dtl 12/12/1999 12:04'! primitivePosixTimeMicrosecondResolution "Answer Posix time as a float with microsecond precision, limited of course by the capability of the hardware. Use a gettimeofday() call to get current time. This may not be supported on some systems." | tv dt | self var: #tv declareC: 'struct timeval tv'. self var: #dt declareC: 'double dt'. (self cCode: 'gettimeofday(&tv, NULL)') ifTrue: [interpreterProxy pop: 1; push: interpreterProxy nilObject] ifFalse: [dt _ self cCode: 'tv.tv_usec / 1000000.0 + tv.tv_sec'. interpreterProxy pop: 1; pushFloat: dt] ! ! !TimePlugin methodsFor: 'primitives - timezone' stamp: 'dtl 11/28/1999 19:18'! primitiveGetDaylightFlag "Answer the daylight savings time flag at the present time" | t daylight | self var: #t declareC: 'time_t t'. t _ self cCode: 'time(NULL)'. self cCode: 'localtime(&t)'. "External variable daylight is set as side effect of localtime(3)" interpreterProxy pop: 1; pushBool: (daylight ~= 0)! ! !TimePlugin methodsFor: 'primitives - timezone' stamp: 'dtl 11/28/1999 20:44'! primitiveGetDaylightFlagAt "Answer the daylight savings time flag for a Posix time expressed as a Float." | t daylight | self var: #t declareC: 'time_t t'. t _ self popFloat. "Coersce to time_t." self cCode: 'localtime(&t)'. "External variable daylight is set as side effect of localtime(3)" interpreterProxy pop: 1; pushBool: (daylight ~= 0)! ! !TimePlugin methodsFor: 'primitives - timezone' stamp: 'dtl 12/12/1999 07:59'! primitiveGetTimeZone "Answer a four element array of two time zone names (primary and secondary), daylight savings time flag, and seconds offset from UTC." | t timeStruct tz strOop1 strPtr1 strOop2 strPtr2 daylight timezone | self var: #t declareC: 'time_t t'. self var: #timeStruct declareC: 'struct tm *timeStruct'. self var: #strPtr1 declareC: 'char * strPtr1'. self var: #strPtr2 declareC: 'char * strPtr2'. "Get timezone information from the operating system." t _ self cCode: 'time(NULL)'. timeStruct _ self cCode: 'localtime(&t)'. "External variable tzname[] is set as side effect of localtime(3)" "Instantiate an array of two strings." tz _ interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 4. interpreterProxy pushRemappableOop: tz. strOop1 _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: (self cCode: 'strlen(tzname[0])'). interpreterProxy pushRemappableOop: strOop1. strOop2 _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: (self cCode: 'strlen(tzname[1])'). strOop1 _ interpreterProxy popRemappableOop. tz _ interpreterProxy popRemappableOop. interpreterProxy stObject: tz at: 1 put: strOop1. interpreterProxy stObject: tz at: 2 put: strOop2. strPtr1 _ interpreterProxy arrayValueOf: strOop1. strPtr2 _ interpreterProxy arrayValueOf: strOop2. "Copy the time zone names into the strings." self cCode: 'strcpy(strPtr1, tzname[0])'. self cCode: 'strcpy(strPtr2, tzname[1])'. "Daylight savings time flag, a boolean." (daylight ~= 0) ifTrue: [interpreterProxy stObject: tz at: 3 put: interpreterProxy trueObject] ifFalse: [interpreterProxy stObject: tz at: 3 put: interpreterProxy falseObject]. "Seconds offset from UTC." interpreterProxy stObject: tz at: 4 put: (interpreterProxy integerObjectOf: timezone). "Answer the results array." interpreterProxy pop: 1; push: tz ! ! !TimePlugin methodsFor: 'primitives - timezone' stamp: 'dtl 12/12/1999 07:56'! primitiveGetTimeZoneAt "Answer a four element array of two time zone names (primary and secondary), daylight savings time flag, and seconds offset from UTC. The values are obtained relative to the given Posix time, which is passed as a Float." | t timeStruct tz strOop1 strPtr1 strOop2 strPtr2 daylight timezone | self var: #t declareC: 'time_t t'. self var: #timeStruct declareC: 'struct tm *timeStruct'. self var: #strPtr1 declareC: 'char * strPtr1'. self var: #strPtr2 declareC: 'char * strPtr2'. "Get timezone information from the operating system." t _ self popFloat. "Coersce to time_t." timeStruct _ self cCode: 'localtime(&t)'. "External variable tzname[] is set as side effect of localtime(3)" "Instantiate an array of two strings." tz _ interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 4. interpreterProxy pushRemappableOop: tz. strOop1 _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: (self cCode: 'strlen(tzname[0])'). interpreterProxy pushRemappableOop: strOop1. strOop2 _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: (self cCode: 'strlen(tzname[1])'). strOop1 _ interpreterProxy popRemappableOop. tz _ interpreterProxy popRemappableOop. interpreterProxy stObject: tz at: 1 put: strOop1. interpreterProxy stObject: tz at: 2 put: strOop2. strPtr1 _ interpreterProxy arrayValueOf: strOop1. strPtr2 _ interpreterProxy arrayValueOf: strOop2. "Copy the time zone names into the strings." self cCode: 'strcpy(strPtr1, tzname[0])'. self cCode: 'strcpy(strPtr2, tzname[1])'. "Daylight savings time flag, a boolean." (daylight ~= 0) ifTrue: [interpreterProxy stObject: tz at: 3 put: interpreterProxy trueObject] ifFalse: [interpreterProxy stObject: tz at: 3 put: interpreterProxy falseObject]. "Seconds offset from UTC." interpreterProxy stObject: tz at: 4 put: (interpreterProxy integerObjectOf: timezone). "Answer the results array." interpreterProxy pop: 1; push: tz ! ! !TimePlugin methodsFor: 'primitives - timezone' stamp: 'dtl 11/27/1999 01:23'! primitiveGetTimeZoneName "Answer the name of this time zone." | t timeStruct tz tzPtr | self var: #t declareC: 'time_t t'. self var: #timeStruct declareC: 'struct tm *timeStruct'. self var: #tzPtr declareC: 'char * tzPtr'. t _ self cCode: 'time(NULL)'. timeStruct _ self cCode: 'localtime(&t)'. "External variable tzname[] is set as side effect of localtime(3)" tz _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: (self cCode: 'strlen(tzname[0])'). tzPtr _ interpreterProxy arrayValueOf: tz. self cCode: 'strcpy(tzPtr, tzname[0])'. interpreterProxy pop: 1; push: tz ! ! !TimePlugin methodsFor: 'primitives - timezone' stamp: 'dtl 11/27/1999 01:24'! primitiveGetTimeZoneSecondaryName "Answer the name of this time zone." | t timeStruct tz tzPtr | self var: #t declareC: 'time_t t'. self var: #timeStruct declareC: 'struct tm *timeStruct'. self var: #tzPtr declareC: 'char * tzPtr'. t _ self cCode: 'time(NULL)'. timeStruct _ self cCode: 'localtime(&t)'. "External variable tzname[] is set as side effect of localtime(3)" tz _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: (self cCode: 'strlen(tzname[1])'). tzPtr _ interpreterProxy arrayValueOf: tz. self cCode: 'strcpy(tzPtr, tzname[1])'. interpreterProxy pop: 1; push: tz ! ! !TimePlugin methodsFor: 'primitives - timezone' stamp: 'dtl 11/28/1999 19:12'! primitiveLocalOffsetSeconds | t timezone | self var: #t declareC: 'time_t t'. self var: #timezone declareC: 'extern long int timezone'. t _ self cCode: 'time(NULL)'. self cCode: 'localtime(&t)'. "External variable timezone is set as side effect of localtime(3)" interpreterProxy pop: 1. interpreterProxy pushInteger: timezone ! ! !TimePlugin methodsFor: 'primitives - timezone' stamp: 'dtl 11/28/1999 21:04'! primitiveLocalOffsetSecondsAt "Answer the local offset in seconds for a Posix time expressed as a Float. For a given time zone, the offset may change as a function of absolute time, for example if daylight savings time is in effect." | t timezone | self var: #t declareC: 'time_t t'. self var: #timeStruct declareC: 'struct tm *timeStruct'. self var: #timezone declareC: 'extern long int timezone'. t _ self popFloat. "Coersce to time_t." self cCode: 'localtime(&t)'. interpreterProxy pop: 1; pushInteger: timezone ! ! !TimePlugin methodsFor: 'primitives - timezone' stamp: 'dtl 1/7/2000 19:52'! primitiveLocalSecondsClockWithOffset "Answer an array with the local time expressed in the Smalltalk frame of reference, and with the current local offset. The two values are obtained simultaneously. The result array is instantiated in this primitive." | t timeStruct timezone result timeOop offsetOop | self var: #t declareC: 'time_t t'. self var: #timeStruct declareC: 'struct tm *timeStruct'. self var: #timezone declareC: 'extern long int timezone'. t _ self cCode: 'time(NULL)'. timeStruct _ self cCode: 'localtime(&t)'. "External variable timezone is set as side effect of localtime(3)" timeOop _ interpreterProxy positive32BitIntegerFor: (t + self posixOffset - timezone). interpreterProxy pushRemappableOop: timeOop. offsetOop _ interpreterProxy integerObjectOf: timezone. interpreterProxy pushRemappableOop: offsetOop. result _ interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2. offsetOop _ interpreterProxy popRemappableOop. timeOop _ interpreterProxy popRemappableOop. interpreterProxy stObject: result at: 1 put: timeOop. interpreterProxy stObject: result at: 2 put: offsetOop. interpreterProxy pop: 1; push: result ! ! !TimePlugin methodsFor: 'private' stamp: 'dtl 12/2/1999 20:14'! 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! ! !TimePlugin class methodsFor: 'class initialization' stamp: 'dtl 11/27/1999 12:46'! declareCVarsIn: cg cg addHeaderFile: ''. cg addHeaderFile: ''. cg addHeaderFile: ' /* D T Lewis 1999 - TimeFunctions.c translated from class TimePlugin */'. ! ! !TimePlugin class methodsFor: 'translation' stamp: 'dtl 11/26/1999 13:31'! moduleName ^ 'TimeFunctions'! ! !TimePlugin class methodsFor: 'translation' stamp: 'dtl 11/25/1999 23:15'! translate: fileName doInlining: inlineFlag "This is a convenience method which simply documents that the C source code file may be generated as shown below." "TimePlugin translate: TimePlugin moduleName,'.c' doInlining: true" ^ super translate: fileName doInlining: inlineFlag! ! !TimePlugin class methodsFor: 'translation' stamp: 'dtl 11/25/1999 23:16'! translateDoInlining: inlineFlag "Translate to C source code file." "TimePlugin translateDoInlining: true" ^ super translate: TimePlugin moduleName,'.c' doInlining: inlineFlag! ! !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. ! !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 12/28/1999 20:01'! defaultLocation: aString "TimeZoneDatabase systemDatabase defaultLocation: 'right/America/Detroit' " defaultLocation _ aString ! ! !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 1/3/2000 21:30'! 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. 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: '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'! defaultTimeZone "TimeZoneDatabase systemDatabase defaultTimeZone" ^ self timeZoneFor: self defaultLocation! ! !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 12/28/1999 20:01'! leapSecondsAt: aPointInTimeOrPosixSeconds "Answer the leap seconds for a point in time (or its integer value)." ^ self leapSecondRuleSet leapSecondsAt: aPointInTimeOrPosixSeconds ! ! !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 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 12/28/1999 20:01'! timeZoneNames "TimeZoneDatabase systemDatabase timeZoneNames" ^ self allTimeZones collect: [:e | e timeZoneName] ! ! !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: '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 class methodsFor: 'instance creation' stamp: 'dtl 12/28/1999 20:01'! 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" ThisSystemDatabase _ self fromZoneinfoDirectory: self tzPrefixPath. ^ ThisSystemDatabase ! ! !TimeZoneDatabase class methodsFor: 'instance creation' stamp: 'dtl 12/28/1999 20:01'! buildSystemDatabaseFromExamples "Build a full timezone database and install it as ThisSystemDatabase" "TimeZoneDatabase buildSystemDatabaseFromExamples" 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 12/28/1999 20:01'! systemDatabase "TimeZoneDatabase systemDatabase" ^ ThisSystemDatabase! ! !TimeZoneDatabase class methodsFor: 'initialize-release' stamp: 'dtl 1/8/2000 19:59'! 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: [ (TimeZoneDatabase exampleTzFiles select: [:e | ((Smalltalk at: #FileDirectory) default fileExists: e) not]) isEmpty ifTrue: [TimeZoneDatabase buildSystemDatabaseFromExamples] ifFalse: [TimeZoneDatabase thisSystemDatabase: nil]]. smalltalkFlavor == #VisualWorks ifTrue: [ contents _ ((Smalltalk at: #Filename) currentDirectory directoryContents). (TimeZoneDatabase exampleTzFiles select: [:e | (contents includes: e) not]) isEmpty ifTrue: [TimeZoneDatabase buildSystemDatabaseFromExamples] ifFalse: [TimeZoneDatabase thisSystemDatabase: nil]]. smalltalkFlavor == #'Smalltalk/X' ifTrue: [ contents _ ((Smalltalk at: #Filename) currentDirectory directoryContents). (TimeZoneDatabase exampleTzFiles select: [:e | (contents includes: e) not]) isEmpty ifTrue: [TimeZoneDatabase buildSystemDatabaseFromExamples] ifFalse: [TimeZoneDatabase thisSystemDatabase: nil]] ! ! !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 1/1/2000 11:46'! 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" | 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.2000') 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 12/28/1999 20:01'! 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." ^ 'right/America/Detroit' "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: '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 12/31/1999 15:52'! thisSystemDatabase: anObject ThisSystemDatabase _ anObject! ! !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 ! ! !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.! !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: 'printing' stamp: 'dtl 12/28/1999 20:01'! printOn: aStream "^ self printSimplyOn: aStream" ^ self printVerboseOn: aStream withLeapSeconds: nil! ! !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 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: $)! ! !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) ! ! !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. ! !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 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: '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: '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: '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: '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 12/30/1999 18:58'! 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 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. ! !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 loading' stamp: 'dtl 1/3/2000 22:52'! load "Load from my fileStream, and answer an array of a TimeZoneRuleSet and a LeapSecondRuleSet. My name and fileStream instance variables should already be set. Close fileStream when the file load is complete." | ttisgmtcnt ttisstdcnt leapcnt timecnt typecnt charcnt transitionTimes ttinfoIndices ttinfoStructs abbreviations isStd isGmt rec timeZoneRuleSet leapSecondRuleSet | "Check magic ID for the file" ((self magic: fileStream) = 'TZif') ifFalse: [ self notify: 'bad magic for zoneinfo file'. fileStream close. ^ nil]. "Skip 16 unused characters" fileStream next: 16. "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))]. fileStream atEnd ifFalse: [ self warn: 'zoneinfo parse error, should be at end of file'. fileStream close. ^ nil]. fileStream close. "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! ! !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 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 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 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 commentStamp: '' prior: 0! I provide access to time zone functions provided by the base VisualWorks system. ! !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 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: '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: '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 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 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).! !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: '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: '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 1/5/2000 20:26'! update: aParameter | dt | now isNil ifFalse: [ dt _ self now asDateAndTimeForTimeZone: self timeZone. date _ dt at: 1. time _ dt at: 2] ! ! !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)! ! OSTimeZone initialize! PointInTime initialize! PointInTimeNow initialize! TimeZoneDatabase initialize! "Postscript: Explore the example database." TimeZoneDatabase systemDatabase explore!