;;; strptime.el -- partial implementation of POSIX date and time parsing ;;; ;;; Copyright (C) 2006 by Adrian Aichner , The ;;; XEmacs Project, 2006-11-05. ;;; ;;; Implemented (partially, specifically without locale support) ;;; according to ;;; http://www.opengroup.org/onlinepubs/009695399/functions/strptime.html (defun strptime (time format) " Return a nine element list of TIME, parsed according to FORMAT. The elements of the list are of the same form as those returned by `decode-time' and may be used as aguments to `encode-time'. \(SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE\) The returned date may be outside the range `encode-time' can handle. This is a partial implementation of the POSIX `strptime' function. Following directives are supported: %d The day of the month [01,31]; leading zeros are permitted but not required. %D The date as %m / %d / %y. %e Equivalent to %d. %H The hour (24-hour clock) [00,23]; leading zeros are permitted but not required. %I The hour (12-hour clock) [01,12]; leading zeros are permitted but not required. %m The month number [01,12]; leading zeros are permitted but not required. %M The minute [00,59]; leading zeros are permitted but not required. %n Any white space. %p The locale's equivalent of a.m or p.m. %R The time as %H : %M. %S The seconds [00,60]; leading zeros are permitted but not required. %t Any white space. %T The time as %H : %M : %S. %y The year within century. When a century is not otherwise specified, values in the range [69,99] shall refer to years 1969 to 1999 inclusive, and values in the range [00,68] shall refer to years 2000 to 2068 inclusive; leading zeros shall be permitted but shall not be required. Note: It is expected that in a future version of IEEE Std 1003.1-2001 the default century inferred from a 2-digit year will change. (This would apply to all commands accepting a 2-digit year as input.) %Y The year, including the century (for example, 1988). %% Replaced by %. " (interactive "stime: \nsformat: ") (flet ((handle-item (format-regex data-regex index) ;; Bind case-fold-search to nil to distinguish %m and %M! (let (case-fold-search text) (if (not (looking-at format-regex)) nil (goto-char (match-end 0)) (if data-regex (if (looking-at data-regex time-buffer) (progn (setq text (buffer-substring (match-beginning 0) (match-end 0) time-buffer)) (if index (progn (aset result index (string-to-number text)) (if (string-equal format-regex "%y") (if (< (aref result 5) 69) (aset result 5 (+ (aref result 5) 2000)) (aset result 5 (+ (aref result 5) 1900))))) (if (string-equal format-regex "%p") (cond ((string-equal (upcase text) "AM") (if (= (aref result 2) 12) (aset result 2 0))) ((string-equal (upcase text) "PM") (if (< (aref result 2) 12) (aset result 2 (+ (aref result 2) 12))))))) (goto-char (match-end 0) time-buffer)) (error "failed to parse %S by %S in %S at %S" format-regex data-regex time (buffer-substring (point-min) (point time-buffer) time-buffer))) (goto-char (+ (point time-buffer) (- (match-end 0) (match-beginning 0))) time-buffer)))))) (let (time-buffer format-buffer case-fold-search case-replace ;; This retains values from previous invocations! ;; (result '[0 0 0 0 0 0 0 0 0]) ;; make a new vector! (result (make-vector 9 0))) ;; Break down composite cases to individual components. (setq format (replace-in-string format "%D" "%m/%d/%y")) (setq format (replace-in-string format "%T" "%H:%M:%S")) (setq format (replace-in-string format "%R" "%H:%M")) (save-excursion (with-temp-buffer (setq time-buffer (current-buffer)) (insert time) (goto-char (point-min)) (save-excursion (with-temp-buffer ;; (message (buffer-name)) (insert format) (goto-char (point-min)) (while (and (not (eobp)) (not (eobp time-buffer))) (cond ((and (handle-item "%Y" "[0-9]\\{4\\}" 5)) t) ((and (handle-item "%y" "[0-9]\\{1,2\\}" 5)) t) ((and (handle-item "%m" "[0-9]\\{1,2\\}" 4)) t) ((and (handle-item "%d" "[0-9]\\{1,2\\}" 3)) t) ((and (handle-item "%H" "[0-9]\\{1,2\\}" 2)) t) ((and (handle-item "%I" "[0-9]\\{1,2\\}" 2)) t) ((and (handle-item "%M" "[0-9]\\{1,2\\}" 1)) t) ((and (handle-item "%S" "[0-9]\\{1,2\\}" 0)) t) ((and (handle-item "%p" "\\([ap]m\\)" nil)) t) ((and (handle-item "%[nt]" "\\s-+" nil)) t) ((and (handle-item "%%" "%" nil)) t) ((and (handle-item "[^%]" nil nil)) t) (t (error "cannot parse date %S with %S at %S" time format (buffer-substring (point-min time-buffer) (point time-buffer) time-buffer))))))) ;; (message (buffer-name)) )) (append result nil)) ;; (message (buffer-name)) )) ;;; Manual testing (when nil (equal (strptime "2006-11-05" "%Y-%m-%d") '(0 0 0 5 11 2006 0 0 0)) (equal (strptime "2006-11-05 6:19 PM" "%Y-%m-%d %R %p") '(0 19 18 5 11 2006 0 0 0)) (equal (strptime "2006-11-05 6:19 PM" "%Y-%m-%d %R %p") '(0 19 18 5 11 2006 0 0 0)) (equal (strptime "2006-11-05 6:19 PM" "%Y-%m-%d %H:%M %p") '(0 19 18 5 11 2006 0 0 0)) (equal (strptime "2006-11-05 6:19 % PM" "%Y-%m-%d %H:%M %% %p") '(0 19 18 5 11 2006 0 0 0)) (equal (strptime "2006 -11\t-05 6:19 % PM" "%Y%n-%m%t-%d %H:%M %% %p") '(0 19 18 5 11 2006 0 0 0)) (equal (strptime "2006-11-5 12:19 PM" "%Y-%m-%d %H:%M %p") '(0 19 12 5 11 2006 0 0 0)) (equal (strptime "2006-11-5 12:19 am" "%Y-%m-%d %H:%M %p") '(0 19 0 5 11 2006 0 0 0)) (equal (strptime "11/5/68 12:19 am" "%m/%d/%y %H:%M %p") '(0 19 0 5 11 2068 0 0 0)) (equal (strptime "11/5/68 12:19 am" "%D %H:%M %p") '(0 19 0 5 11 2068 0 0 0)) (equal (strptime "11/5/69 12:19 am" "%D %H:%M %p") '(0 19 0 5 11 1969 0 0 0))) ;;; strptime.el ends here