Diff checked-out quicklisp project against dist version

qdiff.lisp

;;;; qdiff.lisp                                                                                                                                         

(defpackage #:qdiff
  (:use #:cl)
  (:shadowing-import-from #:ql-dist
                          #:name
                          #:release
                          #:ensure-local-archive-file
                          #:base-directory
                          #:prefix)
  (:shadowing-import-from #:ql-setup
                          #:qmerge)
  (:shadowing-import-from #:ql-gunzipper
                          #:gunzip)
  (:shadowing-import-from #:ql-minitar
                          #:unpack-tarball)
  (:shadowing-import-from #:ql-impl-util
                          #:delete-directory-tree
                          #:native-namestring)
  (:shadowing-import-from #:asdf
                          #:*verbose-out*
                          #:run-shell-command)
  (:export #:qdiff
           #:qdiff-all))

(in-package #:qdiff)

#-sbcl
(defun diff (old-pathname new-pathname &key verbosep)
  (let ((*verbose-out* (and verbosep *standard-output*)))
    (run-shell-command "diff -aur '~A' '~A'"
                       (native-namestring (truename old-pathname))
                       (native-namestring (truename new-pathname)))))

#+sbcl                                                                                                                                                  
(defun diff (old-pathname new-pathname &key verbosep)                                                                                                   
  (run-program "diff"                                                                                                                                   
               (list "-aur"                                                                                                                             
                     (native-namestring (truename old-pathname))                                                                                        
                     (native-namestring (truename new-pathname)))                                                                                       
               :search t                                                                                                                                
               :output (and verbosep *standard-output*)))

(defun qdiff (project-name &key (diff-function 'diff) (verbosep t))
  (let ((release (release project-name)))
    (unless release
      (error "Unknown project -- ~S" project-name))
    (let ((tarball (ensure-local-archive-file release))
          (tmpbase (qmerge "tmp/qdiff/"))
          (tmptree (qmerge (format nil "tmp/qdiff/~A/"
                                   (prefix release))))
          (tmptar (qmerge "tmp/qdiff/release.tar")))
      (ensure-directories-exist tmpbase)
      (gunzip tarball tmptar)
      (unpack-tarball tmptar :directory tmpbase)
      (prog1
          (funcall diff-function tmptree (base-directory release) :verbosep verbosep)
        (delete-directory-tree tmpbase)))))

(defun qdiff-all (&key verbosep)
  (dolist (system (ql-dist:installed-releases t))
    (unless (zerop (qdiff (name system) :verbosep verbosep))
      (format t "~&; ~A has local changes~%" (name system)))))