/[meta-cvs]/meta-cvs/F-9A67B1893CE1CF23455CD1EF0F486B65
ViewVC logotype

Contents of /meta-cvs/F-9A67B1893CE1CF23455CD1EF0F486B65

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7.2.9 - (hide annotations)
Tue Feb 3 11:49:12 2004 UTC (10 years, 2 months ago) by kaz
Branch: mcvs-1-0-branch
CVS Tags: mcvs-1-0-branch~merged-to-HEAD-1, mcvs-1-0-branch~merged-to-HEAD-0, mcvs-1-0-13
Changes since 1.7.2.8: +20 -5 lines
* code/convert.lisp (mcvs-convert): Ensure that the converted
project has TYPES and .cvsignore files, not just a MAP, and that
these have all the branch and version tags.  This is important,
because users might end up independently adding these on branches
and end up with merge problems.
1 kaz 1.1 ;;; This source file is part of the Meta-CVS program,
2     ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5     (require "system")
6     (require "dirwalk")
7 kaz 1.3 (require "chatter")
8 kaz 1.1 (require "split")
9     (require "mapping")
10 kaz 1.7.2.9 (require "types")
11 kaz 1.4 (require "rcs-utils")
12 kaz 1.1 (provide "convert")
13    
14     (defun remove-attic-component (path)
15 kaz 1.7.2.6 (let ((split-path (nreverse (split-fields path "/")))
16     (attic-p nil))
17 kaz 1.7.2.1 (when (string= (first split-path) "Attic")
18 kaz 1.7.2.6 (pop split-path)
19     (setf attic-p t))
20     (values (reduce #'(lambda (x y) (format nil "~a/~a" x y))
21     (nreverse split-path)
22     :initial-value ".")
23     attic-p)))
24 kaz 1.1
25     (defun classify-tags (tags)
26     (let (version-tags branch-tags)
27     (dolist (tag tags (values version-tags branch-tags))
28 kaz 1.3 (destructuring-bind (tag-name tag-value) tag
29 kaz 1.1 (if (search ".0." tag-value)
30     (push tag-name branch-tags)
31     (push tag-name version-tags))))))
32    
33     (defun mcvs-convert (source-dir target-dir)
34     (when (ignore-errors (stat target-dir))
35 kaz 1.6 (error "a directory or file called ~a exists here already."
36 kaz 1.1 target-dir))
37    
38     (multiple-value-bind (path created)
39     (ensure-directories-exist (path-cat target-dir
40     *mcvs-map-name*))
41     (declare (ignore path))
42     (if (not created)
43 kaz 1.6 (error "unable to create directory ~a." target-dir)))
44 kaz 1.1
45 kaz 1.7.2.6 (let (filemap all-version-tags all-branch-tags attic-made)
46 kaz 1.1 (current-dir-restore
47     (chdir source-dir)
48     (for-each-file-info (fi ".")
49 kaz 1.7.2.3 (when (and (directory-p fi)
50     (path-equal (basename (file-name fi)) "CVS"))
51     (skip))
52 kaz 1.1 (when (regular-p fi)
53 kaz 1.3 (let ((canon-name (canonicalize-path (file-name fi))))
54 kaz 1.7.2.1 (multiple-value-bind (suffix basename dir)
55 kaz 1.1 (suffix canon-name #\,)
56 kaz 1.7.2.6 (multiple-value-bind (no-attic-dir attic-p)
57     (remove-attic-component (or dir "."))
58     (when (and suffix (string= suffix "v"))
59     (let* ((no-attic-suffix-name
60     (canonicalize-path (path-cat no-attic-dir basename)))
61     (f-name (mapping-generate-id :suffix (suffix basename)
62     :no-dir t))
63 kaz 1.7.2.8 (orig-rcs (path-cat source-dir canon-name))
64     (new-rcs (apply #'path-cat `(,target-dir
65     ,@(if attic-p '("Attic"))
66     ,(format nil "~A,v"
67     f-name)))))
68     (in-original-dir
69     (when attic-p
70     (unless attic-made
71     (ensure-directories-exist new-rcs)
72     (setf attic-made t)))
73     (chatter-info "hard linking ~a -> ~a~%" orig-rcs new-rcs)
74     (link orig-rcs new-rcs))
75 kaz 1.7.2.6 (push (make-mapping-entry :kind :file
76     :id (path-cat *mcvs-dir* f-name)
77     :path no-attic-suffix-name
78     :executable (executable-p fi))
79     filemap)
80     (with-open-file (f (parse-posix-namestring canon-name)
81     :direction :input)
82     (chatter-info "scanning ~a~%" canon-name)
83     (let ((rcs-file (rcs-parse f)))
84     (multiple-value-bind (version-tags branch-tags)
85     (classify-tags (rcs-admin-symbols (rcs-file-admin rcs-file)))
86     (setf all-version-tags (nunion all-version-tags
87     version-tags
88     :test #'string=))
89     (setf all-branch-tags (nunion all-branch-tags branch-tags
90     :test #'string=)))))))))))))
91 kaz 1.1
92     (current-dir-restore
93     (chdir target-dir)
94 kaz 1.7.2.1 (chatter-info "writing ~a~%" *mcvs-map-name*)
95 kaz 1.7.2.5 (mapping-write filemap *mcvs-map-name* :sort-map t)
96 kaz 1.1
97 kaz 1.7.2.9 (chatter-info "writing ~a~%" *mcvs-types-name*)
98     (with-open-file (f *mcvs-types-name* :direction :output)
99     (prin1 nil f)
100     (terpri f))
101    
102     (chatter-info "writing .cvsignore~%")
103     (with-open-file (f (make-pathname :name ".cvsignore") :direction :output)
104     (write-line *mcvs-map-local-name* f)
105     (write-line *mcvs-displaced-name* f))
106    
107     (execute-program `("ci" "-mCreated by Meta-CVS convert operation."
108     "-t/dev/null" ,*mcvs-map-name*
109     ,*mcvs-types-name* ".cvsignore"))
110 kaz 1.1 (execute-program `("chmod" "ug+rw" ,(format nil "~A,v" *mcvs-map-name*)))
111    
112 kaz 1.7.2.9 (chatter-info "setting up version and branch tags in ~a, ~a and .cvsignore~%"
113     *mcvs-map-name* *mcvs-types-name*)
114 kaz 1.7.2.1 (unless (null all-version-tags)
115     (execute-program-xargs '("rcs")
116     (mapcar #'(lambda (tag)
117     (format nil "-n~A:1.1" tag))
118     all-version-tags)
119 kaz 1.7.2.9 (list *mcvs-map-name* *mcvs-types-name*
120     ".cvsignore")))
121 kaz 1.1
122     (let ((branch-counter 0))
123 kaz 1.7.2.1 (unless (null all-branch-tags)
124     (execute-program-xargs '("rcs")
125     (mapcar #'(lambda (tag)
126     (format nil
127     "-n~A:1.1.0.~A"
128 kaz 1.7.2.2 tag (incf branch-counter
129     2)))
130 kaz 1.7.2.1 all-branch-tags)
131 kaz 1.7.2.9 (list *mcvs-map-name* *mcvs-types-name*
132     ".cvsignore")))))))
133 kaz 1.1
134 kaz 1.2 (defun mcvs-convert-wrapper (cvs-options cvs-command-options mcvs-args)
135     (declare (ignore cvs-options cvs-command-options))
136     (if (/= (length mcvs-args) 2)
137 kaz 1.6 (error "specify cvs source dir and new target dir."))
138 kaz 1.2 (mcvs-convert (first mcvs-args) (second mcvs-args)))
139 kaz 1.7.2.2
140     (defconstant *convert-help*
141     "Syntax:
142    
143     mcvs convert source-cvs-module target-mcvs-module
144    
145     Options:
146    
147     None.
148    
149     Semantics:
150    
151     The convert command builds a Meta-CVS module directly out of the RCS files of
152 kaz 1.7.2.8 a CVS module. The source-cvs-module is the pathname to an existing
153     module directory in the CVS repository containing an ordinary CVS module.
154     The target-mcvs-module is the pathname of a new Meta-CVS module directory to
155     be created.
156    
157     The source and target paths have to be on the same filesystem volume.
158    
159     The chmod and rcs programs are required.
160    
161     The algorithm is extremely naive:
162    
163     - A list of the pathnames of the RCS files is collected, as the basis for
164     creating the MAP file. The Attic directory components are removed from these
165     paths, and the ,v suffixes are stripped.
166 kaz 1.7.2.2
167 kaz 1.7.2.8 - The execute property of files is lifted from the permission bits on
168 kaz 1.7.2.2 the RCS files.
169    
170 kaz 1.7.2.8 - The MAP,v file is created using the ``rcs ci'' command.
171 kaz 1.7.2.2
172 kaz 1.7.2.8 - The F- files are generated as hard links to the RCS files, to save space
173 kaz 1.7.2.2 and avoid the overhead of copying.
174    
175 kaz 1.7.2.8 - All of the RCS files are scanned to find version and branch tags. Quite
176 kaz 1.7.2.2 naively, the version tags are installed in the MAP file, all pointing to
177     revision 1.1. The branch tags are installed in MAP, pointing to revisions
178     1.1.0.2, 1.1.0.4, ... This is a lame attempt to make it possible to check
179     out past baselines. But note that the contents of MAP don't vary: only a
180     single version node is generated with a fixed set of files. It is not taken
181     into consideration that some of the CVS files may be deleted in the head
182     revision or some branches. Therefore, when the resulting Meta-CVS project is
183     checked out, or when past versions are retrieved, there may be complaints
184     from Meta-CVS about nonexistent files.
185 kaz 1.7.2.7
186     The complaints about nonexistent files may be fixed at the tips of the
187     main trunk or branches using the ``mcvs remap'' command which will purge
188     the working MAP of entries for F- files for which no working copy is found.
189     A commit will then commit the change so that subsequent work may continue
190     without any more complaints.
191 kaz 1.7.2.2
192     The hard linking of the original RCS objects under F- names means that any
193     permission, ownership or time-stamp changes done in the CVS module will
194     affect the content of the Meta-CVS module and vice versa. Destructive
195     modifications to the file contents, ditto. Be careful!
196    
197     If the hard links make you nervous, do a deep copy of the module,
198     using ``cp -a source-dir target-dir''.
199    
200     Note that CVS does not destructively manipulate RCS files. A commit
201     or tagging operation creates a new RCS object which atomically replaces the
202     old hard link. This means that a commit to a file in the Meta-CVS module will
203     not affect the CVS module and vice versa.")

  ViewVC Help
Powered by ViewVC 1.1.5