[bknr-cvs] edi changed trunk/thirdparty/drakma/

BKNR Commits bknr at bknr.net
Mon Feb 9 09:29:04 UTC 2009


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)





More information about the Bknr-cvs mailing list