LCOV - code coverage report
Current view: top level - lisp/calendar - parse-time.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 0 85 0.0 %
Date: 2017-08-27 09:44:50 Functions: 0 4 0.0 %

          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

Generated by: LCOV version 1.12