[noctool-cvs] CVS source
jprewett
jprewett at common-lisp.net
Fri Jun 20 12:19:58 UTC 2008
Update of /project/noctool/cvsroot/source
In directory clnet:/tmp/cvs-serv7636
Modified Files:
classes.lisp graph-monitors.lisp graphing.lisp scheduler.lisp
tests.lisp
Log Message:
factored out the ID slot from the EQUIPMENT, MONITOR, and BASE-GRAPH
classes. Created ID-OBJECT mixin class with :AFTER method that causes
the instance to be added to the *ID-OBJECTS* hash table. Instances may be retrieved
using the newly added GET-INSTANCE-BY-ID macro.
Modified NEXT-TIMESLOT so if it is called without the optional
scheduler and there is no *DEFAULT-SCHEDULER*, a default scheduler is
created and bound to *DEFAULT-SCHEDULER*.
Modified PARSE-DF so that if it is given a line, like an automount
line on MacOS, it munges the line into something useable. This is
sort-of *(OK, REALLY)* kludgy but it makes it so NOCtool doesn't blow
up on my Mac :) . Also modified PARSE-DF so that it says the disk is
100% full if there is 0 available space instead of signaling a
DIVIDE-BY-ZERO error.
Added SHOW method for DISK-CONTAINER class.
--- /project/noctool/cvsroot/source/classes.lisp 2008/06/14 16:15:33 1.8
+++ /project/noctool/cvsroot/source/classes.lisp 2008/06/20 12:19:57 1.9
@@ -1,8 +1,20 @@
(in-package #:noctool)
-(defclass equipment ()
+
+;; a hash so we can look up objects by their ID
+(defvar *id-objects* (make-hash-table :test #'equal))
+(defclass id-object ()
+ ((id :reader id :initarg :id)))
+
+(defmethod initialize-instance :after ((instance id-object) &key)
+ (setf (gethash (symbol-name (id instance)) *id-objects*)
+ instance))
+
+(defmacro get-instance-by-id (id-string)
+ `(gethash ,id-string *id-objects*))
+
+(defclass equipment (id-object)
((monitors :accessor monitors :initarg :monitors :initform nil)
- (id :reader id :initarg :id)
(name :reader name :initarg :name)
(address :reader address :initarg :address)
(username :reader username :initarg :username :initform nil)
@@ -47,9 +59,8 @@
(object :reader object :initarg :object)
))
-(defclass monitor ()
+(defclass monitor (id-object)
((equipment :reader equipment :initarg :equipment)
- (id :reader id :initarg :id)
(alert-level :accessor alert-level :initarg :alert-level :initform 0)
(interval :accessor interval :initarg :interval :initform 300)
(last-updated :accessor last-updated :initarg :last-updated)
--- /project/noctool/cvsroot/source/graph-monitors.lisp 2008/05/17 17:27:26 1.4
+++ /project/noctool/cvsroot/source/graph-monitors.lisp 2008/06/20 12:19:57 1.5
@@ -97,6 +97,25 @@
t (nth 0 color) (nth 1 color)(nth 2 color)))))
image)))
+(defmethod show ((graph noctool::disk-container) sink format &key (selector :short) scale &allow-other-keys)
+ (let ((lines (length (noctool::disk-list graph)))
+ (disks (sort (copy-list (noctool::disk-list graph)) #'> :key #'noctool::disk-max)))
+ (let ((image (image:make-image 350 (+ 130 (* 10 lines)))))
+ (image:rect image 0 0 349 (1- (image::height image)) t 192 192 192)
+ (multiple-value-bind (percentile max scale) (show (noctool::disk-graph (car disks)) image nil :color '(0 0 0 0.0) :base-x 25 :base-y 110 :height 100 :selector selector)
+ (draw-grid image max (interval graph) selector scale "b" 3 (noctool:last-updated graph))
+ (loop for disk in disks
+ for color in *graph-colors*
+ for text-offset = 125 then (+ text-offset 10)
+ for style = :line then :plot
+ do (let ((graph (noctool::disk-graph disk))
+ (text (format nil "~a [ ~a ]" (noctool::mountpoint disk) (noctool::device disk))))
+ (show graph image nil :color color :scale scale :height 100 :base-y 110 :base-x 25 :selector selector :style style)
+ (image:text image text 25 text-offset 0 0 0)
+ (image:rect image 15 text-offset 20 (+ 5 text-offset)
+ t (nth 0 color) (nth 1 color)(nth 2 color)))))
+ image)))
+
(defmethod show :around ((graph noctool::monitor) (sink string) format &key (selector :short) scale &allow-other-keys)
(let ((image (call-next-method)))
(image:export-to-gif image sink)))
--- /project/noctool/cvsroot/source/graphing.lisp 2008/05/17 17:25:47 1.3
+++ /project/noctool/cvsroot/source/graphing.lisp 2008/06/20 12:19:57 1.4
@@ -4,14 +4,13 @@
(:meter . meter-graph) (:gauge-avg . avg-graph)
(:gauge-max . max-graph)))
;;; Graph storage classes
-(defclass base-graph ()
+(defclass base-graph (noctool::id-object)
((short :reader short :initarg :short)
(medium :reader medium :initarg :medium)
(long :reader long :initarg :long)
(short-ix :accessor short-ix :initarg :short-ix)
(medium-ix :accessor medium-ix :initarg :medium-ix)
(long-ix :accessor long-ix :initarg :long-ix)
- (id :reader id :initarg :id)
(interval :reader interval :initarg :interval)
(proxies :accessor proxies :initform nil))
(:default-initargs :short-ix 0 :medium-ix 0 :long-ix 0 :id (gensym "GRAPH-")))
--- /project/noctool/cvsroot/source/scheduler.lisp 2008/05/16 19:23:06 1.2
+++ /project/noctool/cvsroot/source/scheduler.lisp 2008/06/20 12:19:58 1.3
@@ -25,6 +25,7 @@
foo)
(defmethod first-timeslot ((foo null))
foo)
+
(defmethod last-timeslot ((foo null))
foo)
(defmethod prev ((foo null))
@@ -105,6 +106,10 @@
(setf (next timeslot) nil))
(defun next-timeslot (&optional (scheduler *default-scheduler*))
+ (unless scheduler
+ (unless *default-scheduler*
+ (setf *default-scheduler* (make-instance 'scheduler)))
+ (setf scheduler *default-scheduler*))
(prog1
(first-timeslot scheduler)
(setf (first-timeslot scheduler) (next (first-timeslot scheduler)))
--- /project/noctool/cvsroot/source/tests.lisp 2008/05/29 19:21:38 1.3
+++ /project/noctool/cvsroot/source/tests.lisp 2008/06/20 12:19:58 1.4
@@ -39,13 +39,17 @@
with last = NIL
for len = (+ (length split) (length last))
while line
- when (> 6 len)
+ if (> 6 len)
do
(setf last split)
else
do
- (push (nconc last split) ret)
- (setf last NIL))
+ (let ((result (nconc last split)))
+ (if (= (length result) 8)
+ (push (cons (format NIL "~A-~A" (car result) (cadr result))
+ (cdddr result)) ret)
+ (push result ret))
+ (setf last NIL)))
ret))
@@ -79,7 +83,7 @@
(setf (mountpoint platter) mount)
(setf (disk-free platter) free)
(add-value (disk-graph platter) used)
- (let ((percent (* 100 (/ used disk))))
+ (let ((percent (if (= 0 disk) 100 (* 100 (/ used disk)))))
(setf (alert-level platter)
(decay-alert
(alert-level platter)
More information about the noctool-cvs
mailing list