[usocket-cvs] r30 - in usocket/trunk: . backend

ehuelsmann at common-lisp.net ehuelsmann at common-lisp.net
Fri Feb 3 22:10:44 UTC 2006


Author: ehuelsmann
Date: Fri Feb  3 16:10:43 2006
New Revision: 30

Modified:
   usocket/trunk/backend/clisp.lisp
   usocket/trunk/condition.lisp
Log:
Implement condition handling for clisp.

Modified: usocket/trunk/backend/clisp.lisp
==============================================================================
--- usocket/trunk/backend/clisp.lisp	(original)
+++ usocket/trunk/backend/clisp.lisp	Fri Feb  3 16:10:43 2006
@@ -25,21 +25,25 @@
     (system::simple-os-error
        (destructuring-bind
            (&optional usock-err errorp)
-           (cdr (assoc (car (system::$format-arguments))
-                       +clisp-error-map+))
+           (cdr (assoc (car (simple-condition-format-arguments condition))
+                       +clisp-error-map+ :test #'member))
          (if usock-err
              (if errorp
                  (error usock-err :socket socket)
                (signal usock-err :socket socket))
-           (error 'usocket-unkown-error
+           (error 'usocket-unknown-error
                   :socket socket
                   :real-error condition))))))
 
 (defun socket-connect (host port &optional (type :stream))
   (declare (ignore type))
-  (let ((socket (socket:socket-connect port (host-to-hostname host)
-                                       :element-type 'character
-                                       :buffered t)))
+  (let ((socket)
+        (hostname (host-to-hostname host)))
+    (with-mapped-conditions (socket)
+       (setf socket
+             (socket:socket-connect port hostname
+                                    :element-type 'character
+                                    :buffered t)))
     (make-socket :socket socket
                  :stream socket))) ;; the socket is a stream too
 ;;                 :host host
@@ -47,19 +51,6 @@
 
 (defmethod socket-close ((usocket usocket))
   "Close socket."
-  (close (socket usocket)))
-
-
-
-(defun get-host-by-address (address)
-  (handler-case
-   (posix:hostent-name
-    (posix:resolve-host-ipaddr (vector-quad-to-dotted-quad address)))
-   (condition (condition) (handle-condition condition))))
-
-(defun get-hosts-by-name (name)
-  (handler-case
-   (mapcar #'dotted-quad-to-vector-quad
-           (posix:hostent-addr-list (posix:resolve-host-ipaddr name)))
-   (condition (condition) (handle-condition condition))))
+  (with-mapped-conditions (usocket)
+    (close (socket usocket))))
 

Modified: usocket/trunk/condition.lisp
==============================================================================
--- usocket/trunk/condition.lisp	(original)
+++ usocket/trunk/condition.lisp	Fri Feb  3 16:10:43 2006
@@ -17,7 +17,9 @@
 ;;                      (real-condition c) (socket c)))))
 
 (define-condition usocket-condition (condition)
-  () ;;###FIXME: no slots (yet); should at least be the affected usocket...
+  ((socket :initarg :socket
+           :accessor :usocket-socket))
+  ;;###FIXME: no slots (yet); should at least be the affected usocket...
   (:documentation ""))
 
 (define-condition usocket-error (usocket-condition error)
@@ -72,7 +74,12 @@
 
 (define-condition usocket-unknown-error (usocket-error)
   ((real-error :initarg :real-error
-               :accessor usocket-real-error))
+               :accessor usocket-real-error)
+   ;; clisp error wrt its condition system...
+   ;;it doesn't seem to inherit slots
+   #+clisp
+   (socket :initarg :socket
+           :accessor :usocket-socket))
   (:documentation ""))
 
 



More information about the usocket-cvs mailing list