<pre style='margin:0'>
Umesh Singla (umeshksingla) pushed a commit to branch gsoc17-migrate
in repository macports-base.
</pre>
<p><a href="https://github.com/macports/macports-base/commit/4b52a6fa0358058a3b922a9d9b5f5a50db6c81e8">https://github.com/macports/macports-base/commit/4b52a6fa0358058a3b922a9d9b5f5a50db6c81e8</a></p>
<pre style="white-space: pre; background: #F8F8F8"><span style='display:block; white-space:pre;color:#808000;'>commit 4b52a6fa0358058a3b922a9d9b5f5a50db6c81e8
</span>Author: Umesh Singla <umeshksingla@macports.org>
AuthorDate: Sat Aug 26 03:45:05 2017 +0530
<span style='display:block; white-space:pre;color:#404040;'> Add ui_msgs and convert camelcases to underscores
</span><span style='display:block; white-space:pre;color:#404040;'>
</span><span style='display:block; white-space:pre;color:#404040;'> Add copyright as well
</span>---
src/macports1.0/migrate.tcl | 147 +++++++++++++++++++++++++-------------------
1 file changed, 83 insertions(+), 64 deletions(-)
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/macports1.0/migrate.tcl b/src/macports1.0/migrate.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index 92df280..e820f21 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/macports1.0/migrate.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/macports1.0/migrate.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -1,9 +1,32 @@
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+#!@TCLSH@
</span> # -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:filetype=tcl:et:sw=4:ts=4:sts=4
<span style='display:block; white-space:pre;background:#ffe0e0;'>-# restore.tcl
</span> #
<span style='display:block; white-space:pre;background:#ffe0e0;'>-# TODO: include MacPorts copyright
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# Copyright (c) 2017 The MacPorts Project
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# All rights reserved.
</span> #
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# Redistribution and use in source and binary forms, with or without
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# modification, are permitted provided that the following conditions
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# are met:
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# 1. Redistributions of source code must retain the above copyright
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# notice, this list of conditions and the following disclaimer.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# 2. Redistributions in binary form must reproduce the above copyright
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# notice, this list of conditions and the following disclaimer in the
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# documentation and/or other materials provided with the distribution.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# 3. Neither the name of Apple Inc. nor the names of its contributors
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# may be used to endorse or promote products derived from this software
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# without specific prior written permission.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+#
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# POSSIBILITY OF SUCH DAMAGE.
</span>
package provide migrate 1.0
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -41,22 +64,22 @@ namespace eval migrate {
</span> puts "here 1"
# create a snapshot
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ ui_msg "Taking a snapshot of the current state.."
</span> set snapshot [snapshot::main $opts]
<span style='display:block; white-space:pre;background:#ffe0e0;'>- puts $snapshot
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts [$snapshot note]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts [$snapshot created_at]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set portlist1 [$snapshot ports]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts $portlist1
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set note [$snapshot note]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set datetime [$snapshot created_at]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ ui_msg "Done: snapshot '$note' created at $datetime"
</span>
<span style='display:block; white-space:pre;background:#ffe0e0;'>- puts "\nhere 2\n"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ ui_msg "Fetching ports.."
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set portlist1 [$snapshot ports]
</span>
<span style='display:block; white-space:pre;background:#ffe0e0;'>- # uninstall_installed $portlist1
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ ui_msg "Uninstalling all ports.."
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ uninstall_installed $portlist1
</span>
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ ui_msg "Restoring the original state.."
</span> recover_ports_state $portlist1
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span> # TODO: CLEAN PARTIAL BUILDS STEP HERE
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span> }
proc fetch_snapshot { snapshot_id } {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -68,41 +91,13 @@ namespace eval migrate {
</span> return
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>- proc port_dependencies {portName variantInfo} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set dependencyList [list]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set portSearchResult [mportlookup $portName]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # TODO: error handling, if any?
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set portInfo [lindex $portSearchResult 1]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[catch {set mport [mportopen $portInfo(porturl) [list subport $portInfo(name)] $variantInfo]} result]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- global errorInfo
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts stderr "$errorInfo"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return -code error "Unable to open port '$portName': $result"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array unset portInfo
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set portInfo [mportinfo $mport]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- mportclose $mport
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set dependencyTypes { depends_fetch depends_extract depends_build depends_lib depends_run }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach dependencyType $dependencyTypes {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[info exists portInfo($dependencyType)] && [string length $portInfo($dependencyType)] > 0} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach dependency $portInfo($dependencyType) {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- lappend dependencyList [lindex [split $dependency:] end]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return $dependencyList
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span> proc portlist_sort_dependencies_first {portlist} {
array set port_installed {}
array set port_deps {}
array set port_in_list {}
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set newList [list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set new_list [list]
</span>
foreach port $portlist {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -144,18 +139,16 @@ namespace eval migrate {
</span> }
if {![info exists port_deps(${name},${variants})]} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set port_deps(${name},${variants}) [port_dependencies $name $variants]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set port_deps(${name},${variants}) [portlist_sort_dependencies_first_helper $name $variants]
</span> }
<span style='display:block; white-space:pre;background:#ffe0e0;'>- lappend newList [list $name $variants $active]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lappend new_list [list $name $variants $active]
</span> }
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set operationList [list]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- while {[llength $newList] > 0} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set oldLen [llength $newList]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set operation_list [list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ while {[llength $new_list] > 0} {
</span>
<span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach port $newList {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set oldLen [llength $new_list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach port $new_list {
</span> foreach {name variants active} $port break
if {$active && $port_installed($name) < ($port_in_list($name) - 1)} {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -169,19 +162,44 @@ namespace eval migrate {
</span> }
}
if {$installable} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- lappend operationList [list $name $variants $active]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lappend operation_list [list $name $variants $active]
</span> incr port_installed($name)
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set index [lsearch $newList [list $name $variants $active]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set newList [lreplace $newList $index $index]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set index [lsearch $new_list [list $name $variants $active]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set new_list [lreplace $new_list $index $index]
</span> }
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[llength $newList] == $oldLen} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[llength $new_list] == $oldLen} {
</span> return -code error "Stuck in loop"
}
}
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ return $operation_list
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span>
<span style='display:block; white-space:pre;background:#ffe0e0;'>- return $operationList
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ proc portlist_sort_dependencies_first_helper {portname variant_info} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set dependency_list [list]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set port_search_result [mportlookup $portname]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[llength $port_search_result] < 2} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ ui_warn "Skipping $portname (not in the ports tree)"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return $dependency_list
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set portinfo [lindex $port_search_result 1]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[catch {set mport [mportopen $portinfo(porturl) [list subport $portinfo(name)] $variant_info]} result]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ global errorInfo
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts stderr "$errorInfo"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return -code error "Unable to open port '$portname': $result"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array unset portinfo
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set portinfo [mportinfo $mport]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ mportclose $mport
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set dependency_types { depends_fetch depends_extract depends_build depends_lib depends_run }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach dependency_type $dependency_types {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists portinfo($dependency_type)] && [string length $portinfo($dependency_type)] > 0} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach dependency $portinfo($dependency_type) {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lappend dependency_list [lindex [split $dependency:] end]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return $dependency_list
</span> }
proc portlist_sort_dependencies_later {portlist} {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -196,8 +214,7 @@ namespace eval migrate {
</span> # the list in dependency-sorted order
foreach port $portlist {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set portname [$port name]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set portname [lindex $port 0]
</span> lappend entries($portname) $port
# Avoid adding ports in loop
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -263,7 +280,6 @@ namespace eval migrate {
</span>
proc recover_ports_state {portlist} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span> set sorted_portlist [portlist_sort_dependencies_first $portlist]
foreach port $sorted_portlist {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -279,16 +295,16 @@ namespace eval migrate {
</span>
if {!$active} {
set target install
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ ui_msg "Installing (not activating): $name $variations"
</span> } else {
set target activate
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ ui_msg "Installing (and activating): $name $variations"
</span> }
<span style='display:block; white-space:pre;background:#ffe0e0;'>- puts "$name $variations $active $target"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span> if {[catch {set res [mportlookup $name]} result]} {
global errorInfo
ui_debug "$errorInfo"
<span style='display:block; white-space:pre;background:#ffe0e0;'>- return -code error "lookup of portname $name failed: $result"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return -code error "lookup of port $name failed: $result"
</span> }
if {[llength $res] < 2} {
# not in the index, but we already warned about that earlier
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -299,9 +315,12 @@ namespace eval migrate {
</span> array set portinfo [lindex $res 1]
set porturl $portinfo(porturl)
<span style='display:block; white-space:pre;background:#ffe0e0;'>- # TODO: error handling, if any?
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[catch {set workername [mportopen $porturl [list subport $portinfo(name)] $variations]} result]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ global errorInfo
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts stderr "$errorInfo"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return -code error "Unable to open port '$name': $result"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span>
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set workername [mportopen $porturl [list subport $portinfo(name)] $variations]
</span> if {[catch {set result [mportexec $workername $target]} result]} {
global errorInfo
mportclose $workername
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -310,7 +329,7 @@ namespace eval migrate {
</span> } else {
mportclose $workername
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>- # TODO: dependencies active?
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # TODO: some ports may get re-activated to fulfil dependencies - recheck?
</span> }
}
</pre><pre style='margin:0'>
</pre>