[51586] branches/images-and-archives/base/src/registry1.0/portuninstall.tcl
blb at macports.org
blb at macports.org
Wed May 27 23:17:05 PDT 2009
Revision: 51586
http://trac.macports.org/changeset/51586
Author: blb at macports.org
Date: 2009-05-27 23:17:05 -0700 (Wed, 27 May 2009)
Log Message:
-----------
Make uninstall work with imagefiles
Modified Paths:
--------------
branches/images-and-archives/base/src/registry1.0/portuninstall.tcl
Modified: branches/images-and-archives/base/src/registry1.0/portuninstall.tcl
===================================================================
--- branches/images-and-archives/base/src/registry1.0/portuninstall.tcl 2009-05-28 05:48:06 UTC (rev 51585)
+++ branches/images-and-archives/base/src/registry1.0/portuninstall.tcl 2009-05-28 06:17:05 UTC (rev 51586)
@@ -33,6 +33,7 @@
package provide portuninstall 1.0
package require registry 1.0
+package require macports 1.0
set UI_PREFIX "---> "
@@ -40,6 +41,7 @@
proc uninstall {portname {v ""} optionslist} {
global uninstall.force uninstall.nochecksum UI_PREFIX
+ global macports::portimagefilepath macports::os_platform macports::os_arch
array set options $optionslist
set ilist [registry::installed $portname $v]
@@ -66,6 +68,7 @@
set revision [lindex [lindex $ilist 0] 2]
set variants [lindex [lindex $ilist 0] 3]
set active [lindex [lindex $ilist 0] 4]
+ set epoch [lindex [lindex $ilist 0] 5]
}
# determine if it's the only installed port with that name or not.
@@ -149,98 +152,12 @@
registry::unregister_dependencies $portname
}
- # Now look for a contents list
- set contents [registry::property_retrieve $ref contents]
- if { $contents != "" } {
- set uninst_err 0
- set files [list]
- foreach f $contents {
- 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 equal -nocase $uninstall.nochecksum "yes"] } {
- if {![catch {set sum2 [md5 $fname]}]} {
- if {![string match $sum1 $sum2]} {
- if {![info exists uninstall.force] && ![string equal -nocase $uninstall.force "yes"] } {
- ui_info "$UI_PREFIX [format [msgcat::mc "Original checksum does not match for %s, not removing"] $fname]"
- set uninst_err 1
- continue
- } else {
- ui_info "$UI_PREFIX [format [msgcat::mc "Original checksum does not match for %s, removing anyway [force in effect]"] $fname]"
- }
- }
- }
- }
- # Normalize the file path to avoid removing the intermediate
- # symlinks (remove the empty directories instead)
- set theFile [file normalize [lindex $f 0]]
- lappend files $theFile
-
- # Split out the filename's subpaths and add them to the
- # list as well.
- set directory [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.
- if { [catch {_uninstall_list $theList} result] } {
- return -code error $result
- }
-
- if {!$uninst_err || [info exists uninstall.force] && [string equal -nocase $uninstall.force "yes"] } {
- ui_info "$UI_PREFIX [format [msgcat::mc "Uninstall is removing %s from the port registry."] $portname]"
- registry::delete_entry $ref
- return 0
- }
-
- } else {
- return -code error [msgcat::mc "Uninstall failed: Port has no contents entry"]
- }
+ set macport_filename "${portname}-${epoch}-${version}_${revision}${variants}.${macports::os_platform}.${macports::os_arch}.macport"
+ set macport_file [file join ${macports::portimagefilepath} $portname $macport_filename]
+ file delete $macport_file
+ ui_info "$UI_PREFIX [format [msgcat::mc "Uninstall is removing %s from the port registry."] $portname]"
+ registry::delete_entry $ref
}
-proc _uninstall_file {dstfile} {
- if { ![catch {set type [file type $dstfile]}] } {
- if { $type == "link" } {
- ui_debug "uninstalling link: $dstfile"
- file delete -- $dstfile
- } elseif { [file isdirectory $dstfile] } {
- # 0 item means empty.
- if { [llength [readdir $dstfile]] == 0 } {
- ui_debug "uninstalling directory: $dstfile"
- file delete -- $dstfile
- } else {
- ui_debug "$dstfile is not empty"
- }
- } else {
- ui_debug "uninstalling file: $dstfile"
- file delete -- $dstfile
- }
- } else {
- ui_debug "skip missing file: $dstfile"
- }
-}
-
-proc _uninstall_list {filelist} {
- foreach file $filelist {
- _uninstall_file $file
- }
-}
-
# End of portuninstall namespace
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20090527/eb603981/attachment-0001.html>
More information about the macports-changes
mailing list