;;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*- ;;; ;;; Touched: Sun Jan 01 19:14:41 2006 +0530 ;;; Time-stamp: <06/01/08 01:46:42 madhu> ;;; Bugs-To: ;;; ;;; (C) 2006 Madhu, All rights Reserved. ;;; $Id: tzfile.lisp,v 1.3 2006/01/07 18:48:58 madhu Exp madhu $ ;;; ;;; Some text adapted from man tzfile(5). ;;; (in-package "CL-USER") (eval-when (load eval compile) (unless (find-package "BINARY-TYPES") (or #+cmu (lc "home:cmu/binary-types-0.90/binary-types.lisp") (error "Requires frodef's excellent BINARY-TYPES package.")))) (defpackage "TZFILE" (:use "CL" "BINARY-TYPES") (:export "TIMEZONE-INFO")) (in-package "TZFILE") #+nil (use-package "BINARY-TYPES") (setq *endian* :big-endian) ; network byte (defconstant +timezone-info-magic+ '(#\T #\Z #\i #\f)) (define-binary-class timezone-info-header () ((tzh_ttisgmtcnt :binary-type 's32 :documentation "The number of UTC/local indicators stored in the file.") (tzh_ttisstdcnt :binary-type 's32 :documentation "The number of standard/wall indicators stored in the file.") (tzh_leapcnt :binary-type 's32 :documentation "The number of leap seconds for which data is stored in the file.") (tzh_timecnt :binary-type 's32 :documentation "The number of `transition times' for which data is stored in the file") (tzh_typecnt :binary-type 's32 :documentation "The number of `local time types' for which data is stored in the file (must not be zero).") (tzh_charcnt :binary-type 's32 :documentation "The number of characters of `time zone abbreviation strings' stored in the file."))) ;; local time type (define-binary-class ttinfo () ((tt_gmtoff ; long, 4 network bytes :binary-type 's32 :documentation "the number of seconds to be added to UTC.") (tt_isdst ; int, 1 byte :binary-type 's8 :documentation "whether tm_isdst should be set by localtime(3).") (tt_abbrind ; unsigned int, 1 byte :binary-type 'u8 :documentation "index into array of time zone abbreviation characters"))) (defclass TIMEZONE-INFO () ((timezone-info-magic :type (array character 4) :documentation "The time zone information files used by tzset(3) begin with the magic characters ``TZif'' to identify then as time zone information files") (future-use :type (array character 16) :documentation "sixteen bytes reserved for future use") (timezone-info-header :type timezone-info-header :documentation "six four-byte values of type long, written in a ``standard'' byte order (the high-order byte of the value is written first).") (transition-times :type array ; :documentation "tzh_timecnt four-byte values of type long, sorted in ascending order. Each is used as a transition time (as returned by time(2)) at which the rules for computing local time change.") (local-ttindices :type (array (unsigned-byte 8) *) :documentation "tzh_timecnt one-byte values of type unsigned char; each one tells which of the different types of ``local time'' types described in the file is associated with the same-indexed transition time. These values serve as indices into an array of ttinfo structures that appears next in the file;") (local-ttinfo :type (array ttinfo *) :documentation "tzh_typecnt ttinfo objects. Each TTINFO object is written as a four-byte value for tt_gmtoff of type long, in a standard byte order, followed by a one-byte value for tt_isdst and a one-byte value for tt_abbrind.") (abbreviations :type (array character *) :documentation "tzh_charcnt string of time zone abbreviation characters") (leap-second-info :type (array cons *) :documentation "tzh_leapcnt pairs of four-byte values, written in standard byte order; the first value of each pair gives the time (as returned by time(2)) at which a leap second occurs; the second gives the total number of leap seconds to be applied after the given time. The pairs of values are sorted in ascending order by time.") (standard/wall-indicators :type (array (unsigned-byte 8) *) :documentation "tzh_ttisstdcnt standard/wall indicators, each stored as a one-byte value; they tell whether the transition times associated with local time types were specified as standard time or wall clock time, and are used when a time zone file is used in handling POSIX-style time zone environment variables.") (utc/local-indicators :type (array (unsigned-byte 8) *) :documentation "tzh_ttisgmtcnt UTC/local indicators, each stored as a one-byte value; they tell whether the transition times associated with local time types were specified as UTC or local time, and are used when a time zone file is used in handling POSIX-style time zone environment variables."))) (defun parse-timezone-info (obj stream) "(INTERNAL) parse STREAM into a `TIMEZONE-INFO' OBJ" (with-slots (timezone-info-magic future-use timezone-info-header transition-times local-ttindices local-ttinfo abbreviations leap-second-info standard/wall-indicators utc/local-indicators) obj (setf timezone-info-magic (read-binary-string stream :size 4)) (map nil (lambda (x y) (unless (char= x y) (error "Bad magic"))) timezone-info-magic +timezone-info-magic+) (setq future-use (read-binary-string stream :size 16)) (setf timezone-info-header (read-binary 'timezone-info-header stream)) (with-slots (tzh_ttisgmtcnt tzh_ttisstdcnt tzh_leapcnt tzh_timecnt tzh_typecnt tzh_charcnt) timezone-info-header (setf transition-times (coerce (loop for i below tzh_timecnt collect (read-binary 's32 stream)) 'vector)) (setf local-ttindices (coerce (loop for i below tzh_timecnt collect (read-binary 'u8 stream)) 'vector)) (setf local-ttinfo (coerce (loop for i below tzh_typecnt collect (read-binary 'ttinfo stream)) 'vector)) (setf abbreviations (read-binary-string stream :size tzh_charcnt)) (setf leap-second-info (coerce (loop for i below tzh_leapcnt collect (cons (read-binary 's32 stream) (read-binary 's32 stream))) 'vector)) (setf standard/wall-indicators (coerce (loop for i below tzh_ttisstdcnt collect (read-binary 'u8 stream)) 'vector)) (setf utc/local-indicators (coerce (loop for i below tzh_ttisgmtcnt collect (read-binary 'u8 stream)) 'vector))))) ;;; ;;; ENTRYPOINT: ;;; (defmethod initialize-instance :after ((obj timezone-info) &key pathname) (with-open-file (stream pathname :element-type '(unsigned-byte 8)) (parse-timezone-info obj stream))) (defconstant +unix-epoch+ (encode-universal-time 0 0 0 1 1 1970 0)) (defun unix-time (universal-time) (- universal-time +unix-epoch+)) ;; TIMEZONE-INFO uses the first standard-time ttinfo structure in the ;; file (or simply the first ttinfo structure in the absence of a ;; standard-time structure) if either tzh_timecnt is zero or the time ;; argument is less than the first transition time recorded in the ;; file. (defun TIMEZONE-INFO (universal-time timezone-info) "TIMEZONE-INFO returns `local time' information for a given UNIVERSAL-TIME and a TIMEZONE-INFO file. Returns as values the number of seconds east of GMT, isdst, abbr, ttisstd, and ttisgmt." (check-type universal-time (integer 0)) (check-type timezone-info timezone-info) (with-slots (transition-times local-ttindices local-ttinfo abbreviations utc/local-indicators standard/wall-indicators) timezone-info (let* ((unix-time (unix-time universal-time)) (index (or (loop for i from 0 for timezone-transition across transition-times if (< unix-time timezone-transition) return (if (< 0 i) (elt local-ttindices (1- i))) finally (return (if (< 0 i) (elt local-ttindices (1- i))))) (loop for ttisstd across standard/wall-indicators for i from 0 if (not (zerop ttisstd)) ; untested return (elt local-ttindices i)) 0)) (ttinfo (elt local-ttinfo index))) (with-slots (tt_gmtoff tt_isdst tt_abbrind) ttinfo (values tt_gmtoff ; the number of seconds ahead of GMT (not (zerop tt_isdst)) ; boolean daylight-saving-p ;; the customary abbreviation of the timezone (subseq abbreviations tt_abbrind (position #\null abbreviations :start tt_abbrind)) ;; ttisstd (not (zerop (elt standard/wall-indicators index))) ;; ttisgmt (not (zerop (elt utc/local-indicators index)))))))) #|| (defvar $ist (make-instance 'timezone-info :pathname #p"/etc/localtime")) (timezone-info (get-universal-time) $ist) (defvar $mst (make-instance 'timezone-info :pathname "/usr/share/zoneinfo/posix/MST")) (defvar $bst (make-instance 'timezone-info :pathname "/usr/share/zoneinfo/GB")) (defvar $est (make-instance 'timezone-info :pathname "/usr/share/zoneinfo/EST")) (timezone-info 193999999 $ist) (timezone (get-universal-time) $mst) (timezone-info (ext:parse-time "07 Feb 1999 21:20:37") $bst) (timezone-info (ext:parse-time "07 Jun 1941 21:20:37") $ist) (timezone-info (ext:parse-time "Sat Jul 07 21:20:37 2028") $mst) (timezone-info (ext:parse-time "07 Jul 1988 21:20:37 ") $est) (timezone-info (ext:parse-time "07 Jan 1998 21:20:37") $est) ||#