Changeset 79445

Timestamp:

06/13/11 08:53:43 (4 years ago)

Author:

jmr@…

Message:

images_to_archives.tcl: don't modify registry until all archives have been successfully created, and don't delete old image dirs until registry has been successfully changed. This should allow users to at least go back to 1.9 if conversion fails.

File:

• trunk/base/src/images_to_archives.tcl (modified) (4 diffs)

trunk/base/src/images_to_archives.tcl

@@ -9 +9 @@
 package require macports 1.0
 package require registry 1.0
+package require registry2 2.0
+package require Pextlib 1.0
+
+umask 022
 
 mportinit
@@ -24 +28 @@
 
 puts "This could take a while..."
+
+# list of ports we successfully create an archive of, to be used to update
+# the registry only after we know all creation attempts were successful.
+set archived_list {}
 
 foreach installed $ilist {
@@ -102 +110 @@
         }
 
+        lappend archived_list [list $installtype $iref $location $newlocation]
+    }
+}
+
+registry::write {
+    foreach archived $archived_list {
+        set installtype [lindex $archived 0]
+        set iref [lindex $archived 1]
+        set newlocation [lindex $archived 3]
+    
         if {$installtype == "direct"} {
             # change receipt to image
@@ -109 +127 @@
             $iref state installed
         }
+    
+        # set the new location in the registry and delete the old dir
+        $iref location $newlocation
+    }
+}
 
-        # set the new location in the registry and delete the old dir
-        registry::property_store $iref location $newlocation
-        if {$location != "" && [file isdirectory $location]} {
-            file delete -force $location
+foreach archived $archived_list {
+    set location [lindex $archived 2]
+    if {$location != "" && [file isdirectory $location]} {
+        if {[catch {file delete -force $location} result]} {
+            ui_warn "Failed to delete ${location}: $result"
         }
     }