/[meta-cvs]/meta-cvs/F-36433FEEE65F109159A4ADF217F5145C
ViewVC logotype

Contents of /meta-cvs/F-36433FEEE65F109159A4ADF217F5145C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.22 - (hide annotations)
Mon Nov 27 02:12:58 2006 UTC (7 years, 4 months ago) by kaz
Branch: MAIN
Changes since 1.21: +10 -6 lines
Bugfix and enhancement in mcvs-filt.

* code/mcvs.filt (mcvs-filt-loop): When a "/F-" pattern is found,
suggesting a F- name embedded in a path, the algorithm was skipping
ahead from that position by 7 characters instead of 3. That's because
that pattern used to be the 7 character "MCVS/F-" string long ago.
The enhancement is that the F- names are now not filtered if they
immediately follow a ".#", which is part of the prefix used by CVS
for naming backup files. The names must not be decoded in this context
since the backup files are not mapped to human-readable names.
1 kaz 1.3 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.1 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.21 (in-package :meta-cvs)
6 kaz 1.16
7 kaz 1.6 (defun make-filt-hash (mapping)
8     (let ((h (make-hash-table :test #'equal)))
9     (dolist (entry mapping h)
10     (multiple-value-bind (suffix nosuffix)
11 kaz 1.11 (suffix (mapping-entry-id entry))
12 kaz 1.6 (declare (ignore suffix))
13     (setf (gethash nosuffix h) entry)))))
14    
15 kaz 1.17 (defun filt-select-map (filt-options &key remote-module)
16 kaz 1.8 (find-bind (:test #'string= :key #'first :take #'second)
17 kaz 1.10 ((revision "r") (date "D") (extra-r "r") (extra-d "D"))
18 kaz 1.8 filt-options
19     (cond
20 kaz 1.10 ((or extra-r extra-d)
21 kaz 1.13 (error "only one date or revision may be specified."))
22 kaz 1.17 ((or revision date remote-module)
23     (unless remote-module
24     (chdir *mcvs-dir*))
25     (with-input-from-program (stream `("cvs" "-Q"
26     ,(if remote-module "co" "up") "-p"
27 kaz 1.8 ,@(format-opt filt-options)
28 kaz 1.17 ,(if remote-module
29     (format nil "~a/~a"
30     remote-module
31     *mcvs-map-name*)
32     *mcvs-map-name*)))
33     (handler-case
34     (mapping-read stream)
35     (error ()
36     (error "unable to retrieve specified revision of map file.")))))
37 kaz 1.8 (t (mapping-read *mcvs-map-local*)))))
38    
39 kaz 1.17 (defun mcvs-filt-loop (filehash)
40     (loop
41 kaz 1.18 (let ((line (read-line *standard-input* nil)))
42 kaz 1.17 (when (null line)
43     (return (values)))
44     (loop
45     (let ((f-start (search "F-" line :test #'char=))
46 kaz 1.22 (embedded-in-path (search "/F-" line :test #'char=))
47     (cvs-backup-notation (search ".#F-" line :test #'char=)))
48 kaz 1.17 (flet ((is-hex-digit (x)
49     (or (digit-char-p x)
50     (find x "ABCDEF"))))
51     (cond
52 kaz 1.22 ((and embedded-in-path (< embedded-in-path f-start))
53     (write-string (subseq line 0 (+ embedded-in-path 3)))
54     (setf line (subseq line (+ embedded-in-path 3))))
55     ((and cvs-backup-notation (< cvs-backup-notation f-start))
56     (write-string (subseq line 0 cvs-backup-notation))
57     (write-string *mcvs-dir*)
58     (write-string "/.#F-")
59     (setf line (subseq line (+ cvs-backup-notation 4))))
60 kaz 1.17 (f-start
61     (write-string (subseq line 0 f-start))
62     (setf line (subseq line (+ f-start 2)))
63     (when (< (length line) 32)
64     (write-string "F-")
65     (write-line line)
66     (return))
67     (cond
68     ((notevery #'is-hex-digit (subseq line 0 32))
69     (write-string "F-")
70     (setf line (subseq line 2)))
71     (t (let* ((f-digits (subseq line 0 32))
72     (entry (gethash (format nil "F-~a" f-digits)
73     filehash))
74     (suffix (and entry
75     (suffix (mapping-entry-id entry)))))
76     (setf line (subseq line 32))
77     (cond
78     ((null entry)
79     (write-string "F-")
80     (write-string f-digits))
81     ((and suffix
82     (or (< (length line) (1+ (length suffix)))
83     (not (path-equal (subseq line 1
84     (1+ (length suffix)))
85     suffix))))
86     (write-string "F-")
87     (write-string f-digits))
88     (t (write-string (mapping-entry-path entry))
89     (when suffix
90     (setf line
91     (subseq line
92     (1+ (length suffix)))))))))))
93     (t (write-line line)
94     (return)))))))))
95    
96 kaz 1.8 (defun mcvs-filt (filt-options)
97 kaz 1.1 (in-sandbox-root-dir
98 kaz 1.17 (mcvs-filt-loop (make-filt-hash (filt-select-map filt-options)))))
99    
100     (defun mcvs-remote-filt (filt-options module)
101     (mcvs-filt-loop (make-filt-hash (filt-select-map filt-options
102     :remote-module module))))
103 kaz 1.1
104     (defun mcvs-filt-wrapper (cvs-options cvs-command-options mcvs-args)
105 kaz 1.8 (declare (ignore cvs-options))
106 kaz 1.1 (when mcvs-args
107 kaz 1.13 (error "no arguments permitted."))
108 kaz 1.8 (mcvs-filt cvs-command-options))
109 kaz 1.17
110     (defun mcvs-remote-filt-wrapper (cvs-options cvs-command-options mcvs-args)
111     (declare (ignore cvs-options))
112     (unless (= (length mcvs-args) 1)
113     (error "module name required."))
114     (mcvs-remote-filt cvs-command-options (first mcvs-args)))

  ViewVC Help
Powered by ViewVC 1.1.5