From a1b71945378be03ce71e124663bac7dbc4d5bf08 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Wed, 7 Jun 2000 12:35:39 +0000 Subject: [PATCH] o Extend parse-time to accept the patterns it matches as a keyword argument, allowing it to be used for parsing alternate date-time formats. o Add support for parsing the three common HTTP time formats: RFC1123/RFC822, RFC850, and ANSI-C - requiring the new pattern symbol izone to handle the different time zone convention. --- code/parse-time.lisp | 52 ++++++++++++++++++++++++++++++++++---------- 1 file changed, 41 insertions(+), 11 deletions(-) diff --git a/code/parse-time.lisp b/code/parse-time.lisp index e4563713e..380032dbf 100644 --- a/code/parse-time.lisp +++ b/code/parse-time.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/parse-time.lisp,v 1.6 1996/07/12 19:26:57 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/parse-time.lisp,v 1.7 2000/06/07 12:35:39 dtc Exp $") ;;; ;;; ********************************************************************** @@ -98,10 +98,10 @@ ;;; patterns are specified below determines the order of search. ;;; Choices of pattern symbols are: second, minute, hour, day, month, -;;; year, time-divider, date-divider, am-pm, zone, weekday, noon-midn, -;;; and any special symbol. +;;; year, time-divider, date-divider, am-pm, zone, izone, weekday, +;;; noon-midn, and any special symbol. -(defparameter patterns +(defparameter *default-date-time-patterns* '( ;; Date formats. ((weekday) month (date-divider) day (date-divider) year (noon-midn)) @@ -186,6 +186,20 @@ (tomorrow (noon-midn)) ((noon-midn) tomorrow) )) + +;;; HTTP header style date/time patterns: RFC1123/RFC822, RFC850, ANSI-C. +(defparameter *http-date-time-patterns* + '( + ;; RFC1123/RFC822 and RFC850. + ((weekday) day (date-divider) month (date-divider) year + hour time-divider minute (time-divider) (secondp) izone) + ((weekday) day (date-divider) month (date-divider) year + hour time-divider minute (time-divider) (secondp) (zone)) + + ;; ANSI-C. + ((weekday) month day + hour time-divider minute (time-divider) (secondp) year))) + ;;; The decoded-time structure holds the time/date values which are ;;; eventually passed to 'encode-universal-time' after parsing. @@ -200,7 +214,7 @@ (day 1 :type integer) ; Value between 1 and 31. (month 1 :type integer) ; Value between 1 and 12. (year 1900 :type integer) ; Value above 1899 or between 0 and 99. - (zone 0 :type integer) ; Value between 0 and 23. + (zone 0 :type rational) ; Value between -24 and 24 inclusive. (dotw 0 :type integer)) ; Value between 0 and 6. ;;; Make-default-time returns a decoded-time structure with the default @@ -256,7 +270,7 @@ default-time))) ;;; Converts the values in the decoded-time structure to universal time -;;; by calling extensions:encode-universal-time. +;;; by calling encode-universal-time. ;;; If zone is in numerical form, tweeks it appropriately. (defun convert-to-unitime (parsed-values) @@ -267,7 +281,7 @@ (decoded-time-day parsed-values) (decoded-time-month parsed-values) (decoded-time-year parsed-values) - (if (or (> zone 23) (< zone -23)) + (if (or (> zone 24) (< zone -24)) (let ((new-zone (/ zone 100))) (cond ((minusp new-zone) (- new-zone)) ((plusp new-zone) (- 24 new-zone)) @@ -278,9 +292,10 @@ ;;; Sets the current values for the time and/or date parts of the ;;; decoded time structure. -(defun set-current-value (values-structure &key (time nil) (date nil) (zone nil)) +(defun set-current-value (values-structure &key (time nil) (date nil) + (zone nil)) (multiple-value-bind (sec min hour day mon year dotw dst tz) - (get-decoded-time) + (get-decoded-time) (declare (ignore dst)) (when time (setf (decoded-time-second values-structure) sec) @@ -345,7 +360,14 @@ (or (and (simple-string-p thing) (gethash thing *zone-strings*)) (if (integerp thing) (let ((zone (/ thing 100))) - (and (integerp zone) (<= -23 zone 23)))))) + (and (integerp zone) (<= -24 zone 24)))))) + +;;; Internet numerical time zone, e.g. RFC1123, in hours and minutes. +(defun izone (thing) + (if (integerp thing) + (multiple-value-bind (hours mins) + (truncate thing 100) + (and (<= -24 hours 24) (<= -59 mins 59))))) (defun special-string-p (string) (and (simple-string-p string) (gethash string *special-strings*))) @@ -547,6 +569,12 @@ (mod (+ hour 12) 24)))) (t (error "~A isn't AM/PM - this shouldn't happen."))))) +;;; Internet numerical time zone, e.g. RFC1123, in hours and minutes. +(defun deal-with-izone (form-value parsed-values) + (multiple-value-bind (hours mins) + (truncate form-value 100) + (setf (decoded-time-zone parsed-values) (- (+ hours (/ mins 60)))))) + ;;; Set-time-values uses the association list of symbols and values ;;; to set the time in the decoded-time structure. @@ -562,6 +590,7 @@ (month (setf (decoded-time-month parsed-values) form-value)) (year (setf (decoded-time-year parsed-values) form-value)) (zone (setf (decoded-time-zone parsed-values) form-value)) + (izone (deal-with-izone form-value parsed-values)) (weekday (setf (decoded-time-dotw parsed-values) form-value)) (am-pm (deal-with-am-pm form-value parsed-values)) (noon-midn (deal-with-noon-midn form-value parsed-values)) @@ -569,7 +598,8 @@ (t (error "Unrecognized symbol in form list: ~A." form-type)))))) (defun parse-time (time-string &key (start 0) (end (length time-string)) - (error-on-mismatch nil) + (error-on-mismatch nil) + (patterns *default-date-time-patterns*) (default-seconds nil) (default-minutes nil) (default-hours nil) (default-day nil) (default-month nil) (default-year nil) -- GitLab