Changeset 3954 for trunk/base

Timestamp:

Nov 15, 2003, 9:46:50 PM (20 years ago)

Author:

fkr

Message:

Bug:
Submitted by: wbb4@
Reviewed by:
Approved by:
Obtained from:

enabled uninstall to work properly when version in dports-tree is not equal
installed version.
also add's installed check, so a port is not accidently installed over an existing
version.

Location:

trunk/base/src/port1.0

Files:

• portinstall.tcl (modified) (1 diff)
• portmain.tcl (modified) (1 diff)
• portuninstall.tcl (modified) (4 diffs)

trunk/base/src/port1.0/portinstall.tcl

@@ -42 +42 @@
 
 proc install_start {args} {
-    global UI_PREFIX portname
+    global UI_PREFIX portname portversion
 
-    ui_msg "$UI_PREFIX [format [msgcat::mc "Installing %s"] ${portname}]"
+        # Check to make sure this port is not already installed.  This is a 
+        # general check of the portname only, so previous versions will fail 
+        # as well.
+        if {[string length [registry_exists $portname]]} {
+                # Also check to see if it's this version or another
+                if {[string length [registry_exists $portname $portversion]]} {
+                        return -code error [format [msgcat::mc "Port %s already registered as installed."] $portname]
+                } else {
+                        return -code error [format [msgcat::mc "Another version of Port %s is already registered as installed.  Please uninstall the port first."] $portname]
+                }
+        } else {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Installing %s"] ${portname}]"
+        }
 }
 

trunk/base/src/port1.0/portmain.tcl

@@ -86 +86 @@
 default os.endian {[string range $tcl_platform(byteOrder) 0 [expr [string length $tcl_platform(byteOrder)] - 7]]}
 
-
 # Select implicit variants
 if {[info exists os.platform] && ![info exists variations(${os.platform})]} { variant_set ${os.platform}}

trunk/base/src/port1.0/portuninstall.tcl

@@ -47 +47 @@
     global portname portversion UI_PREFIX
 
-    if {[string length [registry_exists $portname $portversion]]} {
-        ui_msg "$UI_PREFIX [format [msgcat::mc "Uninstalling %s-%s"] $portname $portversion]"
+    if {[string length [registry_exists $portname]]} {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Uninstalling %s"] $portname]"
     }
 }
@@ -60 +60 @@
     }
 
-    set rfile [registry_exists $portname $portversion]
+    set rfile [registry_exists $portname]
     if {[string length $rfile]} {
         if {[regexp .bz2$ $rfile]} {
@@ -127 +127 @@
             }
             if {!$uninst_err || [tbool uninstall.force]} {
-                registry_delete $portname $portversion
+                if {[regexp .bz2$ $rfile]} {
+                        regsub {.bz2$} $rfile {} r_file
+                        set r_version [lindex [split $r_file -] 1]
+                } else {
+                        set r_version [lindex [split $rfile -] 1]
+                }
+                registry_delete $portname $r_version
                 return 0
             }
@@ -134 +140 @@
         }
     }
-    return -code error [msgcat::mc "Uninstall failed: Port not registered as installed"]
+    return -code error [format [msgcat::mc "Uninstall failed: Port %s not registered as installed"] $portname]
 }