[66215] trunk/base/src
jmr at macports.org
jmr at macports.org
Wed Apr 7 03:53:38 PDT 2010
Revision: 66215
http://trac.macports.org/changeset/66215
Author: jmr at macports.org
Date: 2010-04-07 03:53:37 -0700 (Wed, 07 Apr 2010)
Log Message:
-----------
add --follow-dependencies option for uninstall
Modified Paths:
--------------
trunk/base/src/port/port.tcl
trunk/base/src/registry2.0/portuninstall.tcl
trunk/base/src/registry2.0/receipt_flat.tcl
trunk/base/src/registry2.0/receipt_sqlite.tcl
trunk/base/src/registry2.0/registry.tcl
Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl 2010-04-07 10:45:07 UTC (rev 66214)
+++ trunk/base/src/port/port.tcl 2010-04-07 10:53:37 UTC (rev 66215)
@@ -3832,7 +3832,7 @@
long_description maintainer maintainers name platform
platforms portdir regex revision variant variants version}
selfupdate {nosync}
- uninstall {follow-dependents}
+ uninstall {follow-dependents follow-dependencies}
variants {index}
clean {all archive dist work logs}
mirror {new}
Modified: trunk/base/src/registry2.0/portuninstall.tcl
===================================================================
--- trunk/base/src/registry2.0/portuninstall.tcl 2010-04-07 10:45:07 UTC (rev 66214)
+++ trunk/base/src/registry2.0/portuninstall.tcl 2010-04-07 10:53:37 UTC (rev 66215)
@@ -208,110 +208,194 @@
}
}
}
+
+ # note deps before we uninstall if we're going to uninstall them too
+ if {[info exists options(ports_uninstall_follow-dependencies)] && [string is true -strict $options(ports_uninstall_follow-dependencies)]} {
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+ set all_dependencies {}
+ # look up deps from the saved portfile if possible
+ if {$use_reg2 && ![catch {set mport [mportopen_installed [$port name] [$port version] [$port revision] [$port variants] $optionslist]}]} {
+ array set depportinfo [mportinfo $mport]
+ mportclose_installed $mport
+ foreach type $deptypes {
+ if {[info exists depportinfo($type)]} {
+ foreach dep $depportinfo($type) {
+ lappend all_dependencies [lindex [split $dep :] end]
+ }
+ }
+ }
+ } else {
+ # grab the deps from the dep map
+ set depmaplist [registry::list_depends $portname $version $revision $variants]
+ foreach dep $depmaplist {
+ lappend all_dependencies [lindex $dep 0]
+ }
+ # and the ones from the current portfile
+ if {![catch {mportlookup $portname} result] && [llength $result] >= 2} {
+ array set depportinfo [lindex $result 1]
+ set porturl $depportinfo(porturl)
+ set variations {}
+ set minusvariant [lrange [split [$port negated_variants] -] 1 end]
+ set plusvariant [lrange [split [$port variants] +] 1 end]
+ foreach v $plusvariant {
+ lappend variations $v "+"
+ }
+ foreach v $minusvariant {
+ lappend variations $v "-"
+ }
+ if {![catch {set mport [mportopen $porturl $optionslist [array get variations]]} result]} {
+ array unset depportinfo
+ array set depportinfo [mportinfo $mport]
+ mportclose $mport
+ }
+ foreach type $deptypes {
+ if {[info exists depportinfo($type)]} {
+ foreach dep $depportinfo($type) {
+ lappend all_dependencies [lindex [split $dep :] end]
+ }
+ }
+ }
+ }
+ }
+ array unset depportinfo
+ }
if {[info exists options(ports_dryrun)] && [string is true -strict $options(ports_dryrun)]} {
ui_msg "For $portname @${v}: skipping uninstall (dry run)"
- return 0
- }
-
- ui_msg "$UI_PREFIX [format [msgcat::mc "Uninstalling %s @%s"] $portname $v]"
-
- if {!$use_reg2} {
- # Look to see if the port has registered an uninstall procedure
- set uninstall [registry::property_retrieve $ref pkg_uninstall]
- if { $uninstall != 0 } {
- if {![catch {eval [string map { \\n \n } $uninstall]} err]} {
- ui_info "Executing pkg_uninstall procedure"
- if {[catch {pkg_uninstall $portname "${version}_${revision}${variants}" } err]} {
- ui_error [format [msgcat::mc "Error executing pkg_uninstall procedure: %s"] $err]
+ } else {
+ ui_msg "$UI_PREFIX [format [msgcat::mc "Uninstalling %s @%s"] $portname $v]"
+
+ if {!$use_reg2} {
+ # Look to see if the port has registered an uninstall procedure
+ set uninstall [registry::property_retrieve $ref pkg_uninstall]
+ if { $uninstall != 0 } {
+ if {![catch {eval [string map { \\n \n } $uninstall]} err]} {
+ ui_info "Executing pkg_uninstall procedure"
+ if {[catch {pkg_uninstall $portname "${version}_${revision}${variants}" } err]} {
+ ui_error [format [msgcat::mc "Error executing pkg_uninstall procedure: %s"] $err]
+ }
+ } else {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error [format [msgcat::mc "Could not evaluate pkg_uninstall procedure: %s"] $err]
}
- } else {
- global errorInfo
- ui_debug "$errorInfo"
- ui_error [format [msgcat::mc "Could not evaluate pkg_uninstall procedure: %s"] $err]
}
+
+ # Remove the port from the dep_map if only one version was installed.
+ # This is a temporary fix for a deeper problem that is that the dependency
+ # map doesn't take the port version into account (but should).
+ # Fixing it means transitioning to a new dependency map format.
+ if {$nb_versions_installed == 1} {
+ registry::unregister_dependencies $portname
+ }
}
- # Remove the port from the dep_map if only one version was installed.
- # This is a temporary fix for a deeper problem that is that the dependency
- # map doesn't take the port version into account (but should).
- # Fixing it means transitionning to a new dependency map format.
- if {$nb_versions_installed == 1} {
- registry::unregister_dependencies $portname
- }
- }
-
- # Now look for a contents list
- if {$use_reg2} {
- # imagefiles gives the actual installed files in direct mode
- set contents [$port imagefiles]
- set imagedir [$port location]
- } else {
- set contents [registry::property_retrieve $ref contents]
- if { $contents == "" } {
- return -code error [msgcat::mc "Uninstall failed: Port has no contents entry"]
- }
- }
- set bak_suffix ".mp_[clock seconds]"
- set files [list]
- foreach f $contents {
+ # Now look for a contents list
if {$use_reg2} {
- set fname "${imagedir}${f}"
- #set sum1 [$port md5sum $f]
- # there's an md5 column in registry.files in the db, but
- # no way to get or set it seems to be implemented
- set sum1 NONE
+ # imagefiles gives the actual installed files in direct mode
+ set contents [$port imagefiles]
+ set imagedir [$port location]
} else {
- set fname [lindex $f 0]
- set md5index [lsearch -regex [lrange $f 1 end] MD5]
- if {$md5index != -1} {
- set sumx [lindex $f [expr $md5index + 1]]
- } else {
- # XXX There is no MD5 listed, set sumx to an
- # empty list, causing the next conditional to
- # return a checksum error
- set sumx {}
+ set contents [registry::property_retrieve $ref contents]
+ if { $contents == "" } {
+ return -code error [msgcat::mc "Uninstall failed: Port has no contents entry"]
}
- set sum1 [lindex $sumx [expr [llength $sumx] - 1]]
}
- if {![string match $sum1 NONE] && !([info exists uninstall.nochecksum] && [string is true -strict ${uninstall.nochecksum}]) } {
- if {![catch {set sum2 [md5 $fname]}] && ![string match $sum1 $sum2]} {
- ui_warn "$UI_PREFIX [format [msgcat::mc "Original checksum does not match for %s, saving a copy to %s"] $fname ${fname}${bak_suffix}]"
- catch {file copy $fname "${fname}${bak_suffix}"}
+ set bak_suffix ".mp_[clock seconds]"
+ set files [list]
+ foreach f $contents {
+ if {$use_reg2} {
+ set fname "${imagedir}${f}"
+ #set sum1 [$port md5sum $f]
+ # there's an md5 column in registry.files in the db, but
+ # no way to get or set it seems to be implemented
+ set sum1 NONE
+ } else {
+ set fname [lindex $f 0]
+ set md5index [lsearch -regex [lrange $f 1 end] MD5]
+ if {$md5index != -1} {
+ set sumx [lindex $f [expr $md5index + 1]]
+ } else {
+ # XXX There is no MD5 listed, set sumx to an
+ # empty list, causing the next conditional to
+ # return a checksum error
+ set sumx {}
+ }
+ set sum1 [lindex $sumx [expr [llength $sumx] - 1]]
}
+ if {![string match $sum1 NONE] && !([info exists uninstall.nochecksum] && [string is true -strict ${uninstall.nochecksum}]) } {
+ if {![catch {set sum2 [md5 $fname]}] && ![string match $sum1 $sum2]} {
+ ui_warn "$UI_PREFIX [format [msgcat::mc "Original checksum does not match for %s, saving a copy to %s"] $fname ${fname}${bak_suffix}]"
+ catch {file copy $fname "${fname}${bak_suffix}"}
+ }
+ }
+
+ set theFile [file normalize $fname]
+ if { [file exists $theFile] || (![catch {file type $theFile}] && [file type $theFile] == "link") } {
+ # Normalize the file path to avoid removing the intermediate
+ # symlinks (remove the empty directories instead)
+ lappend files $theFile
+
+ # Split out the filename's subpaths and add them to the
+ # list as well. The realpath call is necessary because file normalize
+ # does not resolve symlinks on OS X < 10.6
+ set directory [realpath [file dirname $theFile]]
+ while { [lsearch -exact $files $directory] == -1 } {
+ lappend files $directory
+ set directory [file dirname $directory]
+ }
+ }
}
-
- set theFile [file normalize $fname]
- if { [file exists $theFile] || (![catch {file type $theFile}] && [file type $theFile] == "link") } {
- # Normalize the file path to avoid removing the intermediate
- # symlinks (remove the empty directories instead)
- lappend files $theFile
-
- # Split out the filename's subpaths and add them to the
- # list as well. The realpath call is necessary because file normalize
- # does not resolve symlinks on OS X < 10.6
- set directory [realpath [file dirname $theFile]]
- while { [lsearch -exact $files $directory] == -1 } {
- lappend files $directory
- set directory [file dirname $directory]
+
+ # Sort the list in reverse order, removing duplicates.
+ # Since the list is sorted in reverse order, we're sure that directories
+ # are after their elements.
+ set theList [lsort -decreasing -unique $files]
+
+ # Remove all elements.
+ _uninstall_list $theList
+
+ if {$use_reg2} {
+ registry::entry delete $port
+ } else {
+ ui_info "$UI_PREFIX [format [msgcat::mc "Uninstall is removing %s from the port registry."] $portname]"
+ registry::delete_entry $ref
+ }
+ }
+
+ # uninstall dependencies if requested
+ if {[info exists options(ports_uninstall_follow-dependencies)] && [string is true -strict $options(ports_uninstall_follow-dependencies)]} {
+ while 1 {
+ set remaining_list {}
+ foreach dep $all_dependencies {
+ if {![catch {set ilist [registry::installed $dep]}]} {
+ set remaining 0
+ foreach i $ilist {
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ if {[llength [registry::list_dependents $dep $iversion $irevision $ivariants]] == 0} {
+ set regref [registry::open_entry $dep $iversion $irevision $ivariants [lindex $i 5]]
+ if {![registry::property_retrieve $regref requested] && (!$use_reg2 || ![registry::run_target $regref uninstall $optionslist])} {
+ set depver "${iversion}_${irevision}${ivariants}"
+ registry_uninstall::uninstall $dep $depver $optionslist
+ }
+ } else {
+ set remaining 1
+ }
+ }
+ if {$remaining} {
+ lappend remaining_list $dep
+ }
+ }
}
+ if {[llength $remaining_list] == 0 || [llength $remaining_list] == [llength $all_dependencies]} {
+ break
+ }
+ set all_dependencies $remaining_list
}
}
-
- # Sort the list in reverse order, removing duplicates.
- # Since the list is sorted in reverse order, we're sure that directories
- # are after their elements.
- set theList [lsort -decreasing -unique $files]
-
- # Remove all elements.
- _uninstall_list $theList
-
- if {$use_reg2} {
- registry::entry delete $port
- } else {
- ui_info "$UI_PREFIX [format [msgcat::mc "Uninstall is removing %s from the port registry."] $portname]"
- registry::delete_entry $ref
- }
+
return 0
}
Modified: trunk/base/src/registry2.0/receipt_flat.tcl
===================================================================
--- trunk/base/src/registry2.0/receipt_flat.tcl 2010-04-07 10:45:07 UTC (rev 66214)
+++ trunk/base/src/registry2.0/receipt_flat.tcl 2010-04-07 10:53:37 UTC (rev 66215)
@@ -764,7 +764,7 @@
}
# List all ports this one depends on
-proc list_depends {name} {
+proc list_depends {name version revision variants} {
variable dep_map
if { [llength $dep_map] < 1 && [info exists dep_map] } {
open_dep_map
Modified: trunk/base/src/registry2.0/receipt_sqlite.tcl
===================================================================
--- trunk/base/src/registry2.0/receipt_sqlite.tcl 2010-04-07 10:45:07 UTC (rev 66214)
+++ trunk/base/src/registry2.0/receipt_sqlite.tcl 2010-04-07 10:53:37 UTC (rev 66215)
@@ -204,6 +204,30 @@
proc open_dep_map {args} {
}
+# List all the ports that this port depends on
+proc list_depends {name version revision variants} {
+ set rlist [list]
+ set searchcmd "registry::entry search"
+ foreach key {name version revision} {
+ if {[set $key] != ""} {
+ append searchcmd " $key [set $key]"
+ }
+ }
+ if {$variants != 0} {
+ append searchcmd " variants {$variants}"
+ }
+ if {[catch {set ports [eval $searchcmd]}]} {
+ set ports [list]
+ }
+ foreach port $ports {
+ foreach dep [$port dependencies] {
+ lappend rlist [list [$dep name] port [$port name]]
+ }
+ }
+
+ return [lsort -unique $rlist]
+}
+
# List all the ports that depend on this port
proc list_dependents {name version revision variants} {
set rlist [list]
Modified: trunk/base/src/registry2.0/registry.tcl
===================================================================
--- trunk/base/src/registry2.0/registry.tcl 2010-04-07 10:45:07 UTC (rev 66214)
+++ trunk/base/src/registry2.0/registry.tcl 2010-04-07 10:53:37 UTC (rev 66215)
@@ -356,9 +356,9 @@
}
# List all ports this one depends on
-proc list_depends {name} {
+proc list_depends {name {version ""} {revision ""} {variants 0}} {
global macports::registry.format
- return [${macports::registry.format}::list_depends $name]
+ return [${macports::registry.format}::list_depends $name $version $revision $variants]
}
# List all the ports that depend on this port
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100407/44c38e50/attachment-0001.html>
More information about the macports-changes
mailing list