#||
(setq $a "Date: Sun, 02 Sep 2007 02:20:55 GMTServer: ApacheExpires: -1Set-Cookie: OASISID=\"9181809302132\"Content-Length: 31211Content-Type: text/html; charset=iso-8859-1")
(subseq $a 57 60)
(www-utils:parse-gmt-time $a 57 60)
(www-utils::parse-http-time-string $a 57 60)
(www-utils::parse-rfc-850-and-822-time $a 57 60)
||#
(in-package "WWW-UTILS")

(define parse-gmt-time (string &optional (start 0) (end (length string)))
  (declare (optimize (speed 3)))
  (flet ((report-parse-bug (err)
           (report-bug http:*server-mail-address*
                       "Time Parsing Error"
                       "Error in (www-utils:parse-gmt-time  ~S)~&Type: ~S~&Report: ~A"
                       (subseq string start end) (type-of err) (report-string err))))
    (cond ((and (not http:*debug-server*) (boundp 'http:*server*) http:*server*)
           (flet ((handle-error (err) ;provides some additional information in error reports
                    (when (typep err 'http::time-parse-error) ;condition defined afterwards
                      (report-parse-bug err) 
                      (return-from parse-gmt-time (get-universal-time)))))
             (handler-bind
                 ((condition #'handle-error))
               (parse-http-time-string string start end))))
          (t (parse-http-time-string string start end)))))

(defun parse-http-time-string (string &optional (start 0) (end (length string)))
  "This Returns a universal time when a string containing a time in RFC 850, 822
    or ANSI-C format."
  (flet ((handle-error (err) ;provides some additional information in error reports
           (cond (http::*debug-server* nil) ;when debugging, let errors  through for human attention
                 ((typep err 'http::time-parse-error) nil) ;don't resignal time errors
                 (t (error 'http::time-parse-error :format-string (report-string err))))))
    (handler-bind
        ((error #'handle-error))
      (cond ((ansi-c-time-string-p string start end)
             (parse-ansi-c-time string start end))
            ((iso-time-string-p string start end)
             (parse-iso-time string start end))
            (t (parse-rfc-850-and-822-time string start end))))))