source: users/jmr/restore_ports/restore_ports.tcl @ 62946

Last change on this file since 62946 was 62946, checked in by jmr@…, 10 years ago

script to correctly install a list of ports with their specified variants

File size: 7.5 KB
Line 
1#!/usr/bin/tclsh
2# -*- 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
3#
4# Install a list of ports given in the form produced by 'port installed', in
5# correct dependency order so as to preserve the selected variants.
6#
7# Todo:
8# Handle conflicting ports somehow
9# Once "good enough", integrate into port
10
11
12set MY_VERSION 0.1
13
14proc printUsage {} {
15   puts "Usage: $::argv0 \[-hV\] \[-t macports-tcl-path\] \[filename\]"
16   puts "   -h   This help"
17   puts "   -t   Give a different location for the base MacPorts Tcl"
18   puts "        file (defaults to /Library/Tcl)"
19   puts "   -V   show version and MacPorts version being used"
20}
21
22
23proc dependenciesForPort {portName variantInfo} {
24   set dependencyList [list]
25   set portSearchResult [mportlookup $portName]
26   if {[llength $portSearchResult] < 1} {
27      return -code error "port \"$portName\" not found"
28   }
29   array set portInfo [lindex $portSearchResult 1]
30   set mport [mportopen $portInfo(porturl) {} $variantInfo]
31   array unset portInfo
32   array set portInfo [mportinfo $mport]
33   mportclose $mport
34   foreach dependencyType {depends_fetch depends_extract depends_build depends_lib depends_run} {
35      if {[info exists portInfo($dependencyType)] && [string length $portInfo($dependencyType)] > 0} {
36         foreach dependency $portInfo($dependencyType) {
37            lappend dependencyList [lindex [split $dependency :] end]
38         }
39      }
40   }
41
42   return $dependencyList
43}
44
45proc sort_ports {portList} {
46    array set port_installed {}
47    array set port_deps {}
48    array set port_in_list {}
49   
50    set newList [list]
51    foreach port $portList {
52        set name [lindex $port 0]
53        #ui_msg "name = $name"
54        set version [lindex $port 1]
55        set variants ""
56        # XXX will need updating when we start recording -variants
57        set variantsStart [string first "+" $version]
58        if {$variantsStart != -1} {
59            set variants [string range $version $variantsStart end]
60            set variant_names [lrange [split $variants +] 1 end]
61            set variants [list]
62            foreach v $variant_names {
63                lappend variants $v "+"
64            }
65        }
66        #ui_msg "variants = $variants"
67        set active 0
68        if {[llength $port] > 2 && [lindex $port 2] == "(active)"} {
69            set active 1
70        }
71        #ui_msg "active = $active"
72
73        if {![info exists port_in_list($name)]} {
74            set port_in_list($name) 1
75            set port_installed($name) 0
76        } else {
77            incr port_in_list($name)
78        }
79        if {![info exists port_deps(${name},${variants})]} {
80            set port_deps(${name},${variants}) [dependenciesForPort $name $variants]
81        }
82        lappend newList [list $active $name $variants]
83    }
84    unset portList
85
86    set operationList [list]
87    while {[llength $newList] > 0} {
88        set oldLen [llength $newList]
89        foreach port $newList {
90            foreach {active name variants} $port break
91            # ensure active versions are installed after inactive versions,
92            # since installing will also activate and we don't want to
93            # displace the active version
94            if {$active && $port_installed($name) < ($port_in_list($name) - 1)} {
95                continue
96            }
97            set installable 1
98            foreach dep $port_deps(${name},${variants}) {
99                # XXX maybe check dep is active here?
100                if {[info exists port_installed($dep)] && $port_installed($dep) == 0} {
101                    set installable 0
102                    break
103                }
104            }
105            if {$installable} {
106                lappend operationList [list $name $variants $active]
107                incr port_installed($name)
108                set index [lsearch $newList [list $active $name $variants]]
109                #ui_msg "deleting \"[list $active $name $variants]\" from list"
110                #ui_msg "list with element: $newList"
111                set newList [lreplace $newList $index $index]
112                #ui_msg "list without element: $newList"
113            }
114        }
115        if {[llength $newList] == $oldLen} {
116            ui_error "we appear to be stuck, exiting..."
117            return -code error "infinite loop"
118        }
119    }
120   
121    return $operationList
122}
123
124proc install_ports {operationList} {
125    foreach op $operationList {
126        set name [string trim [lindex $op 0]]
127        set variations [lindex $op 1]
128        set active [lindex $op 2]
129       
130         if {[catch {set res [mportlookup $name]} result]} {
131            global errorInfo
132            ui_debug "$errorInfo"
133            return -code error "lookup of portname $name failed: $result"
134        }
135        if {[llength $res] < 2} {
136            ui_warn "Skipping $name (not in the ports tree)"
137            continue
138        }
139        array unset portinfo
140        array set portinfo [lindex $res 1]
141        set porturl $portinfo(porturl)
142       
143        # XXX should explicitly turn off default variants that don't appear in the list
144        set filtered_variations [mport_filtervariants $variations no]
145       
146        if {[catch {set workername [mportopen $porturl {} $filtered_variations]} result]} {
147            global errorInfo
148            ui_debug "$errorInfo"
149            return -code error "Unable to open port '$name': $result"
150        }
151        if {[catch {set result [mportexec $workername install]} result]} {
152            global errorInfo
153            mportclose $workername
154            ui_msg "$errorInfo"
155            return -code error "Unable to execute target 'install' for port '$name': $result"
156        } else {
157            mportclose $workername
158        }
159       
160        # XXX some ports may be reactivated to fulfil dependencies - check again at the end?
161        if {!$active} {
162            if {[catch {portimage::deactivate $name "" ""} result]} {
163                global errorInfo
164                ui_debug "$errorInfo"
165                return -code error "port deactivate failed: $result"
166            }
167        }
168    }
169}
170
171proc read_portlist {filename} {
172    if {$filename == "-"} {
173        set infile stdin
174    } else {
175        set infile [open $filename r]
176    }
177    set data [read -nonewline $infile]
178    set portList [split $data \n]
179    close $infile
180    if {[lindex $portList 0] == "The following ports are currently installed:"} {
181        set portList [lrange $portList 1 end]
182    }
183    return $portList
184}
185
186# Begin
187
188set macportsTclPath "/Library/Tcl"
189#set macportsTclPath "/opt/mptest/share/macports/Tcl"
190set showVersion 0
191
192while {[string index [lindex $::argv 0] 0] == "-" } {
193   switch [string range [lindex $::argv 0] 1 end] {
194      h {
195         printUsage
196         exit 0
197      }
198      t {
199         if {[llength $::argv] < 2} {
200            puts "-t needs a path"
201            printUsage
202            exit 1
203         }
204         set macportsTclPath [lindex $::argv 1]
205         set ::argv [lrange $::argv 1 end]
206      }
207      V {
208         set showVersion 1
209      }
210      default {
211         puts "Unknown option [lindex $::argv 0]"
212         printUsage
213         exit 1
214      }
215   }
216   set ::argv [lrange $::argv 1 end]
217}
218
219source ${macportsTclPath}/macports1.0/macports_fastload.tcl
220package require macports
221mportinit
222
223if {$showVersion} {
224   puts "Version $MY_VERSION"
225   puts "MacPorts version [macports::version]"
226   exit 0
227}
228
229if {[llength $::argv] == 0} {
230   set filename "-"
231} else {
232    set filename [lindex $::argv 0]
233}
234set portList [read_portlist $filename]
235#ui_msg "portlist = $portList"
236
237set operationList [sort_ports $portList]
238
239install_ports $operationList
Note: See TracBrowser for help on using the repository browser.