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

Diff of /meta-cvs/F-9A67B1893CE1CF23455CD1EF0F486B65

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by kaz, Sun Oct 6 05:25:31 2002 UTC revision 1.7.2.5 by kaz, Thu Jan 29 06:10:06 2004 UTC
# Line 11  Line 11 
11  (provide "convert")  (provide "convert")
12    
13  (defun remove-attic-component (path)  (defun remove-attic-component (path)
14    (let* ((split-path (split-fields path "/"))    (let* ((split-path (nreverse (split-fields path "/"))))
15           (len (length split-path)))      (when (string= (first split-path) "Attic")
16      (when (and (>= len 2) (string= (nth (- len 2) split-path) "Attic"))        (pop split-path))
17        (setf split-path (append (butlast (butlast split-path))      (reduce #'(lambda (x y) (format nil "~a/~a" x y))
18                                 (last split-path))))              (nreverse split-path)
19      (reduce #'(lambda (x y) (format nil "~a/~a" x y)) split-path)))              :initial-value ".")))
20    
21  (defun classify-tags (tags)  (defun classify-tags (tags)
22    (let (version-tags branch-tags)    (let (version-tags branch-tags)
# Line 40  Line 40 
40    
41    (let (filemap all-version-tags all-branch-tags)    (let (filemap all-version-tags all-branch-tags)
42      (current-dir-restore      (current-dir-restore
43          (chatter-info "descending into ~a~%" source-dir)
44        (chdir source-dir)        (chdir source-dir)
45        (for-each-file-info (fi ".")        (for-each-file-info (fi ".")
46            (when (and (directory-p fi)
47                       (path-equal (basename (file-name fi)) "CVS"))
48              (skip))
49          (when (regular-p fi)          (when (regular-p fi)
50            (let ((canon-name (canonicalize-path (file-name fi))))            (let ((canon-name (canonicalize-path (file-name fi))))
51              (multiple-value-bind (suffix v-suffix-free-name)              (multiple-value-bind (suffix basename dir)
52                                   (suffix canon-name #\,)                                   (suffix canon-name #\,)
53                (when (and suffix (string= suffix "v"))                (when (and suffix (string= suffix "v"))
54                  (let ((attic-free-name                  (let* ((dir (or dir "."))
55                          (remove-attic-component v-suffix-free-name))                         (no-attic-dir (remove-attic-component dir))
56                        (f-name (mapping-generate-id :suffix (suffix v-suffix-free-name)                         (no-attic-suffix-name
57                                                     :no-dir t)))                           (canonicalize-path (path-cat no-attic-dir basename)))
58                    (link canon-name (path-cat *up-dir*                         (f-name (mapping-generate-id :suffix (suffix basename)
59                                               target-dir                                                      :no-dir t))
60                                               (format nil "~A,v" f-name)))                         (rcs-name (path-cat *up-dir* target-dir
61                                               (format nil "~A,v" f-name))))
62                      (chatter-info "hard linking ~a -> ~a~%"
63                                    canon-name
64                                    rcs-name)
65                      (link canon-name rcs-name)
66                    (push (make-mapping-entry :kind :file                    (push (make-mapping-entry :kind :file
67                                              :id (path-cat *mcvs-dir* f-name)                                              :id (path-cat *mcvs-dir* f-name)
68                                              :path attic-free-name                                              :path no-attic-suffix-name
69                                              :executable (executable-p fi))                                              :executable (executable-p fi))
70                          filemap)                          filemap)
71                    (with-open-file (f (parse-posix-namestring canon-name)                    (with-open-file (f (parse-posix-namestring canon-name)
72                                       :direction :input)                                       :direction :input)
73                      (chatter-info "scanning ~a.~%" canon-name)                      (chatter-info "scanning ~a~%" canon-name)
74                      (let ((rcs-file (rcs-parse f)))                      (let ((rcs-file (rcs-parse f)))
75                        (multiple-value-bind (version-tags branch-tags)                        (multiple-value-bind (version-tags branch-tags)
76                                             (classify-tags (rcs-admin-symbols (rcs-file-admin rcs-file)))                                             (classify-tags (rcs-admin-symbols (rcs-file-admin rcs-file)))
# Line 73  Line 82 
82    
83      (current-dir-restore      (current-dir-restore
84        (chdir target-dir)        (chdir target-dir)
85        (chatter-info "Writing map.")        (chatter-info "writing ~a~%" *mcvs-map-name*)
86        (mapping-write filemap *mcvs-map-name*)        (mapping-write filemap *mcvs-map-name* :sort-map t)
87    
88        (execute-program `("ci" "-mMeta-CVS MAP file created by mcvs convert."        (execute-program `("ci" "-mMeta-CVS MAP file created by mcvs convert."
89                           "-t/dev/null" ,*mcvs-map-name*))                           "-t/dev/null" ,*mcvs-map-name*))
90        (execute-program `("chmod" "ug+rw" ,(format nil "~A,v" *mcvs-map-name*)))        (execute-program `("chmod" "ug+rw" ,(format nil "~A,v" *mcvs-map-name*)))
91    
92        (execute-program-xargs '("rcs")        (chatter-info "setting up version and branch tags in ~a~%" *mcvs-map-name*)
93                               (mapcar #'(lambda (tag)        (unless (null all-version-tags)
94                                           (format nil "-n~A:1.1" tag))          (execute-program-xargs '("rcs")
95                                       all-version-tags)                                 (mapcar #'(lambda (tag)
96                               (list *mcvs-map-name*))                                             (format nil "-n~A:1.1" tag))
97                                           all-version-tags)
98                                   (list *mcvs-map-name*)))
99    
100        (let ((branch-counter 0))        (let ((branch-counter 0))
101          (execute-program-xargs '("rcs")          (unless (null all-branch-tags)
102                                 (mapcar #'(lambda (tag)            (execute-program-xargs '("rcs")
103                                             (format nil                                   (mapcar #'(lambda (tag)
104                                                     "-n~A:1.1.0.~A"                                               (format nil
105                                                     tag (+ 2 branch-counter)))                                                       "-n~A:1.1.0.~A"
106                                         all-branch-tags)                                                       tag (incf branch-counter
107                                 (list *mcvs-map-name*))))))                                                                 2)))
108                                             all-branch-tags)
109                                     (list *mcvs-map-name*)))))))
110    
111  (defun mcvs-convert-wrapper (cvs-options cvs-command-options mcvs-args)  (defun mcvs-convert-wrapper (cvs-options cvs-command-options mcvs-args)
112    (declare (ignore cvs-options cvs-command-options))    (declare (ignore cvs-options cvs-command-options))
113    (if (/= (length mcvs-args) 2)    (if (/= (length mcvs-args) 2)
114      (error "specify cvs source dir and new target dir."))      (error "specify cvs source dir and new target dir."))
115    (mcvs-convert (first mcvs-args) (second mcvs-args)))    (mcvs-convert (first mcvs-args) (second mcvs-args)))
116    
117    (defconstant *convert-help*
118    "Syntax:
119    
120      mcvs convert source-cvs-module target-mcvs-module
121    
122    Options:
123    
124      None.
125    
126    Semantics:
127    
128      The convert command builds a Meta-CVS module directly out of the RCS files of
129      a CVS module.  It must be run in the root directory of a CVS repository.
130      It requires the chmod and rcs command line tools.
131    
132      The algorithm is extremely naive. A list of the pathnames of the RCS files
133      is collected, as the basis for creating the MAP file. The Attic directory
134      components are removed from these paths, and the ,v suffixes are stripped.
135    
136      The execute property of files is lifted from the permission bits on
137      the RCS files.
138    
139      The MAP,v file is created using the ``rcs ci'' command.
140    
141      The F- files are generated as hard links to the RCS files, to save space
142      and avoid the overhead of copying.
143    
144      All of the RCS files are scanned to find version and branch tags.  Quite
145      naively, the version tags are installed in the MAP file, all pointing to
146      revision 1.1. The branch tags are installed in MAP, pointing to revisions
147      1.1.0.2, 1.1.0.4, ...  This is a lame attempt to make it possible to check
148      out past baselines. But note that the contents of MAP don't vary: only a
149      single version node is generated with a fixed set of files. It is not taken
150      into consideration that some of the CVS files may be deleted in the head
151      revision or some branches.  Therefore, when the resulting Meta-CVS project is
152      checked out, or when past versions are retrieved, there may be complaints
153      from Meta-CVS about nonexistent files.
154    
155      The hard linking of the original RCS objects under F- names means that any
156      permission, ownership or time-stamp changes done in the CVS module will
157      affect the content of the Meta-CVS module and vice versa. Destructive
158      modifications to the file contents, ditto. Be careful!
159    
160      If the hard links make you nervous, do a deep copy of the module,
161      using ``cp -a source-dir target-dir''.
162    
163      Note that CVS does not destructively manipulate RCS files. A commit
164      or tagging operation creates a new RCS object which atomically replaces the
165      old hard link. This means that a commit to a file in the Meta-CVS module will
166      not affect the CVS module and vice versa.")

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.7.2.5

  ViewVC Help
Powered by ViewVC 1.1.5