[49845] trunk/base/src
jmr at macports.org
jmr at macports.org
Sat Apr 18 22:07:48 PDT 2009
Revision: 49845
http://trac.macports.org/changeset/49845
Author: jmr at macports.org
Date: 2009-04-18 22:07:47 -0700 (Sat, 18 Apr 2009)
Log Message:
-----------
Add new proc registry::entry_exists_for_name, which checks whether any version of the named port is installed, but (like entry_exists) returns no information about it.
Modified Paths:
--------------
trunk/base/src/macports1.0/macports.tcl
trunk/base/src/port/port.tcl
trunk/base/src/registry1.0/portuninstall.tcl
trunk/base/src/registry1.0/receipt_flat.tcl
trunk/base/src/registry1.0/registry.tcl
Modified: trunk/base/src/macports1.0/macports.tcl
===================================================================
--- trunk/base/src/macports1.0/macports.tcl 2009-04-19 04:53:08 UTC (rev 49844)
+++ trunk/base/src/macports1.0/macports.tcl 2009-04-19 05:07:47 UTC (rev 49845)
@@ -816,6 +816,7 @@
$workername alias registry_prop_retr registry::property_retrieve
$workername alias registry_delete registry::delete_entry
$workername alias registry_exists registry::entry_exists
+ $workername alias registry_exists_for_name registry::entry_exists_for_name
$workername alias registry_activate portimage::activate
$workername alias registry_deactivate portimage::deactivate
$workername alias registry_register_deps registry::register_dependencies
@@ -1269,13 +1270,9 @@
# Determine if a port is already *installed*, as in "in the registry".
proc _mportinstalled {mport} {
- # Check for the presense of the port in the registry
+ # Check for the presence of the port in the registry
set workername [ditem_key $mport workername]
- if {[catch {set reslist [$workername eval registry_installed \${portname}]}]} {
- return 0
- } else {
- return [expr [llength $reslist] > 0]
- }
+ return [$workername eval registry_exists_for_name \${portname}]
}
# Determine if a port is active (only for image mode)
Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl 2009-04-19 04:53:08 UTC (rev 49844)
+++ trunk/base/src/port/port.tcl 2009-04-19 05:07:47 UTC (rev 49845)
@@ -1955,7 +1955,7 @@
# shared depscache for all ports in the list
array set depscache {}
foreachport $portlist {
- if {[catch {registry::installed $portname}]} {
+ if {![registry::entry_exists_for_name $portname]} {
ui_error "$portname is not installed"
return 1
}
Modified: trunk/base/src/registry1.0/portuninstall.tcl
===================================================================
--- trunk/base/src/registry1.0/portuninstall.tcl 2009-04-19 04:53:08 UTC (rev 49844)
+++ trunk/base/src/registry1.0/portuninstall.tcl 2009-04-19 05:07:47 UTC (rev 49845)
@@ -92,12 +92,8 @@
foreach dep $deplist {
set depport [lindex $dep 2]
ui_debug "$depport depends on this port"
- # xxx: Should look at making registry::installed return 0 or
- # something instead of erroring.
- if { ![catch {set installed [registry::installed $depport]} res] } {
- if { [llength installed] > 0 } {
- lappend dl $depport
- }
+ if {[registry::entry_exists_for_name $depport]} {
+ lappend dl $depport
}
}
# Now see if we need to error
@@ -105,11 +101,8 @@
if {[info exists options(ports_uninstall_follow-dependents)] && $options(ports_uninstall_follow-dependents) eq "yes"} {
foreach depport $dl {
# make sure it's still installed, since a previous dep uninstall may have removed it
- # does registry::installed still error? A cursory look at the code says no, but above says yes
- if { ![catch {set installed [registry::installed $depport]} res] } {
- if { [llength installed] > 0 } {
- portuninstall::uninstall $depport "" [array get options]
- }
+ if {[registry::entry_exists_for_name $depport]} {
+ portuninstall::uninstall $depport "" [array get options]
}
}
} else {
Modified: trunk/base/src/registry1.0/receipt_flat.tcl
===================================================================
--- trunk/base/src/registry1.0/receipt_flat.tcl 2009-04-19 04:53:08 UTC (rev 49844)
+++ trunk/base/src/registry1.0/receipt_flat.tcl 2009-04-19 05:07:47 UTC (rev 49845)
@@ -335,9 +335,6 @@
# Check to see if an entry exists
proc entry_exists {name version {revision 0} {variants ""}} {
global macports::registry.path
- variable receipt_handle
- variable receipt_file
- variable receipt_path
set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
set receipt_file [file join ${receipt_path} receipt]
@@ -351,6 +348,19 @@
return 0
}
+# Check to see if any entry exists for the given port name
+proc entry_exists_for_name {name} {
+ global macports::registry.path
+
+ set receipt_path [file join ${macports::registry.path} receipts ${name}]
+
+ if {[llength [glob -nocomplain -directory $receipt_path */receipt{,.bz2}]] > 0} {
+ return 1
+ }
+
+ return 0
+}
+
##
#
# Store a property to a receipt that was loaded in memory.
Modified: trunk/base/src/registry1.0/registry.tcl
===================================================================
--- trunk/base/src/registry1.0/registry.tcl 2009-04-19 04:53:08 UTC (rev 49844)
+++ trunk/base/src/registry1.0/registry.tcl 2009-04-19 05:07:47 UTC (rev 49845)
@@ -82,6 +82,12 @@
return [${macports::registry.format}::entry_exists $name $version $revision $variants]
}
+# Check to see if any entry exists in the registry for the given port name.
+proc entry_exists_for_name {name} {
+ global macports::registry.format
+ return [${macports::registry.format}::entry_exists_for_name $name]
+}
+
# Close the registry... basically wrap the receipts systems's write process
proc write_entry {ref} {
global macports::registry.format
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20090418/f475ee8d/attachment.html>
More information about the macports-changes
mailing list