[62946] users
jmr at macports.org
jmr at macports.org
Fri Jan 22 07:40:11 PST 2010
Revision: 62946
http://trac.macports.org/changeset/62946
Author: jmr at macports.org
Date: 2010-01-22 07:40:08 -0800 (Fri, 22 Jan 2010)
Log Message:
-----------
script to correctly install a list of ports with their specified variants
Added Paths:
-----------
users/jmr/
users/jmr/restore_ports/
users/jmr/restore_ports/restore_ports.tcl
Added: users/jmr/restore_ports/restore_ports.tcl
===================================================================
--- users/jmr/restore_ports/restore_ports.tcl (rev 0)
+++ users/jmr/restore_ports/restore_ports.tcl 2010-01-22 15:40:08 UTC (rev 62946)
@@ -0,0 +1,239 @@
+#!/usr/bin/tclsh
+# -*- 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
+#
+# Install a list of ports given in the form produced by 'port installed', in
+# correct dependency order so as to preserve the selected variants.
+#
+# Todo:
+# Handle conflicting ports somehow
+# Once "good enough", integrate into port
+
+
+set MY_VERSION 0.1
+
+proc printUsage {} {
+ puts "Usage: $::argv0 \[-hV\] \[-t macports-tcl-path\] \[filename\]"
+ puts " -h This help"
+ puts " -t Give a different location for the base MacPorts Tcl"
+ puts " file (defaults to /Library/Tcl)"
+ puts " -V show version and MacPorts version being used"
+}
+
+
+proc dependenciesForPort {portName variantInfo} {
+ set dependencyList [list]
+ set portSearchResult [mportlookup $portName]
+ if {[llength $portSearchResult] < 1} {
+ return -code error "port \"$portName\" not found"
+ }
+ array set portInfo [lindex $portSearchResult 1]
+ set mport [mportopen $portInfo(porturl) {} $variantInfo]
+ array unset portInfo
+ array set portInfo [mportinfo $mport]
+ mportclose $mport
+ foreach dependencyType {depends_fetch depends_extract depends_build depends_lib depends_run} {
+ if {[info exists portInfo($dependencyType)] && [string length $portInfo($dependencyType)] > 0} {
+ foreach dependency $portInfo($dependencyType) {
+ lappend dependencyList [lindex [split $dependency :] end]
+ }
+ }
+ }
+
+ return $dependencyList
+}
+
+proc sort_ports {portList} {
+ array set port_installed {}
+ array set port_deps {}
+ array set port_in_list {}
+
+ set newList [list]
+ foreach port $portList {
+ set name [lindex $port 0]
+ #ui_msg "name = $name"
+ set version [lindex $port 1]
+ set variants ""
+ # XXX will need updating when we start recording -variants
+ set variantsStart [string first "+" $version]
+ if {$variantsStart != -1} {
+ set variants [string range $version $variantsStart end]
+ set variant_names [lrange [split $variants +] 1 end]
+ set variants [list]
+ foreach v $variant_names {
+ lappend variants $v "+"
+ }
+ }
+ #ui_msg "variants = $variants"
+ set active 0
+ if {[llength $port] > 2 && [lindex $port 2] == "(active)"} {
+ set active 1
+ }
+ #ui_msg "active = $active"
+
+ if {![info exists port_in_list($name)]} {
+ set port_in_list($name) 1
+ set port_installed($name) 0
+ } else {
+ incr port_in_list($name)
+ }
+ if {![info exists port_deps(${name},${variants})]} {
+ set port_deps(${name},${variants}) [dependenciesForPort $name $variants]
+ }
+ lappend newList [list $active $name $variants]
+ }
+ unset portList
+
+ set operationList [list]
+ while {[llength $newList] > 0} {
+ set oldLen [llength $newList]
+ foreach port $newList {
+ foreach {active name variants} $port break
+ # ensure active versions are installed after inactive versions,
+ # since installing will also activate and we don't want to
+ # displace the active version
+ if {$active && $port_installed($name) < ($port_in_list($name) - 1)} {
+ continue
+ }
+ set installable 1
+ foreach dep $port_deps(${name},${variants}) {
+ # XXX maybe check dep is active here?
+ if {[info exists port_installed($dep)] && $port_installed($dep) == 0} {
+ set installable 0
+ break
+ }
+ }
+ if {$installable} {
+ lappend operationList [list $name $variants $active]
+ incr port_installed($name)
+ set index [lsearch $newList [list $active $name $variants]]
+ #ui_msg "deleting \"[list $active $name $variants]\" from list"
+ #ui_msg "list with element: $newList"
+ set newList [lreplace $newList $index $index]
+ #ui_msg "list without element: $newList"
+ }
+ }
+ if {[llength $newList] == $oldLen} {
+ ui_error "we appear to be stuck, exiting..."
+ return -code error "infinite loop"
+ }
+ }
+
+ return $operationList
+}
+
+proc install_ports {operationList} {
+ foreach op $operationList {
+ set name [string trim [lindex $op 0]]
+ set variations [lindex $op 1]
+ set active [lindex $op 2]
+
+ if {[catch {set res [mportlookup $name]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ return -code error "lookup of portname $name failed: $result"
+ }
+ if {[llength $res] < 2} {
+ ui_warn "Skipping $name (not in the ports tree)"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+
+ # XXX should explicitly turn off default variants that don't appear in the list
+ set filtered_variations [mport_filtervariants $variations no]
+
+ if {[catch {set workername [mportopen $porturl {} $filtered_variations]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ return -code error "Unable to open port '$name': $result"
+ }
+ if {[catch {set result [mportexec $workername install]} result]} {
+ global errorInfo
+ mportclose $workername
+ ui_msg "$errorInfo"
+ return -code error "Unable to execute target 'install' for port '$name': $result"
+ } else {
+ mportclose $workername
+ }
+
+ # XXX some ports may be reactivated to fulfil dependencies - check again at the end?
+ if {!$active} {
+ if {[catch {portimage::deactivate $name "" ""} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ return -code error "port deactivate failed: $result"
+ }
+ }
+ }
+}
+
+proc read_portlist {filename} {
+ if {$filename == "-"} {
+ set infile stdin
+ } else {
+ set infile [open $filename r]
+ }
+ set data [read -nonewline $infile]
+ set portList [split $data \n]
+ close $infile
+ if {[lindex $portList 0] == "The following ports are currently installed:"} {
+ set portList [lrange $portList 1 end]
+ }
+ return $portList
+}
+
+# Begin
+
+set macportsTclPath "/Library/Tcl"
+#set macportsTclPath "/opt/mptest/share/macports/Tcl"
+set showVersion 0
+
+while {[string index [lindex $::argv 0] 0] == "-" } {
+ switch [string range [lindex $::argv 0] 1 end] {
+ h {
+ printUsage
+ exit 0
+ }
+ t {
+ if {[llength $::argv] < 2} {
+ puts "-t needs a path"
+ printUsage
+ exit 1
+ }
+ set macportsTclPath [lindex $::argv 1]
+ set ::argv [lrange $::argv 1 end]
+ }
+ V {
+ set showVersion 1
+ }
+ default {
+ puts "Unknown option [lindex $::argv 0]"
+ printUsage
+ exit 1
+ }
+ }
+ set ::argv [lrange $::argv 1 end]
+}
+
+source ${macportsTclPath}/macports1.0/macports_fastload.tcl
+package require macports
+mportinit
+
+if {$showVersion} {
+ puts "Version $MY_VERSION"
+ puts "MacPorts version [macports::version]"
+ exit 0
+}
+
+if {[llength $::argv] == 0} {
+ set filename "-"
+} else {
+ set filename [lindex $::argv 0]
+}
+set portList [read_portlist $filename]
+#ui_msg "portlist = $portList"
+
+set operationList [sort_ports $portList]
+
+install_ports $operationList
Property changes on: users/jmr/restore_ports/restore_ports.tcl
___________________________________________________________________
Added: svn:executable
+
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100122/7e39d944/attachment.html>
More information about the macports-changes
mailing list