source: cl-darcs/trunk/patchinfo.lisp

Last change on this file was 121, checked in by Magnus Henoch, 15 years ago

Ironclad's SHA1 works with CLISP now

File size: 4.3 KB
Line 
1;;; Copyright (C) 2006, 2007 Magnus Henoch
2;;;
3;;; This program is free software; you can redistribute it and/or
4;;; modify it under the terms of the GNU General Public License as
5;;; published by the Free Software Foundation; either version 2 of the
6;;; License, or (at your option) any later version.
7;;;
8;;; This program is distributed in the hope that it will be useful,
9;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11;;; General Public License for more details.
12;;;
13;;; You should have received a copy of the GNU General Public License
14;;; along with this program; if not, write to the Free Software
15;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
16
17(in-package :darcs)
18
19;; defclass?
20(defstruct patchinfo
21  date name author log inverted)
22
23;; make_filename in PatchInfo.lhs
24(defun patchinfo-make-filename (patchinfo)
25  (with-slots (date name author log inverted) patchinfo
26    (labels ((sha1-internal (bytes)
27               (ironclad:digest-sequence :sha1 bytes))
28             (sha1 (str)
29               (ironclad:byte-array-to-hex-string
30                (sha1-internal
31                 (ironclad:ascii-string-to-byte-array str)))))
32      (concatenate 'string
33                   ;; the original code uses cleanDate... but why?
34                   date
35                   "-"
36                   (subseq (sha1 author) 0 5)
37                   "-"
38                   (sha1
39                    (concatenate 
40                     'string
41                     name author date
42                     (apply #'concatenate 'string log)
43                     (if inverted "t" "f")))
44                   ".gz"))))
45
46;; readPatchInfo in PatchInfo.lhs
47(defun read-patchinfo (stream)
48  "Read a patch id from STREAM.
49Return NIL if none found due to EOF."
50  ;; skip whitespace
51  (let ((c
52         (loop for c = (read-byte stream nil :eof)
53            while (and (not (eql c :eof)) (isspace c))
54            finally (return c))))
55    (cond
56      ;; EOF?
57      ((eql c :eof)
58       (return-from read-patchinfo nil))
59      ;; First character must be [
60      ((eql c (char-code #\[))
61       )
62      (t
63       (error "~S is not #\\[, no patchinfo read." (code-char c)))))
64
65  (let ( ;; Now, the rest of the line is the name.
66        (name (read-binary-line stream))
67        ;; And up to * is the author.
68        (author (read-until (char-code #\*) stream))
69        ;; Next character is '*' (normal patch) or '-' (inverted patch)
70        (inverted (eql (read-byte stream) (char-code #\-))))
71    ;; Up to end of line (modulo possible ]) is date
72    (multiple-value-bind (date char) (read-until (list 10 (char-code #\])) stream)
73      ;; If char is #\] here, we have no log.  Else, the log is the
74      ;; following lines starting with a space.  The line after the
75      ;; log starts with #\].  We should remove the space in front of
76      ;; each line.  We need bit-by-bit quality, since the log is used
77      ;; for hashing later.
78      (dformat "~&Date terminated by ~A." char)
79      (let ((log (when (/= char (char-code #\]))
80                   (loop 
81                      for line = (read-binary-line stream)
82                      until (= (elt line 0) (char-code #\]))
83                      do (dformat "~&Got line ~S." line)
84                      do (when (or (zerop (length line))
85                                   (/= (elt line 0) 32))
86                           (error "Malformed log line ~S." line))
87                      collect (bytes-to-string (subseq line 1))
88                      finally (unread-line stream (subseq line 1)))))) ;discard #\]
89        (make-patchinfo :date (bytes-to-string date)
90                        :name (bytes-to-string name)
91                        :author (bytes-to-string author)
92                        :log log
93                        :inverted inverted)))))
94
95(defun write-patchinfo (patchinfo stream)
96  "Write PATCHINFO to STREAM."
97  (write-char #\[ stream)
98  (write-line (patchinfo-name patchinfo) stream)
99  (write-string (patchinfo-author patchinfo) stream)
100  (write-string (if (patchinfo-inverted patchinfo)
101                    "*-"
102                    "**")
103                stream)
104  (write-string (patchinfo-date patchinfo) stream)
105  (when (patchinfo-log patchinfo)
106    (terpri stream)
107    (dolist (log (patchinfo-log patchinfo))
108      (write-char #\Space stream)
109      (write-line log stream)))
110  (write-string "] " stream))
111
112(defun invert-patchinfo (patchinfo)
113  "Make a copy of PATCHINFO with the inverted flag toggled."
114  (let ((copy (copy-patchinfo patchinfo)))
115    (setf (patchinfo-inverted copy)
116          (not (patchinfo-inverted copy)))
117    copy))
118
119(defmethod print-object ((patchinfo patchinfo) stream)
120  (print-unreadable-object (patchinfo stream)
121    (format stream "~A ~A (~A)" (patchinfo-date patchinfo)
122            (patchinfo-name patchinfo)
123            (patchinfo-author patchinfo))))
Note: See TracBrowser for help on using the repository browser.