Revision: 4192 Author: edi URL: http://bknr.net/trac/changeset/4192
Even more conditions
U trunk/thirdparty/drakma/conditions.lisp U trunk/thirdparty/drakma/cookies.lisp U trunk/thirdparty/drakma/packages.lisp U trunk/thirdparty/drakma/read.lisp U trunk/thirdparty/drakma/request.lisp U trunk/thirdparty/drakma/util.lisp
Modified: trunk/thirdparty/drakma/conditions.lisp =================================================================== --- trunk/thirdparty/drakma/conditions.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/conditions.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -41,13 +41,21 @@ () (:documentation "Like DRAKMA-ERROR but with formatting capabilities."))
-(defun drakma-error (format-control &rest format-arguments) - "Signals an error of type DRAKMA-SIMPLE-ERROR with the provided -format control and arguments." - (error 'drakma-simple-error - :format-control format-control - :format-arguments format-arguments)) +(define-condition drakma-warning (drakma-condition warning) + () + (:documentation "Superclass for all warnings related to Drakma."))
+(define-condition drakma-simple-warning (drakma-warning simple-condition) + () + (:documentation "Like DRAKMA-WARNING but with formatting capabilities.")) + +(defun drakma-warn (format-control &rest format-arguments) + "Signals a warning of type DRAKMA-SIMPLE-WARNING with the +provided format control and arguments." + (warn 'drakma-simple-warning + :format-control format-control + :format-arguments format-arguments)) + (define-condition parameter-error (drakma-simple-error) () (:documentation "Signalled if a function was called with incosistent or illegal parameters."))
Modified: trunk/thirdparty/drakma/cookies.lisp =================================================================== --- trunk/thirdparty/drakma/cookies.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/cookies.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -240,7 +240,7 @@ (encode-universal-time second minute hour day month year time-zone)) (cookie-date-parse-error (condition) (cond (*ignore-unparseable-cookie-dates-p* - (warn "~A" condition) + (drakma-warn "~A" condition) nil) (t (error condition))))))
Modified: trunk/thirdparty/drakma/packages.lisp =================================================================== --- trunk/thirdparty/drakma/packages.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/packages.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -55,6 +55,7 @@ :delete-old-cookies :drakma-condition :drakma-error + :drakma-warning :get-content-type :header-value :http-request
Modified: trunk/thirdparty/drakma/read.lisp =================================================================== --- trunk/thirdparty/drakma/read.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/read.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -36,7 +36,8 @@ status code as an integer, and optionally the reason phrase." (let* ((*current-error-message* "While reading status line:") (line (or (read-line* stream log-stream) - (error "Could not read status line."))) + (error 'drakma-simple-error + :format-control "No status line - probably network error."))) (first-space-pos (or (position #\Space line :test #'char=) (syntax-error "No space in status line ~S." line))) (second-space-pos (position #\Space line
Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/request.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -54,8 +54,8 @@ (t external-format-in)))) (make-external-format name :eol-style :lf))))) (error (condition) - (warn "Problems determining charset (falling back to binary):~%~A" - condition)))) + (drakma-warn "Problems determining charset (falling back to binary):~%~A" + condition))))
(defun send-content (content stream &optional external-format-out) "Sends CONTENT to the stream STREAM as part of the request body @@ -442,7 +442,7 @@ (not :lw-does-not-have-write-timeout)) (when use-ssl (when (and write-timeout write-timeout-provided-p) - (warn "Disabling WRITE-TIMEOUT because it doesn't mix well with SSL.")) + (drakma-warn "Disabling WRITE-TIMEOUT because it doesn't mix well with SSL.")) (setq write-timeout nil)) (setq http-stream (or stream #+:lispworks @@ -613,18 +613,21 @@ (and (integerp redirect) (plusp redirect))) (cerror "Continue anyway." - "Status code was ~A, but ~ + 'drakma-simple-error + :format-control "Status code was ~A, but ~ ~:[REDIRECT is ~S~;redirection limit has been exceeded~]." - status-code (integerp redirect) redirect)) + :format-arguments (list status-code (integerp redirect) redirect))) (when auto-referer (setq additional-headers (set-referer uri additional-headers))) (let* ((location (header-value :location headers)) - (new-uri (merge-uris (cond ((or (null location) - (zerop (length location))) - (warn "Empty `Location' header, assuming "/".") - "/") - (t location)) - uri)) + (new-uri (merge-uris + (cond ((or (null location) + (zerop (length location))) + (drakma-warn + "Empty `Location' header, assuming "/".") + "/") + (t location)) + uri)) ;; can we re-use the stream? (old-server-p (and (string= (uri-host new-uri) (uri-host uri)) @@ -671,7 +674,7 @@ (multiple-value-setq (body trailers) (read-body http-stream headers must-close external-format-body)) (when trailers - (warn "Adding trailers from chunked encoding to HTTP headers.") + (drakma-warn "Adding trailers from chunked encoding to HTTP headers.") (setq headers (nconc headers trailers))))) (setq done t) (values (cond (want-stream http-stream)
Modified: trunk/thirdparty/drakma/util.lisp =================================================================== --- trunk/thirdparty/drakma/util.lisp 2009-02-09 09:15:30 UTC (rev 4191) +++ trunk/thirdparty/drakma/util.lisp 2009-02-09 09:29:04 UTC (rev 4192) @@ -250,7 +250,7 @@ (every (lambda (pos) (digit-char-p (char string pos))) '(4 5 7 8))) - (error "Can't interpret ~S as a time zone." string)) + (cookie-date-parse-error "Can't interpret ~S as a time zone." string)) (let ((hours (parse-integer string :start 4 :end 6)) (minutes (parse-integer string :start 7 :end 9))) (* (if (char= (char string 3) #+) -1 1)