260 lines
9.8 KiB
Common Lisp
260 lines
9.8 KiB
Common Lisp
;;; Copyright (c) 2017, Sudhir Shenoy. All rights reserved.
|
|
|
|
;;; Redistribution and use in source and binary forms, with or without
|
|
;;; modification, are permitted provided that the following conditions
|
|
;;; are met:
|
|
|
|
;;; * Redistributions of source code must retain the above copyright
|
|
;;; notice, this list of conditions and the following disclaimer.
|
|
|
|
;;; * Redistributions in binary form must reproduce the above
|
|
;;; copyright notice, this list of conditions and the following
|
|
;;; disclaimer in the documentation and/or other materials
|
|
;;; provided with the distribution.
|
|
|
|
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
|
|
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
|
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
|
|
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
|
|
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
|
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
|
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
|
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
|
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
(in-package :cl-dates)
|
|
|
|
;; hash table containing mappings from time zone abbreviation to GMT offset
|
|
(defparameter +tz-info+ (make-hash-table :test #'equalp))
|
|
|
|
(defun str-to-tz-offset (str)
|
|
(gethash str +tz-info+))
|
|
|
|
(defun zone-to-offset (zone)
|
|
(typecase zone
|
|
(number zone)
|
|
(string (or (str-to-tz-offset zone) 0))
|
|
(t 0)))
|
|
|
|
(progn
|
|
;; Time zone abbreviation to offset mapping table (source: Wikipedia)
|
|
;; Wherever there are duplicate abbreviations, the more economically significant
|
|
;; (in terms of trading centres) zone has been retained
|
|
(let ((info '(("ACDT" 10.5 "Australian Central Daylight Savings Time")
|
|
("ACST" 9.5 "Australian Central Standard Time")
|
|
("ACT" -5 "Acre Time")
|
|
("ADT" -3 "Atlantic Daylight Time")
|
|
("AEDT" 11 "Australian Eastern Daylight Savings Time")
|
|
("AEST" 10 "Australian Eastern Standard Time")
|
|
("AFT" 4.5 "Afghanistan Time")
|
|
("AKDT" -8 "Alaska Daylight Time")
|
|
("AKST" -9 "Alaska Standard Time")
|
|
("AMST" -3 "Amazon Summer Time (Brazil)")
|
|
("AMT" -4 "Amazon Time (Brazil)")
|
|
("AMT" 4 "Armenia Time")
|
|
("ART" -3 "Argentina Time")
|
|
("AST" 3 "Arabia Standard Time")
|
|
;; ("AST" -4 "Atlantic Standard Time")
|
|
("AWST" 8 "Australian Western Standard Time")
|
|
("AZOST" 0 "Azores Summer Time")
|
|
("AZOT" -1 "Azores Standard Time")
|
|
("AZT" 4 "Azerbaijan Time")
|
|
("BDT" 8 "Brunei Time")
|
|
("BIOT" 6 "British Indian Ocean Time")
|
|
("BIT" -12 "Baker Island Time")
|
|
("BOT" -4 "Bolivia Time")
|
|
("BRST" -2 "Brasilia Summer Time")
|
|
("BRT" -3 "Brasilia Time")
|
|
;; ("BST" 6 "Bangladesh Standard Time")
|
|
;; ("BST" 11 "Bougainville Standard Time")
|
|
("BST" 1 "British Summer Time")
|
|
("BTT" 6 "Bhutan Time")
|
|
("CAT" 2 "Central Africa Time")
|
|
("CCT" 6.5 "Cocos Islands Time")
|
|
("CDT" -5 "Central Daylight Time (North America)")
|
|
;; ("CDT" -4 "Cuba Daylight Time")
|
|
("CEST" 2 "Central European Summer Time (Cf. HAEC)")
|
|
("CET" 1 "Central European Time")
|
|
("CHADT" 13.75 "Chatham Daylight Time")
|
|
("CHAST" 12.75 "Chatham Standard Time")
|
|
("CHOT" 8 "Choibalsan Standard Time")
|
|
("CHOST" 9 "Choibalsan Summer Time")
|
|
("CHST" 10 "Chamorro Standard Time")
|
|
("CHUT" 10 "Chuuk Time")
|
|
("CIST" -8 "Clipperton Island Standard Time")
|
|
("CIT" 8 "Central Indonesia Time")
|
|
("CKT" -10 "Cook Island Time")
|
|
("CLST" -3 "Chile Summer Time")
|
|
("CLT" -4 "Chile Standard Time")
|
|
("COST" -4 "Colombia Summer Time")
|
|
("COT" -5 "Colombia Time")
|
|
("CST" -6 "Central Standard Time (North America)")
|
|
;; ("CST" 8 "China Standard Time")
|
|
;; ("CST" -5 "Cuba Standard Time")
|
|
("ACST" 9.5 "Central Standard Time (Australia)")
|
|
("ACDT" 10.5 "Central Summer Time (Australia)")
|
|
("CT" 8 "China time")
|
|
("CVT" -1 "Cape Verde Time")
|
|
("CXT" 7 "Christmas Island Time")
|
|
("DAVT" 7 "Davis Time")
|
|
("DDUT" 10 "Dumont d'Urville Time")
|
|
("DFT" 1 "AIX specific equivalent of Central European Time")
|
|
("EASST" -5 "Easter Island Summer Time")
|
|
("EAST" -6 "Easter Island Standard Time")
|
|
("EAT" 3 "East Africa Time")
|
|
("ECT" -4 "Eastern Caribbean Time (does not recognise DST)")
|
|
;; ("ECT" -5 "Ecuador Time")
|
|
("EDT" -4 "Eastern Daylight Time (North America)")
|
|
("AEDT" 11 "Eastern Summer Time (Australia)")
|
|
("EEST" 3 "Eastern European Summer Time")
|
|
("EET" 2 "Eastern European Time")
|
|
("EGST" 0 "Eastern Greenland Summer Time")
|
|
("EGT" -1 "Eastern Greenland Time")
|
|
("EIT" 9 "Eastern Indonesian Time")
|
|
("EST" -5 "Eastern Standard Time (North America)")
|
|
("AEST" 10 "Eastern Standard Time (Australia)")
|
|
("FET" 3 "Further-eastern European Time")
|
|
("FJT" 12 "Fiji Time")
|
|
("FKST" -3 "Falkland Islands Summer Time")
|
|
("FKT" -4 "Falkland Islands Time")
|
|
("FNT" -2 "Fernando de Noronha Time")
|
|
("GALT" -6 "Galapagos Time")
|
|
("GAMT" -9 "Gambier Islands")
|
|
("GET" 4 "Georgia Standard Time")
|
|
("GFT" -3 "French Guiana Time")
|
|
("GILT" 12 "Gilbert Island Time")
|
|
("GIT" -9 "Gambier Island Time")
|
|
("GMT" 0 "Greenwich Mean Time")
|
|
;; ("GST" -2 "South Georgia and the South Sandwich Islands")
|
|
("GST" 4 "Gulf Standard Time")
|
|
("GYT" -4 "Guyana Time")
|
|
("HADT" -9 "Hawaii-Aleutian Daylight Time")
|
|
("HAEC" 2 "Heure Avancée d'Europe Centrale francised name for CEST")
|
|
("HAST" -10 "Hawaii-Aleutian Standard Time")
|
|
("HKT" 8 "Hong Kong Time")
|
|
("HMT" 5 "Heard and McDonald Islands Time")
|
|
("HOVST" 8 "Khovd Summer Time")
|
|
("HOVT" 7 "Khovd Standard Time")
|
|
("ICT" 7 "Indochina Time")
|
|
("IDT" 3 "Israel Daylight Time")
|
|
("IOT" 3 "Indian Ocean Time")
|
|
("IRDT" 4.5 "Iran Daylight Time")
|
|
("IRKT" 8 "Irkutsk Time")
|
|
("IRST" 3.5 "Iran Standard Time")
|
|
("IST" 5.5 "Indian Standard Time")
|
|
;; ("IST" 1 "Irish Standard Time[6]")
|
|
;; ("IST" 2 "Israel Standard Time")
|
|
("JST" 9 "Japan Standard Time")
|
|
("KGT" 6 "Kyrgyzstan time")
|
|
("KOST" 11 "Kosrae Time")
|
|
("KRAT" 7 "Krasnoyarsk Time")
|
|
("KST" 9 "Korea Standard Time")
|
|
("LHST" 10.5 "Lord Howe Standard Time")
|
|
;; ("LHST" 11 "Lord Howe Summer Time")
|
|
("LINT" 14 "Line Islands Time")
|
|
("MAGT" 12 "Magadan Time")
|
|
("MART" -9.5 "Marquesas Islands Time")
|
|
("MAWT" 5 "Mawson Station Time")
|
|
("MDT" -6 "Mountain Daylight Time (North America)")
|
|
("MET" 1 "Middle European Time Same zone as CET")
|
|
("MEST" 2 "Middle European Summer Time Same zone as CEST")
|
|
("MHT" 12 "Marshall Islands")
|
|
("MIST" 11 "Macquarie Island Station Time")
|
|
("MIT" -9.5 "Marquesas Islands Time")
|
|
("MMT" 6.5 "Myanmar Standard Time")
|
|
("MSK" 3 "Moscow Time")
|
|
;; ("MST" 8 "Malaysia Standard Time")
|
|
("MST" -7 "Mountain Standard Time (North America)")
|
|
("MUT" 4 "Mauritius Time")
|
|
("MVT" 5 "Maldives Time")
|
|
("MYT" 8 "Malaysia Time")
|
|
("NCT" 11 "New Caledonia Time")
|
|
("NDT" -2.5 "Newfoundland Daylight Time")
|
|
("NFT" 11 "Norfolk Time")
|
|
("NPT" 5.75 "Nepal Time")
|
|
("NST" -3.5 "Newfoundland Standard Time")
|
|
("NT" -3.5 "Newfoundland Time")
|
|
("NUT" -11 "Niue Time")
|
|
("NZDT" 13 "New Zealand Daylight Time")
|
|
("NZST" 12 "New Zealand Standard Time")
|
|
("OMST" 6 "Omsk Time")
|
|
("ORAT" 5 "Oral Time")
|
|
("PDT" -7 "Pacific Daylight Time (North America)")
|
|
("PET" -5 "Peru Time")
|
|
("PETT" 12 "Kamchatka Time")
|
|
("PGT" 10 "Papua New Guinea Time")
|
|
("PHOT" 13 "Phoenix Island Time")
|
|
("PHT" 8 "Philippine Time")
|
|
("PKT" 5 "Pakistan Standard Time")
|
|
("PMDT" -2 "Saint Pierre and Miquelon Daylight time")
|
|
("PMST" -3 "Saint Pierre and Miquelon Standard Time")
|
|
("PONT" 11 "Pohnpei Standard Time")
|
|
("PST" -8 "Pacific Standard Time (North America)")
|
|
;; ("PST" 8 "Philippine Standard Time")
|
|
("PYST" -3 "Paraguay Summer Time (South America)[7]")
|
|
("PYT" -4 "Paraguay Time (South America)[8]")
|
|
("RET" 4 "Réunion Time")
|
|
("ROTT" -3 "Rothera Research Station Time")
|
|
("SAKT" 11 "Sakhalin Island time")
|
|
("SAMT" 4 "Samara Time")
|
|
("SAST" 2 "South African Standard Time")
|
|
("SBT" 11 "Solomon Islands Time")
|
|
("SCT" 4 "Seychelles Time")
|
|
("SGT" 8 "Singapore Time")
|
|
("SLST" 5.5 "Sri Lanka Standard Time")
|
|
("SRET" 11 "Srednekolymsk Time")
|
|
("SRT" -3 "Suriname Time")
|
|
;; ("SST" -11 "Samoa Standard Time")
|
|
("SST" 8 "Singapore Standard Time")
|
|
("SYOT" 3 "Showa Station Time")
|
|
("TAHT" -10 "Tahiti Time")
|
|
("THA" 7 "Thailand Standard Time")
|
|
("TFT" 5 "Indian/Kerguelen")
|
|
("TJT" 5 "Tajikistan Time")
|
|
("TKT" 13 "Tokelau Time")
|
|
("TLT" 9 "Timor Leste Time")
|
|
("TMT" 5 "Turkmenistan Time")
|
|
("TRT" 3 "Turkey Time")
|
|
("TOT" 13 "Tonga Time")
|
|
("TVT" 12 "Tuvalu Time")
|
|
("ULAST" 9 "Ulaanbaatar Summer Time")
|
|
("ULAT" 8 "Ulaanbaatar Standard Time")
|
|
("USZ1" 2 "Kaliningrad Time")
|
|
("UTC" 0 "Coordinated Universal Time")
|
|
("UYST" -2 "Uruguay Summer Time")
|
|
("UYT" -3 "Uruguay Standard Time")
|
|
("UZT" 5 "Uzbekistan Time")
|
|
("VET" -4 "Venezuelan Standard Time")
|
|
("VLAT" 10 "Vladivostok Time")
|
|
("VOLT" 4 "Volgograd Time")
|
|
("VOST" 6 "Vostok Station Time")
|
|
("VUT" 11 "Vanuatu Time")
|
|
("WAKT" 12 "Wake Island Time")
|
|
("WAST" 2 "West Africa Summer Time")
|
|
("WAT" 1 "West Africa Time")
|
|
("WEST" 1 "Western European Summer Time")
|
|
("WET" 0 "Western European Time")
|
|
("WIT" 7 "Western Indonesian Time")
|
|
("WST" 8 "Western Standard Time")
|
|
("YAKT" 9 "Yakutsk Time")
|
|
("YEKT" 5 "Yekaterinburg Time"))))
|
|
(dolist (tz info)
|
|
(setf (gethash (car tz) +tz-info+) (cadr tz))))
|
|
|
|
;; add Military time zones
|
|
(loop for ch across "ABCDEFGHI"
|
|
do (let ((offset (1+ (- (char-code ch) (char-code #\A)))))
|
|
(setf (gethash (string ch) +tz-info+) offset)))
|
|
(setf (gethash "K" +tz-info+) 10
|
|
(gethash "L" +tz-info+) 11
|
|
(gethash "M" +tz-info+) 12
|
|
(gethash "C*" +tz-info+) 3.5
|
|
(gethash "D*" +tz-info+) 4.5
|
|
(gethash "E*" +tz-info+) 5.5
|
|
(gethash "F*" +tz-info+) 6.5)
|
|
(loop for ch across "NOPQRSTUVWXY"
|
|
do (let ((offset (- (1+ (- (char-code ch) (char-code #\N))))))
|
|
(setf (gethash (string ch) +tz-info+) offset)))
|
|
(setf (gethash "Z" +tz-info+) 0))
|