1 ! Copyright (C) 2013 John Benediktsson
2 ! See https://factorcode.org/license.txt for BSD license
4 USING: accessors alien.c-types alien.data alien.endian arrays
5 assocs calendar classes.struct combinators endian hashtables io
6 io.encodings.binary io.files kernel locals math math.order
14 { tzh_reserved char[16] }
15 { tzh_ttisgmtcnt be32 }
16 { tzh_ttisstdcnt be32 }
20 { tzh_charcnt be32 } ;
25 { tt_abbrind uchar } ;
30 4 read "TZif" sequence= [ bad-magic ] unless ;
32 TUPLE: tzfile header transition-times local-times types abbrevs
40 : read-tzfile ( -- tzfile )
41 check-magic tzhead read-struct dup {
42 [ tzh_timecnt>> [ read-be32 ] replicate ]
43 [ tzh_timecnt>> [ read1 ] replicate ]
44 [ tzh_typecnt>> [ ttinfo read-struct ] replicate ]
45 [ tzh_charcnt>> read ]
46 [ tzh_leapcnt>> [ read-be32 read-be32 2array ] replicate ]
47 [ tzh_ttisstdcnt>> read ]
48 [ tzh_ttisgmtcnt>> read ]
51 :: tznames ( abbrevs -- assoc )
53 0 over abbrevs index-from dup
55 [ dupd abbrevs subseq >string 2array ] keep 1 + swap
56 ] produce 2nip >hashtable ;
58 TUPLE: local-time gmt-offset dst? abbrev std? gmt? ;
60 C: <local-time> local-time
62 TUPLE: transition seconds timestamp local-time ;
64 C: <transition> transition
66 :: tzfile>transitions ( tzfile -- transitions )
67 tzfile abbrevs>> tznames :> abbrevs
68 tzfile is-std>> :> is-std
69 tzfile is-gmt>> :> is-gmt
73 [ tt_gmtoff>> seconds ]
75 [ tt_abbrind>> abbrevs at ]
78 [ is-std ?nth dup [ 1 = ] when ]
79 [ is-gmt ?nth dup [ 1 = ] when ] bi <local-time>
80 ] map-index :> local-times
81 tzfile transition-times>>
82 tzfile local-times>> [
83 [ dup unix-time>timestamp ] [ local-times nth ] bi*
87 TUPLE: tzinfo tzfile transitions ;
91 : find-transition ( timestamp tzinfo -- transition )
92 [ timestamp>unix-time ] [ transitions>> ] bi*
93 [ [ seconds>> before? ] with find drop ]
94 [ swap [ 1 [-] swap nth ] [ last ] if* ] bi ;
98 : file>tzinfo ( path -- tzinfo )
100 read-tzfile dup tzfile>transitions <tzinfo>
103 : from-utc ( timestamp tzinfo -- timestamp' )
104 [ drop instant >>gmt-offset ]
105 [ find-transition local-time>> gmt-offset>> ] 2bi
108 : normalize ( timestamp tzinfo -- timestamp' )
109 [ instant convert-timezone ] [ from-utc ] bi* ;
111 : load-tzinfo ( name -- tzinfo )
112 "/usr/share/zoneinfo/" prepend file>tzinfo ;