From mkennedy at common-lisp.net Mon Feb 4 14:42:43 2008 From: mkennedy at common-lisp.net (mkennedy) Date: Mon, 4 Feb 2008 09:42:43 -0500 (EST) Subject: [lispy-cvs] CVS lispy Message-ID: <20080204144243.3F7C43002F@common-lisp.net> Update of /p/lispy/cvsroot/lispy In directory clnet:/tmp/cvs-serv21004 Modified Files: bootstrap.sh lispy.asd lispy.lisp utils.lisp Added Files: logging.lisp Log Message: --- /p/lispy/cvsroot/lispy/bootstrap.sh 2008/01/27 20:19:57 1.5 +++ /p/lispy/cvsroot/lispy/bootstrap.sh 2008/02/04 14:42:42 1.6 @@ -36,7 +36,8 @@ salza-0.7.4.tar.gz split-sequence-2002-04-10.tar.gz trivial-gray-streams-2006-09-16.tar.gz -usocket-0.3.5.tar.gz' +usocket-0.3.5.tar.gz +log5_0.3.1.tar.gz' TMP=`mktemp -d -t bootstrap.sh.XXXXXX` trap "rm -rf $TMP* 2>/dev/null" EXIT --- /p/lispy/cvsroot/lispy/lispy.asd 2007/07/23 14:25:57 1.5 +++ /p/lispy/cvsroot/lispy/lispy.asd 2008/02/04 14:42:42 1.6 @@ -7,6 +7,7 @@ (defsystem #:lispy :components ((:file "packages") + (:file "logging") (:file "utils") (:file "specials") (:file "lispy")) @@ -16,7 +17,8 @@ #:gzip-stream #:archive #:ironclad - #:cl-fad)) + #:cl-fad + #:log5)) (defmethod perform :after ((o load-op) (c (eql (find-system 'lispy)))) (let ((lispy-config (merge-pathnames #p".lispy.lisp"(user-homedir-pathname)))) --- /p/lispy/cvsroot/lispy/lispy.lisp 2008/01/27 19:54:07 1.11 +++ /p/lispy/cvsroot/lispy/lispy.lisp 2008/02/04 14:42:42 1.12 @@ -47,7 +47,7 @@ (labels ((dependencies-of (name) (push (module-by-name name) dependencies) (let ((m (module-by-name name))) - (if m + (if m (dolist (d (dependencies (latest-version m))) (dependencies-of d)) (error "No such module ~A found in map." name))))) @@ -107,7 +107,7 @@ (unwind-protect (dolist (module (mapcar #'(lambda (m) (parse-module m map-url)) - (read stream))) + (read-stream stream))) (setf (gethash (name module) *lispy-map*) module)) (close stream)))) @@ -177,7 +177,7 @@ (with-open-file (stream *lispy-installation-pathname* :direction :input :if-does-not-exist :create) - (dolist (install (mapcar #'parse-install (read stream nil nil))) + (dolist (install (mapcar #'parse-install (read-stream stream nil nil))) (setf (gethash (name install) *lispy-installation*) install))) (log-message "read-installation" "Map contains ~A entr~:@p" (hash-table-count *lispy-installation*)) --- /p/lispy/cvsroot/lispy/utils.lisp 2007/07/23 14:25:58 1.4 +++ /p/lispy/cvsroot/lispy/utils.lisp 2008/02/04 14:42:42 1.5 @@ -23,6 +23,7 @@ (let ((archive (archive:open-archive 'archive:tar-archive stream))) (unwind-protect (archive:do-archive-entries (entry archive) + (log-message 'extract-archive (archive:name entry)) (when (archive:entry-regular-file-p entry) (extract-entry entry target-directory-pathname))) (close stream))))) @@ -48,3 +49,7 @@ (defmacro define-constant (name value &optional doc) `(defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value) ,@(when doc (list doc)))) + +(defun read-stream (stream &rest args) + (let ((*read-eval* nil)) + (apply #'read stream args))) --- /p/lispy/cvsroot/lispy/logging.lisp 2008/02/04 14:42:43 NONE +++ /p/lispy/cvsroot/lispy/logging.lisp 2008/02/04 14:42:43 1.1 (in-package #:lispy) (log5:defcategory install) (log5:defcategory uninstall) (log5:defcategory upgrade) From mkennedy at common-lisp.net Mon Feb 4 15:15:09 2008 From: mkennedy at common-lisp.net (mkennedy) Date: Mon, 4 Feb 2008 10:15:09 -0500 (EST) Subject: [lispy-cvs] CVS lispy Message-ID: <20080204151509.167911B01D@common-lisp.net> Update of /p/lispy/cvsroot/lispy In directory clnet:/tmp/cvs-serv27075 Modified Files: lispy.lisp logging.lisp utils.lisp Log Message: Change logging to use log5. --- /p/lispy/cvsroot/lispy/lispy.lisp 2008/02/04 14:42:42 1.12 +++ /p/lispy/cvsroot/lispy/lispy.lisp 2008/02/04 15:15:08 1.13 @@ -1,13 +1,6 @@ (in-package #:lispy) -(defun log-message (name control-string &rest format-arguments) - (when *lispy-log-stream* - (format *lispy-log-stream* "~&~A ~A: ~A~%" - (get-universal-time) - (string-upcase name) - (apply #'format nil (cons control-string format-arguments))))) - (defclass module () ((name :initarg :name :reader name @@ -47,7 +40,7 @@ (labels ((dependencies-of (name) (push (module-by-name name) dependencies) (let ((m (module-by-name name))) - (if m + (if m (dolist (d (dependencies (latest-version m))) (dependencies-of d)) (error "No such module ~A found in map." name))))) @@ -100,7 +93,7 @@ (defun read-map (map-url) "Read the map at MAP-URL and merge the modules into *LISPY-MAP*." - (log-message "read-map" "Reading ~A" (uri-to-string map-url)) + (log5:log-for map "Reading ~A" (uri-to-string map-url)) (multiple-value-bind (stream status-code headers uri http-stream must-close) (drakma:http-request map-url :want-stream t) (declare (ignore status-code headers uri http-stream must-close)) @@ -117,8 +110,7 @@ Returns the mutated *LISPY-MAPS*." (dolist (map-url map-urls) (read-map map-url)) - (log-message "read-maps" "Map contains ~A entr~:@p" - (hash-table-count *lispy-map*)) + (log5:log-for map "Maps contain contains ~A entr~:@p" (hash-table-count *lispy-map*)) *lispy-map*) (defun parse-module (module map-url) @@ -173,19 +165,19 @@ (defun read-installation () "Read the installation file into *LISPY-INSTALLATION*" - (log-message "read-installation" "Reading ~A" (namestring *lispy-installation-pathname*)) + (log5:log-for installation "Reading ~A" (namestring *lispy-installation-pathname*)) (with-open-file (stream *lispy-installation-pathname* :direction :input :if-does-not-exist :create) (dolist (install (mapcar #'parse-install (read-stream stream nil nil))) (setf (gethash (name install) *lispy-installation*) install))) - (log-message "read-installation" "Map contains ~A entr~:@p" (hash-table-count *lispy-installation*)) + (log5:log-for installation "Installation contains ~A entr~:@p" (hash-table-count *lispy-installation*)) *lispy-installation*) (defun write-installation () "Write *LISPY-INSTALLATION* to the installtaion file." - (log-message "write-installation" "Writing ~A" (namestring *lispy-installation-pathname*)) + (log5:log-for installation "Writing ~A" (namestring *lispy-installation-pathname*)) (with-open-file (stream *lispy-installation-pathname* :direction :output :if-does-not-exist :create @@ -216,13 +208,13 @@ (defun read-asdf-config () "Load the Lispy ASDF configuration, which in turn adds paths to ASDF:*CENTRAL-REGISTRY*." - (log-message "read-asdf-config" "Loading ~A" (namestring *lispy-asdf-config-pathname*)) + (log5:log-for asdf "Loading ~A" (namestring *lispy-asdf-config-pathname*)) (load *lispy-asdf-config-pathname*)) (defun write-asdf-config () "Write a Lispy ASDF configuration file which can be loaded indepedent of Lispy." - (log-message "write-asdf-config" "Writing ~A" (namestring *lispy-asdf-config-pathname*)) + (log5:log-for asdf "Writing ~A" (namestring *lispy-asdf-config-pathname*)) (with-open-file (stream *lispy-asdf-config-pathname* :direction :output :if-does-not-exist :create @@ -247,18 +239,18 @@ (:documentation "Download Lisp package source.")) (defmethod fetch ((module module)) - (log-message "fetch" "Fetching ~A" (name module)) + (log5:log-for fetch "Fetching ~A" (name module)) (fetch (latest-version module))) (defmethod fetch ((version version)) - (log-message "fetch" "Fetching ~A" (uri-to-string (make-fetch-url (source version) (map-url version)))) + (log5:log-for fetch "Fetching ~A" (uri-to-string (make-fetch-url (source version) (map-url version)))) (ensure-directories-exist *lispy-distfiles-pathname*) (let ((pathname (merge-pathnames (source version) *lispy-distfiles-pathname*))) (if (and (probe-file pathname ) (compare-to-md5sum pathname (md5sum version))) - (log-message "fetch" "~A already exists and matches the version ~A MD5 checksum." - pathname - (version version)) + (log5:log-for fetch "~A already exists and matches the version ~A MD5 checksum." + pathname + (version version)) (progn (multiple-value-bind (stream status-code headers uri http-stream must-close) (drakma:http-request (make-fetch-url (source version) (map-url version)) @@ -288,7 +280,7 @@ (:documentation "Install Lisp package source.")) (defmethod install ((module module)) - (log-message "install" "Installing ~A" (name module)) + (log5:log-for install "Installing ~A" (name module)) (dolist (module (remove-duplicates (dependency-list module))) (install (latest-version module)))) @@ -296,9 +288,9 @@ (if (and (install-by-name (name version)) (= (our-version (install-by-name (name version))) (our-version version))) - (log-message "install" "Already installed ~A ~A." (name version) (version version)) + (log5:log-for install "Already installed ~A ~A." (name version) (version version)) (progn - (log-message "install" "Installing ~A ~A" (name version) (version version)) + (log5:log-for install "Installing ~A ~A" (name version) (version version)) (fetch version) (extract version) (setf (gethash (name version) *lispy-installation*) @@ -316,11 +308,11 @@ (:documentation "Extract Lisp package source.")) (defmethod extract ((module module)) - (log-message "extract" "Extracting ~A" (name module)) + (log5:log-for extract "Extracting ~A" (name module)) (extract (latest-version module))) (defmethod extract ((version version)) - (log-message "extract" "Extracting ~A ~A" (name version) (version version)) + (log5:log-for extract "Extracting ~A ~A" (name version) (version version)) (let ((pathname (merge-pathnames (source version) *lispy-distfiles-pathname*))) (extract-archive pathname *lispy-pathname*))) @@ -351,7 +343,7 @@ configuration file and updates ASDF:*CENTRAL-REGISTRY*." (setf *lispy-installation* (make-hash-table :test 'eq) *lispy-map* (make-hash-table :test 'eq)) - (log-message "initialize" "Initializing Lispy system on ~A ~A" (lisp-implementation-type) (lisp-implementation-version)) + (log5:log-for all-categories "Initializing Lispy system on ~A ~A" (lisp-implementation-type) (lisp-implementation-version)) (read-maps) (read-installation) (write-asdf-config) @@ -383,16 +375,16 @@ (let ((module (module-by-name (name install)))) (if (upgradable-p install module) (let ((latest-version (latest-version module))) - (log-message "upgrade" "Upgrading ~A from ~A to ~A" - (name install) - (version install) - (version latest-version)) + (log5:log-for upgrade "Upgrading ~A from ~A to ~A" + (name install) + (version install) + (version latest-version)) ;; FIXME: this needs to be transactional (uninstall install) (install latest-version)) - (log-message "upgrade" "~A ~A is already the latest version." - (name install) - (version install))))) + (log5:log-for upgrade "~A ~A is already the latest version." + (name install) + (version install))))) (defun upgrade-all () "Upgrade all upgradable Lisp source packages." --- /p/lispy/cvsroot/lispy/logging.lisp 2008/02/04 14:42:42 1.1 +++ /p/lispy/cvsroot/lispy/logging.lisp 2008/02/04 15:15:08 1.2 @@ -4,5 +4,22 @@ (log5:defcategory install) (log5:defcategory uninstall) (log5:defcategory upgrade) +(log5:defcategory extract) +(log5:defcategory map) +(log5:defcategory installation) +(log5:defcategory asdf) +(log5:defcategory fetch) +(log5:defcategory all-categories (install uninstall upgrade extract map installation asdf fetch)) +(log5:defoutput newline (format nil "~%")) + +(log5:defoutput time-hms + (multiple-value-bind (second minute hour day month year) + (decode-universal-time (get-universal-time)) + (format nil "~D:~2,'0D:~2,'0D" hour minute second))) + +(log5:start-sender 'debug + (log5:stream-sender :location *error-output*) + :category-spec '(all-categories log5:error+) + :output-spec '(time-hms log5:message newline)) --- /p/lispy/cvsroot/lispy/utils.lisp 2008/02/04 14:42:42 1.5 +++ /p/lispy/cvsroot/lispy/utils.lisp 2008/02/04 15:15:08 1.6 @@ -23,7 +23,7 @@ (let ((archive (archive:open-archive 'archive:tar-archive stream))) (unwind-protect (archive:do-archive-entries (entry archive) - (log-message 'extract-archive (archive:name entry)) + (log5:log-for extract "Extracting ~A" (archive:name entry)) (when (archive:entry-regular-file-p entry) (extract-entry entry target-directory-pathname))) (close stream)))))