;;----------------------------------------------------------------------------- ;; for CoCreate OneSpace Designer ;; Description: ;; retrieve user names who are using a given license ;; * retrieves 3 files from the license server ;; * analyse the returend HTML code!!! this is quite version dependend ;; ;;----------------------------------------------------------------------------- ;; ;; Filename : sd_licence_info.lsp ;; Version : 1.04 ;; Datum : 18jan2008 ;; Author : der_Wolfgang@forum@cad.de ;; Download : osd.cad.de (sooner or later) ;; Language : LISP ;; SD-Version : developed with 15.00 + License Server 2008 16.00 ;; ;;----------------------------------------------------------------------------- (in-package :mels-info) (use-package :oli) ;;----------------------------------------------------------------------------- (defparameter *licence-server* ;; inclusive port! list is in defdialog range format '(("localhost:17171" :label "My Machine") ("somwhere.invalid:17171" :label "the big one") )) (defparameter *licenses-avail* nil) ;; used as cache ;;----------------------------------------------------------------------------- ;; 3 function to conntect to the license server(s) to retrieve information ;;----------------------------------------------------------------------------- ;; e.g. test call (mels-info::get-licence-lines "localhost:17171" "Sheet Metal") (defun get-licence-lines (melshost which) (let (melshost-I-file match-for matched) (setq melshost-I-file (sd-retrieve-url (format nil "http://~A/i.html" melshost))) (setq match-for (format nil "*>~A<*" which)) (dolist (a-line (ascii-file2str-list melshost-I-file)) (when (sd-string-match-pattern-p match-for a-line) (setq a-line (html-table-row-2-content-list a-line)) (push (list (nth 0 a-line) (nth 1 a-line) (nth 4 a-line)) matched) ) ) ;; end dolist ;(delete-file melshost-I-file) (sort (remove-duplicates matched) #'string< :key #'first) ) ;; end let ) ;; end defun (defun get-clients-for-licence (melshost which) (let (melshost-C-file licenses lic-found matched) (setq licenses (get-licence-lines melshost which)) (setq licenses (mapcar #'first licenses)) (setq melshost-C-file (sd-retrieve-url (format nil "http://~A/c.html" melshost))) (dolist (a-line (ascii-file2str-list melshost-C-file)) (when (sd-string-match-pattern-p "*>Client<*" a-line) (setq lic-found nil) ;(trace sd-string-match-pattern-p) (dolist (a-lic licenses) (when (sd-string-match-pattern-p (format nil "*~A*" a-lic) a-line) (setq lic-found T))) ;(untrace sd-string-match-pattern-p) (when lic-found ;(pprint a-line) (setq a-line (html-table-row-2-content-list a-line)) (when (stringp (nth 0 a-line)) (push (sd-string-trim (nth 0 a-line)) matched)) ) ) ) ;; end dolist ;(delete-file melshost-C-file) (sort (remove-duplicates matched :test #'string=) #'string< ) ) ;; end let ) ;; end defun (defun get-licenses-avail (melshost) (let (melshost-S-file matched) (setq melshost-S-file (sd-retrieve-url (format nil "http://~A/s.html" melshost))) (dolist (a-line (ascii-file2str-list melshost-S-file)) (when (sd-string-match-pattern-p "*a href=*i.html?*" a-line) (setq a-line (html-table-row-2-content-list a-line)) (when (stringp (nth 0 a-line)) (push (sd-string-trim (nth 0 a-line)) matched)) ) ) ;; end dolist ;(delete-file melshost-S-file) (sort (remove-duplicates matched :test #'string=) #'string< ) ) ;; end let ) ;; end defun ;; for testing ;(trace oli::sd-retrieve-url get-licence-lines get-clients-for-licence get-clients-for-licence) ;;----------------------------------------------------------------------------- ;; UI to inquire the licence stuff ;;----------------------------------------------------------------------------- (sd-defdialog 'sd_look_for_used_license :dialog-title '(sd-multi-lang-string "License in Use" :german "Lizenz Verbrauch") :after-initialization '(progn (sd-set-range 'melshost *licence-server*) (setq melshost (caar *licence-server*)) (if (second *licence-server*) (sd-set-variable-status 'melshost :enable T :visible T) (sd-set-variable-status 'melshost :enable nil :visible nil) ) (unless *licenses-avail* (setq *licenses-avail* (get-licenses-avail (caar *licence-server*)))) (sd-set-range 'licence *licenses-avail*) (setq licence nil) ) :variables '( (melshost :range ("dummy") :title (sd-multi-lang-string "MELS host" :german "Li Server") :size :third :after-input (progn (setq *licenses-avail* (get-licenses-avail melshost)) (sd-set-range 'licence *licenses-avail*) (setq licence nil) ) ) (licence :range ("dummy") :title (sd-multi-lang-string "license" :german "Lizenz") :size :third :after-input (let ((users (get-clients-for-licence melshost licence))) (if users (display (format nil "~%~%~S ~A~%~{ * ~A~%~}~%" licence (sd-multi-lang-string "used by" :german "genutzt durch") (mapcar #'(lambda (u) ;; beautify or enhance info on user! (e.g. search in csv file.. in LDAP) (string-capitalize u)) users) )) (display (format nil "~%~%~S ~A!~%" licence (sd-multi-lang-string "not used" :german "nicht genutzt") )) ) ) ) ) ;; end variables ) ;; end dialog ;;----------------------------------------------------------------------------- ;; split a HTML source code line with all elements of a HTML source row ;; into a string list, one table cell per element and HTML stuff removed ;;----------------------------------------------------------------------------- (defun html-table-row-2-content-list (html-line) ;; has to match to ..... (let (new-line new-list) (setq new-line (sd-string-split (sd-string-replace (sd-string-replace html-line "")) (dotimes (i (length new-line)) (when (evenp i) (push (nth i new-line) new-list))) (setq new-line (format nil "~{~A~}" (nreverse new-list))) (when (sd-string-match-pattern-p "*;*" new-line) ;;; remove some special HTML codes (dolist (a '(("ä" "ae") ("ö" "oe") ("ü" "ue") ("Ä" "Ae") ("Ö" "Oe") ("Ü" "Ue") ("ß" "sz") ("&" "&")(" " " ")("<" "<")(">" ">") )) (setq new-line (sd-string-replace new-line (car a) (cadr a))) )) (rest (sd-string-split new-line "|")) ) ) ;;----------------------------------------------------------------------------- ;; ascii-file2str-list ;; ascii-file2str-list ;; generates a list of strings(lines) taken from a file ;; input parameter ;; filename : ;; return value ;; list of strings taken from file ;;----------------------------------------------------------------------------- (defun ascii-file2str-list (filename) (if (probe-file filename) (let (list-of-lines line-of-file) (with-open-file (in-stream filename :direction :input :if-does-not-exist nil) (loop while (setf line-of-file (read-line in-stream nil)) do (push (frame2::generalstring-replace line-of-file (format nil "~A" (code-char 13)) "") list-of-lines) ) ;; end loop ) ;; end with-open-file (nreverse list-of-lines) ;; return lines in correct order ) ;; end let (values NIL :file-not-found) ) ;; end if ) ;; end ascii-file2str-list