;;;; PMSF-Lib --- PMSF Common Lisp Utility Library
;;;; This is copyrighted software.  See documentation for terms.
;;;; 
;;;; doc.lisp --- Documentation of file origins and versions
;;;; 
;;;; $Id$

(cl:in-package #:pmsf-lib)

;;;; %File Description:
;;;; 
;;;; This file provides mechanisms to record the id of files compiled
;;;; and loaded to create a runtime image.
;;;; 

(defvar *file-versions* nil
  "Associaton list of loaded file-ids.")

(defmacro file-version (system id-string)
  "Register the File-Id `id-string' in the system `system'."
  ;; On CMUCL we use `ext:file-comment' in addition to our own
  ;; tracking, so that the File-Id gets embedded in the fasl, and can
  ;; be seen in descriptions of functions, etc.  See the documentation
  ;; of `ext:file-comment' for more details.
  `(progn
    #+cmucl
    (ext:file-comment ,id-string)
    ;; Do compile-time processing by MD5 checksumming the file itself.
    (process-file-version ',system *load-truename* ',id-string
                          ',*compile-file-truename* 
                          ',(md5:md5sum-file *compile-file-truename*))))

(defun process-file-version (system file-name id-string 
                             source-file-name source-md5)
  "Load-time part of `file-version'."
  (let* ((system-list (or (assoc system *file-versions*)
                          (let ((sys (cons system nil)))
                            (push sys *file-versions*)
                            sys)))
         (file-entry (or (assoc file-name (cdr system-list) :test #'equal)
                         (let ((entry (cons file-name nil)))
                           (push entry (cdr system-list))
                           entry))))
    (setf (cdr file-entry) 
          (list id-string (md5:md5sum-file file-name) 
                source-file-name source-md5))
    nil))

(defun get-file-versions (system)
  (let ((system-list (assoc system *file-versions*)))
    (if system-list
        (cdr system-list)
        (error "System ~S not found!" system))))

(defun list-file-versions (system)
  (loop for (path id) in (get-file-versions system)
     do
       (format t "~20A ~A~%" path id)
     initially
       (format t "~&~20A ~A~2%" "Path" "Version-Id")))

(defun list-file-checksums (system)
  (loop for (path nil md5) in (get-file-versions system)
     do
       (format t "~40A ~{~2,'0X~}~%" path (coerce md5 'list))
     initially
       (format t "~&~40A ~32A~2%" "Path" "MD5")))

(defun list-source-checksums (system)
  (loop for (nil nil nil source-path source-md5) in (get-file-versions system)
     do
       (format t "~40A ~{~2,'0X~}~%" source-path (coerce source-md5 'list))
     initially
       (format t "~&~40A ~32A~2%" "Source-Path" "MD5")))

(defun md5-file-versions (system)
  (md5:md5sum-string
   (with-output-to-string (stream)
     (loop for (path id md5) in (sort (copy-list (get-file-versions system))
                                      #'string< :key 
                                      (lambda (x) 
                                        (if (pathnamep (car x))
                                            (namestring (car x))
                                            (car x))))
        do
          (format stream "~A!~A!~{~2,'0X~}~%" path id (coerce md5 'list))))
   :external-format :utf-8))