Line data Source code
1 : ;;; parse-time.el --- parsing time strings -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 1996, 2000-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Erik Naggum <erik@naggum.no>
6 : ;; Keywords: util
7 :
8 : ;; This file is part of GNU Emacs.
9 :
10 : ;; GNU Emacs is free software: you can redistribute it and/or modify
11 : ;; it under the terms of the GNU General Public License as published by
12 : ;; the Free Software Foundation, either version 3 of the License, or
13 : ;; (at your option) any later version.
14 :
15 : ;; GNU Emacs is distributed in the hope that it will be useful,
16 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 : ;; GNU General Public License for more details.
19 :
20 : ;; You should have received a copy of the GNU General Public License
21 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22 :
23 : ;;; Commentary:
24 :
25 : ;; With the introduction of the `encode-time', `decode-time', and
26 : ;; `format-time-string' functions, dealing with time became simpler in
27 : ;; Emacs. However, parsing time strings is still largely a matter of
28 : ;; heuristics and no common interface has been designed.
29 :
30 : ;; `parse-time-string' parses a time in a string and returns a list of 9
31 : ;; values, just like `decode-time', where unspecified elements in the
32 : ;; string are returned as nil. `encode-time' may be applied on these
33 : ;; values to obtain an internal time value.
34 :
35 : ;;; Code:
36 :
37 : (require 'cl-lib)
38 :
39 : ;; Byte-compiler warnings
40 : (defvar parse-time-elt)
41 : (defvar parse-time-val)
42 :
43 : (defsubst parse-time-string-chars (char)
44 0 : (cond ((<= ?a char ?z) ?a)
45 0 : ((<= ?0 char ?9) ?0)
46 0 : ((eq char ?+) 1)
47 0 : ((eq char ?-) -1)
48 0 : ((eq char ?:) ?d)))
49 :
50 : (defun parse-time-tokenize (string)
51 : "Tokenize STRING into substrings.
52 : Each substring is a run of \"valid\" characters, i.e., lowercase
53 : letters, digits, plus or minus signs or colons."
54 0 : (let ((start nil)
55 0 : (end (length string))
56 : (all-digits nil)
57 : (list ())
58 : (index 0)
59 : (c nil))
60 0 : (while (< index end)
61 0 : (while (and (< index end) ;Skip invalid characters.
62 0 : (not (setq c (parse-time-string-chars (aref string index)))))
63 0 : (cl-incf index))
64 0 : (setq start index
65 0 : all-digits (eq c ?0))
66 0 : (while (and (< (cl-incf index) end) ;Scan valid characters.
67 0 : (setq c (parse-time-string-chars (aref string index))))
68 0 : (setq all-digits (and all-digits (eq c ?0))))
69 0 : (if (<= index end)
70 0 : (push (if all-digits (cl-parse-integer string :start start :end index)
71 0 : (substring string start index))
72 0 : list)))
73 0 : (nreverse list)))
74 :
75 : (defvar parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3)
76 : ("apr" . 4) ("may" . 5) ("jun" . 6)
77 : ("jul" . 7) ("aug" . 8) ("sep" . 9)
78 : ("oct" . 10) ("nov" . 11) ("dec" . 12)
79 : ("january" . 1) ("february" . 2)
80 : ("march" . 3) ("april" . 4) ("june" . 6)
81 : ("july" . 7) ("august" . 8)
82 : ("september" . 9) ("october" . 10)
83 : ("november" . 11) ("december" . 12)))
84 : (defvar parse-time-weekdays '(("sun" . 0) ("mon" . 1) ("tue" . 2)
85 : ("wed" . 3) ("thu" . 4) ("fri" . 5)
86 : ("sat" . 6) ("sunday" . 0) ("monday" . 1)
87 : ("tuesday" . 2) ("wednesday" . 3)
88 : ("thursday" . 4) ("friday" . 5)
89 : ("saturday" . 6)))
90 : (defvar parse-time-zoneinfo `(("z" 0) ("ut" 0) ("gmt" 0)
91 : ("pst" ,(* -8 3600)) ("pdt" ,(* -7 3600) t)
92 : ("mst" ,(* -7 3600)) ("mdt" ,(* -6 3600) t)
93 : ("cst" ,(* -6 3600)) ("cdt" ,(* -5 3600) t)
94 : ("est" ,(* -5 3600)) ("edt" ,(* -4 3600) t))
95 : "(zoneinfo seconds-off daylight-savings-time-p)")
96 :
97 : (defvar parse-time-rules
98 : `(((6) parse-time-weekdays)
99 : ((3) (1 31))
100 : ((4) parse-time-months)
101 : ((5) (100 ,most-positive-fixnum))
102 : ((2 1 0)
103 : ,#'(lambda () (and (stringp parse-time-elt)
104 : (= (length parse-time-elt) 8)
105 : (= (aref parse-time-elt 2) ?:)
106 : (= (aref parse-time-elt 5) ?:)))
107 : [0 2] [3 5] [6 8])
108 : ((8 7) parse-time-zoneinfo
109 : ,#'(lambda () (car parse-time-val))
110 : ,#'(lambda () (cadr parse-time-val)))
111 : ((8)
112 : ,#'(lambda ()
113 : (and (stringp parse-time-elt)
114 : (= 5 (length parse-time-elt))
115 : (or (= (aref parse-time-elt 0) ?+)
116 : (= (aref parse-time-elt 0) ?-))))
117 : ,#'(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5)
118 : (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3)))
119 : (if (= (aref parse-time-elt 0) ?-) -1 1))))
120 : ((5 4 3)
121 : ,#'(lambda () (and (stringp parse-time-elt)
122 : (= (length parse-time-elt) 10)
123 : (= (aref parse-time-elt 4) ?-)
124 : (= (aref parse-time-elt 7) ?-)))
125 : [0 4] [5 7] [8 10])
126 : ((2 1 0)
127 : ,#'(lambda () (and (stringp parse-time-elt)
128 : (= (length parse-time-elt) 5)
129 : (= (aref parse-time-elt 2) ?:)))
130 : [0 2] [3 5] ,#'(lambda () 0))
131 : ((2 1 0)
132 : ,#'(lambda () (and (stringp parse-time-elt)
133 : (= (length parse-time-elt) 4)
134 : (= (aref parse-time-elt 1) ?:)))
135 : [0 1] [2 4] ,#'(lambda () 0))
136 : ((2 1 0)
137 : ,#'(lambda () (and (stringp parse-time-elt)
138 : (= (length parse-time-elt) 7)
139 : (= (aref parse-time-elt 1) ?:)))
140 : [0 1] [2 4] [5 7])
141 : ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt)))
142 : ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt))))
143 : "(slots predicate extractor...)")
144 : ;;;###autoload(put 'parse-time-rules 'risky-local-variable t)
145 :
146 : ;;;###autoload
147 : (defun parse-time-string (string)
148 : "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
149 : STRING should be on something resembling an RFC2822 string, a la
150 : \"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is
151 : somewhat liberal in what format it accepts, and will attempt to
152 : return a \"likely\" value even for somewhat malformed strings.
153 : The values returned are identical to those of `decode-time', but
154 : any values that are unknown are returned as nil."
155 0 : (let ((time (list nil nil nil nil nil nil nil nil nil))
156 0 : (temp (parse-time-tokenize (downcase string))))
157 0 : (while temp
158 0 : (let ((parse-time-elt (pop temp))
159 0 : (rules parse-time-rules)
160 : (exit nil))
161 0 : (while (and rules (not exit))
162 0 : (let* ((rule (pop rules))
163 0 : (slots (pop rule))
164 0 : (predicate (pop rule))
165 : (parse-time-val))
166 0 : (when (and (not (nth (car slots) time)) ;not already set
167 0 : (setq parse-time-val
168 0 : (cond ((and (consp predicate)
169 0 : (not (eq (car predicate)
170 0 : 'lambda)))
171 0 : (and (numberp parse-time-elt)
172 0 : (<= (car predicate) parse-time-elt)
173 0 : (<= parse-time-elt (cadr predicate))
174 0 : parse-time-elt))
175 0 : ((symbolp predicate)
176 0 : (cdr (assoc parse-time-elt
177 0 : (symbol-value predicate))))
178 0 : ((funcall predicate)))))
179 0 : (setq exit t)
180 0 : (while slots
181 0 : (let ((new-val (if rule
182 0 : (let ((this (pop rule)))
183 0 : (if (vectorp this)
184 0 : (cl-parse-integer
185 0 : parse-time-elt
186 0 : :start (aref this 0)
187 0 : :end (aref this 1))
188 0 : (funcall this)))
189 0 : parse-time-val)))
190 0 : (rplaca (nthcdr (pop slots) time) new-val))))))))
191 0 : time))
192 :
193 : (defconst parse-time-iso8601-regexp
194 : (let* ((dash "-?")
195 : (colon ":?")
196 : (4digit "\\([0-9][0-9][0-9][0-9]\\)")
197 : (2digit "\\([0-9][0-9]\\)")
198 : (date-fullyear 4digit)
199 : (date-month 2digit)
200 : (date-mday 2digit)
201 : (time-hour 2digit)
202 : (time-minute 2digit)
203 : (time-second 2digit)
204 : (time-secfrac "\\(\\.[0-9]+\\)?")
205 : (time-numoffset (concat "\\([-+]\\)" time-hour ":?" time-minute "?"))
206 : (partial-time (concat time-hour colon time-minute colon time-second
207 : time-secfrac))
208 : (full-date (concat date-fullyear dash date-month dash date-mday)))
209 : (list (concat "^" full-date)
210 : (concat "T" partial-time)
211 : (concat "\\(Z\\|" time-numoffset "\\)")))
212 : "List of regular expressions matching ISO 8601 dates.
213 : 1st regular expression matches the date.
214 : 2nd regular expression matches the time.
215 : 3rd regular expression matches the (optional) timezone specification.")
216 :
217 : (defun parse-iso8601-time-string (date-string)
218 : "Parse an ISO 8601 time string, such as 2016-12-01T23:35:06-05:00.
219 : If DATE-STRING cannot be parsed, it falls back to
220 : `parse-time-string'."
221 0 : (let* ((date-re (nth 0 parse-time-iso8601-regexp))
222 0 : (time-re (nth 1 parse-time-iso8601-regexp))
223 0 : (tz-re (nth 2 parse-time-iso8601-regexp))
224 : re-start
225 : time seconds minute hour
226 : day month year day-of-week dst tz)
227 : ;; We need to populate 'time' with
228 : ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
229 :
230 : ;; Nobody else handles iso8601 correctly, let's do it ourselves.
231 0 : (when (string-match date-re date-string re-start)
232 0 : (setq year (string-to-number (match-string 1 date-string))
233 0 : month (string-to-number (match-string 2 date-string))
234 0 : day (string-to-number (match-string 3 date-string))
235 0 : re-start (match-end 0))
236 0 : (when (string-match time-re date-string re-start)
237 0 : (setq hour (string-to-number (match-string 1 date-string))
238 0 : minute (string-to-number (match-string 2 date-string))
239 0 : seconds (string-to-number (match-string 3 date-string))
240 0 : re-start (match-end 0))
241 0 : (when (string-match tz-re date-string re-start)
242 0 : (if (string= "Z" (match-string 1 date-string))
243 0 : (setq tz 0) ;; UTC timezone indicated by Z
244 0 : (setq tz (+
245 0 : (* 3600
246 0 : (string-to-number (match-string 3 date-string)))
247 0 : (* 60
248 0 : (string-to-number
249 0 : (or (match-string 4 date-string) "0")))))
250 0 : (when (string= "-" (match-string 2 date-string))
251 0 : (setq tz (- tz)))))
252 0 : (setq time (list seconds minute hour day month year day-of-week dst tz))))
253 :
254 : ;; Fall back to having `parse-time-string' do fancy things for us.
255 0 : (when (not time)
256 0 : (setq time (parse-time-string date-string)))
257 :
258 0 : (and time
259 0 : (apply 'encode-time time))))
260 :
261 : (provide 'parse-time)
262 :
263 : ;;; parse-time.el ends here
|