source: cl-darcs/tags/0.1.0/patchinfo.lisp

;;; Copyright (C) 2006 Magnus Henoch
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 2 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

(in-package :darcs)

;; defclass?
(defstruct patchinfo
  date name author log inverted)

;; make_filename in PatchInfo.lhs
(defun patchinfo-make-filename (patchinfo)
  (with-slots (date name author log inverted) patchinfo
    (labels ((sha1-internal (bytes)
               #+clisp (sb-sha1:sha1sum-sequence bytes)
               #-clisp (ironclad:digest-sequence :sha1 bytes))
             (sha1 (str)
               (ironclad:byte-array-to-hex-string
                (sha1-internal
                 (ironclad:ascii-string-to-byte-array str)))))
      (concatenate 'string
                   ;; the original code uses cleanDate... but why?
                   date
                   "-"
                   (subseq (sha1 author) 0 5)
                   "-"
                   (sha1
                    (concatenate 
                     'string
                     name author date
                     (apply #'concatenate 'string log)
                     (if inverted "t" "f")))
                   ".gz"))))

;; readPatchInfo in PatchInfo.lhs
(defun read-patchinfo (stream)
  "Read a patch id from STREAM.
Return NIL if none found due to EOF."
  ;; skip whitespace
  (let ((c
         (loop for c = (read-byte stream nil :eof)
            while (and (not (eql c :eof)) (isspace c))
            finally (return c))))
    (cond
      ;; EOF?
      ((eql c :eof)
       (return-from read-patchinfo nil))
      ;; First character must be [
      ((eql c (char-code #\[))
       )
      (t
       (error "~S is not #\\[, no patchinfo read." (code-char c)))))

  (let ( ;; Now, the rest of the line is the name.
        (name (read-binary-line stream))
        ;; And up to * is the author.
        (author (read-until (char-code #\*) stream))
        ;; Next character is '*' (normal patch) or '-' (inverted patch)
        (inverted (eql (read-byte stream) (char-code #\-))))
    ;; Up to end of line (modulo possible ]) is date
    (multiple-value-bind (date char) (read-until (list 10 (char-code #\])) stream)
      ;; If char is #\] here, we have no log.  Else, the log is the
      ;; following lines starting with a space.  The line after the
      ;; log starts with #\].  We should remove the space in front of
      ;; each line.  We need bit-by-bit quality, since the log is used
      ;; for hashing later.
      (dformat "~&Date terminated by ~A." char)
      (let ((log (when (/= char (char-code #\]))
                   (loop 
                      for line = (read-binary-line stream)
                      until (= (elt line 0) (char-code #\]))
                      do (dformat "~&Got line ~S." line)
                      do (when (or (zerop (length line))
                                   (/= (elt line 0) 32))
                           (error "Malformed log line ~S." line))
                      collect (bytes-to-string (subseq line 1))
                      finally (unread-line stream (subseq line 1)))))) ;discard #\]
        (make-patchinfo :date (bytes-to-string date)
                        :name (bytes-to-string name)
                        :author (bytes-to-string author)
                        :log log
                        :inverted inverted)))))

(defun write-patchinfo (patchinfo stream)
  "Write PATCHINFO to STREAM."
  (write-char #\[ stream)
  (write-line (patchinfo-name patchinfo) stream)
  (write-string (patchinfo-author patchinfo) stream)
  (write-string (if (patchinfo-inverted patchinfo)
                    "*-"
                    "**")
                stream)
  (write-string (patchinfo-date patchinfo) stream)
  (when (patchinfo-log patchinfo)
    (terpri stream)
    (dolist (log (patchinfo-log patchinfo))
      (write-char #\Space stream)
      (write-line log stream)))
  (write-string "] " stream))

(defun invert-patchinfo (patchinfo)
  "Make a copy of PATCHINFO with the inverted flag toggled."
  (let ((copy (copy-patchinfo patchinfo)))
    (setf (patchinfo-inverted copy)
          (not (patchinfo-inverted copy)))
    copy))

(defmethod print-object ((patchinfo patchinfo) stream)
  (if *print-readably*
      (call-next-method)
      (format stream "~A ~A (~A)" (patchinfo-date patchinfo)
              (patchinfo-name patchinfo)
              (patchinfo-author patchinfo))))