[64076] trunk/base/src
jmr at macports.org
jmr at macports.org
Sun Feb 21 08:08:37 PST 2010
Revision: 64076
http://trac.macports.org/changeset/64076
Author: jmr at macports.org
Date: 2010-02-21 08:08:34 -0800 (Sun, 21 Feb 2010)
Log Message:
-----------
bring back receipt_sqlite as a compatibility layer for registry2.0, tweak registry API usage where necessary
Modified Paths:
--------------
trunk/base/src/macports1.0/macports.tcl
trunk/base/src/port/port.tcl
trunk/base/src/port1.0/portutil.tcl
trunk/base/src/registry2.0/Makefile
trunk/base/src/registry2.0/entry.c
trunk/base/src/registry2.0/portuninstall.tcl
trunk/base/src/registry2.0/receipt_flat.tcl
trunk/base/src/registry2.0/registry.tcl
Added Paths:
-----------
trunk/base/src/registry2.0/receipt_sqlite.tcl
Modified: trunk/base/src/macports1.0/macports.tcl
===================================================================
--- trunk/base/src/macports1.0/macports.tcl 2010-02-21 15:54:01 UTC (rev 64075)
+++ trunk/base/src/macports1.0/macports.tcl 2010-02-21 16:08:34 UTC (rev 64076)
@@ -968,15 +968,12 @@
$workername alias registry_write registry::write_entry
$workername alias registry_prop_store registry::property_store
$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
$workername alias registry_fileinfo_for_index registry::fileinfo_for_index
$workername alias registry_bulk_register_files registry::register_bulk_files
- $workername alias registry_installed registry::installed
$workername alias registry_active registry::active
# deferred options processing.
@@ -2887,7 +2884,11 @@
set options(ports_nodeps) 1
registry::open_dep_map
- set deplist [registry::list_dependents $portname]
+ if {$anyactive} {
+ set deplist [registry::list_dependents $portname $version_active $revision_active $variant_active]
+ } else {
+ set deplist [registry::list_dependents $portname $version_installed $revision_installed $variant_installed]
+ }
if { [llength deplist] > 0 } {
foreach dep $deplist {
@@ -3026,10 +3027,16 @@
set options(ports_nodeps) 1
registry::open_dep_map
- set deplist [registry::list_dependents $newname]
if {$portname != $newname} {
- set deplist [concat $deplist [registry::list_dependents $portname]]
+ set deplist [registry::list_dependents $newname "" "" ""]
+ } else {
+ set deplist [list]
}
+ if {$anyactive} {
+ set deplist [concat $deplist [registry::list_dependents $portname $version_active $revision_active $variant_active]]
+ } else {
+ set deplist [concat $deplist [registry::list_dependents $portname $version_installed $revision_installed $variant_installed]]
+ }
if { [llength deplist] > 0 } {
foreach dep $deplist {
Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl 2010-02-21 15:54:01 UTC (rev 64075)
+++ trunk/base/src/port/port.tcl 2010-02-21 16:08:34 UTC (rev 64076)
@@ -2190,11 +2190,26 @@
ui_debug "$errorInfo"
break_softcontinue "$result" 1 status
} else {
+ # choose the active version if there is one
+ set index 0
+ foreach i $ilist {
+ if {[lindex $i 4]} {
+ set found 1
+ break
+ }
+ incr index
+ }
+ if {![info exists found]} {
+ set index 0
+ }
# set portname again since the one we were passed may not have had the correct case
- set portname [lindex [lindex $ilist 0] 0]
+ set portname [lindex [lindex $ilist $index] 0]
+ set iversion [lindex [lindex $ilist $index] 1]
+ set irevision [lindex [lindex $ilist $index] 2]
+ set ivariants [lindex [lindex $ilist $index] 3]
}
- set deplist [registry::list_dependents $portname]
+ set deplist [registry::list_dependents $portname $iversion $irevision $ivariants]
if { [llength $deplist] > 0 } {
set dl [list]
# Check the deps first
Modified: trunk/base/src/port1.0/portutil.tcl
===================================================================
--- trunk/base/src/port1.0/portutil.tcl 2010-02-21 15:54:01 UTC (rev 64075)
+++ trunk/base/src/port1.0/portutil.tcl 2010-02-21 16:08:34 UTC (rev 64076)
@@ -1456,7 +1456,7 @@
proc eval_targets {target} {
- global targets target_state_fd name version revision portvariants ports_dryrun user_options
+ global targets target_state_fd name version revision portvariants epoch ports_dryrun user_options
set dlist $targets
# the statefile will likely be autocleaned away after install,
@@ -1466,7 +1466,7 @@
ui_debug "Skipping $target ($name) since this port is already installed"
return 0
} elseif {$target == "activate"} {
- set regref [registry_open $name $version $revision $portvariants]
+ set regref [registry_open $name $version $revision $portvariants $epoch]
if {[registry_prop_retr $regref active] != 0} {
# Something to close the registry entry may be called here, if it existed.
ui_debug "Skipping $target ($name @${version}_${revision}${portvariants}) since this port is already active"
Modified: trunk/base/src/registry2.0/Makefile
===================================================================
--- trunk/base/src/registry2.0/Makefile 2010-02-21 15:54:01 UTC (rev 64075)
+++ trunk/base/src/registry2.0/Makefile 2010-02-21 16:08:34 UTC (rev 64076)
@@ -1,6 +1,6 @@
# $Id$
-SRCS = registry.tcl registry_autoconf.tcl registry_util.tcl receipt_flat.tcl portimage.tcl portuninstall.tcl
+SRCS = registry.tcl registry_autoconf.tcl registry_util.tcl receipt_flat.tcl receipt_sqlite.tcl portimage.tcl portuninstall.tcl
OBJS = registry.o util.o \
entry.o entryobj.o \
../cregistry/cregistry.a
Modified: trunk/base/src/registry2.0/entry.c
===================================================================
--- trunk/base/src/registry2.0/entry.c 2010-02-21 15:54:01 UTC (rev 64075)
+++ trunk/base/src/registry2.0/entry.c 2010-02-21 16:08:34 UTC (rev 64076)
@@ -423,6 +423,9 @@
/*
+ * registry::entry owner filename
+ *
+ * Returns the port that owns the given filename (empty string if none).
*/
static int entry_owner(Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[]) {
reg_registry* reg = registry_for(interp, reg_attached);
Modified: trunk/base/src/registry2.0/portuninstall.tcl
===================================================================
--- trunk/base/src/registry2.0/portuninstall.tcl 2010-02-21 15:54:01 UTC (rev 64075)
+++ trunk/base/src/registry2.0/portuninstall.tcl 2010-02-21 16:08:34 UTC (rev 64076)
@@ -154,7 +154,7 @@
# Check and make sure no ports depend on this one
registry::open_dep_map
- set deplist [registry::list_dependents $portname]
+ set deplist [registry::list_dependents $portname $version $revision $variants]
if { [llength $deplist] > 0 } {
set dl [list]
# Check the deps first
Modified: trunk/base/src/registry2.0/receipt_flat.tcl
===================================================================
--- trunk/base/src/registry2.0/receipt_flat.tcl 2010-02-21 15:54:01 UTC (rev 64075)
+++ trunk/base/src/registry2.0/receipt_flat.tcl 2010-02-21 16:08:34 UTC (rev 64076)
@@ -100,7 +100,7 @@
##
#
# Open an existing entry and return its reference number.
-proc open_entry {name {version ""} {revision 0} {variants ""}} {
+proc open_entry {name {version ""} {revision 0} {variants ""} {epoch ""}} {
global macports::registry.installtype
global macports::registry.path
variable ref_index
@@ -779,7 +779,7 @@
}
# List all the ports that depend on this port
-proc list_dependents {name} {
+proc list_dependents {name version revision variants} {
variable dep_map
if { [llength $dep_map] < 1 && [info exists dep_map] } {
open_dep_map
Copied: trunk/base/src/registry2.0/receipt_sqlite.tcl (from rev 62691, trunk/base/src/registry1.0/receipt_sqlite.tcl)
===================================================================
--- trunk/base/src/registry2.0/receipt_sqlite.tcl (rev 0)
+++ trunk/base/src/registry2.0/receipt_sqlite.tcl 2010-02-21 16:08:34 UTC (rev 64076)
@@ -0,0 +1,201 @@
+# receipt_sqlite.tcl
+# $Id$
+#
+# Copyright (c) 2010 The MacPorts Project
+# Copyright (c) 2004 Will Barton <wbb4 at opendarwin.org>
+# Copyright (c) 2002 Apple Inc.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. Neither the name of Apple Inc. nor the names of its contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+#
+
+package provide receipt_sqlite 1.0
+
+package require macports 1.0
+package require registry2 2.0
+package require registry_util 2.0
+
+##
+# registry2.0 wrapper code that matches old receipt_flat interface
+##
+namespace eval receipt_sqlite {
+
+# return list of active ports, or active version of port 'name' if specified
+proc active {name} {
+ if {$name != ""} {
+ set ports [registry::entry installed $name]
+ } else {
+ set ports [registry::entry installed]
+ }
+ set rlist [list]
+ foreach port $ports {
+ lappend rlist [list [$port name] [$port version] [$port revision] [$port variants] [string equal [$port state] "installed"] [$port epoch]]
+ }
+ return $rlist
+}
+
+##
+# Open an existing entry and return a reference.
+proc open_entry {name version revision variants epoch} {
+ return [registry::entry open $name $version $revision $variants $epoch]
+}
+
+# Check to see if an entry exists
+proc entry_exists {name version {revision 0} {variants ""}} {
+ set searchcmd "registry::entry search"
+ foreach key {name version revision variants} {
+ append searchcmd " $key [set $key]"
+ }
+ if {![catch {[eval $searchcmd]}]} {
+ return 1
+ }
+ return 0
+}
+
+# Check to see if an entry exists
+proc entry_exists_for_name {name} {
+ if {![catch {registry::entry search name $name}]} {
+ return 1
+ }
+ return 0
+}
+
+##
+# determine if a file is registered in the file map, and if it is,
+# get its port.
+#
+# - file the file to test
+# returns 0 if the file is not registered, the name of the port otherwise.
+#
+proc file_registered {file} {
+ set port [registry::entry owner $file]
+ if {$port != ""} {
+ return [$port name]
+ } else {
+ return 0
+ }
+}
+
+##
+# determine if a port is registered in the file map, and if it is,
+# get its installed (activated) files.
+#
+# - port the port to test
+# returns 0 if the port is not registered, the list of its files otherwise.
+proc port_registered {name} {
+ if {![catch {set ports [registry::entry search name $name state installed]}]} {
+ # should never return more than one port
+ set port [lindex $ports 0]
+ return [$port files]
+ } else {
+ return 0
+ }
+}
+
+##
+# Retrieve a property from a registry entry.
+#
+# ref reference to the entry.
+# property key for the property to retrieve.
+proc property_retrieve {ref property} {
+ switch $property {
+ active {
+ set ret [string equal [$ref state] "installed"]
+ }
+ imagedir {
+ set ret [$ref location]
+ }
+ default {
+ set ret [$ref $property]
+ }
+ }
+ return $ret
+}
+
+# Return installed ports
+#
+# If version is "", return all ports of that name.
+# Otherwise, return only ports that exactly match this version.
+# What we call version here is version_revision+variants.
+proc installed {{name ""} {version ""}} {
+ global macports::registry.installtype
+
+ if { $name == "" && $version == "" } {
+ if {${macports::registry.installtype} == "image"} {
+ set ports [registry::entry imaged]
+ } else {
+ set ports [registry::entry installed]
+ }
+ } else {
+ set searchcmd "registry::entry search"
+ registry::decode_spec $version version revision variants
+ foreach key {name version revision variants} {
+ if {[set $key] != ""} {
+ append searchcmd " $key [set $key]"
+ }
+ }
+ if {[catch {set ports [eval $searchcmd]}]} {
+ set ports [list]
+ }
+ }
+
+ set rlist [list]
+ foreach port $ports {
+ lappend rlist [list [$port name] [$port version] [$port revision] [$port variants] [string equal [$port state] "installed"] [$port epoch]]
+ }
+ return $rlist
+}
+
+proc close_file_map {args} {
+}
+
+proc open_dep_map {args} {
+}
+
+# List all the ports that depend on this port
+proc list_dependents {name version revision variants} {
+ set rlist [list]
+ set searchcmd "registry::entry search"
+ foreach key {name version revision variants} {
+ if {[set $key] != ""} {
+ append searchcmd " $key [set $key]"
+ }
+ }
+ if {[catch {set ports [eval $searchcmd]}]} {
+ set ports [list]
+ }
+ foreach port $ports {
+ set dependents [$port dependents]
+ foreach dependent $dependents {
+ # XXX need to store path deps
+ lappend rlist [list [$port name] port [$dependent name]]
+ }
+ }
+
+ return $rlist
+}
+
+# End of receipt_sqlite namespace
+}
Property changes on: trunk/base/src/registry2.0/receipt_sqlite.tcl
___________________________________________________________________
Added: svn:keywords
+ Id
Added: svn:mergeinfo
+ /branches/gsoc08-privileges/base/src/registry1.0/receipt_sqlite.tcl:37343-46937
/branches/gsoc09-logging/base/src/registry1.0/receipt_sqlite.tcl:51231-60371
/branches/universal-sanity/base/src/registry1.0/receipt_sqlite.tcl:51872-52323
/branches/variant-descs-14482/base/src/registry1.0/receipt_sqlite.tcl:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/users/perry/base-bugs_and_notes/src/registry1.0/receipt_sqlite.tcl:45682-46060
/users/perry/base-select/src/registry1.0/receipt_sqlite.tcl:44044-44692
Added: svn:eol-style
+ native
Modified: trunk/base/src/registry2.0/registry.tcl
===================================================================
--- trunk/base/src/registry2.0/registry.tcl 2010-02-21 15:54:01 UTC (rev 64075)
+++ trunk/base/src/registry2.0/registry.tcl 2010-02-21 16:08:34 UTC (rev 64076)
@@ -33,6 +33,7 @@
package require macports 1.0
package require receipt_flat 1.0
+package require receipt_sqlite 1.0
package require portimage 2.0
package require portuninstall 2.0
package require msgcat
@@ -115,10 +116,10 @@
}
# Open a registry entry.
-proc open_entry {name {version ""} {revision 0} {variants ""}} {
+proc open_entry {name {version ""} {revision 0} {variants ""} {epoch ""}} {
global macports::registry.format
- return [${macports::registry.format}::open_entry $name $version $revision $variants]
+ return [${macports::registry.format}::open_entry $name $version $revision $variants $epoch]
}
@@ -139,40 +140,36 @@
proc installed {{name ""} {version ""}} {
global macports::registry.format
- set ilist [${macports::registry.format}::installed $name $version]
- set rlist [list]
-
- if { [llength $ilist] > 1 } {
- foreach installed $ilist {
- set iname [lindex $installed 0]
- set iversion [lindex $installed 1]
- set irevision [lindex $installed 2]
- set ivariants [lindex $installed 3]
- set iref [open_entry $iname $iversion $irevision $ivariants]
- set iactive [property_retrieve $iref active]
- set iepoch [property_retrieve $iref epoch]
- lappend rlist [list $iname $iversion $irevision $ivariants $iactive $iepoch]
- }
- } elseif { [llength $ilist] < 1 } {
- if { $name == "" } {
- return -code error "Registry error: No ports registered as installed."
- } else {
- if { $version == "" } {
- return -code error "Registry error: $name not registered as installed."
- } else {
- return -code error "Registry error: $name $version not registered as installed."
- }
- }
- } else {
- set iname [lindex [lindex $ilist 0] 0]
- set iversion [lindex [lindex $ilist 0] 1]
- set irevision [lindex [lindex $ilist 0] 2]
- set ivariants [lindex [lindex $ilist 0] 3]
- set iref [open_entry $iname $iversion $irevision $ivariants]
- set iactive [property_retrieve $iref active]
- set iepoch [property_retrieve $iref epoch]
- lappend rlist [list $iname $iversion $irevision $ivariants $iactive $iepoch]
- }
+ if {${macports::registry.format} == "receipt_flat"} {
+ set ilist [${macports::registry.format}::installed $name $version]
+ set rlist [list]
+
+ foreach installed $ilist {
+ set iname [lindex $installed 0]
+ set iversion [lindex $installed 1]
+ set irevision [lindex $installed 2]
+ set ivariants [lindex $installed 3]
+ set iref [open_entry $iname $iversion $irevision $ivariants]
+ set iactive [property_retrieve $iref active]
+ set iepoch [property_retrieve $iref epoch]
+ lappend rlist [list $iname $iversion $irevision $ivariants $iactive $iepoch]
+ }
+ } else {
+ set rlist [${macports::registry.format}::installed $name $version]
+ }
+
+ if { [llength $rlist] < 1 } {
+ if { $name == "" } {
+ return -code error "Registry error: No ports registered as installed."
+ } else {
+ if { $version == "" } {
+ return -code error "Registry error: $name not registered as installed."
+ } else {
+ return -code error "Registry error: $name $version not registered as installed."
+ }
+ }
+ }
+
return $rlist
}
@@ -180,24 +177,26 @@
# all ports if name is "").
proc active {{name ""}} {
global macports::registry.format
-
- set ilist [${macports::registry.format}::installed $name]
- set rlist [list]
-
- if { [llength $ilist] > 0 } {
- foreach installed $ilist {
- set iname [lindex $installed 0]
- set iversion [lindex $installed 1]
- set irevision [lindex $installed 2]
- set ivariants [lindex $installed 3]
- set iref [open_entry $iname $iversion $irevision $ivariants]
- set iactive [property_retrieve $iref active]
- set iepoch [property_retrieve $iref epoch]
- if {$iactive} {
- lappend rlist [list $iname $iversion $irevision $ivariants $iactive $iepoch]
- }
- }
- }
+
+ if {${macports::registry.format} == "receipt_flat"} {
+ set rlist [list]
+ set ilist [${macports::registry.format}::installed $name]
+
+ foreach installed $ilist {
+ set iname [lindex $installed 0]
+ set iversion [lindex $installed 1]
+ set irevision [lindex $installed 2]
+ set ivariants [lindex $installed 3]
+ set iref [open_entry $iname $iversion $irevision $ivariants]
+ set iactive [property_retrieve $iref active]
+ set iepoch [property_retrieve $iref epoch]
+ if {$iactive} {
+ lappend rlist [list $iname $iversion $irevision $ivariants $iactive $iepoch]
+ }
+ }
+ } else {
+ set rlist [${macports::registry.format}::active $name]
+ }
if { [llength $rlist] < 1 } {
if { $name == "" } {
@@ -365,9 +364,9 @@
}
# List all the ports that depend on this port
-proc list_dependents {name} {
+proc list_dependents {name version revision variants} {
global macports::registry.format
- return [${macports::registry.format}::list_dependents $name]
+ return [${macports::registry.format}::list_dependents $name $version $revision $variants]
}
proc register_dep {dep type port} {
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100221/7be7134c/attachment.html>
More information about the macports-changes
mailing list