This file is indexed.

/usr/share/common-lisp/source/kmrcl/datetime.lisp is in cl-kmrcl 1.106-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          datetime.lisp
;;;; Purpose:       Date & Time functions for KMRCL package
;;;; Programmer:    Kevin M. Rosenberg
;;;; Date Started:  Apr 2000
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************

(in-package #:kmrcl)


;;; Formatting functions

(defun pretty-date (year month day &optional (hour 12) (m 0) (s 0))
  (multiple-value-bind (sec min hr dy mn yr wkday)
    (decode-universal-time
     (encode-universal-time s m hour day month year))
    (values (elt '("Monday" "Tuesday" "Wednesday" "Thursday"
                   "Friday" "Saturday" "Sunday")
                 wkday)
            (elt '("January" "February" "March" "April" "May" "June"
                   "July" "August" "September" "October" "November"
                   "December")
                 (1- mn))
            (format nil "~A" dy)
            (format nil "~A" yr)
            (format nil "~2,'0D:~2,'0D:~2,'0D" hr min sec))))

(defun pretty-date-ut (&optional (tm (get-universal-time)))
  (multiple-value-bind (sec min hr dy mn yr) (decode-universal-time tm)
    (pretty-date yr mn dy hr min sec)))

(defun date-string (&optional (ut (get-universal-time)))
  (if (typep ut 'integer)
      (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
          (decode-universal-time ut)
        (declare (ignore daylight-p zone))
        (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"
                dow
                day
                (1- mon)
                year
                hr min sec))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defconstant +minute-seconds+ 60)
  (defconstant +hour-seconds+ (* 60 +minute-seconds+))
  (defconstant +day-seconds+ (* 24 +hour-seconds+))
  (defconstant +week-seconds+ (* +day-seconds+ 7))
  (defconstant +month-seconds+ (* +day-seconds+ (/ 365.25 12)))
  (defconstant +year-seconds+ (* +day-seconds+ 365.25)))

(defun seconds-to-condensed-time-string (sec &key (dp-digits 0))
  "Prints a quantity of seconds as a condensed string. DP-DIGITS controls
how many digits after decimal point."
  (multiple-value-bind (year yrem) (floor (coerce sec 'double-float) +year-seconds+)
    (multiple-value-bind (month mrem) (floor yrem +month-seconds+)
      (multiple-value-bind (week wrem) (floor mrem +week-seconds+)
        (multiple-value-bind (day drem) (floor wrem +day-seconds+)
          (multiple-value-bind (hour hrem) (floor drem +hour-seconds+)
            (multiple-value-bind (minute minrem) (floor hrem +minute-seconds+)
              (let ((secstr (if (zerop dp-digits)
                                (format nil "~Ds" (round minrem))
                                (format nil (format nil "~~,~DFs" dp-digits) minrem))))
                (cond
                  ((plusp year)
                   (format nil "~Dy~DM~Dw~Dd~Dh~Dm~A" year month week day hour minute secstr))
                  ((plusp month)
                   (format nil "~DM~Dw~Dd~Dh~Dm~A" month week day hour minute secstr))
                  ((plusp week)
                   (format nil "~Dw~Dd~Dh~Dm~A" week day hour minute secstr))
                  ((plusp day)
                   (format nil "~Dd~Dh~Dm~A" day hour minute secstr))
                  ((plusp hour)
                   (format nil "~Dh~Dm~A" hour minute secstr))
                  ((plusp minute)
                   (format nil "~Dm~A" minute secstr))
                  (t
                   secstr))))))))))

(defun print-seconds (secs)
  (print-float-units secs "sec"))

(defun print-float-units (val unit)
  (cond
    ((< val 1d-6)
     (format t "~,2,9F nano~A" val unit))
    ((< val 1d-3)
     (format t "~,2,6F micro~A" val unit))
    ((< val 1)
     (format t "~,2,3F milli~A" val unit))
    ((> val 1d9)
     (format t "~,2,-9F giga~A" val unit))
    ((> val 1d6)
     (format t "~,2,-6F mega~A" val unit))
    ((> val 1d3)
     (format t "~,2,-3F kilo~A" val unit))
    (t
     (format t "~,2F ~A" val unit))))

(defconstant +posix-epoch+
  (encode-universal-time 0 0 0 1 1 1970 0))

(defun posix-time-to-utime (time)
  (+ time +posix-epoch+))

(defun utime-to-posix-time (utime)
  (- utime +posix-epoch+))

;; Monthnames taken from net-telent-date to support lml2

(defvar *monthnames*
  '((1 . "January")
    (2 . "February")
    (3 . "March")
    (4 . "April")
    (5 . "May")
    (6 . "June")
    (7 . "July")
    (8 . "August")
    (9 . "September")
    (10 . "October")
    (11 . "November")
    (12 . "December")))

(defun monthname (stream arg colon-p at-p &optional width (mincol 0) (colinc 1) (minpad 0) (padchar #\Space))
  "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"
  (declare (ignore colon-p))
  (let ((monthstring (cdr (assoc arg *monthnames*))))
    (if (not monthstring) (return-from monthname nil))
    (let ((truncate (if width (min width (length monthstring)) nil)))
      (format stream
              (if at-p "~V,V,V,V@A" "~V,V,V,VA")
              mincol colinc minpad padchar
              (subseq monthstring 0 truncate)))))

(defconstant* +zellers-adj+ #(0 3 2 5 0 3 5 1 4 6 2 4))

(defun day-of-week (year month day)
  "Day of week calculation using Zeller's Congruence.
Input: The year y, month m (1 <= m <= 12) and day d (1 <= d <= 31).
Output: n - the day of the week (Sunday = 0, Saturday = 6)."

  (when (< month 3)
    (decf year))
  (mod
   (+ year (floor year 4) (- (floor year 100)) (floor year 400)
      (aref +zellers-adj+ (1- month)) day)
   7))

;;;; Daylight Saving Time calculations

;; Daylight Saving Time begins for most of the United States at 2
;; a.m. on the first Sunday of April. Time reverts to standard time at
;; 2 a.m. on the last Sunday of October. In the U.S., each time zone
;; switches at a different time.

;; In the European Union, Summer Time begins and ends at 1 am
;; Universal Time (Greenwich Mean Time). It starts the last Sunday in
;; March, and ends the last Sunday in October. In the EU, all time
;; zones change at the same moment.

;; Spring forward, Fall back
;; During DST, clocks are turned forward an hour, effectively moving
;; an hour of daylight from the morning to the evening.

;; United States                  European Union

;; Year  DST Begins DST Ends     Summertime     Summertime
;;       at 2 a.m.  at 2 a.m.    period begins  period ends
;;                               at 1 a.m. UT   at 1 a.m. UT
;; ----------------------------------------------------------
;; 2000  April 2   October 29    March 26       October 29
;; 2001  April 1   October 28    March 25       October 28
;; 2002  April 7   October 27    March 31       October 27
;; 2003  April 6   October 26    March 30       October 26
;; 2004  April 4   October 31    March 28       October 31
;; 2005  April 3   October 30    March 27       October 30
;; 2006  April 2   October 29    March 26       October 29
;; 2007  April 1   October 28    March 25       October 28
;; 2008  April 6   October 26    March 30       October 26