[noctool-cvs] CVS source

[jprewett]

Update of /project/noctool/cvsroot/source
In directory clnet:/tmp/cvs-serv10754

Modified Files:
	classes.lisp 
Log Message:

made equipment set its name or its IP if the other is specified when it is created or signal an error if neither is specified.



--- /project/noctool/cvsroot/source/classes.lisp	2008/06/12 13:24:40	1.6
+++ /project/noctool/cvsroot/source/classes.lisp	2008/06/13 19:15:39	1.7
@@ -10,6 +10,38 @@
    )
   (:default-initargs :id (gensym "EQ-")))
 
+;; if an instance has a name, but no address, give it an address
+;; if an instance has an address, but no name, give it a name
+;; if it has neither, signal an error
+(defmethod initialize-instance :after ((instance equipment) &key)
+  (cond ((and (not (slot-boundp instance 'address))
+              (not (slot-boundp instance 'name)))
+         (error "both name and address are unbound for this host!"))
+        ((not (slot-boundp instance 'address))
+         (setf (slot-value instance 'address)
+               (let ((hostent 
+                      (sb-bsd-sockets:host-ent-address
+                       (sb-bsd-sockets:get-host-by-name (name instance)))))
+                 (format NIL "~A.~A.~A.~A"
+                         (aref hostent 0)
+                         (aref hostent 1)
+                         (aref hostent 2)
+                         (aref hostent 3)))))
+        ((not (slot-boundp instance 'name))
+         (setf (slot-value instance 'name)
+               (sb-bsd-sockets:host-ent-name
+                (sb-bsd-sockets:get-host-by-address
+                 (let ((arr (make-array '(4))))
+                   (loop 
+                      for i from 0 
+                      for element in 
+                        (mapcar #'read-from-string
+                                (cl-ppcre:split #\. (address instance)))
+                      do
+                      (setf (aref arr i) element))
+                   arr)))))))
+
+
 (defclass proxy ()
   ((remote-node :reader remote-node :initarg :remote-node)
    (object :reader object :initarg :object)