[64201] trunk/base/src
jmr at macports.org
jmr at macports.org
Thu Feb 25 05:51:21 PST 2010
Revision: 64201
http://trac.macports.org/changeset/64201
Author: jmr at macports.org
Date: 2010-02-25 05:51:21 -0800 (Thu, 25 Feb 2010)
Log Message:
-----------
registry fixes
Modified Paths:
--------------
trunk/base/src/macports1.0/macports.tcl
trunk/base/src/port/port.tcl
trunk/base/src/port1.0/portinstall.tcl
trunk/base/src/registry2.0/portimage.tcl
trunk/base/src/registry2.0/portuninstall.tcl
trunk/base/src/registry2.0/receipt_sqlite.tcl
Modified: trunk/base/src/macports1.0/macports.tcl
===================================================================
--- trunk/base/src/macports1.0/macports.tcl 2010-02-25 13:51:12 UTC (rev 64200)
+++ trunk/base/src/macports1.0/macports.tcl 2010-02-25 13:51:21 UTC (rev 64201)
@@ -841,6 +841,7 @@
# should ship with macports1.0 API?
package require Pextlib 1.0
package require registry 1.0
+ package require registry2 2.0
} else {
return -code error "Library directory '$libpath' must exist"
}
@@ -903,6 +904,14 @@
ui_warn "port definitions are more than two weeks old, consider using selfupdate"
}
}
+
+ # init registry if needed
+ if {$portdbformat == "sqlite"} {
+ registry::open [file join ${registry.path} registry registry.db]
+ # for the benefit of the portimage code that is called from multiple interpreters
+ global registry_open
+ set registry_open yes
+ }
}
proc macports::worker_init {workername portpath porturl portbuildpath options variations} {
Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl 2010-02-25 13:51:12 UTC (rev 64200)
+++ trunk/base/src/port/port.tcl 2010-02-25 13:51:21 UTC (rev 64201)
@@ -2470,7 +2470,7 @@
}
} else {
if {![macports::ui_isset ports_quiet]} {
- puts "Port $portname does not contain any file or is not active."
+ puts "Port $portname does not contain any files or is not active."
}
}
} else {
Modified: trunk/base/src/port1.0/portinstall.tcl
===================================================================
--- trunk/base/src/port1.0/portinstall.tcl 2010-02-25 13:51:12 UTC (rev 64200)
+++ trunk/base/src/port1.0/portinstall.tcl 2010-02-25 13:51:21 UTC (rev 64201)
@@ -33,6 +33,7 @@
package provide portinstall 1.0
package require portutil 1.0
+package require registry2 2.0
set org.macports.install [target_new org.macports.install portinstall::install_main]
target_provides ${org.macports.install} install
@@ -57,7 +58,7 @@
proc portinstall::install_start {args} {
global UI_PREFIX name version revision portvariants
- global prefix
+ global prefix registry_open registry.format registry.path
ui_msg "$UI_PREFIX [format [msgcat::mc "Installing %s @%s_%s%s"] $name $version $revision $portvariants]"
# start gsoc08-privileges
@@ -66,6 +67,11 @@
elevateToRoot "install"
}
# end gsoc08-privileges
+
+ if {${registry.format} == "receipt_sqlite" && ![info exists registry_open]} {
+ registry::open [file join ${registry.path} registry registry.db]
+ set registry_open yes
+ }
}
proc portinstall::install_element {src_element dst_element} {
@@ -126,7 +132,7 @@
}
}
if {[file isdirectory $name] && [file type $name] != "link"} {
- directory_dig $rootdir $name $imagedir [file join $cwd $name]
+ directory_dig $rootdir $name $imagedir [file join $cwd $name] $prepend
}
}
_cd $pwd
@@ -147,7 +153,7 @@
# Trick to have a portable GMT-POSIX epoch-based time.
$regref date [expr [clock scan now -gmt true] - [clock scan "1970-1-1 00:00:00" -gmt true]]
- if {[info exists default_variants} {
+ if {[info exists default_variants]} {
$regref default_variants $default_variants
}
@@ -166,12 +172,12 @@
$regref installtype image
$regref state imaged
set imagedir [file join ${registry.path} software ${name} ${version}_${revision}${portvariants}]
- $regref location $imagedir
} else {
$regref installtype direct
$regref state installed
set imagedir ""
}
+ $regref location $imagedir
# Install the files, requesting that the list not have the image dir prepended
directory_dig ${destroot} ${destroot} ${imagedir} "" 0
Modified: trunk/base/src/registry2.0/portimage.tcl
===================================================================
--- trunk/base/src/registry2.0/portimage.tcl 2010-02-25 13:51:12 UTC (rev 64200)
+++ trunk/base/src/registry2.0/portimage.tcl 2010-02-25 13:51:21 UTC (rev 64201)
@@ -69,7 +69,7 @@
# Activate a "Port Image"
proc activate {name v optionslist} {
- global macports::prefix macports::registry.path UI_PREFIX
+ global macports::prefix macports::registry.format macports::registry.path registry_open UI_PREFIX
array set options $optionslist
variable force
variable use_reg2
@@ -77,7 +77,13 @@
if {[info exists options(ports_force)] && [string is true -strict $options(ports_force)] } {
set force 1
}
- set use_reg2 [string equal ${macports::registry.format} "receipt_sqlite"]
+ if {[string equal ${macports::registry.format} "receipt_sqlite"]} {
+ set use_reg2 1
+ if {![info exists registry_open]} {
+ registry::open [file join ${macports::registry.path} registry registry.db]
+ set registry_open yes
+ }
+ }
set todeactivate [list]
if {$use_reg2} {
@@ -160,7 +166,7 @@
if {$use_reg2} {
_activate_contents $requested
- $requested state active
+ $requested state installed
} else {
set imagedir [registry::property_retrieve $ref imagedir]
@@ -184,7 +190,7 @@
}
proc deactivate {name v optionslist} {
- global UI_PREFIX
+ global UI_PREFIX macports::registry.format macports::registry.path registry_open
array set options $optionslist
variable use_reg2
@@ -194,7 +200,13 @@
# the activation is being forced
set force 1
}
- set use_reg2 [string equal ${macports::registry.format} "receipt_sqlite"]
+ if {[string equal ${macports::registry.format} "receipt_sqlite"]} {
+ set use_reg2 1
+ if {![info exists registry_open]} {
+ registry::open [file join ${macports::registry.path} registry registry.db]
+ set registry_open yes
+ }
+ }
if {$use_reg2} {
if { [string equal $name ""] } {
@@ -278,7 +290,7 @@
}
proc _check_registry {name v} {
- global UI_PREFIX
+ global UI_PREFIX macports::registry.installtype
variable use_reg2
if {$use_reg2} {
@@ -400,7 +412,7 @@
set files [list]
set baksuffix .mp_[clock seconds]
if {$use_reg2} {
- set imagedir [$port imagedir]
+ set imagedir [$port location]
set imagefiles [$port imagefiles]
} else {
set name $port
@@ -494,17 +506,22 @@
# Activate it, and catch errors so we can roll-back
try {
- [$port activate $imagefiles]
+ $port activate $imagefiles
foreach file $theList {
_activate_file "${imagedir}${file}" $file
}
} catch {*} {
ui_debug "Activation failed, rolling back."
- _deactivate_contents $port {} yes
+ # can't do it here since we're already inside a transaction
+ set deactivate_this yes
throw
}
}
} catch {*} {
+ # roll back activation of this port
+ if {[info exists deactivate_this]} {
+ _deactivate_contents $port {} yes
+ }
# 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.
Modified: trunk/base/src/registry2.0/portuninstall.tcl
===================================================================
--- trunk/base/src/registry2.0/portuninstall.tcl 2010-02-25 13:51:12 UTC (rev 64200)
+++ trunk/base/src/registry2.0/portuninstall.tcl 2010-02-25 13:51:21 UTC (rev 64201)
@@ -41,7 +41,8 @@
namespace eval portuninstall {
proc uninstall {portname {v ""} optionslist} {
- global uninstall.force uninstall.nochecksum UI_PREFIX macports::registry.format
+ global uninstall.force uninstall.nochecksum UI_PREFIX \
+ macports::registry.format macports::registry.installtype
array set options $optionslist
if {![info exists uninstall.force]} {
@@ -55,38 +56,48 @@
set use_reg2 [string equal ${macports::registry.format} "receipt_sqlite"]
if {$use_reg2} {
+ if {${macports::registry.installtype} == "image"} {
+ set imaged_or_installed imaged
+ } else {
+ set imaged_or_installed installed
+ }
if { [registry::decode_spec $v version revision variants] } {
- set ilist [registry::entry imaged $portname $version $revision $variants]
+ set ilist [registry::entry $imaged_or_installed $portname $version $revision $variants]
set valid 1
} else {
set valid [string equal $v {}]
- set ilist [registry::entry imaged $portname]
+ set ilist [registry::entry $imaged_or_installed $portname]
}
} else {
set ilist [registry::installed $portname $v]
set valid 1
}
if { [llength $ilist] > 1 } {
- set portname [lindex [lindex $ilist 0] 0]
+ # set portname again since the one we were passed may not have had the correct case
+ if {$use_reg2} {
+ set portname [[lindex $ilist 0] name]
+ } else {
+ 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]
+ foreach i [portlist_sortint $ilist] {
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]"
+ ui_msg "$UI_PREFIX [format [msgcat::mc " %s @%s (active)"] [$i name] $ispec]"
+ } else {
+ ui_msg "$UI_PREFIX [format [msgcat::mc " %s @%s"] [$i name] $ispec]"
}
} else {
+ set iname [lindex $i 0]
set iversion [lindex $i 1]
set irevision [lindex $i 2]
set ivariants [lindex $i 3]
- if { $iactive == 0 } {
+ set iactive [lindex $i 4]
+ if { $iactive == 1 } {
+ 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]"
- } elseif { $iactive == 1 } {
- ui_msg "$UI_PREFIX [format [msgcat::mc " %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
}
}
}
@@ -96,10 +107,9 @@
throw registry::invalid "Registry error: Invalid version specified. Please specify a version as recorded in the port registry."
}
} 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]
+ ui_debug "$port exists? [registry::entry exists $port]"
if {$v == ""} {
set v "[$port version]_[$port revision][$port variants]"
}
@@ -237,6 +247,7 @@
if {$use_reg2} {
# imagefiles gives the actual installed files in direct mode
set contents [$port imagefiles]
+ set imagedir [$port location]
} else {
set contents [registry::property_retrieve $ref contents]
if { $contents == "" } {
@@ -247,7 +258,7 @@
set files [list]
foreach f $contents {
if {$use_reg2} {
- set fname $f
+ set fname "${imagedir}${f}"
set sum1 [$port md5sum $f]
} else {
set fname [lindex $f 0]
@@ -264,8 +275,8 @@
}
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}"}
+ ui_warn "$UI_PREFIX [format [msgcat::mc "Original checksum does not match for %s, saving a copy to %s"] $fname ${fname}${bak_suffix}]"
+ catch {file copy $fname "${fname}${bak_suffix}"}
}
}
Modified: trunk/base/src/registry2.0/receipt_sqlite.tcl
===================================================================
--- trunk/base/src/registry2.0/receipt_sqlite.tcl 2010-02-25 13:51:12 UTC (rev 64200)
+++ trunk/base/src/registry2.0/receipt_sqlite.tcl 2010-02-25 13:51:21 UTC (rev 64201)
@@ -68,7 +68,7 @@
foreach key {name version revision variants} {
append searchcmd " $key [set $key]"
}
- if {![catch {[eval $searchcmd]}]} {
+ if {![catch {set ports [eval $searchcmd]}] && [llength $ports] > 0} {
return 1
}
return 0
@@ -105,10 +105,14 @@
# - port the port to test
# returns 0 if the port is not registered, the list of its files otherwise.
proc port_registered {name} {
- if {![catch {set ports [registry::entry search name $name state installed]}]} {
+ if {![catch {set ports [registry::entry installed $name]}]
+ && [llength $ports] > 0} {
# should never return more than one port
set port [lindex $ports 0]
return [$port files]
+ } elseif {![catch {set ports [registry::entry imaged $name]}]
+ && [llength $ports] > 0} {
+ return ""
} else {
return 0
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100225/e4cceaa4/attachment.html>
More information about the macports-changes
mailing list