[50647] branches/images-and-archives/base/src
blb at macports.org
blb at macports.org
Tue May 5 17:30:22 PDT 2009
Revision: 50647
http://trac.macports.org/changeset/50647
Author: blb at macports.org
Date: 2009-05-05 17:30:21 -0700 (Tue, 05 May 2009)
Log Message:
-----------
Move activate/deactivate into registry namespace instead of a dedicated
portimage:: one
Modified Paths:
--------------
branches/images-and-archives/base/src/macports1.0/macports.tcl
branches/images-and-archives/base/src/port/port.tcl
branches/images-and-archives/base/src/registry1.0/Makefile
branches/images-and-archives/base/src/registry1.0/portuninstall.tcl
branches/images-and-archives/base/src/registry1.0/registry.tcl
Removed Paths:
-------------
branches/images-and-archives/base/src/registry1.0/portimage.tcl
Modified: branches/images-and-archives/base/src/macports1.0/macports.tcl
===================================================================
--- branches/images-and-archives/base/src/macports1.0/macports.tcl 2009-05-06 00:27:03 UTC (rev 50646)
+++ branches/images-and-archives/base/src/macports1.0/macports.tcl 2009-05-06 00:30:21 UTC (rev 50647)
@@ -796,8 +796,8 @@
$workername alias registry_delete registry::delete_entry
$workername alias registry_exists registry::entry_exists
$workername alias registry_exists_for_name registry::entry_exists_for_name
- $workername alias registry_activate portimage::activate
- $workername alias registry_deactivate portimage::deactivate
+ $workername alias registry_activate registry::activate
+ $workername alias registry_deactivate registry::deactivate
$workername alias registry_register_deps registry::register_dependencies
$workername alias registry_fileinfo_for_index registry::fileinfo_for_index
$workername alias registry_bulk_register_files registry::register_bulk_files
@@ -2396,7 +2396,7 @@
# deactivate version_active
if {$is_dryrun eq "yes"} {
ui_msg "Skipping deactivate $portname @${version_active}_${revision_active} (dry run)"
- } elseif {[catch {portimage::deactivate $portname ${version_active}_${revision_active}${variant_active} $optionslist} result]} {
+ } elseif {[catch {registry::deactivate $portname ${version_active}_${revision_active}${variant_active} $optionslist} result]} {
global errorInfo
ui_debug "$errorInfo"
ui_error "Deactivating $portname ${version_active}_${revision_active} failed: $result"
Modified: branches/images-and-archives/base/src/port/port.tcl
===================================================================
--- branches/images-and-archives/base/src/port/port.tcl 2009-05-06 00:27:03 UTC (rev 50646)
+++ branches/images-and-archives/base/src/port/port.tcl 2009-05-06 00:30:21 UTC (rev 50647)
@@ -1805,7 +1805,7 @@
return 1
}
foreachport $portlist {
- if { [catch {portimage::activate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
+ if { [catch {registry::activate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
global errorInfo
ui_debug "$errorInfo"
break_softcontinue "port activate failed: $result" 1 status
@@ -1822,7 +1822,7 @@
return 1
}
foreachport $portlist {
- if { [catch {portimage::deactivate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
+ if { [catch {registry::deactivate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
global errorInfo
ui_debug "$errorInfo"
break_softcontinue "port deactivate failed: $result" 1 status
Modified: branches/images-and-archives/base/src/registry1.0/Makefile
===================================================================
--- branches/images-and-archives/base/src/registry1.0/Makefile 2009-05-06 00:27:03 UTC (rev 50646)
+++ branches/images-and-archives/base/src/registry1.0/Makefile 2009-05-06 00:30:21 UTC (rev 50647)
@@ -1,6 +1,6 @@
INSTALLDIR= ${DESTDIR}${datadir}/macports/Tcl/registry1.0
-SRCS= registry.tcl registry_autoconf.tcl receipt_flat.tcl receipt_sqlite.tcl portimage.tcl portuninstall.tcl
+SRCS= registry.tcl registry_autoconf.tcl receipt_flat.tcl receipt_sqlite.tcl portuninstall.tcl
include ../../Mk/macports.autoconf.mk
Deleted: branches/images-and-archives/base/src/registry1.0/portimage.tcl
===================================================================
--- branches/images-and-archives/base/src/registry1.0/portimage.tcl 2009-05-06 00:27:03 UTC (rev 50646)
+++ branches/images-and-archives/base/src/registry1.0/portimage.tcl 2009-05-06 00:30:21 UTC (rev 50647)
@@ -1,440 +0,0 @@
-# portimage.tcl
-# $Id$
-#
-# 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 portimage 1.0
-
-package require registry 1.0
-package require macports 1.0
-package require Pextlib 1.0
-
-set UI_PREFIX "--> "
-
-#
-# Port Images are basically just installations of the destroot of a port into
-# ${macports::registry.path}/software/${name}/${version}_${revision}${variants}
-# They allow the user to install multiple versions of the same port, treating
-# each revision and each different combination of variants as a "version".
-#
-# From there, the user can "activate" a port image. This creates {sym,hard}links for
-# all files in the image into the ${prefix}. Directories are created.
-# Activation checks the registry's file_map for any files which conflict with
-# other "active" ports, and will not overwrite the links to the those files.
-# The conflicting port must be deactivated first.
-#
-# The user can also "deactivate" an active port. This will remove all {sym,hard}links
-# from ${prefix}, and if any directories are empty, remove them as well. It
-# will also remove all of the references of the files from the registry's
-# file_map
-#
-# For the creating and removing of links during activation and deactivation,
-# code very similar to what is used in portinstall is used.
-#
-
-namespace eval portimage {
-
-variable force
-namespace export force
-
-# Activate a "Port Image"
-proc activate {name v optionslist} {
- global macports::prefix macports::registry.path UI_PREFIX
- array set options $optionslist
- variable force
-
- if {[info exists options(ports_force)] && [string equal -nocase $options(ports_force) "yes"] } {
- set force 1
- } else {
- set force 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 {$v != ""} {
- ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $v]"
- } else {
- ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
- }
-
- set ilist [registry::installed $name]
- if { [llength $ilist] > 1 } {
- 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 { ![string equal ${iversion}_${irevision}${ivariants} ${version}_${revision}${variants}] && $iactive == 1 } {
- return -code error "Image error: Another version of this port ($iname @${iversion}_${irevision}${ivariants}) is already active."
- }
- }
- }
-
- set ref [registry::open_entry $name $version $revision $variants]
-
- if { [registry::property_retrieve $ref active] != 0 } {
- return -code error "Image error: ${name} @${version}_${revision}${variants} is already active."
- }
-
- set imagedir [registry::property_retrieve $ref imagedir]
-
- set contents [registry::property_retrieve $ref contents]
-
- set imagefiles [_check_contents $name $contents $imagedir]
-
- _activate_contents $name $imagefiles $imagedir
-
- registry::property_store $ref active 1
-
- registry::write_entry $ref
-
- registry::open_file_map
- foreach file $imagefiles {
- registry::register_file $file $name
- }
- registry::write_file_map
-}
-
-proc deactivate {name v optionslist} {
- global UI_PREFIX
- array set options $optionslist
- variable force
-
- if {[info exists options(ports_force)] && [string equal -nocase $options(ports_force) "yes"] } {
- set force 1
- } else {
- set force 0
- }
-
- 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 fqversion ${version}_${revision}${variants}
-
- if {$v != ""} {
- ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $v]"
- } else {
- ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
- }
-
- if { $v != "" && ![string equal ${fqversion} $v] } {
- return -code error "Active version of $name is not $v but ${fqversion}."
- }
-
- set ref [registry::open_entry $name $version $revision $variants]
-
- if { [registry::property_retrieve $ref active] != 1 } {
- return -code error "Image error: ${name} @${fqversion} is not active."
- }
-
- set imagedir [registry::property_retrieve $ref imagedir]
-
- set imagefiles [registry::port_registered $name]
-
- _deactivate_contents $name $imagefiles
-
- registry::open_file_map
- foreach file $imagefiles {
- registry::unregister_file $file
- }
- registry::write_file_map
-
- registry::property_store $ref active 0
-
- registry::write_entry $ref
-
-}
-
-proc _check_registry {name v} {
- global UI_PREFIX
-
- set ilist [registry::installed $name $v]
- if { [string equal $v ""] } {
- if { [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."
- } else {
- return [lindex $ilist 0]
- }
- } else {
- return [lindex $ilist 0]
- }
- return -code error "Registry error: No port of $name installed."
-}
-
-proc _check_contents {name contents imagedir} {
- variable force
-
- set imagefiles [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
- foreach fe $contents {
- if { ![file isdirectory [lindex $fe 0]] || [file type [lindex $fe 0]] == "link" } {
- set srcfile [lindex $fe 0]
- set file [string range [lindex $fe 0] [string length $imagedir] [string length [lindex $fe 0]]]
-
- if { ![string equal $srcfile ""] } {
- lappend imagefiles $file
- }
- }
- }
-
- return $imagefiles
-}
-
-proc _activate_file {srcfile dstfile} {
- # Don't recursively copy directories
- if { [file isdirectory $srcfile] && [file type $srcfile] != "link" } {
- # Don't do anything if the directory already exists.
- if { ![file isdirectory $dstfile] } {
- file mkdir $dstfile
-
- # fix attributes on the directory.
- set attributes [file attributes $srcfile]
- for {set i 0} {$i < [llength $attributes]} {incr i} {
- set opt [lindex $attributes $i]
- incr i
- set arg [lindex $attributes $i]
- file attributes $dstfile $opt $arg
- }
-
- # set mtime on installed element
- exec touch -r $srcfile $dstfile
- }
- } elseif { [file type $srcfile] == "link" } {
- file copy -force $srcfile $dstfile
- } else {
- # Try a hard link first and if that fails, a symlink
- if {[catch {file link -hard $dstfile $srcfile}]} {
- ui_debug "hardlinking $srcfile to $dstfile failed, symlinking instead"
- file link -symbolic $dstfile $srcfile
- }
- }
-}
-
-proc _activate_list {flist imagedir} {
- foreach file $flist {
- if { [file type ${imagedir}${file}] == "link" } {
- ui_debug "activating link: $file"
- } elseif { [file isdirectory ${imagedir}${file}] } {
- ui_debug "activating directory: $file"
- } else {
- ui_debug "activating file: $file"
- }
- _activate_file ${imagedir}${file} $file
- }
-}
-
-proc _activate_contents {name imagefiles imagedir} {
- variable force
- global macports::prefix
-
- set files [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
- registry::open_file_map
- 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)
- 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."
- }
-
- set port [registry::file_registered $file]
-
- set timestamp [clock seconds]
-
- 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."
- } elseif { $force == 1 && [file exists $file] || $port != 0 } {
- set bakfile ${file}.mp_${timestamp}
-
- if {[file exists $file]} {
- ui_warn "File $file already exists. Moving to: $bakfile."
- file rename -force $file $bakfile
- }
-
- if { $port != 0 } {
- set bakport [registry::file_registered $file]
- registry::unregister_file $file
- if {[file exists $file]} {
- 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
- }
- 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 {set files [_activate_list $theList $imagedir] } result] } {
- ui_debug "Activation failed, rolling back."
- _deactivate_contents $name $imagefiles
- return -code error $result
- }
-
- #_activate_list $files $imagedir
-
-}
-
-proc _deactivate_file {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"
- }
- } else {
- ui_debug "deactivating file: $dstfile"
- file delete -- $dstfile
- }
-}
-
-proc _deactivate_list {filelist} {
- foreach file $filelist {
- _deactivate_file $file
- }
-}
-
-proc _deactivate_contents {name imagefiles} {
- variable force
-
- set files [list]
-
- foreach file $imagefiles {
- set port [registry::file_registered $file]
- 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)
- # Remark: paths in the registry may be not normalized.
- # This is not really a problem and it is in fact preferable.
- # Indeed, if I change the activate code to include normalized paths
- # instead of the paths we currently have, users' registry won't
- # match and activate will say that some file exists but doesn't
- # belong to any port.
- set theFile [file normalize $file]
- lappend files $theFile
-
- # Split out the filename's subpaths and add them to the image list as
- # well.
- set directory [file dirname $theFile]
- while { [lsearch -exact $files $directory] == -1 } {
- lappend files $directory
- set directory [file dirname $directory]
- }
- } else {
- ui_debug "$file does not exist."
- }
- }
-
- # Sort the list in reverse order, removing duplicates.
- # Since the list is sorted in reverse order, we're sure that directories
- # are after their elements.
- set theList [lsort -decreasing -unique $files]
-
- # Remove all elements.
- if { [catch {_deactivate_list $theList} result] } {
- return -code error $result
- }
-}
-
-# End of portimage namespace
-}
Modified: branches/images-and-archives/base/src/registry1.0/portuninstall.tcl
===================================================================
--- branches/images-and-archives/base/src/registry1.0/portuninstall.tcl 2009-05-06 00:27:03 UTC (rev 50646)
+++ branches/images-and-archives/base/src/registry1.0/portuninstall.tcl 2009-05-06 00:30:21 UTC (rev 50647)
@@ -124,7 +124,7 @@
if {[registry::property_retrieve $ref active] == 1} {
#return -code error [msgcat::mc "Registry Error: ${portname} ${version}_${revision}${variants} is active."]
- portimage::deactivate $portname ${version}_${revision}${variants} $optionslist
+ registry::deactivate $portname ${version}_${revision}${variants} $optionslist
}
ui_msg "$UI_PREFIX [format [msgcat::mc "Uninstalling %s @%s_%s%s"] $portname $version $revision $variants]"
Modified: branches/images-and-archives/base/src/registry1.0/registry.tcl
===================================================================
--- branches/images-and-archives/base/src/registry1.0/registry.tcl 2009-05-06 00:27:03 UTC (rev 50646)
+++ branches/images-and-archives/base/src/registry1.0/registry.tcl 2009-05-06 00:30:21 UTC (rev 50647)
@@ -34,12 +34,18 @@
package require macports 1.0
package require receipt_flat 1.0
package require receipt_sqlite 1.0
-package require portimage 1.0
package require portuninstall 1.0
package require msgcat
+package require Pextlib 1.0
+set UI_PREFIX "--> "
+
namespace eval registry {
+variable force
+namespace export force
+
+
# 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} } {
@@ -384,6 +390,399 @@
}
+#
+# Port Images are basically just installations of the destroot of a port into
+# ${macports::registry.path}/software/${name}/${version}_${revision}${variants}
+# They allow the user to install multiple versions of the same port, treating
+# each revision and each different combination of variants as a "version".
+#
+# From there, the user can "activate" a port image. This creates {sym,hard}links for
+# all files in the image into the ${prefix}. Directories are created.
+# Activation checks the registry's file_map for any files which conflict with
+# other "active" ports, and will not overwrite the links to the those files.
+# The conflicting port must be deactivated first.
+#
+# The user can also "deactivate" an active port. This will remove all {sym,hard}links
+# from ${prefix}, and if any directories are empty, remove them as well. It
+# will also remove all of the references of the files from the registry's
+# file_map
+#
+# For the creating and removing of links during activation and deactivation,
+# code very similar to what is used in portinstall is used.
+#
+
+# Activate a "Port Image"
+proc activate {name v optionslist} {
+ global macports::prefix macports::registry.path UI_PREFIX
+ array set options $optionslist
+ variable force
+
+ if {[info exists options(ports_force)] && [string equal -nocase $options(ports_force) "yes"] } {
+ set force 1
+ } else {
+ set force 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 {$v != ""} {
+ ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $v]"
+ } else {
+ ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
+ }
+
+ set ilist [registry::installed $name]
+ if { [llength $ilist] > 1 } {
+ 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 { ![string equal ${iversion}_${irevision}${ivariants} ${version}_${revision}${variants}] && $iactive == 1 } {
+ return -code error "Image error: Another version of this port ($iname @${iversion}_${irevision}${ivariants}) is already active."
+ }
+ }
+ }
+
+ set ref [registry::open_entry $name $version $revision $variants]
+
+ if { [registry::property_retrieve $ref active] != 0 } {
+ return -code error "Image error: ${name} @${version}_${revision}${variants} is already active."
+ }
+
+ set imagedir [registry::property_retrieve $ref imagedir]
+
+ set contents [registry::property_retrieve $ref contents]
+
+ set imagefiles [_check_contents $name $contents $imagedir]
+
+ _activate_contents $name $imagefiles $imagedir
+
+ registry::property_store $ref active 1
+
+ registry::write_entry $ref
+
+ registry::open_file_map
+ foreach file $imagefiles {
+ registry::register_file $file $name
+ }
+ registry::write_file_map
+}
+
+proc deactivate {name v optionslist} {
+ global UI_PREFIX
+ array set options $optionslist
+ variable force
+
+ if {[info exists options(ports_force)] && [string equal -nocase $options(ports_force) "yes"] } {
+ set force 1
+ } else {
+ set force 0
+ }
+
+ 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 fqversion ${version}_${revision}${variants}
+
+ if {$v != ""} {
+ ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $v]"
+ } else {
+ ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
+ }
+
+ if { $v != "" && ![string equal ${fqversion} $v] } {
+ return -code error "Active version of $name is not $v but ${fqversion}."
+ }
+
+ set ref [registry::open_entry $name $version $revision $variants]
+
+ if { [registry::property_retrieve $ref active] != 1 } {
+ return -code error "Image error: ${name} @${fqversion} is not active."
+ }
+
+ set imagedir [registry::property_retrieve $ref imagedir]
+
+ set imagefiles [registry::port_registered $name]
+
+ _deactivate_contents $name $imagefiles
+
+ registry::open_file_map
+ foreach file $imagefiles {
+ registry::unregister_file $file
+ }
+ registry::write_file_map
+
+ registry::property_store $ref active 0
+
+ registry::write_entry $ref
+
+}
+
+proc _check_registry {name v} {
+ global UI_PREFIX
+
+ set ilist [registry::installed $name $v]
+ if { [string equal $v ""] } {
+ if { [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."
+ } else {
+ return [lindex $ilist 0]
+ }
+ } else {
+ return [lindex $ilist 0]
+ }
+ return -code error "Registry error: No port of $name installed."
+}
+
+proc _check_contents {name contents imagedir} {
+ variable force
+
+ set imagefiles [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
+ foreach fe $contents {
+ if { ![file isdirectory [lindex $fe 0]] || [file type [lindex $fe 0]] == "link" } {
+ set srcfile [lindex $fe 0]
+ set file [string range [lindex $fe 0] [string length $imagedir] [string length [lindex $fe 0]]]
+
+ if { ![string equal $srcfile ""] } {
+ lappend imagefiles $file
+ }
+ }
+ }
+
+ return $imagefiles
+}
+
+proc _activate_file {srcfile dstfile} {
+ # Don't recursively copy directories
+ if { [file isdirectory $srcfile] && [file type $srcfile] != "link" } {
+ # Don't do anything if the directory already exists.
+ if { ![file isdirectory $dstfile] } {
+ file mkdir $dstfile
+
+ # fix attributes on the directory.
+ set attributes [file attributes $srcfile]
+ for {set i 0} {$i < [llength $attributes]} {incr i} {
+ set opt [lindex $attributes $i]
+ incr i
+ set arg [lindex $attributes $i]
+ file attributes $dstfile $opt $arg
+ }
+
+ # set mtime on installed element
+ exec touch -r $srcfile $dstfile
+ }
+ } elseif { [file type $srcfile] == "link" } {
+ file copy -force $srcfile $dstfile
+ } else {
+ # Try a hard link first and if that fails, a symlink
+ if {[catch {file link -hard $dstfile $srcfile}]} {
+ ui_debug "hardlinking $srcfile to $dstfile failed, symlinking instead"
+ file link -symbolic $dstfile $srcfile
+ }
+ }
+}
+
+proc _activate_list {flist imagedir} {
+ foreach file $flist {
+ if { [file type ${imagedir}${file}] == "link" } {
+ ui_debug "activating link: $file"
+ } elseif { [file isdirectory ${imagedir}${file}] } {
+ ui_debug "activating directory: $file"
+ } else {
+ ui_debug "activating file: $file"
+ }
+ _activate_file ${imagedir}${file} $file
+ }
+}
+
+proc _activate_contents {name imagefiles imagedir} {
+ variable force
+ global macports::prefix
+
+ set files [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
+ registry::open_file_map
+ 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)
+ 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."
+ }
+
+ set port [registry::file_registered $file]
+
+ set timestamp [clock seconds]
+
+ 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."
+ } elseif { $force == 1 && [file exists $file] || $port != 0 } {
+ set bakfile ${file}.mp_${timestamp}
+
+ if {[file exists $file]} {
+ ui_warn "File $file already exists. Moving to: $bakfile."
+ file rename -force $file $bakfile
+ }
+
+ if { $port != 0 } {
+ set bakport [registry::file_registered $file]
+ registry::unregister_file $file
+ if {[file exists $file]} {
+ 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
+ }
+ 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 {set files [_activate_list $theList $imagedir] } result] } {
+ ui_debug "Activation failed, rolling back."
+ _deactivate_contents $name $imagefiles
+ return -code error $result
+ }
+
+ #_activate_list $files $imagedir
+
+}
+
+proc _deactivate_file {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"
+ }
+ } else {
+ ui_debug "deactivating file: $dstfile"
+ file delete -- $dstfile
+ }
+}
+
+proc _deactivate_list {filelist} {
+ foreach file $filelist {
+ _deactivate_file $file
+ }
+}
+
+proc _deactivate_contents {name imagefiles} {
+ variable force
+
+ set files [list]
+
+ foreach file $imagefiles {
+ set port [registry::file_registered $file]
+ 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)
+ # Remark: paths in the registry may be not normalized.
+ # This is not really a problem and it is in fact preferable.
+ # Indeed, if I change the activate code to include normalized paths
+ # instead of the paths we currently have, users' registry won't
+ # match and activate will say that some file exists but doesn't
+ # belong to any port.
+ set theFile [file normalize $file]
+ lappend files $theFile
+
+ # Split out the filename's subpaths and add them to the image list as
+ # well.
+ set directory [file dirname $theFile]
+ while { [lsearch -exact $files $directory] == -1 } {
+ lappend files $directory
+ set directory [file dirname $directory]
+ }
+ } else {
+ ui_debug "$file does not exist."
+ }
+ }
+
+ # Sort the list in reverse order, removing duplicates.
+ # Since the list is sorted in reverse order, we're sure that directories
+ # are after their elements.
+ set theList [lsort -decreasing -unique $files]
+
+ # Remove all elements.
+ if { [catch {_deactivate_list $theList} result] } {
+ return -code error $result
+ }
+}
+
# End of registry namespace
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20090505/e6f1aa5a/attachment-0001.html>
More information about the macports-changes
mailing list