commit cf177446e9bca4c62fa76a27ad803b454f83d818
parent 03c9ce8bbd88b44f10c05975a24159a6fb6beaf0
Author: Tomas Hlavaty <tom@logand.com>
Date: Sun, 27 Oct 2013 20:02:44 +0100
rfc822 time first try
Diffstat:
| M | calendar.lisp | | | 77 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
1 file changed, 77 insertions(+), 0 deletions(-)
diff --git a/calendar.lisp b/calendar.lisp
@@ -162,3 +162,80 @@
;;(collect 15 (week-generator 2012 1))
;;(collect 15 (week-generator 2012 12))
+
+(defvar *weekdays* '((#\M #\o #\n)
+ (#\T #\u #\e)
+ (#\W #\e #\d)
+ (#\T #\h #\u)
+ (#\F #\r #\i)
+ (#\S #\a #\t)
+ (#\S #\u #\n)))
+
+(defvar *months* '((#\J #\a #\n)
+ (#\F #\e #\b)
+ (#\M #\a #\r)
+ (#\A #\p #\r)
+ (#\M #\a #\y)
+ (#\J #\u #\n)
+ (#\J #\u #\l)
+ (#\A #\u #\g)
+ (#\S #\e #\p)
+ (#\O #\c #\t)
+ (#\N #\o #\v)
+ (#\D #\e #\c)))
+
+(defun decode-rfc822-time (string) ;; TODO complete spec http://asg.web.cmu.edu/rfc/rfc822.html
+ (let ((r (rw:peek-reader (rw:reader string))))
+ (values (progn
+ (rw:skip r)
+ (position (rw:till r '(#\,)) *weekdays* :test #'equal))
+ (progn
+ (assert (eql #\, (rw:next r)))
+ (rw:skip r)
+ (rw:next-z0 r))
+ (progn
+ (rw:skip r)
+ (1+ (position (rw:till r '(#\space)) *months* :test #'equal)))
+ (progn
+ (rw:skip r)
+ (rw:next-z0 r))
+ (progn
+ (rw:skip r)
+ (rw:next-z0 r))
+ (progn
+ (assert (eql #\: (rw:next r)))
+ (rw:next-z0 r))
+ (progn
+ (assert (eql #\: (rw:next r)))
+ (rw:next-z0 r))
+ (progn
+ (rw:skip r)
+ (ecase (rw:next r)
+ (#\+ (rw:next-z0 r))
+ (#\- (- (rw:next-z0 r))))))))
+
+;;(decode-rfc822-time "Tue, 22 Oct 2013 17:57:25 +0200")
+
+(defun encode-rfc822-time (wd d m y hh mm ss tz)
+ (format nil "~{~a~}, ~2,'0d ~{~a~} ~4,'0d ~2,'0d:~2,'0d:~2,'0d ~a~4,'0d"
+ (nth wd *weekdays*) d (nth (1- m) *months*) y hh mm ss
+ (if (plusp tz) #\+ #\-) (abs tz)))
+
+;;(encode-rfc822-time 3 24 10 2013 23 0 3 200)
+
+(defun rfc822-time-to-universal-time (string)
+ (multiple-value-bind (wd d m y hh mm ss tz) (decode-rfc822-time string)
+ (declare (ignore wd))
+ (encode-universal-time ss mm hh d m y (/ (- tz) 100))))
+
+;;(decode-universal-time (rfc822-time-to-universal-time "Tue, 22 Oct 2013 17:57:25 +0200"))
+;;(decode-universal-time (rfc822-time-to-universal-time "Sun, 27 Oct 2013 17:57:25 +0100"))
+
+(defun universal-time-to-rfc822-time (x)
+ (multiple-value-bind (ss mm hh d m y wd dst tz) (decode-universal-time x)
+ (encode-rfc822-time wd d m y hh mm ss (* 100 (- (if dst (1- tz) tz))))))
+
+;;(universal-time-to-rfc822-time (rfc822-time-to-universal-time "Tue, 22 Oct 2013 17:57:25 +0200"))
+;;(universal-time-to-rfc822-time (rfc822-time-to-universal-time "Sun, 27 Oct 2013 17:57:25 +0100"))
+;;(universal-time-to-rfc822-time (get-universal-time))
+;;(decode-universal-time (get-universal-time))
