Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
uninstall-old-ports.tcl improvements
- Use registry2 API.
- Use the same format for printing full port specs as MacPorts does.
- Simplify check for current version.
  • Loading branch information
jmroot committed Feb 12, 2017
1 parent 98c280c commit a1e518e
Showing 1 changed file with 11 additions and 45 deletions.
56 changes: 11 additions & 45 deletions tools/uninstall-old-ports.tcl
Expand Up @@ -39,64 +39,30 @@ if {$showVersion} {
exit 0
}

##
# Compare two versions in the form of (epoch, version, revision).
#
# @param versionA Tcl array of the first version with the keys epoch, version, and revision.
# @param versionB Tcl array of the second version in the same format as versionA.
# @return An integer < 0 if the first version is smaller than the second. 0, if
# both versions are equal. An integer > 0 if the second version is
# larger than the first.
proc compare_version_tuple {versionA versionB} {
upvar $versionA vA
upvar $versionB vB

set epochCompare [vercmp $vA(epoch) $vB(epoch)]
set versionCompare [vercmp $vA(version) $vB(version)]
set revisionCompare [vercmp $vA(revision) $vB(revision)]

if {$epochCompare != 0} {
return $epochCompare
}
if {$versionCompare != 0} {
return $versionCompare
}
return $revisionCompare
}

foreach port [registry::installed] {
# Set to yes if a port is obsolete
foreach port [registry::entry imaged] {
# Set to yes if a port is not current
set old no

set installed_name [lindex $port 0]
set installed_version [lindex $port 1]
set installed_revision [lindex $port 2]
set installed_variants [lindex $port 3]
set installed_epoch [lindex $port 5]

array set installed_version_tuple {}
set installed_version_tuple(epoch) $installed_epoch
set installed_version_tuple(version) $installed_version
set installed_version_tuple(revision) $installed_revision
set installed_name [$port name]
set installed_version [$port version]
set installed_revision [$port revision]
set installed_variants [$port variants]

set portindex_match [mportlookup $installed_name]
if {[llength $portindex_match] < 2} {
# Not found in index, classify as old
ui_msg "Removing $installed_name$installed_variants $installed_epoch@$installed_version-$installed_revision because it is no longer in the PortIndex"
ui_msg "Removing ${installed_name} @${installed_version}_${installed_revision}${installed_variants} because it is no longer in the PortIndex"
set old yes
} else {
array unset portinfo
array set portinfo [lindex $portindex_match 1]

set result [compare_version_tuple portinfo installed_version_tuple]
if {$result > 0} {
# Port is outdated because the version in the index is newer than
# the installed one
ui_msg "Removing $installed_name$installed_variants $installed_epoch@$installed_version-$installed_revision because there is a newer version in the PortIndex"
if {$portinfo(version) ne $installed_version || $portinfo(revision) != $installed_revision} {
# Port is not current because the version in the index is
# different than the installed one
ui_msg "Removing ${installed_name} @${installed_version}_${installed_revision}${installed_variants} because there is a newer version in the PortIndex"
set old yes
}
# If the version we have is newer than the one in the PortIndex, we are
# probably building agaist an old version of the ports tree.
}
if {$old} {
registry_uninstall::uninstall $installed_name $installed_version $installed_revision $installed_variants [list ports_force 1]
Expand Down

0 comments on commit a1e518e

Please sign in to comment.