datetime.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          datetime.lisp
   6 ;;;; Purpose:       Date & Time functions for KMRCL package
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Apr 2000
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; KMRCL users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  17 ;;;; *************************************************************************
  18
  19 (in-package #:kmrcl)
  20
  21
  22 ;;; Formatting functions
  23
  24 (defun pretty-date (year month day &optional (hour 12) (m 0) (s 0))
  25   (multiple-value-bind (sec min hr dy mn yr wkday)
  26     (decode-universal-time
  27      (encode-universal-time s m hour day month year))
  28     (values (elt '("Monday" "Tuesday" "Wednesday" "Thursday"
  29                    "Friday" "Saturday" "Sunday")
  30                  wkday)
  31             (elt '("January" "February" "March" "April" "May" "June"
  32                    "July" "August" "September" "October" "November"
  33                    "December")
  34                  (1- mn))
  35             (format nil "~A" dy) (format nil "~A" yr)
  36             (format nil "~2,'0D:~2,'0D:~2,'0D" hr min sec))))
  37
  38
  39 (defun date-string (ut)
  40   (if (typep ut 'integer)
  41       (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
  42           (decode-universal-time ut)
  43         (declare (ignore daylight-p zone))
  44         (format nil "~[Mon~;Tue~;Wed~;Thu~;Fri~;Sat~;Sun~], ~d ~[Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~d ~2,'0d:~2,'0d:~2,'0d"
  45                 dow
  46                 day
  47                 (1- mon)
  48                 year
  49                 hr min sec))))
  50
  51 (defun print-seconds (secs)
  52   (print-float-units secs "sec"))
  53
  54 (defun print-float-units (val unit)
  55   (cond
  56     ((< val 1d-6)
  57      (format t "~,2,9F nano~A" val unit))
  58     ((< val 1d-3)
  59      (format t "~,2,6F micro~A" val unit))
  60     ((< val 1)
  61      (format t "~,2,3F milli~A" val unit))
  62     ((> val 1d9)
  63      (format t "~,2,-9F giga~A" val unit))
  64     ((> val 1d6)
  65      (format t "~,2,-6F mega~A" val unit))
  66     ((> val 1d3)
  67      (format t "~,2,-3F kilo~A" val unit))
  68     (t
  69      (format t "~,2F ~A" val unit))))
  70
  71 (defconstant +posix-epoch+
  72   (encode-universal-time 0 0 0 1 1 1970 0))
  73
  74 (defun posix-time-to-utime (time)
  75   (+ time +posix-epoch+))
  76
  77 (defun utime-to-posix-time (utime)
  78   (- utime +posix-epoch+))
  79
  80 ;; Monthnames taken from net-telent-date to support lml2
  81
  82 (defvar *monthnames*
  83   '((1 . "January")
  84     (2 . "February")
  85     (3 . "March")
  86     (4 . "April")
  87     (5 . "May")
  88     (6 . "June")
  89     (7 . "July")
  90     (8 . "August")
  91     (9 . "September")
  92     (10 . "October")
  93     (11 . "November")
  94     (12 . "December")))
  95
  96 (defun monthname (stream arg colon-p at-p &optional width (mincol 0) (colinc 1) (minpad 0) (padchar #\Space))
  97   "Print the name of the month (1=January) corresponding to ARG on STREAM.  This is intended for embedding in a FORMAT directive: WIDTH governs the number of characters of text printed, MINCOL, COLINC, MINPAD, PADCHAR work as for ~A"
  98   (declare (ignore colon-p))
  99   (let ((monthstring (cdr (assoc arg *monthnames*))))
 100     (if (not monthstring) (return-from monthname nil))
 101     (let ((truncate (if width (min width (length monthstring)) nil)))
 102       (format stream
 103               (if at-p "~V,V,V,V@A" "~V,V,V,VA")
 104               mincol colinc minpad padchar
 105               (subseq monthstring 0 truncate)))))
 106
 107 ;;;; Daylight Saving Time calculations
 108
 109 ;; Daylight Saving Time begins for most of the United States at 2
 110 ;; a.m. on the first Sunday of April. Time reverts to standard time at
 111 ;; 2 a.m. on the last Sunday of October. In the U.S., each time zone
 112 ;; switches at a different time.
 113
 114 ;; In the European Union, Summer Time begins and ends at 1 am
 115 ;; Universal Time (Greenwich Mean Time). It starts the last Sunday in
 116 ;; March, and ends the last Sunday in October. In the EU, all time
 117 ;; zones change at the same moment.
 118
 119 ;; Spring forward, Fall back
 120 ;; During DST, clocks are turned forward an hour, effectively moving
 121 ;; an hour of daylight from the morning to the evening.
 122
 123 ;; United States                  European Union
 124
 125 ;; Year  DST Begins DST Ends     Summertime     Summertime
 126 ;;       at 2 a.m.  at 2 a.m.    period begins  period ends
 127 ;;                               at 1 a.m. UT   at 1 a.m. UT
 128 ;; ----------------------------------------------------------
 129 ;; 2000  April 2   October 29    March 26       October 29
 130 ;; 2001  April 1   October 28    March 25       October 28
 131 ;; 2002  April 7   October 27    March 31       October 27
 132 ;; 2003  April 6   October 26    March 30       October 26
 133 ;; 2004  April 4   October 31    March 28       October 31
 134 ;; 2005  April 3   October 30    March 27       October 30
 135 ;; 2006  April 2   October 29    March 26       October 29
 136 ;; 2007  April 1   October 28    March 25       October 28
 137 ;; 2008  April 6   October 26    March 30       October 26
 138
 139