summaryrefslogtreecommitdiffstats
path: root/timezone.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:31 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:31 -0800
commit5145dd3aa0c02c9fc496d1432fc4410674206e1d (patch)
tree540afc30c51da085f5bd8ec3f4c89f6496e7900d /timezone.scm
parent8466d8cfa486fb30d1755c4261b781135083787b (diff)
downloadslib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.tar.gz
slib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.zip
Import Upstream version 3a2upstream/3a2
Diffstat (limited to 'timezone.scm')
-rw-r--r--timezone.scm145
1 files changed, 18 insertions, 127 deletions
diff --git a/timezone.scm b/timezone.scm
index 89f85c8..2d35dd7 100644
--- a/timezone.scm
+++ b/timezone.scm
@@ -49,35 +49,33 @@
;; Sat Nov 15 00:15:33 1997 Aubrey Jaffer
(require 'scanf)
+(require 'time-core)
(require-if 'compiling 'tzfile)
-;@
-(define daylight? #f)
-(define *timezone* 0)
-(define tzname '#("UTC" "???"))
-
-(define tz:default #f)
;;; This definition is here so that READ-TZFILE can verify the
;;; existence of these files before loading tzfile.scm to actually
;;; read them.
(define tzfile:vicinity (make-vicinity
- (if (file-exists? "/usr/share/zoneinfo/.")
+ (if (file-exists? "/usr/share/zoneinfo/GMT")
"/usr/share/zoneinfo/"
"/usr/lib/zoneinfo/")))
(define (read-tzfile path)
+ (define (existing path) (and (file-exists? path) path))
(let ((realpath
- (cond ((not path) (in-vicinity tzfile:vicinity "localtime"))
+ (cond ((not path)
+ (or (existing (in-vicinity tzfile:vicinity "localtime"))
+ (existing "/etc/localtime")))
((or (char-alphabetic? (string-ref path 0))
(char-numeric? (string-ref path 0)))
(in-vicinity tzfile:vicinity path))
(else path))))
- (and (file-exists? realpath)
- (let ((zone #f))
- (require 'tzfile)
- (set! zone (tzfile:read realpath))
- (if zone (list->vector (cons 'tz:file zone))
- (slib:error 'read-tzfile realpath))))))
+ (or (and (file-exists? realpath)
+ (let ((zone #f))
+ (require 'tzfile)
+ (set! zone (tzfile:read realpath))
+ (and zone (list->vector (cons 'tz:file zone)))))
+ (slib:error 'read-tzfile realpath))))
;;; Parse Posix TZ string.
@@ -148,117 +146,10 @@
(else #f))))
;@
(define (time-zone tz)
- (cond ((not tz) (read-tzfile #f))
- ((vector? tz) tz)
- ((eqv? #\: (string-ref tz 0))
- (read-tzfile (substring tz 1 (string-length tz))))
+ (cond ((vector? tz) tz)
+ ((or (not tz)
+ (eqv? #\: (string-ref tz 0)))
+ (let ()
+ (require 'tzfile)
+ (read-tzfile (and tz (substring tz 1 (string-length tz))))))
(else (string->time-zone tz))))
-
-;;; Use the timezone
-
-(define (tzrule->caltime year previous-gmt-offset
- tr-month tr-week tr-day tr-time)
- (define leap? (leap-year? year))
- (define gmmt
- (time:invert time:gmtime
- (vector 0 0 0 1 (if tr-month (+ -1 tr-month) 0) year #f #f 0)))
- (offset-time
- gmmt
- (+ tr-time previous-gmt-offset
- (* 3600 24
- (if tr-month
- (let* ((fdow (vector-ref (time:gmtime gmmt) 6)))
- (case tr-week
- ((1 2 3 4) (+ (modulo (- tr-day fdow) 7)
- (* 7 (+ -1 tr-week))))
- ((5)
- (do ((mmax (vector-ref
- (vector-ref time:days/month (if leap? 1 0))
- (+ -1 tr-month)))
- (d (modulo (- tr-day fdow) 7) (+ 7 d)))
- ((>= d mmax) (+ -7 d))))
- (else (slib:error 'tzrule->caltime
- "week out of range" tr-week))))
- (+ tr-day
- (if (and (not tr-week) (>= tr-day 60) (leap-year? year))
- 1 0)))))))
-;@
-(define (tz:params caltime tz)
- (case (vector-ref tz 0)
- ((tz:fixed) (list 0 (vector-ref tz 3) (vector-ref tz 2)))
- ((tz:rule)
- (let* ((year (vector-ref (time:gmtime caltime) 5))
- (ttime0 (apply tzrule->caltime
- year (vector-ref tz 4) (vector-ref tz 6)))
- (ttime1 (apply tzrule->caltime
- year (vector-ref tz 5) (vector-ref tz 7)))
- (dst (if (and (not (negative? (difftime caltime ttime0)))
- (negative? (difftime caltime ttime1)))
- 1 0)))
- (list dst (vector-ref tz (+ 4 dst)) (vector-ref tz (+ 2 dst)))
- ;;(for-each display (list (gtime ttime0) (gtime caltime) (gtime ttime1)))
- ))
- ((tz:file) (let ((zone-spec (tzfile:get-zone-spec caltime tz)))
- (list (if (vector-ref zone-spec 2) 1 0)
- (- (vector-ref zone-spec 1))
- (vector-ref zone-spec 0))))
- (else (slib:error 'tz:params "unknown timezone type" tz))))
-;@
-(define (tz:std-offset zone)
- (case (vector-ref zone 0)
- ((tz:fixed) (vector-ref zone 3))
- ((tz:rule) (vector-ref zone 4))
- ((tz:file)
- (let ((mode-table (vector-ref zone 2)))
- (do ((type-idx 0 (+ 1 type-idx)))
- ((or (>= type-idx (vector-length mode-table))
- (not (vector-ref (vector-ref mode-table type-idx) 2)))
- (if (>= type-idx (vector-length mode-table))
- (vector-ref (vector-ref mode-table 0) 1)
- (- (vector-ref (vector-ref mode-table type-idx) 1)))))))
- (else (slib:error 'tz:std-offset "unknown timezone type" tz))))
-
-;;;@ Interpret the TZ envariable.
-(define (tzset . opt-tz)
- (define tz (if (null? opt-tz)
- (getenv "TZ")
- (car opt-tz)))
- (if (or (not tz:default)
- (and (string? tz) (not (string-ci=? tz (vector-ref tz:default 1)))))
- (set! tz:default (or (time-zone tz) '#(tz:fixed "UTC" "GMT" 0))))
- (case (vector-ref tz:default 0)
- ((tz:fixed)
- (set! tzname (vector (vector-ref tz:default 2) "???"))
- (set! daylight? #f)
- (set! *timezone* (vector-ref tz:default 3)))
- ((tz:rule)
- (set! tzname (vector (vector-ref tz:default 2)
- (vector-ref tz:default 3)))
- (set! daylight? #t)
- (set! *timezone* (vector-ref tz:default 4)))
- ((tz:file)
- (let ((mode-table (vector-ref tz:default 2))
- (transition-types (vector-ref tz:default 5)))
- (set! daylight? #f)
- (set! *timezone* (vector-ref (vector-ref mode-table 0) 1))
- (set! tzname (make-vector 2 #f))
- (do ((type-idx 0 (+ 1 type-idx)))
- ((>= type-idx (vector-length mode-table)))
- (let ((rec (vector-ref mode-table type-idx)))
- (if (vector-ref rec 2)
- (set! daylight? #t)
- (set! *timezone* (- (vector-ref rec 1))))))
-
- (do ((transition-idx (+ -1 (vector-length transition-types))
- (+ -1 transition-idx)))
- ((or (negative? transition-idx)
- (and (vector-ref tzname 0) (vector-ref tzname 1))))
- (let ((rec (vector-ref mode-table
- (vector-ref transition-types transition-idx))))
- (if (vector-ref rec 2)
- (if (not (vector-ref tzname 1))
- (vector-set! tzname 1 (vector-ref rec 0)))
- (if (not (vector-ref tzname 0))
- (vector-set! tzname 0 (vector-ref rec 0))))))))
- (else (slib:error 'tzset "unknown timezone type" tz)))
- tz:default)