source: trunk/base/src/darwinports1.0/darwinports_dlist.tcl @ 2084

Last change on this file since 2084 was 2084, checked in by kevin, 18 years ago

Re-use the Port API dependency engine for handling portfile dependencies.
Allow multiple Portfiles to be opened simultaneously.
Bug#: 333, 354

  • Property svn:eol-style set to native
File size: 10.7 KB
Line 
1#!/usr/bin/env tclsh8.3
2# darwinports1.0/darwinports_dlist.tcl
3#
4# Copyright (c) 2003 Kevin Van Vechten <kevin@opendarwin.org>
5# Copyright (c) 2002 Apple Computer, Inc.
6# All rights reserved.
7#
8# Redistribution and use in source and binary forms, with or without
9# modification, are permitted provided that the following conditions
10# are met:
11# 1. Redistributions of source code must retain the above copyright
12#    notice, this list of conditions and the following disclaimer.
13# 2. Redistributions in binary form must reproduce the above copyright
14#    notice, this list of conditions and the following disclaimer in the
15#    documentation and/or other materials provided with the distribution.
16# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
17#    may be used to endorse or promote products derived from this software
18#    without specific prior written permission.
19#
20# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
24# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
25# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
26# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
27# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
28# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
29# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
30# POSSIBILITY OF SUCH DAMAGE.
31
32package provide darwinports_dlist 1.0
33
34# dependency dependency list evaluation package
35#
36# This package provides a generic mechanism for managing a list of
37# dependencies.  The basic model is that each dependency item
38# contains a list of tokens it Requires and tokens it Provides.
39# A dependency is selected once all of the tokens it Requires have
40# been provided by another dependency, or if a dependency has no
41# requirements.
42
43# Conceptually a dlist is an ordered list of ditem elements.
44# The order perserves the dependency hierarchy.
45
46# A dlist is an ordinary TCL list.
47# A ditem should be created with the [ditem_create] procedure,
48# and treated as an opaque reference.
49# A statusdict is an ordinary TCL array, though darwinports_dlist
50# should be given complete domain over its contents.
51# XXX: should statusdict and dlist be part of a ditem tuple?
52# Values in the status dict will be {-1, 0, 1} for {failure,
53# pending, success} respectively.
54
55# dlist_search
56# Returns all dependency entries whose 'key' contains 'value'.
57#       dlist - the dependency list to search
58#       key   - the key to compare: Requires, Provides, et al.
59#       value - the value to compare
60
61proc dlist_search {dlist key value} {
62        set result {}
63        foreach ditem $dlist {
64                if {[ditem_contains $ditem $key $value]} {
65                        lappend result $ditem
66                }
67        }
68        return $result
69}
70
71# dlist_delete
72# Deletes the specified ditem from the dlist.
73#       dlist - the list to search
74#       ditem - the item to delete
75proc dlist_delete {dlist ditem} {
76    upvar $dlist uplist
77    set ix [lsearch -exact $uplist $ditem]
78    if {$ix >= 0} {
79                set uplist [lreplace $uplist $ix $ix]
80    }
81}
82
83# dlist_has_pending
84# Returns true if the dlist contains ditems
85# which will provide one of the specified names,
86# and thus are still "pending".
87#       dlist  - the dependency list to search
88#       tokens - the list of pending tokens to check for
89
90proc dlist_has_pending {dlist tokens} {
91        foreach token $tokens {
92                if {[llength [dlist_search $dlist provides $token]] > 0} {
93                        return 1
94                }
95        }
96        return 0
97}
98
99# dlist_count_unmet
100# Returns the total number of unmet dependencies in
101# the list of tokens.  If the tokens are in the status
102# dictionary with a successful result code, they are
103# considered met.
104proc dlist_count_unmet {dlist statusdict tokens} {
105        upvar $statusdict upstatus
106        set result 0
107        foreach token $tokens {
108                if {[info exists upstatus($token)] &&
109                        $upstatus($token) == 1} {
110                        continue
111                } else {
112                        incr result
113                }
114        }
115        return $result
116}
117
118# ditem_create
119# Create a new array in the darwinports_dlist namespace
120# returns the name of the array.  This should be used as
121# the ditem handle.
122
123proc ditem_create {} {
124        return [darwinports_dlist::ditem_create]
125}
126
127# ditem_key
128# Sets and returns the given key of the dependency item.
129#       ditem - the dependency item to operate on
130#       key   - the key to set
131#       value - optional value to set the key to
132
133proc ditem_key {ditem args} {
134        if {[llength $args] > 1} {
135                return [darwinports_dlist::ditem_key $ditem [lindex $args 0] [lindex $args 1]]
136        } else {
137                return [darwinports_dlist::ditem_key $ditem [lindex $args 0]]
138        }
139}
140
141# ditem_append
142# Appends the value to the given key of the dependency item.
143#       ditem - the dependency item to operate on
144#       key   - the key to append to
145#       value - the value to append to the key
146
147proc ditem_append {ditem key args} {
148        eval "return \[darwinports_dlist::ditem_append $ditem $key $args\]"
149}
150
151# ditem_contains
152# Tests whether the ditem key contains the specified value;
153# or if the value is omitted, tests whether the key exists.
154#       ditem - the dependency item to test
155#       key   - the key to examine
156#       value - optional value to search for in the key
157proc ditem_contains {ditem key args} {
158        eval "return \[darwinports_dlist::ditem_contains $ditem $key $args\]"
159}
160
161# dlist_append_dependents
162# Returns the ditems which are dependents of the ditem specified.
163#       dlist - the dependency list to search
164#       ditem - the item which itself, and its dependents should be selected
165#       result - used for recursing, pass empty initially.
166
167proc dlist_append_dependents {dlist ditem result} {
168        # Append the root item to the list if it's not there.
169        if {[lsearch $result $ditem] == -1} {
170                lappend result $ditem
171        }
172        # Recursively append any hard dependencies.
173        foreach token [ditem_key $ditem requires] {
174                foreach provider [dlist_search $dlist provides $token] {
175                        set result [dlist_append_dependents $dlist $provider $result]
176                }
177        }
178        # XXX: add soft-dependencies?
179        return $result
180}
181
182# dlist_get_next
183# Returns the any eligible item from the dependency list.
184# Eligibility is a function of the ditems in the list and
185# the status dictionary.  A ditem is eligible when all of
186# the services it Requires are present in the status
187# dictionary with a successful result code.
188#
189# Notes: this implementation of get next defers items based
190# on unfulfilled tokens in the Uses key.  However these items
191# will eventually be returned if there are no alternatives.
192# Soft-dependencies can be implemented in this way.
193#       dlist      - the dependency list to select from
194#       statusdict - the status dictionary describing the history
195#                    of the dependency list.
196
197proc dlist_get_next {dlist statusdict} {
198        upvar $statusdict upstatus
199        set nextitem {}
200       
201        # arbitrary large number ~ INT_MAX
202        set minfailed 2000000000
203       
204        foreach ditem $dlist {
205                # Skip if the ditem has unsatisfied hard dependencies
206                if {[dlist_count_unmet $dlist upstatus [ditem_key $ditem requires]]} {
207                        continue
208                }
209               
210                # We will favor the ditem with the fewest unmet soft dependencies
211                set unmet [dlist_count_unmet $dlist upstatus [ditem_key $ditem uses]]
212               
213                # Delay items with unment soft dependencies that can eventually be met
214                if {$unmet > 0 && [dlist_has_pending $dlist [ditem_key $ditem uses]]} {
215                        continue
216                }
217               
218                if {$unmet >= $minfailed} {
219                        # not better than the last pick
220                        continue
221                } else {
222                        # better than the last pick (fewer unmet soft deps)
223                        set minfailed $unmet
224                        set nextitem $ditem
225                }
226        }
227        return $nextitem
228}
229
230# dlist_eval
231# Evaluate the dlist, select each eligible ditem according to
232# the optional selector argument (the default selector is
233# dlist_get_next).  The specified handler is then invoked on
234# each ditem in the order they are selected.  When no more
235# ditems are eligible to run (the selector returns {}) then
236# dlist_eval will exit with a list of the remaining ditems,
237# or {} if all ditems were evaluated.
238#       dlist    - the dependency list to evaluate
239#       testcond - test condition to populate the status dictionary
240#                  should return {-1, 0, 1}
241#       handler  - the handler to invoke on each ditem
242#       canfail  - If 1, then progress will not stop when a failure
243#                  occures; if 0, then dlist_eval will return on the
244#                  first failure
245#       selector - the selector for determining eligibility
246
247proc dlist_eval {dlist testcond handler {canfail "0"} {selector "dlist_get_next"}} {
248        array set statusdict [list]
249       
250        # Do a pre-run seeing if any items automagically
251        # can evaluate to true.
252        if {$testcond != ""} {
253                foreach ditem $dlist {
254                        if {[eval "expr \[\$testcond \$ditem\] == 1"]} {
255                                foreach token [ditem_key $ditem provides] {
256                                        set statusdict($token) 1
257                                }
258                                dlist_delete dlist $ditem
259                        }
260                }
261        }
262       
263        # Loop for as long as there are ditems in the dlist.
264        while {1} {
265                set ditem [$selector $dlist statusdict]
266               
267                if {$ditem == {}} {
268                        break
269                } else {
270                        # $handler should return a unix status code, 0 for success.
271                        # statusdict notation is 1 for success
272                        if {[catch {eval "$handler $ditem"} result]} {
273                                puts $result
274                                return $dlist
275                        }
276                        # No news is good news at this point.
277                        if {$result == {}} { set result 0 }
278                       
279                        foreach token [ditem_key $ditem provides] {
280                                set statusdict($token) [expr $result == 0]
281                        }
282                       
283                        # Abort if we're not allowed to fail
284                        if {$canfail == 0 && $result != 0} {
285                                return $dlist
286                        }
287                       
288                        # Delete the ditem from the waiting list.
289                        dlist_delete dlist $ditem
290                }
291        }
292       
293        # Return the list of lusers
294        return $dlist
295}
296
297
298##### Private API #####
299# Anything below this point is subject to change without notice.
300#####
301
302# Each ditem is actually an array in the darwinports_dlist
303# namespace.  ditem keys correspond to the equivalent array
304# key.  A dlist is simply a list of names of ditem arrays.
305# All private API functions exist in the darwinports_dlist
306# namespace.
307
308namespace eval darwinports_dlist {
309
310variable ditem_uniqid 0
311
312proc ditem_create {} {
313        variable ditem_uniqid
314        incr ditem_uniqid
315        set ditem "ditem_${ditem_uniqid}"
316        variable $ditem
317        array set $ditem [list]
318        return $ditem
319}
320
321proc ditem_key {ditem args} {
322        variable $ditem
323        set key [lindex $args 0]
324        if {[llength $args] > 1} {
325                array set $ditem [list $key [lindex $args 1]]
326        }
327        return [lindex [array get $ditem $key] 1]
328}
329
330proc ditem_append {ditem key args} {
331        variable $ditem
332        set x [lindex [array get $ditem $key] 1]
333        if {$x != {}} {
334                eval "lappend x $args"
335        } else {
336                set x $args
337        }
338        array set $ditem [list $key $x]
339        return $x
340}
341
342proc ditem_contains {ditem key args} {
343        variable $ditem
344        if {[llength $args] == 0} {
345                eval "return \[info exists ${ditem}($key)\]"
346        } else {
347                set x [lindex [array get $ditem $key] 1]
348                if {[llength $x] > 0 && [lsearch -exact $x [lindex $args 0]] != -1} {
349                        return 1
350                } else {
351                        return 0
352                }
353        }
354}
355
356# End of darwinports_dlist namespace
357}
358
Note: See TracBrowser for help on using the repository browser.