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

Last change on this file since 2426 was 2426, checked in by landonf (Landon Fuller), 18 years ago

Allow DarwinPorts to build out of the box on newer Darwin releases with Tcl 8.4

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