/[meta-cvs]/meta-cvs/F-FFF16CA4956A36F19290AC9E1EBAFFD8
ViewVC logotype

Diff of /meta-cvs/F-FFF16CA4956A36F19290AC9E1EBAFFD8

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

revision 1.21 by kaz, Sun Feb 10 05:09:16 2002 UTC revision 1.22 by kaz, Sun Feb 10 19:28:27 2002 UTC
# Line 188  to ensure that the newly incorporated ch Line 188  to ensure that the newly incorporated ch
188    
189  (defun mapping-difference (old-mapping new-mapping)  (defun mapping-difference (old-mapping new-mapping)
190  "Compute the difference between two mappings. Returns three values:  "Compute the difference between two mappings. Returns three values:
191  a mapping containing only elements added by new-mapping, a mapping  - a mapping containing only elements added by new-mapping;
192  containing only elements removed by new-mapping, and a list  - a mapping containing only elements removed by new-mapping; and
193  of moved items, which contains pairs of elements from both,  - a list of moved items, which contains pairs of elements from both, whose
194  whose object name matches, but path differs."    object name matches, but path differs."
195    (let (added-items removed-items moved-pairs)    (let (added-items removed-items moved-pairs)
196      (sort old-mapping #'string-lessp :key #'first)      (sort old-mapping #'string-lessp :key #'first)
197      (sort new-mapping #'string-lessp :key #'first)      (sort new-mapping #'string-lessp :key #'first)
# Line 225  bring the local structure up to date aft Line 225  bring the local structure up to date aft
225  whether they came from the CVS repository, or from local operations."  whether they came from the CVS repository, or from local operations."
226  *mcvs-map-local* *mcvs-map*)  *mcvs-map-local* *mcvs-map*)
227    (let ((old-filemap (mapping-read *mcvs-map-local*))    (let ((old-filemap (mapping-read *mcvs-map-local*))
228          (new-filemap (mapping-read *mcvs-map* :sanity-check t)))          (new-filemap (mapping-read *mcvs-map* :sanity-check t))
229      (multiple-value-bind (added-items removed-items moved-pairs)          rollback-remove-items rollback-restore-items)
230                           (mapping-difference old-filemap new-filemap)      (restart-case
231        ;; Sanity checks        (multiple-value-bind (added-items removed-items moved-pairs)
232        (dolist (item added-items)                             (mapping-difference old-filemap new-filemap)
233          (let ((file-info (exists (second item))))          ;; First remove what has to be removed. This way when we
234            (when (and file-info          ;; do sanity checks, we won't complain about clobbering things
235                       (not (same-file-p file-info (stat (first item))))          ;; that are slated to disappear.
236                       (not (mapping-lookup old-filemap (second item))))          (dolist (item removed-items)
237              (error "mcvs: cannot add ~a, a local file is in the way."            (chatter-info "removing ~a~%" (second item))
238                     (second item)))))            (ensure-directories-gone (second item))
239              (push item rollback-restore-items))
240        (dolist (item moved-pairs)  
241          (destructuring-bind (old-item new-item) item          (dolist (pair moved-pairs)
242            (let ((file-info (exists (second new-item))))            (let ((old-item (first pair)))
243                (ensure-directories-gone (second old-item))
244                (push old-item rollback-restore-items)))
245    
246            ;; Now check sanity of adds and moves, to verify they don't
247            ;; clobber any local files.
248            (dolist (item added-items)
249              (let ((file-info (exists (second item))))
250              (when (and file-info              (when (and file-info
251                         (not (mapping-lookup old-filemap (second new-item))))                         (not (same-file-p file-info (stat (first item))))
252                (error "mcvs: cannot move ~a -> ~a, a local file is in the way."                         (not (mapping-lookup old-filemap (second item))))
253                       (second old-item) (second new-item))))))                (error "mcvs: cannot add ~a, a local file is in the way."
254                         (second item)))))
255        ;; Actual restructuring  
256        (dolist (item removed-items)          (dolist (item moved-pairs)
257          (can-restart-here ("Continue updating file structure.")            (destructuring-bind (old-item new-item) item
258            (chatter-info "deleting ~a~%" (second item))              (let ((file-info (exists (second new-item))))
259            (ensure-directories-gone (second item))))                (when (and file-info
260                             (not (mapping-lookup old-filemap (second new-item))))
261        (dolist (item moved-pairs)                  (error "mcvs: cannot move ~a -> ~a, a local file is in the way."
262          (destructuring-bind (old-item new-item) item                         (second old-item) (second new-item))))))
263            (can-restart-here ("Continue updating file structure.")  
264            ;; Sanity check passed, complete moves and adds.
265            (dolist (item moved-pairs)
266              (destructuring-bind (old-item new-item) item
267              (chatter-info "moving ~a -> ~a~%" (second old-item)              (chatter-info "moving ~a -> ~a~%" (second old-item)
268                                                (second new-item))                                                (second new-item))
             (ensure-directories-gone (second old-item))  
269              (no-existence-error (unlink (second new-item)))              (no-existence-error (unlink (second new-item)))
270              (synchronize-files (first new-item) (second new-item)))))              (synchronize-files (first new-item) (second new-item))
271                (push new-item rollback-remove-items)))
272    
273        (dolist (item added-items)          (dolist (item added-items)
274          (can-restart-here ("Continue updating file structure.")            (can-restart-here ("Continue updating file structure.")
275            (chatter-info "adding ~a~%" (second item))              (chatter-info "adding ~a~%" (second item))
276            (synchronize-files (first item) (second item)))))              (synchronize-files (first item) (second item))
277                (push item rollback-remove-items))))
278          (continue ()
279            :report "Restore all restructuring done so far."
280            (chatter-terse "Restoring.~%")
281            (dolist (item rollback-remove-items)
282              (chatter-info "removing ~a~%" (second item))
283              (ensure-directories-gone (second item)))
284            (dolist (item rollback-restore-items)
285              (chatter-info "restoring ~a~%" (second item))
286              (synchronize-files (first item) (second item)))
287            (return-from mapping-update)))
288    
289      (mapping-write new-filemap *mcvs-map-local*)))      (mapping-write new-filemap *mcvs-map-local*)))

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

  ViewVC Help
Powered by ViewVC 1.1.5