[63398] trunk/base

jmr at macports.org jmr at macports.org
Wed Feb 3 16:46:02 PST 2010


Revision: 63398
          http://trac.macports.org/changeset/63398
Author:   jmr at macports.org
Date:     2010-02-03 16:46:00 -0800 (Wed, 03 Feb 2010)
Log Message:
-----------
merge registry1.0 code into registry2.0

Modified Paths:
--------------
    trunk/base/configure
    trunk/base/configure.ac
    trunk/base/doc/macports.conf.in
    trunk/base/portmgr/freebsd/pkg-plist
    trunk/base/src/Makefile.in
    trunk/base/src/macports1.0/macports.tcl
    trunk/base/src/registry2.0/Makefile
    trunk/base/src/registry2.0/portimage.tcl
    trunk/base/src/registry2.0/portuninstall.tcl

Added Paths:
-----------
    trunk/base/src/registry2.0/receipt_flat.tcl
    trunk/base/src/registry2.0/registry.tcl
    trunk/base/src/registry2.0/registry_autoconf.tcl.in

Removed Paths:
-------------
    trunk/base/src/registry1.0/receipt_flat.tcl
    trunk/base/src/registry1.0/registry.tcl
    trunk/base/src/registry1.0/registry_autoconf.tcl.in

Property Changed:
----------------
    trunk/base/src/registry2.0/

Modified: trunk/base/configure
===================================================================
--- trunk/base/configure	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/configure	2010-02-04 00:46:00 UTC (rev 63398)
@@ -9329,7 +9329,7 @@
 
 
 # Output
-ac_config_files="$ac_config_files Doxyfile Makefile Mk/macports.autoconf.mk doc/prefix.mtree doc/macosx.mtree doc/macports.conf portmgr/freebsd/Makefile src/Makefile src/macports1.0/macports_autoconf.tcl src/port1.0/port_autoconf.tcl src/registry1.0/registry_autoconf.tcl src/programs/Makefile src/macports1.0/macports_fastload.tcl setupenv.bash"
+ac_config_files="$ac_config_files Doxyfile Makefile Mk/macports.autoconf.mk doc/prefix.mtree doc/macosx.mtree doc/macports.conf portmgr/freebsd/Makefile src/Makefile src/macports1.0/macports_autoconf.tcl src/port1.0/port_autoconf.tcl src/registry2.0/registry_autoconf.tcl src/programs/Makefile src/macports1.0/macports_fastload.tcl setupenv.bash"
 
 
 ac_config_files="$ac_config_files src/pkg_mkindex.sh"
@@ -10030,7 +10030,7 @@
     "src/Makefile") CONFIG_FILES="$CONFIG_FILES src/Makefile" ;;
     "src/macports1.0/macports_autoconf.tcl") CONFIG_FILES="$CONFIG_FILES src/macports1.0/macports_autoconf.tcl" ;;
     "src/port1.0/port_autoconf.tcl") CONFIG_FILES="$CONFIG_FILES src/port1.0/port_autoconf.tcl" ;;
-    "src/registry1.0/registry_autoconf.tcl") CONFIG_FILES="$CONFIG_FILES src/registry1.0/registry_autoconf.tcl" ;;
+    "src/registry2.0/registry_autoconf.tcl") CONFIG_FILES="$CONFIG_FILES src/registry2.0/registry_autoconf.tcl" ;;
     "src/programs/Makefile") CONFIG_FILES="$CONFIG_FILES src/programs/Makefile" ;;
     "src/macports1.0/macports_fastload.tcl") CONFIG_FILES="$CONFIG_FILES src/macports1.0/macports_fastload.tcl" ;;
     "setupenv.bash") CONFIG_FILES="$CONFIG_FILES setupenv.bash" ;;

Modified: trunk/base/configure.ac
===================================================================
--- trunk/base/configure.ac	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/configure.ac	2010-02-04 00:46:00 UTC (rev 63398)
@@ -397,7 +397,7 @@
 	src/Makefile
 	src/macports1.0/macports_autoconf.tcl
 	src/port1.0/port_autoconf.tcl
-	src/registry1.0/registry_autoconf.tcl
+	src/registry2.0/registry_autoconf.tcl
 	src/programs/Makefile
 	src/macports1.0/macports_fastload.tcl
 	setupenv.bash

Modified: trunk/base/doc/macports.conf.in
===================================================================
--- trunk/base/doc/macports.conf.in	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/doc/macports.conf.in	2010-02-04 00:46:00 UTC (rev 63398)
@@ -11,7 +11,6 @@
 portdbpath		@localstatedir_expanded@/macports
 
 # Type of storage to use for the port registry information, "flat" or "sqlite"
-# NOTE: sqlite not yet supported.
 #portdbformat		flat
 
 # Type of installation to do for ports, "direct" or "image".  See macports.conf(5) and online documentation.

Modified: trunk/base/portmgr/freebsd/pkg-plist
===================================================================
--- trunk/base/portmgr/freebsd/pkg-plist	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/portmgr/freebsd/pkg-plist	2010-02-04 00:46:00 UTC (rev 63398)
@@ -49,12 +49,14 @@
 share/macports/Tcl/port1.0/porttest.tcl
 share/macports/Tcl/port1.0/porttrace.tcl
 share/macports/Tcl/port1.0/portutil.tcl
-share/macports/Tcl/registry1.0/pkgIndex.tcl
-share/macports/Tcl/registry1.0/portimage.tcl
-share/macports/Tcl/registry1.0/portuninstall.tcl
-share/macports/Tcl/registry1.0/receipt_flat.tcl
-share/macports/Tcl/registry1.0/registry.tcl
-share/macports/Tcl/registry1.0/registry_autoconf.tcl
+share/macports/Tcl/registry2.0/pkgIndex.tcl
+share/macports/Tcl/registry2.0/portimage.tcl
+share/macports/Tcl/registry2.0/portuninstall.tcl
+share/macports/Tcl/registry2.0/receipt_flat.tcl
+share/macports/Tcl/registry2.0/registry.so
+share/macports/Tcl/registry2.0/registry.tcl
+share/macports/Tcl/registry2.0/registry_autoconf.tcl
+share/macports/Tcl/registry2.0/registry_util.tcl
 var/macports/.tclpackage
 @unexec /bin/rm -f %D/var/macports/.mprename
 @dirrm var/macports/receipts
@@ -67,7 +69,7 @@
 @dirrm share/macports/resources/port1.0
 @dirrm share/macports/resources
 @dirrm share/macports/Tcl/tclobjc1.0
- at dirrm share/macports/Tcl/registry1.0
+ at dirrm share/macports/Tcl/registry2.0
 @dirrm share/macports/Tcl/port1.0
 @dirrm share/macports/Tcl/pextlib1.0
 @dirrm share/macports/Tcl/package1.0

Modified: trunk/base/src/Makefile.in
===================================================================
--- trunk/base/src/Makefile.in	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/src/Makefile.in	2010-02-04 00:46:00 UTC (rev 63398)
@@ -4,7 +4,6 @@
 			port1.0 \
 			package1.0 \
 			pextlib1.0 \
-			registry1.0 \
 			registry2.0 \
 			darwintracelib1.0
 SUBDIR=		${TCLPKG} port programs

Modified: trunk/base/src/macports1.0/macports.tcl
===================================================================
--- trunk/base/src/macports1.0/macports.tcl	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/src/macports1.0/macports.tcl	2010-02-04 00:46:00 UTC (rev 63398)
@@ -590,9 +590,6 @@
 
     # Format for receipts, can currently be either "flat" or "sqlite"
     if {[info exists portdbformat]} {
-        if { $portdbformat == "sqlite" } {
-            return -code error "SQLite is not yet supported for registry storage."
-        }
         set registry.format receipt_${portdbformat}
     } else {
         set registry.format receipt_flat

Deleted: trunk/base/src/registry1.0/receipt_flat.tcl
===================================================================
--- trunk/base/src/registry1.0/receipt_flat.tcl	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/src/registry1.0/receipt_flat.tcl	2010-02-04 00:46:00 UTC (rev 63398)
@@ -1,864 +0,0 @@
-# receipt_flat.tcl
-# $Id$
-#
-# Copyright (c) 2004 Will Barton <wbb4 at opendarwin.org>
-# Copyright (c) 2004 Paul Guyot, The MacPorts Project.
-# Copyright (c) 2002 Apple Computer, 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 Computer, 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_flat 1.0
-
-package require macports 1.0
-package require Pextlib 1.0
-
-##
-# Receipts Code supporting flat-files
-##
-namespace eval receipt_flat {
-
-# receipt_lastref is the last attributed index of receipts.
-variable receipt_lastref -1
-# maps port name,version,variants to the corresponding receipt ref
-variable ref_index
-
-##
-#
-# Create a new entry and return its reference number.
-# The reference number allows us to retrieve the receipt array.
-proc new_entry {} {
-	variable receipt_lastref
-	incr receipt_lastref
-
-	variable receipt_$receipt_lastref
-	array set receipt_$receipt_lastref {}
-
-	return $receipt_lastref
-}
-
-##
-#
-# Get the path to the receipt in HEAD format.
-# Remark: this code doesn't work for some ports.
-# That's why we moved to the new path format in the first place.
-#
-# portname			the name of the port.
-# portversion		the version for this port, 0 if unknown.
-# return the path to the file or "" if the file couldn't be found.
-proc get_head_entry_receipt_path {portname portversion} {
-    global macports::registry.path
-
-    # regex match case
-    if {$portversion == 0} {
-	set x [glob -nocomplain -directory [file join ${macports::registry.path} receipts] -- ${portname}-*]
-	if {[string length $x]} {
-	    set matchfile [lindex $x 0]
-		# Remove trailing .bz2, if any.
-		regexp {(.*)\.bz2$} $matchfile match matchfile
-	} else {
-	    set matchfile ""
-	}
-    } else {
-	set matchfile [file join ${macports::registry.path} receipts ${portname}-${portversion}]
-    }
-
-    # Might as well bail out early if no file to match
-    if {![string length $matchfile]} {
-		return ""
-    }
-
-    if {[file exists $matchfile] || [file exists ${matchfile}.bz2]} {
-		return $matchfile
-    }
-    return ""
-}
-
-##
-#
-# Open an existing entry and return its reference number.
-proc open_entry {name {version ""} {revision 0} {variants ""}} {
-	global macports::registry.installtype
-	global macports::registry.path
-	variable ref_index
-	
-	# if this entry is already open, just return the reference
-	if {[info exists ref_index($name,$version,$revision,$variants)]} {
-	    return $ref_index($name,$version,$revision,$variants)
-	}
-
-	set receipt_path [file join ${macports::registry.path} receipts ${name}]
-
-	# If the receipt path ${name} doesn't exist, then the receipt probably is
-	# in the old HEAD format.
-	if { ![file isdirectory $receipt_path] } {
-		set receipt_file [get_head_entry_receipt_path $name $version]
-		
-		if {![string length $receipt_file]} {
-			if { $version != "" } {
-				return -code error "Registry error: ${name} @${version}_${revision}${variants} not registered as installed."
-			} else {
-				return -code error "Registry error: ${name} not registered as installed."
-			}
-		}
-		
-		# Extract the version from the path.
-		if { $version == "" } {
-			set theFileName [file tail $receipt_file]
-			regexp "^$name-(.*)\$" $theFileName match version
-		}
-	} else {
-		# If version wasn't specified, find out the version number.  This will
-		# depend on which installtype mode we're in, "direct" or "image"	
-		if { $version == "" } {
-			# xxx: If we're in image mode, we really should have had the 
-			# version given to us.  How should we handle this?
-			set x [glob -nocomplain -directory ${receipt_path} *]
-			if { [string length $x] } {
-				set v [lindex [file split [lindex $x 0]] end]
-				regexp {([-_a-zA-Z0-9\.]+)_([0-9]*)([+-_a-zA-Z0-9]*)$} $v match version revision variants
-			} else {
-				return -code error "Registry error: ${name} not registered as installed."
-			}
-		}
-	
-		if { ![entry_exists $name $version $revision $variants] } {
-			return -code error "Registry error: ${name} @${version}_${revision}${variants} not registered as installed."
-		}
-	
-		set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
-	
-		set receipt_file [file join ${receipt_path} receipt]
-	}
-
-	if { [file exists ${receipt_file}.bz2] && [file exists ${registry::autoconf::bzip2_path}] } {
-		set receipt_file ${receipt_file}.bz2
-		set receipt_contents [exec ${registry::autoconf::bzip2_path} -d -c ${receipt_file}]
-	} elseif { [file exists ${receipt_file}] } {
-		set receipt_handle [open ${receipt_file} r]
-		set receipt_contents [read $receipt_handle]
-		close $receipt_handle
-	} else {
-		return -code error "Registry error: receipt for ${name} @${version}_${revision}${variants} seems to be compressed, but bzip2 couldn't be found."
-	}
-
-	set ref [new_entry]
-	variable receipt_$ref
-
-	# Determine the format of the receipt.
-	if {[string match "# Format: var value ...*" $receipt_contents]} {
-		# This is old HEAD format.
-		# We convert it and we save it.
-		# tell the user
-		ui_msg "Converting receipt for $name-$version to new format"
-
-		convert_entry_from_HEAD $name $version $revision $variants $receipt_contents $ref
-		
-		# move the old receipt
-		set convertedDirPath [file join ${macports::registry.path} receipts_converted]
-		file mkdir $convertedDirPath
-		file rename -- $receipt_file $convertedDirPath
-	} elseif {[string match "# Version: *" $receipt_contents]} {
-		# This is new format
-		if {![string match "# Version: 1.0*" $receipt_contents]} {
-			return -code error "Registry error: receipt ${name} @${version}_${revision}${variants} is in an unknown format (version too new?)."
-		}
-
-		# Remove any line starting with #
-		while {[regexp "(^|\n)#.*\n(.*)\$" $receipt_contents match foo receipt_contents]} {}
-		if {[catch {array set receipt_$ref $receipt_contents} rcpterr]} {
-			ui_error "Malformed receipt for ${name} @${version}_${revision}${variants}"
-			ui_error "receipt_contents = '$receipt_contents'"
-			error $rcpterr
-		}
-	} else {
-		# This is old Images format
-
-		# Iterate on the elements of $receipt_contents and add them to the list.
-		foreach pair $receipt_contents {
-			array set receipt_[set ref] $pair
-		}
-	}
-	
-	set ref_index($name,$version,$revision,$variants) $ref
-	
-	return $ref
-}
-
-##
-#
-# Convert an entry from HEAD old format.
-# HEAD old format is a file in the key,value format with key and values being on the
-# same line separated with a space.
-# This typically is read with an options-like approach.
-# This conversion routine also appends the contents to the file map.
-#
-# name				the name of the port to convert.
-# version			the version of the port to convert.
-# revision			the revision of the port to convert (probably inaccurate).
-# variants			the variants of the port to convert (idem).
-# receipt_contents	the content of the old receipt file.
-# ref				reference of the target receipt array where the content must be put.
-proc convert_entry_from_HEAD {name version revision variants receipt_contents ref} {
-	variable receipt_$ref
-	
-	# First set default value for stuff that aren't in the receipt.
-	array set receipt_[set ref] [list name $name]
-	array set receipt_[set ref] [list version $version]
-	array set receipt_[set ref] [list revision $revision]
-	array set receipt_[set ref] [list variants $variants]
-	array set receipt_[set ref] [list installtype direct]
-	array set receipt_[set ref] [list receipt_f receipt_flat]
-	array set receipt_[set ref] [list active 1]
-	
-	# Then start a new interpreter to read the content of the portfile.
-	interp create theConverterInterpreter
-	# Just ignore prefix.
-	interp eval theConverterInterpreter "proc prefix {args} {\n\
-	}"
-	# Also ignore run_depends.
-	interp eval theConverterInterpreter "proc run_depends {args} {\n\
-	}"
-	interp eval theConverterInterpreter "proc categories {args} {\n\
-		global theConvertedReceipt\n\
-		array set theConvertedReceipt \[list categories \$args\]\n\
-	}"
-	interp eval theConverterInterpreter "proc description {args} {\n\
-		global theConvertedReceipt\n\
-		array set theConvertedReceipt \[list description \$args\]\n\
-	}"
-	interp eval theConverterInterpreter "proc long_description {args} {\
-		global theConvertedReceipt\n\
-		array set theConvertedReceipt \[list long_description \$args\]\n\
-	}"
-	interp eval theConverterInterpreter "proc homepage {args} {\n\
-		global theConvertedReceipt\n\
-		array set theConvertedReceipt \[list homepage \$args\]\n\
-	}"
-	# contents already is a list.
-	interp eval theConverterInterpreter "proc contents {args} {\n\
-		variable contents\n\
-		set contents \[lindex \$args 0\]\n\
-	}"
-	interp eval theConverterInterpreter "array set theConvertedReceipt {}"
-	interp eval theConverterInterpreter "variable contents"
-	interp eval theConverterInterpreter $receipt_contents
-	array set receipt_$ref [interp eval theConverterInterpreter "array get theConvertedReceipt"]
-	set contents [interp eval theConverterInterpreter "set contents"]
-	interp delete theConverterInterpreter
-
-	# Append the contents list to the file map (only the files).
-	set theActualContents [list]
-	foreach file $contents {
-		if {[llength $file]} {
-			set theFilePath [lindex $file 0]
-			if {[file isfile $theFilePath]} {
-				set previousPort [file_registered $theFilePath]
-				if {$previousPort != 0} {
-					ui_warn "Conflict detected for file $theFilePath between $previousPort and $name."
-				}
-				if {[catch {register_file $theFilePath $name}]} {
-					ui_warn "An error occurred while adding $theFilePath to the file_map database."
-				}
-			} elseif {![file exists $theFilePath]} {
-				ui_warn "Port $name refers to $theFilePath which doesn't exist."
-			}
-			lappend theActualContents $file
-		} else {
-			ui_warn "Port $name contents list includes an empty element."
-		}
-	}
-	
-	property_store $ref contents $theActualContents
-
-	# Save the file_map afterwards
-	write_file_map
-	close_file_map
-	
-	# Save the entry to new format.
-	write_entry $ref $name $version $revision $variants
-}
-
-##
-#
-# Write the entry that was previously created.
-#
-# ref				the reference number of the entry.
-# name				the name of the port.
-# version			the version of the port.
-# variants			the variants of the port.
-proc write_entry {ref name version {revision 0} {variants ""}} {
-	global macports::registry.installtype
-	variable receipt_$ref
-
-	set receipt_contents [array get receipt_$ref]
-
-	set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
-	set receipt_file [file join ${receipt_path} receipt]
-
-	if { ![file isdirectory ${receipt_path}] } {
-		file mkdir ${receipt_path}
-	}
-
-	set receipt_handle [open ${receipt_file}.tmp w 0644]
-	puts $receipt_handle "# Version: 1.0"
-	puts $receipt_handle $receipt_contents
-	close $receipt_handle
-
-	if { [file exists ${receipt_file}] } {
-		file delete -force -- "${receipt_file}"
-	} elseif { [file exists ${receipt_file}.bz2] } {
-		file delete -force -- "${receipt_file}.bz2"
-	}
-
-	file rename -force -- "${receipt_file}.tmp" "${receipt_file}"
-
-	if { [file exists ${receipt_file}] && [file exists ${registry::autoconf::bzip2_path}] && ![info exists registry.nobzip] } {
-		system "${registry::autoconf::bzip2_path} -f ${receipt_file}"
-	}
-
-	return 1
-}
-
-# Check to see if an entry exists
-proc entry_exists {name version {revision 0} {variants ""}} {
-	global macports::registry.path
-
-	set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
-	set receipt_file [file join ${receipt_path} receipt]
-
-	if { [file exists $receipt_file] } {
-		return 1
-	} elseif { [file exists ${receipt_file}.bz2] } {
-		return 1
-	}
-
-	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.
-# This replaces any property that had the same key previously in the receipt.
-#
-# ref			reference number for the receipt.
-# property		key for the property to store.
-# value			value for the property to store.
-proc property_store {ref property value} {
-	variable receipt_$ref
-	
-	array set receipt_[set ref] [list $property $value]
-
-	return 1
-}
-
-##
-#
-# Retrieve a property from a receipt that was loaded in memory.
-#
-# ref			reference number for the receipt.
-# property		key for the property to retrieve.
-#
-proc property_retrieve {ref property} {
-	variable receipt_$ref
-
-	set theCouple [array get receipt_[set ref] $property]
-	if {[llength $theCouple] != 2} {
-		return 0
-	} else {
-		return [lindex $theCouple 1]
-	}
-}
-
-# Delete an entry
-proc delete_entry {name version {revision 0} {variants ""}} {
-	global macports::registry.path
-	variable ref_index
-	
-	# if the entry is loaded, purge it
-	if {[info exists ref_index($name,$version,$revision,$variants)]} {
-	    set ref $ref_index($name,$version,$revision,$variants)
-	    variable receipt_${ref}
-	    array unset receipt_${ref}
-	    array unset ref_index "$name,$version,$revision,$variants"
-	}
-
-	set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
-	if { [file exists ${receipt_path}] } {
-		# remove port receipt directory
-		ui_debug "deleting directory: ${receipt_path}"
-		file delete -force -- ${receipt_path}
-		# remove port receipt parent directory (if empty)
-		set receipt_dir [file join ${macports::registry.path} receipts ${name}]
-		if { [file isdirectory ${receipt_dir}] } {
-			# 0 item means empty.
-			if { [llength [readdir ${receipt_dir}]] == 0 } {
-				ui_debug "deleting directory: ${receipt_dir}"
-				file delete -force -- ${receipt_dir}
-			} else {
-				ui_debug "${receipt_dir} is not empty"
-			}
-		}
-		return 1
-	} else {
-		return 0
-	}
-}
-
-# Return all installed ports
-#
-# If version is "", return all ports of that version.
-# Otherwise, return only ports that exactly match this version.
-# What we call version here is version_revision+variants.
-# Note: at some point we need to change these APIs and support something
-# like selecting on the version or selecting variants in any order.
-proc installed {{name ""} {version ""}} {
-	global macports::registry.path
-
-	set query_path [file join ${macports::registry.path} receipts]
-	
-	if { $name == "" } {
-		set query_path [file join ${query_path} *]
-		if { $version == "" } {
-			set query_path [file join ${query_path} *]
-		}
-		# [PG] Huh?
-	} else {
-	    # We want to be case-insensitive but case-preserving, so the name gets
-	    # returned with the correct case even if it's wrong when given. To get the
-	    # correct case on a case-insensitive FS, we have to list the directory and
-	    # compare against each entry.
-	    set name_path [file join ${query_path} *]
-	    set name_entries [glob -nocomplain -types d ${name_path}]
-	    foreach entry $name_entries {
-	        set basename [file tail $entry]
-	        if {[string equal -nocase $basename $name]} {
-	            set name $basename
-	            break
-	        }
-	    }
-		set query_path [file join ${query_path} ${name}]
-		if { $version != "" } {
-			set query_path [file join ${query_path} ${version}]
-		} else {
-			set query_path [file join ${query_path} *]
-		}
-	}
-
-	set x [glob -nocomplain -types d ${query_path}]
-	set rlist [list]
-	foreach p $x {
-		if {![file isfile [file join $p receipt.bz2]] && ![file isfile [file join $p receipt]]} {
-			continue
-		}
-		set plist [list]
-		regexp {([-_a-zA-Z0-9\.]+)_([0-9]*)([+-_a-zA-Z0-9]*)$} [lindex [file split $p] end] match version revision variants
-		lappend plist [lindex [file split $p] end-1]
-		lappend plist $version
-		lappend plist $revision
-		lappend plist $variants
-		lappend rlist $plist
-	}
-
-	# append the ports in old HEAD format.
-	if { $name == "" } {
-		set query_path [file join ${macports::registry.path} receipts *]
-	} else {
-		set query_path [file join ${macports::registry.path} receipts ${name}-*]
-	}
-    set receiptglob [glob -nocomplain -types f ${query_path}]
-    foreach receipt_file $receiptglob {
-		set theFileName [file tail $receipt_file]
-
-    	# Remark: these regexes do not always work.
-   		set theName ""
-    	if { $name == "" } {
-			regexp {^(.*)-(.*)$} $theFileName match theName version
-    	} else {
-			regexp "^($name)-(.*)\$" $theFileName match theName version
-		}
-		
-		# Skip if the name is empty, i.e. if it didn't match.
-		if {[string length $theName]} {
-			set plist [list]
-			lappend plist $theName
-			
-			# Remove .bz2 suffix, if present.
-			regexp {^(.*)\.bz2$} $version match version
-			lappend plist $version
-			lappend plist 0
-			lappend plist ""
-			lappend rlist $plist
-		}
-	}
-
-	return $rlist
-}
-
-# File Map stuff
-
-##
-# open the file map and store a reference to it into variable file_map.
-# convert from the old format if required.
-#
-proc open_file_map {{readonly 0}} {
-	global macports::registry.path
-	variable file_map
-
-	set receipt_path [file join ${macports::registry.path} receipts]
-	set map_file [file join ${receipt_path} file_map]
-
-	# Don't reopen it (it actually would deadlock us), unless it was open r/o.
-	# and we want it r/w.
-	if { [info exists file_map] } {
-		if { $readonly == 0 } {
-			if {[filemap isreadonly file_map]} {
-				filemap close file_map
-				filemap open file_map ${map_file}.db
-			}
-		}
-		return 0
-	}
-
-	set old_filemap [list]
-
-	if { ![file exists ${map_file}.db] } {
-		# Convert to new format
-		if { [file exists ${map_file}.bz2] && [file exists ${registry::autoconf::bzip2_path}] } {
-			set old_filemap [exec ${registry::autoconf::bzip2_path} -d -c ${map_file}.bz2]
-		} elseif { [file exists $map_file] } {		
-			set map_handle [open ${map_file} r]
-			set old_filemap [read $map_handle]
-			close $map_handle
-		}
-	}
-
-	if { [llength $old_filemap] > 0 } {
-		# Translate from old format.
-		# Open the map (new format)
-		filemap open file_map ${map_file}.db
-		
-		# Tell the user.
-		ui_msg "Converting file map to new format (this may take a while)"
-
-		foreach f $old_filemap {
-			filemap set file_map [lindex $f 0] [lindex $f 1]
-		}
-		
-		# Save it afterwards.
-		filemap save file_map
-
-		# reopen it r/o if we wanted it r/o.
-	} else {
-		# open it directly
-		if { $readonly == 1 } {
-			filemap open file_map ${map_file}.db readonly
-		} else {
-			filemap open file_map ${map_file}.db
-		}
-	}
-	
-	return 0
-}
-
-##
-# determine if a file is registered in the file map, and if it is,
-# get its port.
-# open the file map if required.
-#
-# - file	the file to test
-# return the 0 if the file is not registered, the name of the port otherwise.
-#
-proc file_registered {file} {
-	variable file_map
-
-	open_file_map 1
-
-	if {[filemap exists file_map $file]} {
-		return [filemap get file_map $file]
-	} else {
-		return 0
-	}
-}
-
-##
-# determine if a port is registered in the file map, and if it is,
-# get its installed (activated) files.
-# convert the port if required.
-# open the file map if required.
-#
-# - port	the port to test
-# return the 0 if the port is not registered, the list of its files otherwise.
-#
-proc port_registered {name} {
-	# Trust the file map first.
-	variable file_map
-
-	open_file_map 1
-
-	set files [filemap list file_map $name]
-
-	if { [llength $files] > 0 } {
-		return $files
-	} else {
-		# Is port installed?
-		set matchingPorts [installed $name]
-		if { [llength $matchingPorts] } {
-			# Convert the port and retry.
-			open_entry $name
-			
-			set files [filemap list file_map $name]
-			
-			return $files
-		} else {
-			return 0
-		}
-	}
-}
-
-##
-# register a file in the file map.
-# open the file map if required.
-#
-# - file	the file to register
-# - port	the port to associate with the file
-#
-proc register_file {file port} {
-	variable file_map
-
-	open_file_map
-
-	if { [file type $file] == "link" } {
-		ui_debug "Adding link to file_map: $file for: $port"
-	} else {
-		ui_debug "Adding file to file_map: $file for: $port"
-	}
-	filemap set file_map $file $port
-}
-
-##
-# register all the files in the list 'files' in the filemap.
-# open the file map if required.
-#
-# - files	the list of files to register
-# - port	the port to associate the files with
-#
-proc register_bulk_files {files port} {
-	variable file_map
-
-	open_file_map
-
-	foreach f $files {
-		set file [lindex $f 0]
-		if { [file type $file] == "link" } {
-			ui_debug "Adding link to file_map: $file for: $port"
-		} else {
-			ui_debug "Adding file to file_map: $file for: $port"
-		}
-		filemap set file_map $file $port
-	}
-}
-
-##
-# unregister a file from the file map.
-# open the file map if required.
-#
-# - file	the file to unregister
-#
-proc unregister_file {file} {
-	variable file_map
-
-	open_file_map
-
-	ui_debug "Removing entry from file_map: $file"
-	filemap unset file_map $file
-}
-
-##
-# save the file map to disk.
-# do not do anything if the file map wasn't open.
-#
-# always return 1
-#
-proc write_file_map {args} {
-	variable file_map
-
-	if { [info exists file_map] } {
-		open_file_map
-		filemap save file_map
-	}
-
-	return 1
-}
-
-##
-# close the file map.
-# important to do this so the lock is released.
-# do not do anything if the file map wasn't open.
-#
-proc close_file_map {args} {
-	variable file_map
-
-	if { [info exists file_map] } {
-		filemap close file_map
-	}
-}
-
-# Dependency Map Code
-proc open_dep_map {args} {
-	global macports::registry.path
-	variable dep_map
-
-	set receipt_path [file join ${macports::registry.path} receipts]
-
-	set map_file [file join ${receipt_path} dep_map]
-
-	if { [file exists ${map_file}.bz2] && [file exists ${registry::autoconf::bzip2_path}] } {
-		set dep_map [exec ${registry::autoconf::bzip2_path} -d -c ${map_file}.bz2]
-	} elseif { [file exists ${map_file}] } {
-		set map_handle [open ${map_file} r]
-		set dep_map [read $map_handle]
-		close $map_handle
-	} else {
-	    set dep_map [list]
-	}
-	if { ![llength $dep_map] > 0 } {
-		set dep_map [list]
-	}
-}
-
-# List all ports this one depends on
-proc list_depends {name} {
-	variable dep_map
-	if { [llength $dep_map] < 1 && [info exists dep_map] } {
-		open_dep_map
-	}
-	set rlist [list]
-	foreach de $dep_map {
-		if { $name == [lindex $de 2] } {
-			lappend rlist $de
-		}
-	}
-	return $rlist
-}
-
-# List all the ports that depend on this port
-proc list_dependents {name} {
-	variable dep_map
-	if { [llength $dep_map] < 1 && [info exists dep_map] } {
-		open_dep_map
-	}
-	set rlist [list]
-	foreach de $dep_map {
-		if { $name == [lindex $de 0] } {
-			lappend rlist $de
-		}
-	}
-	return $rlist
-}
-
-proc register_dep {dep type port} {
-	variable dep_map
-	set newdep [list $dep $type $port]
-	# slow, but avoids duplicate entries building up
-	if {[lsearch -exact $dep_map $newdep] == -1} {
-	    lappend dep_map $newdep
-	}
-}
-
-proc unregister_dep {dep type port} {
-	variable dep_map
-	set new_map [list]
-	foreach de $dep_map {
-		if { $de != [list $dep $type $port] } {
-			lappend new_map $de
-		}
-	}
-	set dep_map $new_map
-}
-
-# remove duplicate entries from the dep_map
-# (could be put there by older versions of MacPorts)
-proc clean_dep_map {args} {
-    variable dep_map
-    set new_map [list]
-    set oldlen [llength $dep_map]
-    ui_debug "Current dep_map has $oldlen entries"
-    foreach de $dep_map {
-        if {[lsearch -exact $new_map $de] == -1} {
-            lappend new_map $de
-        } else {
-            ui_debug "Removing $de from dep_map"
-        }
-    }
-    set dep_map $new_map
-    
-    set newlen [llength $dep_map]
-    set diff [expr $oldlen - $newlen]
-    ui_debug "New dep_map has $newlen entries"
-    ui_info "Removed $diff duplicate entries from the dependency map"
-}
-
-proc write_dep_map {args} {
-	global macports::registry.path
-	variable dep_map
-
-	set receipt_path [file join ${macports::registry.path} receipts]
-
-	set map_file [file join ${receipt_path} dep_map]
-
-	set map_handle [open ${map_file}.tmp w 0644]
-	puts $map_handle $dep_map
-	close $map_handle
-
-    # don't both checking for presence, file delete doesn't error if file doesn't exist
-    file delete -- ${map_file} ${map_file}.bz2
-
-    file rename -- ${map_file}.tmp ${map_file}
-
-	if { [file exists ${map_file}] && [file exists ${registry::autoconf::bzip2_path}] && ![info exists registry.nobzip] } {
-		system "${registry::autoconf::bzip2_path} -f ${map_file}"
-	}
-
-	return 1
-}
-
-# End of receipt_flat namespace
-}
-

Deleted: trunk/base/src/registry1.0/registry.tcl
===================================================================
--- trunk/base/src/registry1.0/registry.tcl	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/src/registry1.0/registry.tcl	2010-02-04 00:46:00 UTC (rev 63398)
@@ -1,396 +0,0 @@
-# registry.tcl
-#
-# Copyright (c) 2004 Will Barton <wbb4 at opendarwin.org>
-# Copyright (c) 2002 Apple Computer, 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 Computer, 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 registry 1.0
-
-package require macports 1.0
-package require receipt_flat 1.0
-package require portimage 1.0
-package require portuninstall 1.0
-package require msgcat
-
-namespace eval registry {
-
-# Begin creating a new registry entry for the port version_revision+variant
-# This process assembles the directory name and creates a receipt dlist
-proc new_entry {name version {revision 0} {variants ""} {epoch 0} } {
-	global macports::registry.path macports::registry.format macports::registry.installtype macports::prefix
-
-	
-	# Make sure we don't already have an entry in the Registry for this
-	# port version_revision+variants
-	if {![entry_exists $name $version $revision $variants] } {
-
-		set ref [${macports::registry.format}::new_entry]
-
-		property_store $ref name $name
-		property_store $ref version $version
-		property_store $ref revision $revision
-		property_store $ref variants $variants
-		property_store $ref epoch $epoch
-		# Trick to have a portable GMT-POSIX epoch-based time.
-		# (because we'll compare this with a file mtime).
-		property_store $ref date [expr [clock scan now -gmt true] - [clock scan "1970-1-1 00:00:00" -gmt true]]
-		property_store $ref installtype ${macports::registry.installtype}
-		property_store $ref receipt_f ${macports::registry.format}
-		if { ${macports::registry.installtype} == "image" } {
-			set imagedir [file join ${macports::registry.path} software ${name} ${version}_${revision}${variants}]
-			property_store $ref imagedir $imagedir
-			property_store $ref active 0
-		}
-
-		return $ref
-	} else {
-		return -code error "Registry error: ${name} @${version}_${revision}${variants} already registered as installed.  Please uninstall it first."
-	}
-}
-
-# Check to see if an entry exists in the registry.  This is passed straight 
-# through to the receipts system
-proc entry_exists {name version {revision 0} {variants ""}} {
-	global macports::registry.format
-	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
-	
-	set name [property_retrieve $ref name]
-	set version [property_retrieve $ref version]
-	set revision [property_retrieve $ref revision]
-	set variants [property_retrieve $ref variants]
-	set epoch [property_retrieve $ref epoch]
-	set contents [property_retrieve $ref contents]
-
-	${macports::registry.format}::write_entry $ref $name $version $revision $variants
-
-}
-
-# Delete an entry from the registry.
-proc delete_entry {ref} {
-	global macports::registry.format
-	
-	set name [property_retrieve $ref name]
-	set version [property_retrieve $ref version]
-	set revision [property_retrieve $ref revision]
-	set variants [property_retrieve $ref variants]
-	
-	${macports::registry.format}::delete_entry $name $version $revision $variants
-	
-}
-
-# Open a registry entry.
-proc open_entry {name {version ""} {revision 0} {variants ""}} {
-	global macports::registry.format
-
-	return [${macports::registry.format}::open_entry $name $version $revision $variants]
-
-}
-
-# Store a property with the open registry entry.
-proc property_store {ref property value} {
-	global macports::registry.format
-	${macports::registry.format}::property_store $ref $property $value
-}
-
-# Retrieve a property from the open registry entry.
-proc property_retrieve {ref property} {
-	global macports::registry.format
-	return [${macports::registry.format}::property_retrieve $ref $property]
-}
-
-# If only one version of the port is installed, this process returns that
-# version's parts.  Otherwise, it lists the versions installed and exists.
-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]
-	}
-	return $rlist
-}
-
-# Return a list with the active version of a port (or the active versions of
-# 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 { [llength $rlist] < 1 } {
-		if { $name == "" } {
-			return -code error "Registry error: No ports registered as active."
-		} else {
-			return -code error "Registry error: $name not registered as installed & active."
-		}
-	}
-	return $rlist
-}
-
-proc location {portname portversion} {
-	set ilist [registry::installed $portname $portversion]
-
-	if { [llength $ilist] > 1 } {
-		puts "The following versions of $portname are currently installed:"
-		foreach i $ilist { 
-			set iname [lindex $i 0]
-			set iversion [lindex $i 1]
-			set irevision [lindex $i 2]
-			set ivariants [lindex $i 3]
-			set iactive [lindex $i 4]
-			if { $iactive == 0 } {
-				puts "	$iname @${iversion}_${irevision}${ivariants}"
-			} elseif { $iactive == 1 } {
-				puts "	$iname @${iversion}_${irevision}${ivariants} (active)"
-			}
-		}
-		return -1
-	} else {
-		return [lindex $ilist 0]
-	}
-}	
-
-
-# File Map Code
-proc open_file_map {args} {
-	global macports::registry.format
-	return [${macports::registry.format}::open_file_map $args]
-}
-
-proc file_registered {file} {
-	global macports::registry.format
-	return [${macports::registry.format}::file_registered $file]
-}
-
-proc port_registered {name} {
-	global macports::registry.format
-	return [${macports::registry.format}::port_registered $name]
-}
-
-proc register_file {file port} {
-	global macports::registry.format
-	return [${macports::registry.format}::register_file $file $port]
-}
-
-proc register_bulk_files {files port} {
-	global macports::registry.format
-	open_file_map
-        set r [${macports::registry.format}::register_bulk_files $files $port]
-	write_file_map
-	close_file_map
-	return $r
-}
-
-proc unregister_file {file} {
-	global macports::registry.format
-	return [${macports::registry.format}::unregister_file $file]
-}
-
-proc write_file_map {args} {
-	global macports::registry.format
-	return [${macports::registry.format}::write_file_map $args]
-}
-
-proc close_file_map {args} {
-	global macports::registry.format
-	return [${macports::registry.format}::close_file_map $args]
-}
-
-# Dependency Map Code
-proc register_dependencies {deps name} {
-
-	open_dep_map
-	foreach dep $deps {
-		# We expect the form type:regexp:port to come in, but we don't need to 
-		# store it that way in the dep map.
-		set type [lindex [split $dep :] 0]
-		set depport [lindex [split $dep :] end]
-		register_dep $depport $type $name
-	}
-	write_dep_map
-}
-
-proc unregister_dependencies {name} {
-
-	open_dep_map
-	foreach dep [list_depends $name] {
-		unregister_dep [lindex $dep 0] [lindex $dep 1] [lindex $dep 2]
-	}
-	write_dep_map
-}
-
-proc open_dep_map {args} {
-	global macports::registry.format
-	return [${macports::registry.format}::open_dep_map $args]
-}
-
-##
-#
-# From a file name, return a list representing data currently known about the file.
-# This list is a 6-tuple of the form:
-# 0: file path
-# 1: uid
-# 2: gid
-# 3: mode
-# 4: size
-# 5: md5 checksum information
-#
-# fname		a path to a given file.
-# return a 6-tuple about this file.
-proc fileinfo_for_file {fname} {
-    # Add the link to the registry, not the actual file.
-    # (we won't store the md5 of the target of links since it's meaningless
-    # and $statvar(mode) tells us that links are links).
-    if {![catch {file lstat $fname statvar}]} {
-	if {[file isfile $fname] && [file type $fname] != "link"} {
-	    if {[catch {md5 file $fname} md5sum] == 0} {
-		# Create a line that matches md5(1)'s output
-		# for backwards compatibility
-		set line "MD5 ($fname) = $md5sum"
-		return [list $fname $statvar(uid) $statvar(gid) $statvar(mode) $statvar(size) $line]
-	    }
-	} else {
-	    return  [list $fname $statvar(uid) $statvar(gid) $statvar(mode) $statvar(size) "MD5 ($fname) NONE"]
-	}
-    }
-    return {}
-}
-
-##
-#
-# From a list of files, return a list of information concerning these files.
-# The information is obtained through fileinfo_for_file.
-#
-# flist		the list of file to get information about.
-# return a list of 6-tuples described in fileinfo_for_file.
-proc fileinfo_for_index {flist} {
-	global prefix
-
-	set rval [list]
-	foreach file $flist {
-		if {[string index $file 0] != "/"} {
-			set file [file join $prefix $file]
-		}
-		lappend rval [fileinfo_for_file $file]
-	}
-	return $rval
-}
-
-# List all ports this one depends on
-proc list_depends {name} {
-	global macports::registry.format
-	return [${macports::registry.format}::list_depends $name]
-}
-
-# List all the ports that depend on this port
-proc list_dependents {name} {
-	global macports::registry.format
-	return [${macports::registry.format}::list_dependents $name]
-}
-
-proc register_dep {dep type port} {
-	global macports::registry.format
-	return [${macports::registry.format}::register_dep $dep $type $port]
-}
-
-proc unregister_dep {dep type port} {
-	global macports::registry.format
-	return [${macports::registry.format}::unregister_dep $dep $type $port]
-}
-
-proc clean_dep_map {args} {
-    global macports::registry.format
-    return [${macports::registry.format}::clean_dep_map $args]
-}
-
-proc write_dep_map {args} {
-	global macports::registry.format
-	return [${macports::registry.format}::write_dep_map $args]
-}
-
-
-# End of registry namespace
-}
-

Deleted: trunk/base/src/registry1.0/registry_autoconf.tcl.in
===================================================================
--- trunk/base/src/registry1.0/registry_autoconf.tcl.in	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/src/registry1.0/registry_autoconf.tcl.in	2010-02-04 00:46:00 UTC (rev 63398)
@@ -1,35 +0,0 @@
-# registry_autoconf.tcl.in
-# $Id$
-#
-# Copyright (c) 2007 Kevin Ballard <eridius at macports.org>
-# 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 Computer, 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 registry 1.0
-
-namespace eval registry::autoconf {
-    variable bzip2_path "@BZIP2@"
-}


Property changes on: trunk/base/src/registry2.0
___________________________________________________________________
Modified: svn:ignore
   - registry.dylib
pkgIndex.tcl

   + pkgIndex.tcl
registry.dylib
registry_autoconf.tcl


Modified: trunk/base/src/registry2.0/Makefile
===================================================================
--- trunk/base/src/registry2.0/Makefile	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/src/registry2.0/Makefile	2010-02-04 00:46:00 UTC (rev 63398)
@@ -1,6 +1,6 @@
 # $Id$
 
-SRCS = registry_util.tcl portimage.tcl portuninstall.tcl
+SRCS = registry.tcl registry_autoconf.tcl registry_util.tcl receipt_flat.tcl portimage.tcl portuninstall.tcl
 OBJS = registry.o util.o \
 	entry.o entryobj.o
 	#graph.o graphobj.o
@@ -19,6 +19,9 @@
 	${TCLSH} tests/entry.tcl ${SHLIB_NAME}
 	${TCLSH} tests/depends.tcl ${SHLIB_NAME}
 
+distclean:: clean
+	rm -f registry_autoconf.tcl
+
 install:: all
 	$(INSTALL) -d -o ${DSTUSR} -g ${DSTGRP} -m ${DSTMODE} ${INSTALLDIR}
 	$(INSTALL) -o ${DSTUSR} -g ${DSTGRP} -m 444 ${SHLIB_NAME} ${INSTALLDIR}

Modified: trunk/base/src/registry2.0/portimage.tcl
===================================================================
--- trunk/base/src/registry2.0/portimage.tcl	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/src/registry2.0/portimage.tcl	2010-02-04 00:46:00 UTC (rev 63398)
@@ -1,4 +1,4 @@
-# et:ts=4
+# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:ft=tcl:et:sw=4:ts=4:sts=4
 # portimage.tcl
 # $Id$
 #
@@ -17,7 +17,7 @@
 # 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
@@ -33,9 +33,10 @@
 
 package provide portimage 2.0
 
-package require macports 1.0
+package require registry 1.0
 package require registry2 2.0
 package require registry_util 2.0
+package require macports 1.0
 package require Pextlib 1.0
 
 set UI_PREFIX "--> "
@@ -63,329 +64,591 @@
 
 namespace eval portimage {
 
+variable force 0
+variable use_reg2 0
+
 # Activate a "Port Image"
-proc activate {name specifier optionslist} {
+proc activate {name v optionslist} {
     global macports::prefix macports::registry.path UI_PREFIX
     array set options $optionslist
+    variable force
+    variable use_reg2
 
-    if {[info exists options(ports_force)] && [string is true $options(ports_force)] } {
+    if {[info exists options(ports_force)] && [string is true -strict $options(ports_force)] } {
         set force 1
-    } else {
-        set force 0
     }
+    set use_reg2 [string equal ${macports::registry.format} "receipt_sqlite"]
+    set todeactivate [list]
 
-    if {$specifier != ""} {
-            ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $specifier]"
-    } else {
-            ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
-    }
+    if {$use_reg2} {
+        registry::read {
 
-    registry::read {
+            set requested [_check_registry $name $v]
+            # set name again since the one we were passed may not have had the correct case
+            set name [$requested name]
+            set version [$requested version]
+            set revision [$requested revision]
+            set variants [$requested variants]
+            set specifier "${version}_${revision}${variants}"
 
-        set requested [_check_registry $name $specifier]
-        set version [$requested version]
-        set revision [$requested revision]
-        set variants [$requested variants]
-        set specifier "${version}_$revision$variants"
+            # if another version of this port is active, deactivate it first
+            set current [registry::entry installed $name]
+            if { [llength $current] > 1 } {
+                foreach i $current {
+                    set iversion [$i version]
+                    set irevision [$i revision]
+                    set ivariants [$i variants]
+                    set ispecifier "${iversion}_${irevision}${ivariants}"
+                    if { ![string equal $specifier $ispecifier]
+                            && [string equal [$i state] "installed"] } {
+                        lappend todeactivate $ispecifier
+                    }
+                }
+            }
 
-        set current [registry::entry installed $name]
-        if { [llength $current] > 1 } {
-            foreach i $current {
-                set iname [$i name]
-                set iversion [$i version]
-                set irevision [$i revision]
-                set ivariants [$i variants]
-                set ispecifier "${iversion}_$irevision$ivariants"
-                if { ![string equal $specifier $ispecifier]
-                        && [string equal [$i state] "installed"] } {
-                    return -code error "Image error: Another version of this port ($iname @${iversion}_${irevision}${ivariants}) is already active."
+            # this shouldn't be possible
+            if { ![string equal [$requested installtype] "image"] } {
+                return -code error "Image error: ${name} @${version}_${revision}${variants} not installed as an image."
+            }
+
+            if { [string equal [$requested state] "active"] } {
+                return -code error "Image error: ${name} @${version}_${revision}${variants} is already active."
+            }
+        }
+    } else {
+        # registry1.0
+        set ilist [_check_registry $name $v]
+        # set name again since the one we were passed may not have had the correct case
+        set name [lindex $ilist 0]
+        set version [lindex $ilist 1]
+        set revision [lindex $ilist 2]
+        set variants [lindex $ilist 3]
+
+        # if another version of this port is active, deactivate it first
+        set ilist [registry::installed $name]
+        if { [llength $ilist] > 1 } {
+            foreach i $ilist {
+                set iversion [lindex $i 1]
+                set irevision [lindex $i 2]
+                set ivariants [lindex $i 3]
+                set iactive [lindex $i 4]
+                if { ![string equal "${iversion}_${irevision}${ivariants}" "${version}_${revision}${variants}"] && $iactive == 1 } {
+                    lappend todeactivate "${iversion}_${irevision}${ivariants}"
                 }
             }
         }
 
-        # this shouldn't be possible
-        if { ![string equal [$requested installtype] "image"] } {
+        set ref [registry::open_entry $name $version $revision $variants]
+
+        if { ![string equal [registry::property_retrieve $ref installtype] "image"] } {
             return -code error "Image error: ${name} @${version}_${revision}${variants} not installed as an image."
         }
-
-        if { [string equal [$requested state] "active"] } {
+        if { [registry::property_retrieve $ref active] != 0 } {
             return -code error "Image error: ${name} @${version}_${revision}${variants} is already active."
         }
     }
 
-    _activate_contents $port $force
-    $requested state active
+    foreach a $todeactivate {
+        deactivate $name $a [list ports_force 1]
+    }
+
+    if {$v != ""} {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $v]"
+    } else {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
+    }
+
+    if {$use_reg2} {
+        _activate_contents $port
+        $requested state active
+    } else {
+        set imagedir [registry::property_retrieve $ref imagedir]
+
+        set contents [registry::property_retrieve $ref contents]
+
+        set imagefiles [_check_contents $name $contents $imagedir]
+
+        registry::open_file_map
+        _activate_contents $name $imagefiles $imagedir
+
+        registry::property_store $ref active 1
+
+        registry::write_entry $ref
+
+        foreach file $imagefiles {
+            registry::register_file $file $name
+        }
+        registry::write_file_map
+        registry::close_file_map
+    }
 }
 
-proc deactivate {name spec optionslist} {
+proc deactivate {name v optionslist} {
     global UI_PREFIX
     array set options $optionslist
+    variable use_reg2
 
-    if {[info exists options(ports_force)] && [string is true $options(ports_force)] } {
+    if {[info exists options(ports_force)] && [string is true -strict $options(ports_force)] } {
+        # this not using the namespace variable is correct, since activate
+        # needs to be able to force deactivate independently of whether
+        # the activation is being forced
         set force 1
-    } else {
-        set force 0
     }
+    set use_reg2 [string equal ${macports::registry.format} "receipt_sqlite"]
 
-    if {$spec != ""} {
-            ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $spec]"
+    if {$use_reg2} {
+        if { [string equal $name ""] } {
+            throw registry::image-error "Registry error: Please specify the name of the port."
+        }
+        set ilist [registry::entry installed $name]
+        if { [llength $ilist] == 1 } {
+            set requested [lindex $ilist 0]
+        } else {
+            throw registry::image-error "Image error: port ${name} is not active."
+        }
+        # set name again since the one we were passed may not have had the correct case
+        set name [$requested name]
+        set version [$requested version]
+        set revision [$requested revision]
+        set variants [$requested variants]
+        set specifier "${version}_${revision}${variants}"
     } else {
-            ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
+        set ilist [registry::active $name]
+        if { [llength $ilist] > 1 } {
+            return -code error "Registry error: Please specify the name of the port."
+        } else {
+            set ilist [lindex $ilist 0]
+        }
+        # set name again since the one we were passed may not have had the correct case
+        set name [lindex $ilist 0]
+        set version [lindex $ilist 1]
+        set revision [lindex $ilist 2]
+        set variants [lindex $ilist 3]
+        set specifier "${version}_${revision}${variants}"
     }
 
-    if { [string equal $name {}] } {
-        throw registry::image-error "Registry error: Please specify the name of the port."
+    if { $v != "" && ![string equal $specifier $v] } {
+        return -code error "Active version of $name is not $v but ${specifier}."
     }
-    set ilist [registry::entry installed $name]
-    if { [llength $ilist] == 1 } {
-        set requested [lindex $ilist 0]
+
+    if {$v != ""} {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $v]"
     } else {
-        throw registry::image-error "Image error: port ${name} is not active."
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
     }
-    set version [$requested version]
-    set revision [$requested revision]
-    set variants [$requested variants]
-    set specifier ${version}_$revision$variants
 
-    if { ![string equal $spec {}] && ![string equal $spec $specifier] } {
-        return -code error "Active version of $name is not $spec but $specifier."
-    }
-    if { ![string equal [$requested installtype] "image"] } {
-        return -code error "Image error: ${name} @${specifier} not installed as an image."
-    }
-    # this shouldn't be possible
-    if { [$requested state] != "installed" } {
-        return -code error "Image error: ${name} @${specifier} is not active."
-    }
+    if {$use_reg2} {
+        if { ![string equal [$requested installtype] "image"] } {
+            return -code error "Image error: ${name} @${specifier} not installed as an image."
+        }
+        # this shouldn't be possible
+        if { [$requested state] != "installed" } {
+            return -code error "Image error: ${name} @${specifier} is not active."
+        }
 
-    registry::check_dependents $port $force
+        registry::check_dependents $port $force
 
-    set imagedir [$requested imagedir]
-    set imagefiles [$requested files]
+        _deactivate_contents $requested {} $force
+        $requested state imaged
+    } else {
+        set ref [registry::open_entry $name $version $revision $variants]
 
-    _deactivate_contents $requested $force
-    $requested state imaged
+        if { ![string equal [registry::property_retrieve $ref installtype] "image"] } {
+            return -code error "Image error: ${name} @${specifier} not installed as an image."
+        }
+        if { [registry::property_retrieve $ref active] != 1 } {
+            return -code error "Image error: ${name} @${specifier} is not active."
+        }
+
+        registry::open_file_map
+        set imagefiles [registry::port_registered $name]
+
+        _deactivate_contents $name $imagefiles
+
+        foreach file $imagefiles {
+            registry::unregister_file $file
+        }
+        registry::write_file_map
+        registry::close_file_map
+
+        registry::property_store $ref active 0
+
+        registry::write_entry $ref
+    }
 }
 
-proc _check_registry {name specifier} {
+proc _check_registry {name v} {
     global UI_PREFIX
+    variable use_reg2
 
-    if { [registry::decode_spec $specifier version revision variants] } {
-        set ilist [registry::entry imaged $name $version $revision $variants]
-        set valid 1
-    } else {
-        set valid [string equal $specifier {}]
-        set ilist [registry::entry imaged $name]
-    }
+    if {$use_reg2} {
+        if { [registry::decode_spec $v version revision variants] } {
+            set ilist [registry::entry imaged $name $version $revision $variants]
+            set valid 1
+        } else {
+            set valid [string equal $v {}]
+            set ilist [registry::entry imaged $name]
+        }
 
-    if { [llength $ilist] > 1 || (!$valid && [llength $ilist] == 1) } {
-        ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
-        foreach i $ilist {
-            set iname [$i name]
-            set iversion [$i version]
-            set irevision [$i revision]
-            set ivariants [$i variants]
-            if { [$i state] == "installed" } {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
+        if { [llength $ilist] > 1 || (!$valid && [llength $ilist] == 1) } {
+            ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
+            foreach i $ilist {
+                set iname [$i name]
+                set iversion [$i version]
+                set irevision [$i revision]
+                set ivariants [$i variants]
+                if { [$i state] == "installed" } {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
+                } else {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
+                }
+            }
+            if { $valid } {
+                throw registry::invalid "Registry error: Please specify the full version as recorded in the port registry."
             } else {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
+                throw registry::invalid "Registry error: Invalid version specified. Please specify a version as recorded in the port registry."
             }
+        } elseif { [llength $ilist] == 1 } {
+            return [lindex $ilist 0]
         }
-        if { $valid } {
-            throw registry::invalid "Registry error: Please specify the full version as recorded in the port registry."
-        } else {
-            throw registry::invalid "Registry error: Invalid version specified. Please specify a version as recorded in the port registry."
+        throw registry::invalid "Registry error: No port of $name installed."
+    } else {
+        # registry1.0
+        set ilist [registry::installed $name $v]
+        if { [string equal $v ""] && [llength $ilist] > 1 } {
+            # set name again since the one we were passed may not have had the correct case
+            set name [lindex [lindex $ilist 0] 0]
+            ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
+            foreach i $ilist { 
+                set iname [lindex $i 0]
+                set iversion [lindex $i 1]
+                set irevision [lindex $i 2]
+                set ivariants [lindex $i 3]
+                set iactive [lindex $i 4]
+                if { $iactive == 0 } {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
+                } elseif { $iactive == 1 } {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
+                }
+            }
+            return -code error "Registry error: Please specify the full version as recorded in the port registry."
+        } elseif {[llength $ilist] == 1} {
+            return [lindex $ilist 0]
         }
-    } else if { [llength $ilist] == 1 } {
-        return [lindex $ilist 0]
+        return -code error "Registry error: No port of $name installed."
     }
-    throw registry::invalid "Registry error: No port of $name installed."
 }
 
+proc _check_contents {name contents imagedir} {
+
+    set imagefiles [list]
+    set idlen [string length $imagedir]
+
+    # generate list of activated file paths from list of paths in the image dir
+    foreach fe $contents {
+        set srcfile [lindex $fe 0]
+        if { ![string equal $srcfile ""] && [file type $srcfile] != "directory" } {
+            set file [string range $srcfile $idlen [string length $srcfile]]
+
+            lappend imagefiles $file
+        }
+    }
+
+    return $imagefiles
+}
+
 ## Activates a file from an image into the filesystem. Deals with symlinks,
 ## directories and files.
 ##
 ## @param [in] srcfile path to file in image
 ## @param [in] dstfile path to activate file to
 proc _activate_file {srcfile dstfile} {
-    switch { [file type $srcfile] } {
-        case link {
+    switch [file type $srcfile] {
+        link {
             ui_debug "activating link: $dstfile"
-            file copy -force $srcfile $dstfile
+            file copy -force -- $srcfile $dstfile
         }
-        case directory {
+        directory {
             # Don't recursively copy directories
             ui_debug "activating directory: $dstfile"
             # Don't do anything if the directory already exists.
             if { ![file isdirectory $dstfile] } {
                 file mkdir $dstfile
-                # copy attributes, set mtime and atime
-                eval file attributes [list $dstfile] [file attributes $srcfile]
+                # fix attributes on the directory.
+                eval file attributes {$dstfile} [file attributes $srcfile]
+                # set mtime on installed element
                 file mtime $dstfile [file mtime $srcfile]
-                file atime $dstfile [file atime $srcfile]
             }
         }
-        case file {
+        default {
             ui_debug "activating file: $dstfile"
             # Try a hard link first and if that fails, a symlink
-            try {
-                file link -hard $dstfile $srcfile
-            } catch {*} {
-                ui_debug "hardlinking $srcfile to $dstfile failed; symlinking instead"
+            if {[catch {file link -hard $dstfile $srcfile}]} {
+                ui_debug "hardlinking $srcfile to $dstfile failed, symlinking instead"
                 file link -symbolic $dstfile $srcfile
             }
         }
-        default {
-            # don't activate e.g. a unix socket
-            ui_warning "skipped file $srcfile of unknown type [file type $srcfile]"
-        }
     }
 }
 
 ## Activates the contents of a port
-proc _activate_contents {port force} {
+proc _activate_contents {port {imagefiles {}} {imagedir {}}} {
+    variable force
+    variable use_reg2
     global macports::prefix
 
     set files [list]
-    set imagedir [$port imagedir]
-    set imagefiles [$port imagefiles]
-
-    # first, ensure all files exist in the image dir
-    foreach file $imagefiles {
-        set srcfile $imagedir$file
-        # To be able to install links, we test if we can lstat the file to
-        # figure out if the source file exists (file exists will return
-        # false for symlinks on files that do not exist)
-        try {
-            file lstat $srcfile dummystatvar
-        } catch {*} {
-            throw registry::image-error "Image error: Source file $srcfile does not appear to exist (cannot lstat it).  Unable to activate port [$port name]."
-        }
+    set baksuffix .mp_[clock seconds]
+    if {$use_reg2} {
+        set imagedir [$port imagedir]
+        set imagefiles [$port imagefiles]
+    } else {
+        set name $port
     }
 
-    set baksuffix .mp_[clock seconds]
+    set deactivated [list]
     set backups [list]
-
     # This is big and hairy and probably could be done better.
-
+    # First, we need to check the source file, make sure it exists
     # Then we remove the $imagedir from the path of the file in the contents
     #  list  and check to see if that file exists
     # Last, if the file exists, and belongs to another port, and force is set
     #  we remove the file from the file_map, take ownership of it, and
     #  clobber it
-    try {
-        registry::write {
-            foreach file $imagefiles {
-                set srcfile ${imagedir}${file}
+    if {$use_reg2} {
+        try {
+            registry::write {
+                foreach file $imagefiles {
+                    set srcfile "${imagedir}${file}"
 
-                set owner [registry::entry owner $file]
+                    # To be able to install links, we test if we can lstat the file to
+                    # figure out if the source file exists (file exists will return
+                    # false for symlinks on files that do not exist)
+                    if { [catch {file lstat $srcfile dummystatvar}] } {
+                        throw registry::image-error "Image error: Source file $srcfile does not appear to exist (cannot lstat it).  Unable to activate port [$port name]."
+                    }
 
-                if { [string is true $force] } {
-                    # if we're forcing the activation, then we move any existing
-                    # files to a backup file, both in the filesystem and in the
-                    # registry
-                    if { [file exists $file] } {
-                        ui_warn "File $file already exists.  Moving to: $bakfile."
-                        file rename -force $file $file$baksuffix
-                        lappend backups $file
+                    set owner [registry::entry owner $file]
+
+                    if {$owner != {} && $owner != $port} {
+                        # deactivate conflicting port if it is replaced_by this one
+                        set result [mportlookup [$owner name]]
+                        array unset portinfo
+                        array set portinfo [lindex $result 1]
+                        if {[info exists portinfo(replaced_by)] && [lsearch -exact -nocase $portinfo(replaced_by) [$port name]] != -1} {
+                            lappend deactivated $owner
+                            deactivate [$owner name] "" ""
+                            set owner {}
+                        }
                     }
-                    if { $owner != {} } {
-                        $owner deactivate [list $file]
-                        $owner activate [list $file] [list $file$baksuffix]
+
+                    if { [string is true -strict $force] } {
+                        # if we're forcing the activation, then we move any existing
+                        # files to a backup file, both in the filesystem and in the
+                        # registry
+                        if { [file exists $file] } {
+                            set bakfile "${file}${baksuffix}"
+                            ui_warn "File $file already exists.  Moving to: $bakfile."
+                            file rename -force -- $file $bakfile
+                            lappend backups $file
+                        }
+                        if { $owner != {} } {
+                            $owner deactivate [list $file]
+                            $owner activate [list $file] [list "${file}${baksuffix}"]
+                        }
+                    } else {
+                        # if we're not forcing the activation, then we bail out if
+                        # we find any files that already exist, or have entries in
+                        # the registry
+                        if { $owner != {} && $owner != $port } {
+                            throw registry::image-error "Image error: $file is being used by the active [$owner name] port.  Please deactivate this port first, or use 'port -f activate [$port name]' to force the activation."
+                        } elseif { $owner == {} && [file exists $file] } {
+                            throw registry::image-error "Image error: $file already exists and does not belong to a registered port.  Unable to activate port [$port name]. Use 'port -f activate [$port name]' to force the activation."
+                        }
                     }
-                } else {
-                    # if we're not forcing the activation, then we bail out if
-                    # we find any files that already exist, or have entries in
-                    # the registry
-                    if { $owner != {} && $owner != $port } {
-                        throw registry::image-error "Image error: $file is being used by the active [$owner name] port.  Please deactivate this port first, or use the -f flag to force the activation."
-                    } elseif { $owner == {} && [file exists $file] } {
-                        throw registry::image-error "Image error: $file already exists and does not belong to a registered port.  Unable to activate port [$owner name]."
+
+                    # Split out the filename's subpaths and add them to the
+                    # imagefile list.
+                    # We need directories first to make sure they will be there
+                    # before links. However, because file mkdir creates all parent
+                    # directories, we don't need to have them sorted from root to
+                    # subpaths. We do need, nevertheless, all sub paths to make sure
+                    # we'll set the directory attributes properly for all
+                    # directories.
+                    set directory [file dirname $file]
+                    while { [lsearch -exact $files $directory] == -1 } {
+                        lappend files $directory
+                        set directory [file dirname $directory]
                     }
+
+                    # Also add the filename to the imagefile list.
+                    lappend files $file
                 }
 
-                # Split out the filename's subpaths and add them to the
-                # imagefile list.
-                # We need directories first to make sure they will be there
-                # before links. However, because file mkdir creates all parent
-                # directories, we don't need to have them sorted from root to
-                # subpaths. We do need, nevertheless, all sub paths to make sure
-                # we'll set the directory attributes properly for all
-                # directories.
-                set directory [file dirname $file]
-                while { [lsearch -exact $files $directory] == -1 } {
-                    lappend files $directory
-                    set directory [file dirname $directory]
+                # Sort the list in forward order, removing duplicates.
+                # Since the list is sorted in forward order, we're sure that
+                # directories are before their elements.
+                # We don't have to do this as mentioned above, but it makes the
+                # debug output of activate make more sense.
+                set theList [lsort -increasing -unique $files]
+
+                # Activate it, and catch errors so we can roll-back
+                try {
+                    [$port activate $imagefiles]
+                    foreach file $theList {
+                        _activate_file "${imagedir}${file}" $file
+                    }
+                } catch {*} {
+                    ui_debug "Activation failed, rolling back."
+                    _deactivate_contents $port {} yes
+                    throw
                 }
+            }
+        } catch {*} {
+            # if any errors occurred, move backed-up files back to their original
+            # locations, then rethrow the error. Transaction rollback will take care
+            # of this in the registry.
+            foreach file $backups {
+                file rename -force -- "${file}${baksuffix}" $file
+            }
+            # reactivate deactivated ports
+            foreach entry $deactivated {
+                set pvers "[$entry version]_[$entry revision][$entry variants]"
+                activate [$entry name] $pvers ""
+            }
+            throw
+        }
+    } else {
+        # registry1.0
+        foreach file $imagefiles {
+            set srcfile "${imagedir}${file}"
 
-                # Also add the filename to the imagefile list.
-                lappend files $file
+            # To be able to install links, we test if we can lstat the file to
+            # figure out if the source file exists (file exists will return
+            # false for symlinks on files that do not exist)
+            if { [catch {file lstat $srcfile dummystatvar}] } {
+                return -code error "Image error: Source file $srcfile does not appear to exist (cannot lstat it).  Unable to activate port $name."
             }
 
-            # Sort the list in forward order, removing duplicates.
-            # Since the list is sorted in forward order, we're sure that
-            # directories are before their elements.
-            # We don't have to do this as mentioned above, but it makes the
-            # debug output of activate make more sense.
-            set theList [lsort -increasing -unique $files]
+            set port [registry::file_registered $file]
+            
+            if {$port != 0  && $port != $name} {
+                # deactivate conflicting port if it is replaced_by this one
+                if {[catch {mportlookup $port} result]} {
+                    global errorInfo
+                    ui_debug "$errorInfo"
+                    return -code error "port lookup failed: $result"
+                }
+                array unset portinfo
+                array set portinfo [lindex $result 1]
+                if {[info exists portinfo(replaced_by)] && [lsearch -exact -nocase $portinfo(replaced_by) $name] != -1} {
+                    lappend deactivated [lindex [registry::active $port] 0]
+                    deactivate $port "" ""
+                    set port 0
+                }
+            }
+    
+            if { $port != 0  && $force != 1 && $port != $name } {
+                return -code error "Image error: $file is being used by the active $port port.  Please deactivate this port first, or use 'port -f activate $name' to force the activation."
+            } elseif { [file exists $file] && $force != 1 } {
+                return -code error "Image error: $file already exists and does not belong to a registered port.  Unable to activate port $name. Use 'port -f activate $name' to force the activation."
+            } elseif { $force == 1 && [file exists $file] || $port != 0 } {
+                set bakfile "${file}${baksuffix}"
 
-            # Activate it, and catch errors so we can roll-back
-            try {
-                [$port activate $imagefiles]
-                foreach file $theList {
-                    _activate_file $imagedir$file $file
+                if {[file exists $file]} {
+                    ui_warn "File $file already exists.  Moving to: $bakfile."
+                    file rename -force -- $file $bakfile
+                    lappend backups $file
                 }
-            } catch {*} {
-                ui_debug "Activation failed, rolling back."
-                _deactivate_contents $port yes
-                throw
+
+                if { $port != 0 } {
+                    set bakport [registry::file_registered $file]
+                    registry::unregister_file $file
+                    if {[file exists $bakfile]} {
+                        registry::register_file $bakfile $bakport
+                    }
+                }
             }
+
+            # Split out the filename's subpaths and add them to the imagefile list.
+            # We need directories first to make sure they will be there before
+            # links. However, because file mkdir creates all parent directories,
+            # we don't need to have them sorted from root to subpaths. We do need,
+            # nevertheless, all sub paths to make sure we'll set the directory
+            # attributes properly for all directories.
+            set directory [file dirname $file]
+            while { [lsearch -exact $files $directory] == -1 } { 
+                lappend files $directory
+                set directory [file dirname $directory]
+            }
+
+            # Also add the filename to the imagefile list.
+            lappend files $file
         }
-    } catch {*} {
-        # if any errors occurred, move backed-up files back to their original
-        # locations, then rethrow the error. Transaction rollback will take care
-        # of this in the registry.
-        foreach file $backups {
-            file rename -force $file$baksuffix $file
+        registry::write_file_map
+
+        # Sort the list in forward order, removing duplicates.
+        # Since the list is sorted in forward order, we're sure that directories
+        # are before their elements.
+        # We don't have to do this as mentioned above, but it makes the
+        # debug output of activate make more sense.
+        set theList [lsort -increasing -unique $files]
+
+        # Activate it, and catch errors so we can roll-back
+        if { [catch { foreach file $theList {
+                        _activate_file "${imagedir}${file}" $file
+                    }} result]} {
+            ui_debug "Activation failed, rolling back."
+            _deactivate_contents $name $imagefiles
+            # return backed up files to their old locations
+            foreach f $backups {
+                set bakfile "${f}${baksuffix}"
+                set bakport [registry::file_registered $bakfile]
+                if {$bakport != 0} {
+                    registry::unregister_file $bakfile
+                    registry::register_file $f $bakport
+                }
+                file rename -force -- $bakfile $file
+            }
+            # reactivate deactivated ports
+            foreach entry $deactivated {
+                set pname [lindex $entry 0]
+                set pvers "[lindex $entry 1]_[lindex $entry 2][lindex $entry 3]"
+                activate $pname $pvers ""
+            }
+            registry::write_file_map
+
+            return -code error $result
         }
-        throw
     }
 }
 
 proc _deactivate_file {dstfile} {
-    switch { [file type $dstfile] } {
-        case link {
-            ui_debug "deactivating link: $dstfile"
+    if { [file type $dstfile] == "link" } {
+        ui_debug "deactivating link: $dstfile"
+        file delete -- $dstfile
+    } elseif { [file isdirectory $dstfile] } {
+        # 0 item means empty.
+        if { [llength [readdir $dstfile]] == 0 } {
+            ui_debug "deactivating directory: $dstfile"
             file delete -- $dstfile
+        } else {
+            ui_debug "$dstfile is not empty"
         }
-        case directory {
-            # 0 item means empty.
-            if { [llength [readdir $dstfile]] == 0 } {
-                ui_debug "deactivating directory: $dstfile"
-                file delete -- $dstfile
-            } else {
-                ui_debug "$dstfile is not empty"
-            }
-        }
-        case file {
-            ui_debug "deactivating file: $dstfile"
-            file delete -- $dstfile
-        }
-        default {
-            # don't deactivate e.g. a unix socket
-            ui_warning "skipped file $dstfile of unknown type [file type $dstfile]"
-        }
+    } else {
+        ui_debug "deactivating file: $dstfile"
+        file delete -- $dstfile
     }
 }
 
-proc _deactivate_contents {port force} {
-
+proc _deactivate_contents {port imagefiles {force 0}} {
+    variable use_reg2
     set files [list]
+    if {$use_reg2} {
+        set imagefiles [$port files]
+    }
 
-    set realfiles [$port files]
-
-    foreach file $realfiles {
-        set owner [registry::entry owner $file]
+    foreach file $imagefiles {
         if { [file exists $file] || (![catch {file type $file}] && [file type $file] == "link") } {
             # Normalize the file path to avoid removing the intermediate
             # symlinks (remove the empty directories instead)
@@ -398,10 +661,11 @@
             set theFile [file normalize $file]
             lappend files $theFile
 
-            # Split out the filename's subpaths and add them to the image list
-            # as well.
+            # Split out the filename's subpaths and add them to the image 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 } {
+            while { [lsearch -exact $files $directory] == -1 } { 
                 lappend files $directory
                 set directory [file dirname $directory]
             }
@@ -415,9 +679,15 @@
     # are after their elements.
     set theList [lsort -decreasing -unique $files]
 
-    registry::write {
-        # Remove all elements.
-        $port deactivate $realfiles
+    # Remove all elements.
+    if {$use_reg2} {
+        registry::write {
+            $port deactivate $imagefiles
+            foreach file $theList {
+                _deactivate_file $file
+            }
+        }
+    } else {
         foreach file $theList {
             _deactivate_file $file
         }

Modified: trunk/base/src/registry2.0/portuninstall.tcl
===================================================================
--- trunk/base/src/registry2.0/portuninstall.tcl	2010-02-04 00:37:32 UTC (rev 63397)
+++ trunk/base/src/registry2.0/portuninstall.tcl	2010-02-04 00:46:00 UTC (rev 63398)
@@ -1,4 +1,4 @@
-# et:ts=4
+# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:ft=tcl:et:sw=4:ts=4:sts=4
 # portuninstall.tcl
 # $Id$
 #
@@ -16,7 +16,7 @@
 # 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
@@ -32,6 +32,7 @@
 
 package provide portuninstall 2.0
 
+package require registry 1.0
 package require registry2 2.0
 package require registry_util 2.0
 
@@ -39,100 +40,248 @@
 
 namespace eval portuninstall {
 
-proc uninstall {portname {specifier ""} optionslist} {
-	global uninstall.force uninstall.nochecksum UI_PREFIX
-	array set options $optionslist
+proc uninstall {portname {v ""} optionslist} {
+    global uninstall.force uninstall.nochecksum UI_PREFIX macports::registry.format
+    array set options $optionslist
 
-	if {[info exists options(ports_force)] && [string is true $options(ports_force)] } {
-        set force 1
-    } else {
-        set force 0
+    if {![info exists uninstall.force]} {
+        set uninstall.force no
     }
+    # If global forcing is on, make it the same as a local force flag.
+    if {[info exists options(ports_force)] && [string is true -strict $options(ports_force)]} {
+        set uninstall.force yes
+    }
+    # check which registry API to use
+    set use_reg2 [string equal ${macports::registry.format} "receipt_sqlite"]
 
-    if { [registry::decode_spec $specifier version revision variants] } {
-        set ilist [registry::entry imaged $portname $version $revision $variants]
+    if {$use_reg2} {
+        if { [registry::decode_spec $v version revision variants] } {
+            set ilist [registry::entry imaged $portname $version $revision $variants]
+            set valid 1
+        } else {
+            set valid [string equal $v {}]
+            set ilist [registry::entry imaged $portname]
+        }
+    } else {
+        set ilist [registry::installed $portname $v]
         set valid 1
-    } else {
-        set valid [string equal $specifier {}]
-        set ilist [registry::entry imaged $portname]
     }
-
-	if { [llength $ilist] > 1 } {
-		ui_msg "$UI_PREFIX [format [msgcat::mc "The following versions of %s are currently installed:"] $portname]"
-		foreach i $ilist { 
-			set iname [lindex $i 0]
-			set iactive [lindex $i 4]
-            set ispec "[$i version]_[$i revision][$i variants]"
-			if { [string equal [$i state] installed] } {
-				ui_msg "$UI_PREFIX [format [msgcat::mc "	%s @%s (active)"] $iname $ispec]"
-			} elseif { $iactive == 1 } {
-				ui_msg "$UI_PREFIX [format [msgcat::mc "	%s @%s"] $iname $ispec]"
-			}
-		}
+    if { [llength $ilist] > 1 } {
+        set portname [lindex [lindex $ilist 0] 0]
+        ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $portname are currently installed:"]"
+        foreach i [portlist_sortint $ilist] { 
+            set iname [lindex $i 0]
+            set iactive [lindex $i 4]
+            if {$use_reg2} {
+                set ispec "[$i version]_[$i revision][$i variants]"
+                if { [string equal [$i state] installed] } {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s (active)"] $iname $ispec]"
+                } elseif { $iactive == 1 } {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s"] $iname $ispec]"
+                }
+            } else {
+                set iversion [lindex $i 1]
+                set irevision [lindex $i 2]
+                set ivariants [lindex $i 3]
+                if { $iactive == 0 } {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
+                } elseif { $iactive == 1 } {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
+                }
+            }
+        }
         if { $valid } {
             throw registry::invalid "Registry error: Please specify the full version as recorded in the port registry."
         } else {
             throw registry::invalid "Registry error: Invalid version specified. Please specify a version as recorded in the port registry."
         }
-	} elseif { [llength $ilist] == 1 } {
-        set port [lindex $ilist 0]
-	} else {
+    } elseif { [llength $ilist] == 1 } {
+        # set portname again since the one we were passed may not have had the correct case
+        set portname [lindex [lindex $ilist 0] 0]
+        if {$use_reg2} {
+            set port [lindex $ilist 0]
+            if {$v == ""} {
+                set v "[$port version]_[$port revision][$port variants]"
+            }
+        } else {
+            set version [lindex [lindex $ilist 0] 1]
+            set revision [lindex [lindex $ilist 0] 2]
+            set variants [lindex [lindex $ilist 0] 3]
+            set active [lindex [lindex $ilist 0] 4]
+            if {$v == ""} {
+                set v "${version}_${revision}${variants}"
+            }
+        }
+    } else {
         throw registry::invalid "Registry error: $portname not registered as installed"
     }
 
-    if { [string equal [$port installtype] direct] } {
-        # if port is installed directly, check its dependents
-        registry::check_dependents $port $force
-    } else {
-        # if it's an image, deactivate it (and check dependents there)
+    if {$use_reg2} {
+        # uninstall dependents if requested
+        if {[info exists options(ports_uninstall_follow-dependents)] && $options(ports_uninstall_follow-dependents) eq "yes"} {
+            foreach depport [$port dependents] {
+                # make sure it's still installed, since a previous dep uninstall may have removed it
+                if {[$depport state] == "imaged" || [$depport state] == "installed"} {
+                    set depname [$depport name]
+                    set depver "[$depport version]_[$depport revision][$depport variants]"
+                    portuninstall::uninstall $depname $depver [array get options]
+                }
+            }
+        } else {
+            # check its dependents
+            registry::check_dependents $port ${uninstall.force}
+        }
+        # if it's an image, deactivate it
         if { [string equal [$port state] installed] } {
-            portimage::deactivate $portname ${version}_${revision}${variants} $optionslist
+            if {[info exists options(ports_dryrun)] && [string is true -strict $options(ports_dryrun)]} {
+                ui_msg "For $portname @${v}: skipping deactivate (dry run)"
+            } else {
+                portimage::deactivate $portname $v $optionslist
+            }
         }
-	}
+    } else {
+        # registry1.0
+        
+        # determine if it's the only installed port with that name or not.
+        if {$v == ""} {
+            set nb_versions_installed 1
+        } else {
+            set ilist [registry::installed $portname ""]
+            set nb_versions_installed [llength $ilist]
+        }
+    
+        set ref [registry::open_entry $portname $version $revision $variants]
+    
+        # Check and make sure no ports depend on this one
+        registry::open_dep_map  
+        set deplist [registry::list_dependents $portname]
+        if { [llength $deplist] > 0 } {
+            set dl [list]
+            # Check the deps first
+            foreach dep $deplist { 
+                set depport [lindex $dep 2]
+                ui_debug "$depport depends on this port"
+                if {[registry::entry_exists_for_name $depport]} {
+                    lappend dl $depport
+                }
+            }
+            # Now see if we need to error
+            if { [llength $dl] > 0 } {
+                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
+                        if {[registry::entry_exists_for_name $depport]} {
+                            portuninstall::uninstall $depport "" [array get options]
+                        }
+                    }
+                } else {
+                    # will need to change this when we get version/variant dependencies
+                    if {$nb_versions_installed == 1 || $active == 1} {
+                        ui_msg "$UI_PREFIX [format [msgcat::mc "Unable to uninstall %s %s_%s%s, the following ports depend on it:"] $portname $version $revision $variants]"
+                        foreach depport $dl {
+                            ui_msg "$UI_PREFIX [format [msgcat::mc "    %s"] $depport]"
+                        }
+                        if { [string is true -strict ${uninstall.force}] } {
+                            ui_warn "Uninstall forced.  Proceeding despite dependencies."
+                        } else {
+                            return -code error "Please uninstall the ports that depend on $portname first."
+                        }
+                    }
+                }
+            }
+        }
+    
+        set installtype [registry::property_retrieve $ref installtype]
+        if { $installtype == "image" && [registry::property_retrieve $ref active] == 1} {
+            if {[info exists options(ports_dryrun)] && [string is true -strict $options(ports_dryrun)]} {
+                ui_msg "For $portname @${version}_${revision}${variants}: skipping deactivate (dry run)"
+            } else {
+                portimage::deactivate $portname ${version}_${revision}${variants} $optionslist
+            }
+        }
+    }
 
-	ui_msg "$UI_PREFIX [format [msgcat::mc "Uninstalling %s @%s_%s%s"] $portname $version $revision $variants]"
+    if {[info exists options(ports_dryrun)] && [string is true -strict $options(ports_dryrun)]} {
+        ui_msg "For $portname @${v}: skipping uninstall (dry run)"
+        return 0
+    }
 
-    # pkg_uninstall isn't used anywhere as far as I can tell and I intend to add
-    # some proper pre-/post- hooks to uninstall/deactivate.
+    ui_msg "$UI_PREFIX [format [msgcat::mc "Uninstalling %s @%s"] $portname $v]"
 
-	# 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 $uninstall} err]} {
-	#		pkg_uninstall $portname ${version}_${revision}${variants}
-	#	} else {
-	#		global errorInfo
-	#		ui_debug "$errorInfo"
-	#		ui_error [format [msgcat::mc "Could not evaluate pkg_uninstall procedure: %s"] $err]
-	#	}
-	#}
+    if {$use_reg2} {
+        # pkg_uninstall isn't used anywhere as far as I can tell and I intend to add
+        # some proper pre-/post- hooks to uninstall/deactivate.
+    } else {
+        # 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 $uninstall} err]} {
+                pkg_uninstall $portname $v
+            } 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 transitionning to a new dependency map format.
+        if {$nb_versions_installed == 1} {
+            registry::unregister_dependencies $portname
+        }
+    }
 
-	set contents [$port files]
-
-    set bak_suffix .mp_[time seconds]
-    set uninst_err 0
+    # Now look for a contents list
+    if {$use_reg2} {
+        set contents [$port files]
+    } 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 file $contents {
-        if { !([info exists uninstall.nochecksum]
-                && [string is true $uninstall.nochecksum]) } {
-            set sum1 [$port md5sum $file]
-            if {![catch {set sum2 [md5 $file]}] && ![string match $sum1 $sum2]} {
-                ui_info "$UI_PREFIX  [format [msgcat::mc "Original checksum does not match for %s, saving a copy to %s"] $file $file$bak_suffix]"
-                file copy $file $file$bak_suffix
+    foreach f $contents {
+        if {$use_reg2} {
+            set fname $f
+            set sum1 [$port md5sum $f]
+        } 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"] $file ${file}${bak_suffix}]"
+                catch {file copy $file "${file}${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
 
-        # Normalize the file path to avoid removing the intermediate
-        # symlinks (remove the empty directories instead)
-        set theFile [file normalize $file]
-        lappend files $theFile
-
-        # Split out the filename's subpaths and add them to the
-        # list as well.
-        set directory [realpath [file dirname $theFile]]
-        while { [lsearch -exact $files $directory] == -1 } { 
-            lappend files $directory
-            set directory [file dirname $directory]
+            # 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]
+            }
         }
     }
 
@@ -142,48 +291,43 @@
     set theList [lsort -decreasing -unique $files]
 
     # Remove all elements.
-    foreach file $theList {
-        _uninstall_file $file
+    _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
     }
-
-    ui_info "$UI_PREFIX [format [msgcat::mc "Uninstall is removing %s from the port registry."] $portname]"
-    registry::entry delete $port
     return 0
 }
 
 proc _uninstall_file {dstfile} {
-	if { ![catch {set type [file type $dstfile]}] } {
-        switch {$type} {
-            case link {
-                ui_debug "uninstalling link: $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"
             }
-            case directory {
-                # 0 item means empty.
-                if { [llength [readdir $dstfile]] == 0 } {
-                    ui_debug "uninstalling directory: $dstfile"
-                    file delete -- $dstfile
-                } else {
-                    ui_debug "$dstfile is not empty"
-                }
-            }
-            case file {
-                ui_debug "uninstalling file: $dstfile"
-                file delete -- $dstfile
-            }
-            default {
-                ui_debug "skip file of unknown type $type: $dstfile"
-            }
+        } else {
+            ui_debug "uninstalling file: $dstfile"
+            file delete -- $dstfile
         }
-	} else {
-		ui_debug "skip missing file: $dstfile"
-	}
+    } else {
+        ui_debug "skip missing file: $dstfile"
+    }
 }
 
 proc _uninstall_list {filelist} {
-	foreach file $filelist {
-		_uninstall_file $file
-	}
+    foreach file $filelist {
+        _uninstall_file $file
+    }
 }
 
 # End of portuninstall namespace

Copied: trunk/base/src/registry2.0/receipt_flat.tcl (from rev 63371, trunk/base/src/registry1.0/receipt_flat.tcl)
===================================================================
--- trunk/base/src/registry2.0/receipt_flat.tcl	                        (rev 0)
+++ trunk/base/src/registry2.0/receipt_flat.tcl	2010-02-04 00:46:00 UTC (rev 63398)
@@ -0,0 +1,864 @@
+# receipt_flat.tcl
+# $Id$
+#
+# Copyright (c) 2004 Will Barton <wbb4 at opendarwin.org>
+# Copyright (c) 2004 Paul Guyot, The MacPorts Project.
+# Copyright (c) 2002 Apple Computer, 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 Computer, 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_flat 1.0
+
+package require macports 1.0
+package require Pextlib 1.0
+
+##
+# Receipts Code supporting flat-files
+##
+namespace eval receipt_flat {
+
+# receipt_lastref is the last attributed index of receipts.
+variable receipt_lastref -1
+# maps port name,version,variants to the corresponding receipt ref
+variable ref_index
+
+##
+#
+# Create a new entry and return its reference number.
+# The reference number allows us to retrieve the receipt array.
+proc new_entry {} {
+	variable receipt_lastref
+	incr receipt_lastref
+
+	variable receipt_$receipt_lastref
+	array set receipt_$receipt_lastref {}
+
+	return $receipt_lastref
+}
+
+##
+#
+# Get the path to the receipt in HEAD format.
+# Remark: this code doesn't work for some ports.
+# That's why we moved to the new path format in the first place.
+#
+# portname			the name of the port.
+# portversion		the version for this port, 0 if unknown.
+# return the path to the file or "" if the file couldn't be found.
+proc get_head_entry_receipt_path {portname portversion} {
+    global macports::registry.path
+
+    # regex match case
+    if {$portversion == 0} {
+	set x [glob -nocomplain -directory [file join ${macports::registry.path} receipts] -- ${portname}-*]
+	if {[string length $x]} {
+	    set matchfile [lindex $x 0]
+		# Remove trailing .bz2, if any.
+		regexp {(.*)\.bz2$} $matchfile match matchfile
+	} else {
+	    set matchfile ""
+	}
+    } else {
+	set matchfile [file join ${macports::registry.path} receipts ${portname}-${portversion}]
+    }
+
+    # Might as well bail out early if no file to match
+    if {![string length $matchfile]} {
+		return ""
+    }
+
+    if {[file exists $matchfile] || [file exists ${matchfile}.bz2]} {
+		return $matchfile
+    }
+    return ""
+}
+
+##
+#
+# Open an existing entry and return its reference number.
+proc open_entry {name {version ""} {revision 0} {variants ""}} {
+	global macports::registry.installtype
+	global macports::registry.path
+	variable ref_index
+	
+	# if this entry is already open, just return the reference
+	if {[info exists ref_index($name,$version,$revision,$variants)]} {
+	    return $ref_index($name,$version,$revision,$variants)
+	}
+
+	set receipt_path [file join ${macports::registry.path} receipts ${name}]
+
+	# If the receipt path ${name} doesn't exist, then the receipt probably is
+	# in the old HEAD format.
+	if { ![file isdirectory $receipt_path] } {
+		set receipt_file [get_head_entry_receipt_path $name $version]
+		
+		if {![string length $receipt_file]} {
+			if { $version != "" } {
+				return -code error "Registry error: ${name} @${version}_${revision}${variants} not registered as installed."
+			} else {
+				return -code error "Registry error: ${name} not registered as installed."
+			}
+		}
+		
+		# Extract the version from the path.
+		if { $version == "" } {
+			set theFileName [file tail $receipt_file]
+			regexp "^$name-(.*)\$" $theFileName match version
+		}
+	} else {
+		# If version wasn't specified, find out the version number.  This will
+		# depend on which installtype mode we're in, "direct" or "image"	
+		if { $version == "" } {
+			# xxx: If we're in image mode, we really should have had the 
+			# version given to us.  How should we handle this?
+			set x [glob -nocomplain -directory ${receipt_path} *]
+			if { [string length $x] } {
+				set v [lindex [file split [lindex $x 0]] end]
+				regexp {([-_a-zA-Z0-9\.]+)_([0-9]*)([+-_a-zA-Z0-9]*)$} $v match version revision variants
+			} else {
+				return -code error "Registry error: ${name} not registered as installed."
+			}
+		}
+	
+		if { ![entry_exists $name $version $revision $variants] } {
+			return -code error "Registry error: ${name} @${version}_${revision}${variants} not registered as installed."
+		}
+	
+		set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
+	
+		set receipt_file [file join ${receipt_path} receipt]
+	}
+
+	if { [file exists ${receipt_file}.bz2] && [file exists ${registry::autoconf::bzip2_path}] } {
+		set receipt_file ${receipt_file}.bz2
+		set receipt_contents [exec ${registry::autoconf::bzip2_path} -d -c ${receipt_file}]
+	} elseif { [file exists ${receipt_file}] } {
+		set receipt_handle [open ${receipt_file} r]
+		set receipt_contents [read $receipt_handle]
+		close $receipt_handle
+	} else {
+		return -code error "Registry error: receipt for ${name} @${version}_${revision}${variants} seems to be compressed, but bzip2 couldn't be found."
+	}
+
+	set ref [new_entry]
+	variable receipt_$ref
+
+	# Determine the format of the receipt.
+	if {[string match "# Format: var value ...*" $receipt_contents]} {
+		# This is old HEAD format.
+		# We convert it and we save it.
+		# tell the user
+		ui_msg "Converting receipt for $name-$version to new format"
+
+		convert_entry_from_HEAD $name $version $revision $variants $receipt_contents $ref
+		
+		# move the old receipt
+		set convertedDirPath [file join ${macports::registry.path} receipts_converted]
+		file mkdir $convertedDirPath
+		file rename -- $receipt_file $convertedDirPath
+	} elseif {[string match "# Version: *" $receipt_contents]} {
+		# This is new format
+		if {![string match "# Version: 1.0*" $receipt_contents]} {
+			return -code error "Registry error: receipt ${name} @${version}_${revision}${variants} is in an unknown format (version too new?)."
+		}
+
+		# Remove any line starting with #
+		while {[regexp "(^|\n)#.*\n(.*)\$" $receipt_contents match foo receipt_contents]} {}
+		if {[catch {array set receipt_$ref $receipt_contents} rcpterr]} {
+			ui_error "Malformed receipt for ${name} @${version}_${revision}${variants}"
+			ui_error "receipt_contents = '$receipt_contents'"
+			error $rcpterr
+		}
+	} else {
+		# This is old Images format
+
+		# Iterate on the elements of $receipt_contents and add them to the list.
+		foreach pair $receipt_contents {
+			array set receipt_[set ref] $pair
+		}
+	}
+	
+	set ref_index($name,$version,$revision,$variants) $ref
+	
+	return $ref
+}
+
+##
+#
+# Convert an entry from HEAD old format.
+# HEAD old format is a file in the key,value format with key and values being on the
+# same line separated with a space.
+# This typically is read with an options-like approach.
+# This conversion routine also appends the contents to the file map.
+#
+# name				the name of the port to convert.
+# version			the version of the port to convert.
+# revision			the revision of the port to convert (probably inaccurate).
+# variants			the variants of the port to convert (idem).
+# receipt_contents	the content of the old receipt file.
+# ref				reference of the target receipt array where the content must be put.
+proc convert_entry_from_HEAD {name version revision variants receipt_contents ref} {
+	variable receipt_$ref
+	
+	# First set default value for stuff that aren't in the receipt.
+	array set receipt_[set ref] [list name $name]
+	array set receipt_[set ref] [list version $version]
+	array set receipt_[set ref] [list revision $revision]
+	array set receipt_[set ref] [list variants $variants]
+	array set receipt_[set ref] [list installtype direct]
+	array set receipt_[set ref] [list receipt_f receipt_flat]
+	array set receipt_[set ref] [list active 1]
+	
+	# Then start a new interpreter to read the content of the portfile.
+	interp create theConverterInterpreter
+	# Just ignore prefix.
+	interp eval theConverterInterpreter "proc prefix {args} {\n\
+	}"
+	# Also ignore run_depends.
+	interp eval theConverterInterpreter "proc run_depends {args} {\n\
+	}"
+	interp eval theConverterInterpreter "proc categories {args} {\n\
+		global theConvertedReceipt\n\
+		array set theConvertedReceipt \[list categories \$args\]\n\
+	}"
+	interp eval theConverterInterpreter "proc description {args} {\n\
+		global theConvertedReceipt\n\
+		array set theConvertedReceipt \[list description \$args\]\n\
+	}"
+	interp eval theConverterInterpreter "proc long_description {args} {\
+		global theConvertedReceipt\n\
+		array set theConvertedReceipt \[list long_description \$args\]\n\
+	}"
+	interp eval theConverterInterpreter "proc homepage {args} {\n\
+		global theConvertedReceipt\n\
+		array set theConvertedReceipt \[list homepage \$args\]\n\
+	}"
+	# contents already is a list.
+	interp eval theConverterInterpreter "proc contents {args} {\n\
+		variable contents\n\
+		set contents \[lindex \$args 0\]\n\
+	}"
+	interp eval theConverterInterpreter "array set theConvertedReceipt {}"
+	interp eval theConverterInterpreter "variable contents"
+	interp eval theConverterInterpreter $receipt_contents
+	array set receipt_$ref [interp eval theConverterInterpreter "array get theConvertedReceipt"]
+	set contents [interp eval theConverterInterpreter "set contents"]
+	interp delete theConverterInterpreter
+
+	# Append the contents list to the file map (only the files).
+	set theActualContents [list]
+	foreach file $contents {
+		if {[llength $file]} {
+			set theFilePath [lindex $file 0]
+			if {[file isfile $theFilePath]} {
+				set previousPort [file_registered $theFilePath]
+				if {$previousPort != 0} {
+					ui_warn "Conflict detected for file $theFilePath between $previousPort and $name."
+				}
+				if {[catch {register_file $theFilePath $name}]} {
+					ui_warn "An error occurred while adding $theFilePath to the file_map database."
+				}
+			} elseif {![file exists $theFilePath]} {
+				ui_warn "Port $name refers to $theFilePath which doesn't exist."
+			}
+			lappend theActualContents $file
+		} else {
+			ui_warn "Port $name contents list includes an empty element."
+		}
+	}
+	
+	property_store $ref contents $theActualContents
+
+	# Save the file_map afterwards
+	write_file_map
+	close_file_map
+	
+	# Save the entry to new format.
+	write_entry $ref $name $version $revision $variants
+}
+
+##
+#
+# Write the entry that was previously created.
+#
+# ref				the reference number of the entry.
+# name				the name of the port.
+# version			the version of the port.
+# variants			the variants of the port.
+proc write_entry {ref name version {revision 0} {variants ""}} {
+	global macports::registry.installtype
+	variable receipt_$ref
+
+	set receipt_contents [array get receipt_$ref]
+
+	set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
+	set receipt_file [file join ${receipt_path} receipt]
+
+	if { ![file isdirectory ${receipt_path}] } {
+		file mkdir ${receipt_path}
+	}
+
+	set receipt_handle [open ${receipt_file}.tmp w 0644]
+	puts $receipt_handle "# Version: 1.0"
+	puts $receipt_handle $receipt_contents
+	close $receipt_handle
+
+	if { [file exists ${receipt_file}] } {
+		file delete -force -- "${receipt_file}"
+	} elseif { [file exists ${receipt_file}.bz2] } {
+		file delete -force -- "${receipt_file}.bz2"
+	}
+
+	file rename -force -- "${receipt_file}.tmp" "${receipt_file}"
+
+	if { [file exists ${receipt_file}] && [file exists ${registry::autoconf::bzip2_path}] && ![info exists registry.nobzip] } {
+		system "${registry::autoconf::bzip2_path} -f ${receipt_file}"
+	}
+
+	return 1
+}
+
+# Check to see if an entry exists
+proc entry_exists {name version {revision 0} {variants ""}} {
+	global macports::registry.path
+
+	set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
+	set receipt_file [file join ${receipt_path} receipt]
+
+	if { [file exists $receipt_file] } {
+		return 1
+	} elseif { [file exists ${receipt_file}.bz2] } {
+		return 1
+	}
+
+	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.
+# This replaces any property that had the same key previously in the receipt.
+#
+# ref			reference number for the receipt.
+# property		key for the property to store.
+# value			value for the property to store.
+proc property_store {ref property value} {
+	variable receipt_$ref
+	
+	array set receipt_[set ref] [list $property $value]
+
+	return 1
+}
+
+##
+#
+# Retrieve a property from a receipt that was loaded in memory.
+#
+# ref			reference number for the receipt.
+# property		key for the property to retrieve.
+#
+proc property_retrieve {ref property} {
+	variable receipt_$ref
+
+	set theCouple [array get receipt_[set ref] $property]
+	if {[llength $theCouple] != 2} {
+		return 0
+	} else {
+		return [lindex $theCouple 1]
+	}
+}
+
+# Delete an entry
+proc delete_entry {name version {revision 0} {variants ""}} {
+	global macports::registry.path
+	variable ref_index
+	
+	# if the entry is loaded, purge it
+	if {[info exists ref_index($name,$version,$revision,$variants)]} {
+	    set ref $ref_index($name,$version,$revision,$variants)
+	    variable receipt_${ref}
+	    array unset receipt_${ref}
+	    array unset ref_index "$name,$version,$revision,$variants"
+	}
+
+	set receipt_path [file join ${macports::registry.path} receipts ${name} ${version}_${revision}${variants}]
+	if { [file exists ${receipt_path}] } {
+		# remove port receipt directory
+		ui_debug "deleting directory: ${receipt_path}"
+		file delete -force -- ${receipt_path}
+		# remove port receipt parent directory (if empty)
+		set receipt_dir [file join ${macports::registry.path} receipts ${name}]
+		if { [file isdirectory ${receipt_dir}] } {
+			# 0 item means empty.
+			if { [llength [readdir ${receipt_dir}]] == 0 } {
+				ui_debug "deleting directory: ${receipt_dir}"
+				file delete -force -- ${receipt_dir}
+			} else {
+				ui_debug "${receipt_dir} is not empty"
+			}
+		}
+		return 1
+	} else {
+		return 0
+	}
+}
+
+# Return all installed ports
+#
+# If version is "", return all ports of that version.
+# Otherwise, return only ports that exactly match this version.
+# What we call version here is version_revision+variants.
+# Note: at some point we need to change these APIs and support something
+# like selecting on the version or selecting variants in any order.
+proc installed {{name ""} {version ""}} {
+	global macports::registry.path
+
+	set query_path [file join ${macports::registry.path} receipts]
+	
+	if { $name == "" } {
+		set query_path [file join ${query_path} *]
+		if { $version == "" } {
+			set query_path [file join ${query_path} *]
+		}
+		# [PG] Huh?
+	} else {
+	    # We want to be case-insensitive but case-preserving, so the name gets
+	    # returned with the correct case even if it's wrong when given. To get the
+	    # correct case on a case-insensitive FS, we have to list the directory and
+	    # compare against each entry.
+	    set name_path [file join ${query_path} *]
+	    set name_entries [glob -nocomplain -types d ${name_path}]
+	    foreach entry $name_entries {
+	        set basename [file tail $entry]
+	        if {[string equal -nocase $basename $name]} {
+	            set name $basename
+	            break
+	        }
+	    }
+		set query_path [file join ${query_path} ${name}]
+		if { $version != "" } {
+			set query_path [file join ${query_path} ${version}]
+		} else {
+			set query_path [file join ${query_path} *]
+		}
+	}
+
+	set x [glob -nocomplain -types d ${query_path}]
+	set rlist [list]
+	foreach p $x {
+		if {![file isfile [file join $p receipt.bz2]] && ![file isfile [file join $p receipt]]} {
+			continue
+		}
+		set plist [list]
+		regexp {([-_a-zA-Z0-9\.]+)_([0-9]*)([+-_a-zA-Z0-9]*)$} [lindex [file split $p] end] match version revision variants
+		lappend plist [lindex [file split $p] end-1]
+		lappend plist $version
+		lappend plist $revision
+		lappend plist $variants
+		lappend rlist $plist
+	}
+
+	# append the ports in old HEAD format.
+	if { $name == "" } {
+		set query_path [file join ${macports::registry.path} receipts *]
+	} else {
+		set query_path [file join ${macports::registry.path} receipts ${name}-*]
+	}
+    set receiptglob [glob -nocomplain -types f ${query_path}]
+    foreach receipt_file $receiptglob {
+		set theFileName [file tail $receipt_file]
+
+    	# Remark: these regexes do not always work.
+   		set theName ""
+    	if { $name == "" } {
+			regexp {^(.*)-(.*)$} $theFileName match theName version
+    	} else {
+			regexp "^($name)-(.*)\$" $theFileName match theName version
+		}
+		
+		# Skip if the name is empty, i.e. if it didn't match.
+		if {[string length $theName]} {
+			set plist [list]
+			lappend plist $theName
+			
+			# Remove .bz2 suffix, if present.
+			regexp {^(.*)\.bz2$} $version match version
+			lappend plist $version
+			lappend plist 0
+			lappend plist ""
+			lappend rlist $plist
+		}
+	}
+
+	return $rlist
+}
+
+# File Map stuff
+
+##
+# open the file map and store a reference to it into variable file_map.
+# convert from the old format if required.
+#
+proc open_file_map {{readonly 0}} {
+	global macports::registry.path
+	variable file_map
+
+	set receipt_path [file join ${macports::registry.path} receipts]
+	set map_file [file join ${receipt_path} file_map]
+
+	# Don't reopen it (it actually would deadlock us), unless it was open r/o.
+	# and we want it r/w.
+	if { [info exists file_map] } {
+		if { $readonly == 0 } {
+			if {[filemap isreadonly file_map]} {
+				filemap close file_map
+				filemap open file_map ${map_file}.db
+			}
+		}
+		return 0
+	}
+
+	set old_filemap [list]
+
+	if { ![file exists ${map_file}.db] } {
+		# Convert to new format
+		if { [file exists ${map_file}.bz2] && [file exists ${registry::autoconf::bzip2_path}] } {
+			set old_filemap [exec ${registry::autoconf::bzip2_path} -d -c ${map_file}.bz2]
+		} elseif { [file exists $map_file] } {		
+			set map_handle [open ${map_file} r]
+			set old_filemap [read $map_handle]
+			close $map_handle
+		}
+	}
+
+	if { [llength $old_filemap] > 0 } {
+		# Translate from old format.
+		# Open the map (new format)
+		filemap open file_map ${map_file}.db
+		
+		# Tell the user.
+		ui_msg "Converting file map to new format (this may take a while)"
+
+		foreach f $old_filemap {
+			filemap set file_map [lindex $f 0] [lindex $f 1]
+		}
+		
+		# Save it afterwards.
+		filemap save file_map
+
+		# reopen it r/o if we wanted it r/o.
+	} else {
+		# open it directly
+		if { $readonly == 1 } {
+			filemap open file_map ${map_file}.db readonly
+		} else {
+			filemap open file_map ${map_file}.db
+		}
+	}
+	
+	return 0
+}
+
+##
+# determine if a file is registered in the file map, and if it is,
+# get its port.
+# open the file map if required.
+#
+# - file	the file to test
+# return the 0 if the file is not registered, the name of the port otherwise.
+#
+proc file_registered {file} {
+	variable file_map
+
+	open_file_map 1
+
+	if {[filemap exists file_map $file]} {
+		return [filemap get file_map $file]
+	} else {
+		return 0
+	}
+}
+
+##
+# determine if a port is registered in the file map, and if it is,
+# get its installed (activated) files.
+# convert the port if required.
+# open the file map if required.
+#
+# - port	the port to test
+# return the 0 if the port is not registered, the list of its files otherwise.
+#
+proc port_registered {name} {
+	# Trust the file map first.
+	variable file_map
+
+	open_file_map 1
+
+	set files [filemap list file_map $name]
+
+	if { [llength $files] > 0 } {
+		return $files
+	} else {
+		# Is port installed?
+		set matchingPorts [installed $name]
+		if { [llength $matchingPorts] } {
+			# Convert the port and retry.
+			open_entry $name
+			
+			set files [filemap list file_map $name]
+			
+			return $files
+		} else {
+			return 0
+		}
+	}
+}
+
+##
+# register a file in the file map.
+# open the file map if required.
+#
+# - file	the file to register
+# - port	the port to associate with the file
+#
+proc register_file {file port} {
+	variable file_map
+
+	open_file_map
+
+	if { [file type $file] == "link" } {
+		ui_debug "Adding link to file_map: $file for: $port"
+	} else {
+		ui_debug "Adding file to file_map: $file for: $port"
+	}
+	filemap set file_map $file $port
+}
+
+##
+# register all the files in the list 'files' in the filemap.
+# open the file map if required.
+#
+# - files	the list of files to register
+# - port	the port to associate the files with
+#
+proc register_bulk_files {files port} {
+	variable file_map
+
+	open_file_map
+
+	foreach f $files {
+		set file [lindex $f 0]
+		if { [file type $file] == "link" } {
+			ui_debug "Adding link to file_map: $file for: $port"
+		} else {
+			ui_debug "Adding file to file_map: $file for: $port"
+		}
+		filemap set file_map $file $port
+	}
+}
+
+##
+# unregister a file from the file map.
+# open the file map if required.
+#
+# - file	the file to unregister
+#
+proc unregister_file {file} {
+	variable file_map
+
+	open_file_map
+
+	ui_debug "Removing entry from file_map: $file"
+	filemap unset file_map $file
+}
+
+##
+# save the file map to disk.
+# do not do anything if the file map wasn't open.
+#
+# always return 1
+#
+proc write_file_map {args} {
+	variable file_map
+
+	if { [info exists file_map] } {
+		open_file_map
+		filemap save file_map
+	}
+
+	return 1
+}
+
+##
+# close the file map.
+# important to do this so the lock is released.
+# do not do anything if the file map wasn't open.
+#
+proc close_file_map {args} {
+	variable file_map
+
+	if { [info exists file_map] } {
+		filemap close file_map
+	}
+}
+
+# Dependency Map Code
+proc open_dep_map {args} {
+	global macports::registry.path
+	variable dep_map
+
+	set receipt_path [file join ${macports::registry.path} receipts]
+
+	set map_file [file join ${receipt_path} dep_map]
+
+	if { [file exists ${map_file}.bz2] && [file exists ${registry::autoconf::bzip2_path}] } {
+		set dep_map [exec ${registry::autoconf::bzip2_path} -d -c ${map_file}.bz2]
+	} elseif { [file exists ${map_file}] } {
+		set map_handle [open ${map_file} r]
+		set dep_map [read $map_handle]
+		close $map_handle
+	} else {
+	    set dep_map [list]
+	}
+	if { ![llength $dep_map] > 0 } {
+		set dep_map [list]
+	}
+}
+
+# List all ports this one depends on
+proc list_depends {name} {
+	variable dep_map
+	if { [llength $dep_map] < 1 && [info exists dep_map] } {
+		open_dep_map
+	}
+	set rlist [list]
+	foreach de $dep_map {
+		if { $name == [lindex $de 2] } {
+			lappend rlist $de
+		}
+	}
+	return $rlist
+}
+
+# List all the ports that depend on this port
+proc list_dependents {name} {
+	variable dep_map
+	if { [llength $dep_map] < 1 && [info exists dep_map] } {
+		open_dep_map
+	}
+	set rlist [list]
+	foreach de $dep_map {
+		if { $name == [lindex $de 0] } {
+			lappend rlist $de
+		}
+	}
+	return $rlist
+}
+
+proc register_dep {dep type port} {
+	variable dep_map
+	set newdep [list $dep $type $port]
+	# slow, but avoids duplicate entries building up
+	if {[lsearch -exact $dep_map $newdep] == -1} {
+	    lappend dep_map $newdep
+	}
+}
+
+proc unregister_dep {dep type port} {
+	variable dep_map
+	set new_map [list]
+	foreach de $dep_map {
+		if { $de != [list $dep $type $port] } {
+			lappend new_map $de
+		}
+	}
+	set dep_map $new_map
+}
+
+# remove duplicate entries from the dep_map
+# (could be put there by older versions of MacPorts)
+proc clean_dep_map {args} {
+    variable dep_map
+    set new_map [list]
+    set oldlen [llength $dep_map]
+    ui_debug "Current dep_map has $oldlen entries"
+    foreach de $dep_map {
+        if {[lsearch -exact $new_map $de] == -1} {
+            lappend new_map $de
+        } else {
+            ui_debug "Removing $de from dep_map"
+        }
+    }
+    set dep_map $new_map
+    
+    set newlen [llength $dep_map]
+    set diff [expr $oldlen - $newlen]
+    ui_debug "New dep_map has $newlen entries"
+    ui_info "Removed $diff duplicate entries from the dependency map"
+}
+
+proc write_dep_map {args} {
+	global macports::registry.path
+	variable dep_map
+
+	set receipt_path [file join ${macports::registry.path} receipts]
+
+	set map_file [file join ${receipt_path} dep_map]
+
+	set map_handle [open ${map_file}.tmp w 0644]
+	puts $map_handle $dep_map
+	close $map_handle
+
+    # don't both checking for presence, file delete doesn't error if file doesn't exist
+    file delete -- ${map_file} ${map_file}.bz2
+
+    file rename -- ${map_file}.tmp ${map_file}
+
+	if { [file exists ${map_file}] && [file exists ${registry::autoconf::bzip2_path}] && ![info exists registry.nobzip] } {
+		system "${registry::autoconf::bzip2_path} -f ${map_file}"
+	}
+
+	return 1
+}
+
+# End of receipt_flat namespace
+}
+

Copied: trunk/base/src/registry2.0/registry.tcl (from rev 63371, trunk/base/src/registry1.0/registry.tcl)
===================================================================
--- trunk/base/src/registry2.0/registry.tcl	                        (rev 0)
+++ trunk/base/src/registry2.0/registry.tcl	2010-02-04 00:46:00 UTC (rev 63398)
@@ -0,0 +1,396 @@
+# registry.tcl
+#
+# Copyright (c) 2004 Will Barton <wbb4 at opendarwin.org>
+# Copyright (c) 2002 Apple Computer, 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 Computer, 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 registry 1.0
+
+package require macports 1.0
+package require receipt_flat 1.0
+package require portimage 2.0
+package require portuninstall 2.0
+package require msgcat
+
+namespace eval registry {
+
+# Begin creating a new registry entry for the port version_revision+variant
+# This process assembles the directory name and creates a receipt dlist
+proc new_entry {name version {revision 0} {variants ""} {epoch 0} } {
+	global macports::registry.path macports::registry.format macports::registry.installtype macports::prefix
+
+	
+	# Make sure we don't already have an entry in the Registry for this
+	# port version_revision+variants
+	if {![entry_exists $name $version $revision $variants] } {
+
+		set ref [${macports::registry.format}::new_entry]
+
+		property_store $ref name $name
+		property_store $ref version $version
+		property_store $ref revision $revision
+		property_store $ref variants $variants
+		property_store $ref epoch $epoch
+		# Trick to have a portable GMT-POSIX epoch-based time.
+		# (because we'll compare this with a file mtime).
+		property_store $ref date [expr [clock scan now -gmt true] - [clock scan "1970-1-1 00:00:00" -gmt true]]
+		property_store $ref installtype ${macports::registry.installtype}
+		property_store $ref receipt_f ${macports::registry.format}
+		if { ${macports::registry.installtype} == "image" } {
+			set imagedir [file join ${macports::registry.path} software ${name} ${version}_${revision}${variants}]
+			property_store $ref imagedir $imagedir
+			property_store $ref active 0
+		}
+
+		return $ref
+	} else {
+		return -code error "Registry error: ${name} @${version}_${revision}${variants} already registered as installed.  Please uninstall it first."
+	}
+}
+
+# Check to see if an entry exists in the registry.  This is passed straight 
+# through to the receipts system
+proc entry_exists {name version {revision 0} {variants ""}} {
+	global macports::registry.format
+	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
+	
+	set name [property_retrieve $ref name]
+	set version [property_retrieve $ref version]
+	set revision [property_retrieve $ref revision]
+	set variants [property_retrieve $ref variants]
+	set epoch [property_retrieve $ref epoch]
+	set contents [property_retrieve $ref contents]
+
+	${macports::registry.format}::write_entry $ref $name $version $revision $variants
+
+}
+
+# Delete an entry from the registry.
+proc delete_entry {ref} {
+	global macports::registry.format
+	
+	set name [property_retrieve $ref name]
+	set version [property_retrieve $ref version]
+	set revision [property_retrieve $ref revision]
+	set variants [property_retrieve $ref variants]
+	
+	${macports::registry.format}::delete_entry $name $version $revision $variants
+	
+}
+
+# Open a registry entry.
+proc open_entry {name {version ""} {revision 0} {variants ""}} {
+	global macports::registry.format
+
+	return [${macports::registry.format}::open_entry $name $version $revision $variants]
+
+}
+
+# Store a property with the open registry entry.
+proc property_store {ref property value} {
+	global macports::registry.format
+	${macports::registry.format}::property_store $ref $property $value
+}
+
+# Retrieve a property from the open registry entry.
+proc property_retrieve {ref property} {
+	global macports::registry.format
+	return [${macports::registry.format}::property_retrieve $ref $property]
+}
+
+# If only one version of the port is installed, this process returns that
+# version's parts.  Otherwise, it lists the versions installed and exists.
+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]
+	}
+	return $rlist
+}
+
+# Return a list with the active version of a port (or the active versions of
+# 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 { [llength $rlist] < 1 } {
+		if { $name == "" } {
+			return -code error "Registry error: No ports registered as active."
+		} else {
+			return -code error "Registry error: $name not registered as installed & active."
+		}
+	}
+	return $rlist
+}
+
+proc location {portname portversion} {
+	set ilist [registry::installed $portname $portversion]
+
+	if { [llength $ilist] > 1 } {
+		puts "The following versions of $portname are currently installed:"
+		foreach i $ilist { 
+			set iname [lindex $i 0]
+			set iversion [lindex $i 1]
+			set irevision [lindex $i 2]
+			set ivariants [lindex $i 3]
+			set iactive [lindex $i 4]
+			if { $iactive == 0 } {
+				puts "	$iname @${iversion}_${irevision}${ivariants}"
+			} elseif { $iactive == 1 } {
+				puts "	$iname @${iversion}_${irevision}${ivariants} (active)"
+			}
+		}
+		return -1
+	} else {
+		return [lindex $ilist 0]
+	}
+}	
+
+
+# File Map Code
+proc open_file_map {args} {
+	global macports::registry.format
+	return [${macports::registry.format}::open_file_map $args]
+}
+
+proc file_registered {file} {
+	global macports::registry.format
+	return [${macports::registry.format}::file_registered $file]
+}
+
+proc port_registered {name} {
+	global macports::registry.format
+	return [${macports::registry.format}::port_registered $name]
+}
+
+proc register_file {file port} {
+	global macports::registry.format
+	return [${macports::registry.format}::register_file $file $port]
+}
+
+proc register_bulk_files {files port} {
+	global macports::registry.format
+	open_file_map
+        set r [${macports::registry.format}::register_bulk_files $files $port]
+	write_file_map
+	close_file_map
+	return $r
+}
+
+proc unregister_file {file} {
+	global macports::registry.format
+	return [${macports::registry.format}::unregister_file $file]
+}
+
+proc write_file_map {args} {
+	global macports::registry.format
+	return [${macports::registry.format}::write_file_map $args]
+}
+
+proc close_file_map {args} {
+	global macports::registry.format
+	return [${macports::registry.format}::close_file_map $args]
+}
+
+# Dependency Map Code
+proc register_dependencies {deps name} {
+
+	open_dep_map
+	foreach dep $deps {
+		# We expect the form type:regexp:port to come in, but we don't need to 
+		# store it that way in the dep map.
+		set type [lindex [split $dep :] 0]
+		set depport [lindex [split $dep :] end]
+		register_dep $depport $type $name
+	}
+	write_dep_map
+}
+
+proc unregister_dependencies {name} {
+
+	open_dep_map
+	foreach dep [list_depends $name] {
+		unregister_dep [lindex $dep 0] [lindex $dep 1] [lindex $dep 2]
+	}
+	write_dep_map
+}
+
+proc open_dep_map {args} {
+	global macports::registry.format
+	return [${macports::registry.format}::open_dep_map $args]
+}
+
+##
+#
+# From a file name, return a list representing data currently known about the file.
+# This list is a 6-tuple of the form:
+# 0: file path
+# 1: uid
+# 2: gid
+# 3: mode
+# 4: size
+# 5: md5 checksum information
+#
+# fname		a path to a given file.
+# return a 6-tuple about this file.
+proc fileinfo_for_file {fname} {
+    # Add the link to the registry, not the actual file.
+    # (we won't store the md5 of the target of links since it's meaningless
+    # and $statvar(mode) tells us that links are links).
+    if {![catch {file lstat $fname statvar}]} {
+	if {[file isfile $fname] && [file type $fname] != "link"} {
+	    if {[catch {md5 file $fname} md5sum] == 0} {
+		# Create a line that matches md5(1)'s output
+		# for backwards compatibility
+		set line "MD5 ($fname) = $md5sum"
+		return [list $fname $statvar(uid) $statvar(gid) $statvar(mode) $statvar(size) $line]
+	    }
+	} else {
+	    return  [list $fname $statvar(uid) $statvar(gid) $statvar(mode) $statvar(size) "MD5 ($fname) NONE"]
+	}
+    }
+    return {}
+}
+
+##
+#
+# From a list of files, return a list of information concerning these files.
+# The information is obtained through fileinfo_for_file.
+#
+# flist		the list of file to get information about.
+# return a list of 6-tuples described in fileinfo_for_file.
+proc fileinfo_for_index {flist} {
+	global prefix
+
+	set rval [list]
+	foreach file $flist {
+		if {[string index $file 0] != "/"} {
+			set file [file join $prefix $file]
+		}
+		lappend rval [fileinfo_for_file $file]
+	}
+	return $rval
+}
+
+# List all ports this one depends on
+proc list_depends {name} {
+	global macports::registry.format
+	return [${macports::registry.format}::list_depends $name]
+}
+
+# List all the ports that depend on this port
+proc list_dependents {name} {
+	global macports::registry.format
+	return [${macports::registry.format}::list_dependents $name]
+}
+
+proc register_dep {dep type port} {
+	global macports::registry.format
+	return [${macports::registry.format}::register_dep $dep $type $port]
+}
+
+proc unregister_dep {dep type port} {
+	global macports::registry.format
+	return [${macports::registry.format}::unregister_dep $dep $type $port]
+}
+
+proc clean_dep_map {args} {
+    global macports::registry.format
+    return [${macports::registry.format}::clean_dep_map $args]
+}
+
+proc write_dep_map {args} {
+	global macports::registry.format
+	return [${macports::registry.format}::write_dep_map $args]
+}
+
+
+# End of registry namespace
+}
+

Copied: trunk/base/src/registry2.0/registry_autoconf.tcl.in (from rev 63371, trunk/base/src/registry1.0/registry_autoconf.tcl.in)
===================================================================
--- trunk/base/src/registry2.0/registry_autoconf.tcl.in	                        (rev 0)
+++ trunk/base/src/registry2.0/registry_autoconf.tcl.in	2010-02-04 00:46:00 UTC (rev 63398)
@@ -0,0 +1,35 @@
+# registry_autoconf.tcl.in
+# $Id$
+#
+# Copyright (c) 2007 Kevin Ballard <eridius at macports.org>
+# 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 Computer, 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 registry 1.0
+
+namespace eval registry::autoconf {
+    variable bzip2_path "@BZIP2@"
+}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100203/af85f1b5/attachment-0001.html>


More information about the macports-changes mailing list