Changeset 37349 for trunk/base/src

Timestamp:

06/04/08 01:32:15 (6 months ago)

Author:

jmr@…

Message:

Try to be case-insensitive and case-preserving with port names as much as
possible. Match names case-insensitively in the registry (previously this was
not done when running on a case-sensitive FS), but return the name with its
correct case. Additionally, make sure to use the correctly-cased name whenever
possible, where previously the name as entered by the user was used. This
changeset fixes the bug where giving the port name with incorrect case when
deactivating would fail to delete the port's files from $prefix (#11759).

Location:

trunk/base/src

Files:

• macports1.0/macports.tcl (modified) (10 diffs)
• port/port.tcl (modified) (6 diffs)
• registry1.0/portimage.tcl (modified) (4 diffs)
• registry1.0/portuninstall.tcl (modified) (2 diffs)
• registry1.0/receipt_flat.tcl (modified) (1 diff)

trunk/base/src/macports1.0/macports.tcl

@@ -1895 +1895 @@
     # fill array with information
     array set portinfo [lindex $result 1]
+    # set portname again since the one we were passed may not have had the correct case
+    set portname $portinfo(name)
 
     # set version_in_tree and revision_in_tree
@@ -1953 +1955 @@
         set version_installed $version_in_tree
         set revision_installed $revision_in_tree
+        set iname $portname
         # That was a very dirty hack showing how ugly our depencendy and upgrade code is.
         # To get it working when user provides -f, we also need to set the variant to
@@ -1970 +1973 @@
                     || ([rpm-vercomp $version $version_installed] == 0
                         && [rpm-vercomp $revision $revision_installed] > 0)} {
+                set iname [lindex $i 0]
                 set version_installed $version
                 set revision_installed $revision
                 set variant_installed $variant
-                set epoch_installed [registry::property_retrieve [registry::open_entry $portname [lindex $i 1] [lindex $i 2] $variant] epoch]
+                set epoch_installed [registry::property_retrieve [registry::open_entry $iname [lindex $i 1] [lindex $i 2] $variant] epoch]
                 set num $i
             }
@@ -1980 +1984 @@
             if {$isactive == 1} {
                 set anyactive yes
+                set active_name [lindex $i 0]
                 set version_active $version
                 set revision_active $revision
@@ -1989 +1994 @@
                             || [string compare $variant_installed $variant_active] != 0)} {
             # deactivate version
-            if {[catch {portimage::deactivate $portname ${version_active}_${revision_active}${variant_active} $optionslist} result]} {
+            if {[catch {portimage::deactivate $active_name ${version_active}_${revision_active}${variant_active} $optionslist} result]} {
                 global errorInfo
                 ui_debug "$errorInfo"
-                ui_error "Deactivating $portname @${version_active}_${revision_active} failed: $result"
+                ui_error "Deactivating $active_name @${version_active}_${revision_active} failed: $result"
                 return 1
             }
@@ -1998 +2003 @@
         if { [lindex $num 4] == 0 && 0 == [string compare "image" ${macports::registry.installtype}] } {
             # activate the latest installed version
-            if {[catch {portimage::activate $portname ${version_installed}_${revision_installed}$variant $optionslist} result]} {
+            if {[catch {portimage::activate $iname ${version_installed}_${revision_installed}$variant $optionslist} result]} {
                 global errorInfo
                 ui_debug "$errorInfo"
-                ui_error "Activating $portname @${version_installed}_${revision_installed} failed: $result"
+                ui_error "Activating $iname @${version_installed}_${revision_installed} failed: $result"
                 return 1
             }
@@ -2010 +2015 @@
     ui_debug "epoch: in tree: $epoch_in_tree installed: $epoch_installed"
     ui_debug "$portname ${version_in_tree}_$revision_in_tree exists in the ports tree"
-    ui_debug "$portname ${version_installed}_$revision_installed is installed"
+    ui_debug "$iname ${version_installed}_$revision_installed is installed"
 
     # set the nodeps option  
@@ -2077 +2082 @@
                 && [rpm-vercomp $revision_installed $revision_in_tree] >= 0 ))
         && ![info exists options(ports_force)] } {
-        ui_debug "No need to upgrade! $portname ${version_installed}_$revision_installed >= $portname ${version_in_tree}_$revision_in_tree"
+        ui_debug "No need to upgrade! $iname ${version_installed}_$revision_installed >= $portname ${version_in_tree}_$revision_in_tree"
         if { $epoch_installed >= $epoch_in_tree } {
             # Check if we have to do dependents
@@ -2085 +2090 @@
 
                 registry::open_dep_map
-                set deplist [registry::list_dependents $portname]
+                set deplist [registry::list_dependents $iname]
 
                 if { [llength deplist] > 0 } {
@@ -2154 +2159 @@
     if {[info exists options(port_uninstall_old)] || $epoch_override == 1 || [info exists options(ports_force)] || 0 != [string compare "image" ${macports::registry.installtype}] } {
         # uninstall old
-        ui_debug "Uninstalling $portname ${version_installed}_$revision_installed$oldvariant"
-        if {[catch {portuninstall::uninstall $portname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
+        ui_debug "Uninstalling $iname ${version_installed}_$revision_installed$oldvariant"
+        if {[catch {portuninstall::uninstall $iname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
             global errorInfo
             ui_debug "$errorInfo"
-            ui_error "Uninstall $portname ${version_installed}_$revision_installed$oldvariant failed: $result"
+            ui_error "Uninstall $iname ${version_installed}_$revision_installed$oldvariant failed: $result"
             return 1
         }
     } else {
         # XXX deactivate version_installed
-        if {[catch {portimage::deactivate $portname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
+        if {[catch {portimage::deactivate $iname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
             global errorInfo
             ui_debug "$errorInfo"
-            ui_error "Deactivating $portname ${version_installed}_$revision_installed failed: $result"
+            ui_error "Deactivating $iname ${version_installed}_$revision_installed failed: $result"
             return 1
         }

trunk/base/src/port/port.tcl

@@ -210 +210 @@
     set ilist [registry::installed $portname $portversion]
     if { [llength $ilist] > 1 } {
+        # set portname again since the one we were passed may not have had the correct case
+        set portname [lindex [lindex $ilist 0] 0]
         puts "The following versions of $portname are currently installed:"
         foreach i [portlist_sortint $ilist] { 
@@ -1500 +1502 @@
             break_softcontinue "port location failed: $result" 1 status
         } else {
+            # set portname again since the one we were passed may not have had the correct case
+            set portname [lindex $ilist 0]
             set version [lindex $ilist 1]
             set revision [lindex $ilist 2]
@@ -1684 +1688 @@
             ui_debug "$errorInfo"
             break_softcontinue "$result" 1 status
+        } else {
+            # set portname again since the one we were passed may not have had the correct case
+            set portname [lindex [lindex $ilist 0] 0]
         }
         
@@ -1914 +1921 @@
     }
     foreachport $portlist {
+        if { ![catch {set ilist [registry::installed $portname]} result] } {
+            # set portname again since the one we were passed may not have had the correct case
+            set portname [lindex [lindex $ilist 0] 0]
+        }
         set files [registry::port_registered $portname]
         if { $files != 0 } {
@@ -1952 +1963 @@
         array unset portinfo
         array set portinfo [lindex $result 1]
+        # set portname again since the one we were passed may not have had the correct case
+        set portname $portinfo(name)
 
         set depstypes {depends_build depends_lib depends_run}
@@ -2000 +2013 @@
         array unset portinfo
         array set portinfo [lindex $result 1]
+        # set portname again since the one we were passed may not have had the correct case
+        set portname $portinfo(name)
         set porturl $portinfo(porturl)
         set portdir $portinfo(portdir)

trunk/base/src/registry1.0/portimage.tcl

@@ -80 +80 @@
         }
 
-        if {$v != ""} {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $v]"
-        } else {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
-        }
-
         set ilist [_check_registry $name $v]
+        # set name again since the one we were passed may not have had the correct case
+        set name [lindex $ilist 0]
         set version [lindex $ilist 1]
         set revision [lindex $ilist 2]
         set     variants [lindex $ilist 3]
+        
+    if {$v != ""} {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $v]"
+    } else {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
+    }
 
         set ilist [registry::installed $name]
@@ -147 +149 @@
         }
 
-        if {$v != ""} {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $v]"
-        } else {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
-        }
-
         set ilist [registry::active $name]
         if { [llength $ilist] > 1 } {
@@ -159 +155 @@
                 set ilist [lindex $ilist 0]
         }
+        # set name again since the one we were passed may not have had the correct case
+        set name [lindex $ilist 0]
         set version [lindex $ilist 1]
         set revision [lindex $ilist 2]
         set     variants [lindex $ilist 3]
         set fqversion ${version}_${revision}${variants}
+        
+    if {$v != ""} {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $v]"
+    } else {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
+    }
         
         if { $v != "" && ![string equal ${fqversion} $v] } {
@@ -218 +222 @@
         if { [string equal $v ""] } {
                 if { [llength $ilist] > 1 } {
+                    # set name again since the one we were passed may not have had the correct case
+                    set name [lindex [lindex $ilist 0] 0]
                         ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
                         foreach i $ilist { 

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

@@ -45 +45 @@
         set ilist [registry::installed $portname $v]
         if { [llength $ilist] > 1 } {
+            set portname [lindex [lindex $ilist 0] 0]
                 ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $portname are currently installed:"]"
                 foreach i $ilist { 
@@ -60 +61 @@
                 return -code error "Registry error: Please specify the full version as recorded in the port registry."
         } else {
+            # set portname again since the one we were passed may not have had the correct case
+            set portname [lindex [lindex $ilist 0] 0]
                 set version [lindex [lindex $ilist 0] 1]
                 set revision [lindex [lindex $ilist 0] 2]

trunk/base/src/registry1.0/receipt_flat.tcl

@@ -427 +427 @@
                 # [PG] Huh?
         } else {
+            # We want to be case-insensitive but case-preserving, so the name gets
+            # returned with the correct case even if it's wrong when given. To get the
+            # correct case on a case-insensitive FS, we have to list the directory and
+            # compare against each entry.
+            set name_path [file join ${query_path} *]
+            set name_entries [glob -nocomplain -types d ${name_path}]
+            foreach entry $name_entries {
+                set basename [file tail $entry]
+                if {[string equal -nocase $basename $name]} {
+                    set name $basename
+                    break
+                }
+            }
                 set query_path [file join ${query_path} ${name}]
                 if { $version != "" } {