[local-time-devel] %offset-timestamp-part
Jaap de Heer
jaap.deheer at streamtech.nl
Wed Feb 17 22:25:55 UTC 2010
On Wed, Feb 17, 2010 at 11:20:16PM +0100, Jaap de Heer wrote:
> Attached a patch with the new function. It fixes the above issue.
Yikes, I forgot to remove some debugging code.
Fix attached.
Jaap
-------------- next part --------------
Wed Feb 17 23:12:57 CET 2010 jaap at streamtech.nl
* %offset-timestamp-part rewrite, fixes infinite loop crossing DST boundaries in Santiago
Wed Feb 17 23:22:21 CET 2010 jaap at streamtech.nl
* forgot to remove a bit of debugging
New patches:
[%offset-timestamp-part rewrite, fixes infinite loop crossing DST boundaries in Santiago
jaap at streamtech.nl**20100217221257
Ignore-this: 468530e59c6f0bc7e13a5c7af332b237
] {
hunk ./src/local-time.lisp 801
(encode-timestamp-into-values nsec sec minute hour day month year :timezone timezone :offset utc-offset)))))
(defun %offset-timestamp-part (time part offset &key (timezone *default-timezone*) utc-offset)
+ "Same as %OFFSET-TIMESTAMP-PART-TO-TIMESTAMP, but return result as nsec/sec/day values."
+ (let ((timestamp (%offset-timestamp-part-to-timestamp time part offset :timezone timezone :utc-offset utc-offset)))
+ (values (nsec-of timestamp)
+ (sec-of timestamp)
+ (day-of timestamp))))
+
+(defun %offset-timestamp-part-to-timestamp (time part offset &key (timezone *default-timezone*) utc-offset)
"Returns a time adjusted by the specified OFFSET. Takes care of
different kinds of overflows. The setting :day-of-week is possible
using a keyword symbol name of a week-day (see
hunk ./src/local-time.lisp 813
+DAY-NAMES-AS-KEYWORDS+) as value. In that case point the result to
the previous day given by OFFSET."
- (labels ((direct-adjust (part offset nsec sec day)
- (cond ((eq part :day-of-week)
- (with-decoded-timestamp (:day-of-week day-of-week
+ (let ((day (day-of time))
+ (sec (sec-of time))
+ (nsec (nsec-of time)))
+ (ecase part
+
+ (:day-of-week
+ (with-decoded-timestamp (:day-of-week day-of-week
:nsec nsec :sec sec :minute minute :hour hour
:day day :month month :year year
hunk ./src/local-time.lisp 822
- :timezone timezone :offset utc-offset)
- time
- (let ((position (position offset +day-names-as-keywords+ :test #'eq)))
- (assert position (position) "~S is not a valid day name" offset)
- (let ((offset (+ (- (if (zerop day-of-week)
- 7
- day-of-week))
- position)))
- (incf day offset)
- (when (< day 1)
- (let (days-in-month)
- (decf month)
- (when (< month 1)
- (setf month 12)
- (decf year))
- (setf days-in-month (days-in-month month year)
- day (+ days-in-month day)))) ;; day here is always <= 0
- (encode-timestamp-into-values nsec sec minute hour day month year
- :timezone timezone :offset utc-offset)))))
- ((zerop offset)
- ;; The offset is zero, so just return the parts of the timestamp object
- (values nsec sec day))
- (t
- (let ((old-utc-offset (or utc-offset
- (timestamp-subtimezone time timezone)))
- new-utc-offset)
- (tagbody
- top
- (ecase part
- (:nsec
- (multiple-value-bind (sec-offset new-nsec)
- (floor (+ offset nsec) 1000000000)
- ;; the time might need to be adjusted a bit more if q != 0
- (setf part :sec
- offset sec-offset
- nsec new-nsec)
- (go top)))
- ((:sec :minute :hour)
- (multiple-value-bind (days-offset new-sec)
- (floor (+ sec (* offset (ecase part
- (:sec 1)
- (:minute +seconds-per-minute+)
- (:hour +seconds-per-hour+))))
- +seconds-per-day+)
- (setf part :day
- offset days-offset
- sec new-sec)
- (go top)))
- (:day
- (incf day offset)
- (setf new-utc-offset (or utc-offset
- (timestamp-subtimezone (make-timestamp :nsec nsec :sec sec :day day)
- timezone)))
- (when (not (= old-utc-offset
- new-utc-offset))
- ;; We hit the DST boundary. We need to restart again
- ;; with :sec, but this time we know both old and new
- ;; UTC offset will be the same, so it's safe to do
- (setf part :sec
- offset (- old-utc-offset
- new-utc-offset)
- old-utc-offset new-utc-offset)
- (go top))
- (return-from direct-adjust (values nsec sec day)))))))))
+ :timezone timezone)
+ time
+ (let ((position (position offset +day-names-as-keywords+ :test #'eq)))
+ (assert position (position) "~S is not a valid day name" offset)
+ (let ((offset (+ (- (if (zerop day-of-week)
+ 7
+ day-of-week))
+ position)))
+ (incf day offset)
+ (when (< day 1)
+ (let (days-in-month)
+ (decf month)
+ (when (< month 1)
+ (setf month 12)
+ (decf year))
+ (setf days-in-month (days-in-month month year)
+ day (+ days-in-month day)))) ;; day here is always <= 0
+ ;; FIXME don't use encode-timestamp because it's ambiguous
+ (encode-timestamp nsec sec minute hour day month year :timezone timezone :offset utc-offset)))))
hunk ./src/local-time.lisp 842
- (safe-adjust (part offset time)
- (with-decoded-timestamp (:nsec nsec :sec sec :minute minute :hour hour :day day
- :month month :year year :timezone timezone :offset utc-offset)
- time
- (multiple-value-bind (month-new year-new)
- (%normalize-month-year-pair
- (+ (ecase part
- (:month offset)
- (:year (* 12 offset)))
- month)
- year)
- ;; Almost there. However, it is necessary to check for
- ;; overflows first
- (encode-timestamp-into-values nsec sec minute hour
- (%fix-overflow-in-days day month-new year-new)
- month-new year-new
- :timezone timezone :offset utc-offset)))))
- (ecase part
- ((:nsec :sec :minute :hour :day :day-of-week)
- (direct-adjust part offset
- (nsec-of time)
- (sec-of time)
- (day-of time)))
- ((:month :year) (safe-adjust part offset time)))))
+ (:nsec
+ (multiple-value-bind (sec-offset new-nsec)
+ (floor (+ offset nsec)
+ 1000000000)
+ (%offset-timestamp-part-to-timestamp (make-timestamp :day day
+ :sec sec
+ :nsec new-nsec)
+ :sec sec-offset)))
+
+ (:sec
+ (multiple-value-bind (days-offset new-sec)
+ (floor (+ sec offset)
+ +seconds-per-day+)
+ ;; We don't use (%offset-timestamp-part-to-timestamp :day) for this, because it would compensate for DST boundary crossing, which we don't want.
+ (print `(make-timestamp :day (+ ,day ,days-offset)
+ :sec ,new-sec
+ :nsec ,nsec))
+ (make-timestamp :day (+ day days-offset)
+ :sec new-sec
+ :nsec nsec)))
+
+ (:minute
+ (%offset-timestamp-part-to-timestamp time :sec (* +seconds-per-minute+ offset) :timezone *default-timezone* :utc-offset utc-offset))
+
+ (:hour
+ (%offset-timestamp-part-to-timestamp time :sec (* +seconds-per-hour+ offset) :timezone *default-timezone* :utc-offset utc-offset))
+
+ (:day
+ (let ((new-time (make-timestamp :day (+ day offset)
+ :sec sec
+ :nsec nsec)))
+ (if (or utc-offset
+ (= (timestamp-subtimezone time timezone)
+ (timestamp-subtimezone new-time timezone)))
+ new-time
+ ;; Compensate for DST boundary crossing...
+ (let ((dst-compensated-new-time (%offset-timestamp-part-to-timestamp new-time :sec (- (timestamp-subtimezone time timezone)
+ (timestamp-subtimezone new-time timezone)))))
+ (if (= (timestamp-subtimezone dst-compensated-new-time timezone)
+ (timestamp-subtimezone new-time timezone))
+ dst-compensated-new-time
+ ;; ... unless compensating takes us back past a DST border, in which case nevermind the compensation.
+ ;; For example, if on March 12 after 01:59:59 the clock is moved an hour forward (i.e. DST starts),
+ ;; and the caller asks for March 11 02:45 plus 1 day, then just give them March 12 03:45 (= March 11 02:45 plus 24 hours),
+ ;; not March 12 01:45 (= March 11 02:45 plus 24 hours - 1 hour DST compensation). This is especially important in zones
+ ;; like Santiago where the clock is moved forward at midnight: if we blindly compensate, this would yield
+ ;; "today 00:00 + 1 day = today 23:00" which is likely to mess up code assuming that today + 1 day is always tomorrow.
+ ;; I don't think there's really a right way to handle these situations; this'll have to do until someone cooks up something
+ ;; better. (Maybe return March 12 03:00 in the example case?)
+ new-time)))))
+
+ ((:month :year)
+ (with-decoded-timestamp (:nsec nsec :sec sec :minute minute :hour hour :day day
+ :month month :year year :timezone timezone)
+ time
+ (multiple-value-bind (month-new year-new)
+ (%normalize-month-year-pair
+ (+ (ecase part
+ (:month offset)
+ (:year (* 12 offset)))
+ month)
+ year)
+ (encode-timestamp nsec sec minute hour
+ (%fix-overflow-in-days day month-new year-new)
+ month-new year-new
+ :timezone timezone :offset utc-offset)))))))
;; TODO merge this functionality into timestamp-difference
(defun timestamp-whole-year-difference (time-a time-b)
}
[forgot to remove a bit of debugging
jaap at streamtech.nl**20100217222221
Ignore-this: a64b42c659027ac33b6b6d3773a537af
] hunk ./src/local-time.lisp 856
(floor (+ sec offset)
+seconds-per-day+)
;; We don't use (%offset-timestamp-part-to-timestamp :day) for this, because it would compensate for DST boundary crossing, which we don't want.
- (print `(make-timestamp :day (+ ,day ,days-offset)
- :sec ,new-sec
- :nsec ,nsec))
(make-timestamp :day (+ day days-offset)
:sec new-sec
:nsec nsec)))
Context:
[roll back my change where adjust-timestamp defaulted to UTC (both are broken, but this way it's at least backwards compatible)
attila.lendvai at gmail.com**20100209102239
Ignore-this: 63f876b8f1bf5483e874b3dbc0d4e177
]
[use hu.dwim.stefil for unit testing.
attila.lendvai at gmail.com**20100127081740
Ignore-this: e5ddf9db232c9723b233e19ba1c9948c
useful things for copy/pasting:
darcs get http://common-lisp.net/project/alexandria/darcs/alexandria/
darcs get http://dwim.hu/darcs/hu.dwim.stefil
(asdf:test-system :local-time)
]
[follow documentation/ -> doc/ rename in .boring
attila.lendvai at gmail.com**20100127081710
Ignore-this: 2ea403b64f5ada4b2e9dbb4b013b99b9
]
[added a (check-type result time-of-day) in cl-postgres integration
attila.lendvai at gmail.com**20100126123531
Ignore-this: 4750c6ffaa3e8ed41d10fe2fb9d5b229
]
[renamed 'time to 'time-of-day for less conflict headaches
attila.lendvai at gmail.com**20100126123505
Ignore-this: 50b518114f386d042701ad92260e4794
]
[fix valid-date-p
attila.lendvai at gmail.com**20091206211948
Ignore-this: 207df3b76010adf3a2e749fe9d60db57
]
[Added date and time types.
levente.meszaros at gmail.com**20091201201849
Ignore-this: b858bbe9a6b10f4ed106fba83d69e406
]
[Split local-time.asd and introduce cl-postgres+local-time.asd.
levente.meszaros at gmail.com**20091009161856
Ignore-this: 3e4521adc1a0afa273c63d304cd6e9c8
]
[TAG before controversial changes
Daniel Lowe <dlowe at bitmuse.com>**20100126123450
Ignore-this: 7f2ec6e3a5baa0691637367f1b22aed
]
[fix test adjust-timestamp/bug3 (PLEASE AUDIT!)
attila.lendvai at gmail.com**20100125122540
Ignore-this: 6b449034e6c96f245709a808c5e14593
]
[fix test adjust-timestamp/bug2 (PLEASE AUDIT!)
attila.lendvai at gmail.com**20100125122530
Ignore-this: 212178187413618cb83e4e7d0bd8658e
]
[adjust-timestamp defaults to :utc-offset 0 unless timezone is specified. fixes surprises shown by test adjust-timestamp/bug2 (PLEASE AUDIT!)
attila.lendvai at gmail.com**20100125122507
Ignore-this: 1eff627c0e5d072b89d7119c4426f229
]
[added adjust-timestamp/bug3
attila.lendvai at gmail.com**20100125121843
Ignore-this: 2c3cd77b1f107152dd36633734ae4ae
]
[whitespace
attila.lendvai at gmail.com**20100125120759
Ignore-this: 341ea584efa430672b4a7fae8368184a
]
[added test adjust-timestamp/bug2
attila.lendvai at gmail.com**20100124185450
Ignore-this: 996991645615afe1a9a6be8cef3c7a4f
]
[Fix SBCL conditional compilation
Jonathan Lee <jonathlee at gmail.com>**20100102181805
Ignore-this: e084a602df8e1931fff11d4d9f6ba814
]
[Updated asdf version number to 1.0.1
dlowe at bitmuse.com**20100111031331
Ignore-this: 17e00a012590c5116fbdeb86566b1786
]
[added +months-per-year+
attila.lendvai at gmail.com**20091202102038
Ignore-this: 5c1c99bee45537409939c4da0ada1075
]
[another take on reread-timezone-repository & co.
attila.lendvai at gmail.com**20091030235517
Ignore-this: ad00124eea993a623c42e0cd9b6ad81c
]
[try to make the initialization of *project-home-directory* a bit less fragile when not loading through ASDF
attila.lendvai at gmail.com**20091030093403
Ignore-this: 5a848c282db52a5edb38df6fdf9c186e
although i personally am much more interested in making local-time load with xcvb, than keeping it in one
file that can be CL:LOAD'ed...
]
[make it loadable with (load "local-time.lisp")
attila.lendvai at gmail.com**20091030092409
Ignore-this: b3aae958e1003af861646fda0f036c9d
]
[fix #+#. voodoo, one less compilation warning
attila.lendvai at gmail.com**20091030091812
Ignore-this: b80cc242457896e43c168c9fdc1aadf3
]
[formatting, semantically NOP
attila.lendvai at gmail.com**20091030091743
Ignore-this: 6edfb0b406108f1b3cd296a245dac55f
]
[whitespace changes, one less warning
attila.lendvai at gmail.com**20091029122310
Ignore-this: 6a319ea0491a85a8bd270a2468c7b47a
]
[added a deftype for timezone-offset, fix bug reported by Abhishek Reddy and Huw Giddens
attila.lendvai at gmail.com**20091029122004
Ignore-this: a3e828c02dcdf1d195311cfe5305ec6f
http://common-lisp.net/pipermail/local-time-devel/2009-October/000173.html
]
[some tests
attila.lendvai at gmail.com**20091029121803
Ignore-this: 9c510d5a16519beeeed2738d290742a1
]
[Don't discard value of sb-ext:get-time-of-day
Daniel Lowe <dlowe at bitmuse.com>**20091022155025
Ignore-this: 565ad4c1ee49c11d900c3e1781e9f6e0
]
[Provide support for formatting the day as an ordinal (e.g. 1st, 22nd)
Daniel White <daniel at whitehouse.id.au>**20091022132601
Ignore-this: c166703967661a3d7e32a4489184fdd4
]
[fix test: reread-timezone-repository is not public in local-time package (anymore?)
attila.lendvai at gmail.com**20091005090107
Ignore-this: 8e3f2381c3c11afdd5123055e332f904
]
[comments
attila.lendvai at gmail.com**20091002083019
Ignore-this: 855a9b7004e33350c0a0394e242f459d
]
[ccl-windows-without-gettimeofday
essdir at web.de**20090901164212
Ignore-this: b6df4f6bd69eff0d6fd18dc1a90097e7
]
[Minor bugfix: :utc-offset instead of :offset
Maciej Katafiasz <mathrick at gmail.com>**20090808135148
Ignore-this: e20b7cff5ec220a83bd112265b06f99f
]
[follow the format-rfcnumber-timestring nameing convention, rename format-http-timestring
attila.lendvai at gmail.com**20090928091959
Ignore-this: a35c5d543cabb520ff676c9a490f1cb2
]
[Make timestamp manipulation functions take and respect timezone arguments.
Maciej Katafiasz <mathrick at gmail.com>**20090727180103
Ignore-this: 79214728e4966f44d8d4587bd850c53b
]
[Make WITH-DECODED-TIMESTAMP and related take timezone/offset arguments.
Maciej Katafiasz <mathrick at gmail.com>**20090727175400
Ignore-this: 296084f8d9179fe257c69118b7123309
]
[Make ENCODE-TIMESTAMP accept timezones instead of fixed offsets.
Maciej Katafiasz <mathrick at gmail.com>**20090727174013
Ignore-this: f6420e93d194396afb221821e1312652
]
[update TODO, add link to chronicity
attila.lendvai at gmail.com**20090729181326
Ignore-this: aa290ebfb4f6001600cf33a228a99a41
]
[Use symbols instead of strings where possible.
Maciej Katafiasz <mathrick at gmail.com>**20090724164920]
[added a once failing test
attila.lendvai at gmail.com**20090616143818
Ignore-this: 741ad01d47b47e15cb4877567d3ba9d9
]
[add a more useful error when find-timezone-by-location-name is used without reading in the timezone files
attila.lendvai at gmail.com**20090616143733
Ignore-this: c982ca27ef16e7f865afece963b6c9be
]
[fix (print (now)) when *timezone* is (find-timezone-by-location-name "UTC")
attila.lendvai at gmail.com**20090616141707
Ignore-this: ac694826aa5e9719d41c51503e0a8785
]
[clean up gettimeofday stuff, follow sbcl's changes (but remain backward compatible)
attila.lendvai at gmail.com**20090521170712
Ignore-this: 70b2754c0a254abb060dce0f15bb266
]
[remove superfluous eval-when around reread-timezone-repository
attila.lendvai at gmail.com**20090513213236
Ignore-this: 337cf4b3d50d0714f2c4a4a3d84e356f
]
[Local-time now passes all tests in CCL
Daniel Lowe <dlowe at bitmuse.com>**20090417142203]
[Changed lispworks/ccl kluge to another, better kluge
Daniel Lowe <dlowe at bitmuse.com>**20090417142156]
[In WITH-DECODED-TIMESTAMP, declare nsec type as ranged integer instead of FIXNUM
Daniel Lowe <dlowe at bitmuse.com>**20090416204555]
[clarification comment for the lispworks #_ situation
attila.lendvai at gmail.com**20090324135651
Ignore-this: 1f97d85c23ecffd5806f7a3c137f8491
]
[Less intrusive version of the Lispworks patch for #_.
Larry Clapp <larry at theclapp.org>**20090324132813
Use an around method in ASDF's compile-op to set the readtable to ignore #_.
This achieves the same end, but more elegantly, and doesn't pollute the
regular readtable.
]
[be more conservative when installing global reader macros as a lispwork workaround
attila.lendvai at gmail.com**20090323142133
Ignore-this: dca64a6f7daa4d478beba41d1c102a16
]
[Work with Lispworks
Larry Clapp <larry at theclapp.org>**20090323132602
- Added a dummy reader macro for #_ so the
#+ccl
(... #_gettimeofday ... )
doesn't break the compile
- Fix %unix-gettimeofday for Lisps other than CMU, SBCL, and CCL.
]
[TAG local-time-1.0.1
Daniel Lowe <dlowe at bitmuse.com>**20090312154109]
Patch bundle hash:
d29a4efe4096fcdbc4aa78b47da570397c3f96af
More information about the local-time-devel
mailing list