/[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.53 by kaz, Thu Oct 31 04:06:01 2002 UTC revision 1.54 by kaz, Mon Nov 4 02:09:17 2002 UTC
# Line 4  Line 4 
4    
5  (require "dirwalk")  (require "dirwalk")
6  (require "system")  (require "system")
7    (require "options")
8  (require "sync")  (require "sync")
9  (require "chatter")  (require "chatter")
10  (require "restart")  (require "restart")
# Line 295  for duplicate entries" Line 296  for duplicate entries"
296        filemap)))        filemap)))
297    
298  (defun mapping-write (filemap filename &key sort-map)  (defun mapping-write (filemap filename &key sort-map)
299      (when *dry-run-option*
300        (chatter-debug "not writing to ~a because of -n global option.~%" filename)
301        (return-from mapping-write))
302    (when sort-map    (when sort-map
303      (setf filemap (sort (copy-list filemap)      (setf filemap (sort (copy-list filemap)
304                          #'string< :key #'mapping-entry-id)))                          #'string< :key #'mapping-entry-id)))
# Line 337  to ensure that the newly incorporated ch Line 341  to ensure that the newly incorporated ch
341                          (linkdata (no-existence-error (readlink symlink))))                          (linkdata (no-existence-error (readlink symlink))))
342                     (when (or (not linkdata)                     (when (or (not linkdata)
343                               (not (string= linkdata target)))                               (not (string= linkdata target)))
                      (no-existence-error (unlink symlink))  
                      (ensure-directories-exist symlink)  
                      (symlink target symlink)  
344                       (chatter-info "linking: ~a -> ~a~%"                       (chatter-info "linking: ~a -> ~a~%"
345                                     symlink target)))))))))))                                     symlink target)
346                         (honor-dry-run (target symlink)
347                           (no-existence-error (unlink symlink))
348                           (ensure-directories-exist symlink)
349                           (symlink target symlink))))))))))))
350    
351  (defun mapping-difference (old-mapping new-mapping)  (defun mapping-difference (old-mapping new-mapping)
352  "Compute the difference between two mappings. Returns three values:  "Compute the difference between two mappings. Returns three values:
# Line 385  whether they came from the CVS repositor Line 390  whether they came from the CVS repositor
390                (chatter-terse "removing ~a~%" real)                (chatter-terse "removing ~a~%" real)
391                (unless no-delete-removed                (unless no-delete-removed
392                  (restart-case                  (restart-case
393                    (ensure-directories-gone real)                    (honor-dry-run (real)
394                        (ensure-directories-gone real))
395                    (ignore () :report "Ignore file removal error."))                    (ignore () :report "Ignore file removal error."))
396                  (push item rollback-restore-items)))))                  (push item rollback-restore-items)))))
397    
# Line 393  whether they came from the CVS repositor Line 399  whether they came from the CVS repositor
399            (let ((old-item (first pair)))            (let ((old-item (first pair)))
400              (with-slots (path) old-item              (with-slots (path) old-item
401                (when (real-path-exists path)                (when (real-path-exists path)
402                  (ensure-directories-gone (abstract-to-real-path path))                  (honor-dry-run (path)
403                      (ensure-directories-gone (abstract-to-real-path path)))
404                  (push old-item rollback-restore-items)))))                  (push old-item rollback-restore-items)))))
405    
406          ;; Now check sanity of adds and moves, to verify they don't          ;; Now check sanity of adds and moves, to verify they don't
# Line 473  whether they came from the CVS repositor Line 480  whether they came from the CVS repositor
480                           (chatter-terse "moving ~a -> (out-of-sandbox)~%" real-old)))                           (chatter-terse "moving ~a -> (out-of-sandbox)~%" real-old)))
481    
482                      (when real-new-exists                      (when real-new-exists
483                        (no-existence-error (unlink real-new))                        (no-existence-error (honor-dry-run (real-new)
484                                                (unlink real-new)))
485                        (case kind                        (case kind
486                          ((:file)                          ((:file)
487                             (synchronize-files new-id real-new executable))                             (synchronize-files new-id real-new executable))
488                          ((:symlink)                          ((:symlink)
489                             (ensure-directories-exist real-new)                             (honor-dry-run (target real-new)
490                             (symlink target real-new)))                               (ensure-directories-exist real-new)
491                                 (symlink target real-new))))
492                        (push new-item rollback-remove-items))))))))                        (push new-item rollback-remove-items))))))))
493    
494          (dolist (item added-items)          (dolist (item added-items)
# Line 487  whether they came from the CVS repositor Line 496  whether they came from the CVS repositor
496              (when (real-path-exists path)              (when (real-path-exists path)
497                (let ((real (abstract-to-real-path path)))                (let ((real (abstract-to-real-path path)))
498                  (can-restart-here ("Continue updating file structure.")                  (can-restart-here ("Continue updating file structure.")
499                    (no-existence-error (unlink real))                    (no-existence-error (honor-dry-run (real)
500                                            (unlink real)))
501                    (case kind                    (case kind
502                      ((:file)                      ((:file)
503                         (chatter-terse "adding ~a~%" real)                         (chatter-terse "adding ~a~%" real)
504                         (synchronize-files id real executable))                         (synchronize-files id real executable))
505                      ((:symlink)                      ((:symlink)
506                         (chatter-terse "linking ~a -> ~a~%" real target)                         (chatter-terse "linking ~a -> ~a~%" real target)
507                         (ensure-directories-exist real)                         (honor-dry-run (real)
508                         (symlink target real)))                           (ensure-directories-exist real)
509                             (symlink target real))))
510                    (push item rollback-remove-items)))))))                    (push item rollback-remove-items)))))))
511        (continue ()        (continue ()
512          :report "Restore all restructuring done so far."          :report "Restore all restructuring done so far."
# Line 503  whether they came from the CVS repositor Line 514  whether they came from the CVS repositor
514          (dolist (item rollback-remove-items)          (dolist (item rollback-remove-items)
515            (let ((real (abstract-to-real-path (mapping-entry-path item))))            (let ((real (abstract-to-real-path (mapping-entry-path item))))
516              (chatter-terse "removing ~a~%" real)              (chatter-terse "removing ~a~%" real)
517              (ensure-directories-gone real)))              (honor-dry-run (real)
518                  (ensure-directories-gone real))))
519          (dolist (item rollback-restore-items)          (dolist (item rollback-restore-items)
520            (with-slots (kind path id target executable) item            (with-slots (kind path id target executable) item
521              (let ((real (abstract-to-real-path path)))              (let ((real (abstract-to-real-path path)))
# Line 512  whether they came from the CVS repositor Line 524  whether they came from the CVS repositor
524                  ((:file)                  ((:file)
525                     (synchronize-files id real executable))                     (synchronize-files id real executable))
526                  ((:symlink)                  ((:symlink)
527                     (ensure-directories-exist real)                     (honor-dry-run (real)
528                     (symlink target real))))))                       (ensure-directories-exist real)
529                         (symlink target real)))))))
530          (return-from mapping-update nil)))          (return-from mapping-update nil)))
531    
532      (mapping-write new-filemap *mcvs-map-local*))      (mapping-write new-filemap *mcvs-map-local*))

Legend:
Removed from v.1.53  
changed lines
  Added in v.1.54

  ViewVC Help
Powered by ViewVC 1.1.5