source: trunk/dports/_resources/port1.0/group/active_variants-1.1.tcl

Last change on this file was 151558, checked in by larryv@…, 2 years ago

active_variants-1.1: Fix expressions

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 10.2 KB
Line 
1# $Id: active_variants-1.1.tcl 151558 2016-08-17 15:46:40Z larryv@macports.org $
2#
3# Copyright (c) 2012-2015 The MacPorts Project
4# All rights reserved.
5#
6# Redistribution and use in source and binary forms, with or without
7# modification, are permitted provided that the following conditions are
8# met:
9#
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 The MacPorts Project nor the names of its
16#    contributors may be used to endorse or promote products derived from
17#    this software without specific prior written permission.
18#
19# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
20# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
21# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
22# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
23# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
24# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
25# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
26# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
27# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
28# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30#
31#
32# Usage:
33# PortGroup       active_variants 1.1
34# if {![catch {set result [active_variants $depspec $required $forbidden]}]} {
35#   if {$result} {
36#     # code to be executed if $depspec is active with at least all variants in
37#     # $required and none from $forbidden
38#   } else {
39#     # code to be executed if $depspec is active, but either not with all
40#     # variants in $required or any variant in $forbidden
41#   }
42# } else {
43#   # code to be executed if $depspec isn't active
44# }
45#
46# where
47#  $depspec
48#    is the name of the port you're trying to check (required), which can be
49#    specified as either just the port, or via "(bin|lib|path):FOO:port"
50#    as accepted by the dependency parser.
51#  $required
52#    is a list of variants that must be enabled for the test to succeed
53#    (required; remember this can also be a space-separated string or just
54#    a string for a single value. It's interpreted as list, though.)
55#  $forbidden
56#    is a list of variants that may not be enabled for the test to succeed
57#    (default is empty list, see description of $required for values that can be
58#    interpreted as list by Tcl)
59#
60#
61# In situations where you know that a version of the port is active (e.g., when
62# checking in pre-configure of a port and the checked port is a dependency),
63# this can be simplified to:
64# if {[active_variants $depspec $required $forbidden]} {
65#   # code to be run if $depspec is active with all from $required and none from
66#   # $forbidden
67# } else {
68#   # code to be run if $depspec is active, but either not with all variants in
69#   # $required or any variant in $forbidden
70# }
71#
72# If all you want to do is bail out when the condition isn't fulfilled, there's
73# a convenience wrapper available. If the condition isn't met it will print an
74# error message and exit in a pre-configure phase. This can't be run any
75# earlier, because not all dependency types are installed before configure
76# phase. Previous versions of this PortGroup required you to manually put
77# require_active_variants in a pre-configure block. This is now done
78# automatically.
79#
80# require_active_variants $depspec $required $forbidden
81#
82# ChangeLog:
83#  v1.1:
84#   - require_active_variants no longer needs to be used in a pre-configure
85#     phase manually, because it automatically wraps itself in pre-configure.
86#   - the active_variants portgroup can now also deal with depspec-style
87#     dependencies, e.g., require_active_variants path:foo/bar:standardport
88#     variant
89
90proc active_variants {depspec required {forbidden {}}} {
91        # get the port which will provide $depspec; this allows us to support e.g.,
92        # path-style dependencies. This comes from port1.0/portutil.tcl and should
93        # probably not be considered public API.
94        set port [_get_dep_port $depspec]
95        if {$port eq ""} {
96            ui_error "active_variants: Error: invalid port depspec '${depspec}'"
97            ui_error "  expecting either: port or (bin|lib|path):foo:port"
98            return 0
99        }
100        if {$depspec ne $port} {
101            ui_debug "Checking $port for active variants for depspec '$depspec'"
102        }
103
104        # registry_active comes from a list of aliased procedures in
105        # macports1.0/macports.tcl, line 1238 - 1303.
106        #
107        # It actually calls registry::active, which is defined in
108        # registry2.0/registry.tcl, line 173 and does some error handling plus
109        # passing the call to the appropriate registry backend (flat file or
110        # sqlite).
111        #
112        # In the SQLite case the call goes to registry2.0/receipt_sqlite.tcl,
113        # line 45, proc active, which in turn calls registry::entry installed
114        # $port, which comes from registry2.0/entry.c, line 387. I won't dig
115        # deeper than that, since that's as far as we need to go to handle this
116        # correctly.
117        #
118        # When looking at registry2.0/receipt_sqlite.tcl, line 53 and following,
119        # we can see the structure returned by this call: it's a list of
120        # registry entries (in the case of active, there can only be one, since
121        # there can never be multiple versions of the same port active at the
122        # same time). This explains the [lindex $active_list 0] in the following
123        # block.
124
125        # this will throw if $port isn't active
126        set installed [lindex [registry_active $port] 0]
127
128        # In $installed there are in order: name, version, revision, variants,
129        # a boolean indicating whether the port is installed and the epoch. So,
130        # we're interested in the field at offset 3.
131        set variants [lindex $installed 3]
132        ui_debug "$port is installed with the following variants: $variants"
133        ui_debug "  required: $required, forbidden: $forbidden"
134
135        # split by "+" into the separate variant names
136        set variant_list [split $variants +]
137
138        # check that each required variant is there
139        foreach required_variant $required {
140                if {![_variant_in_variant_list $required_variant $variant_list]} {
141                        ui_debug "  rejected, because required variant $required_variant is missing"
142                        return 0
143                }
144        }
145
146        # check that no forbidden variant is there
147        foreach forbidden_variant $forbidden {
148                if {[_variant_in_variant_list $forbidden_variant $variant_list]} {
149                        ui_debug "  rejected, because forbidden variant $forbidden_variant is present"
150                        return 0
151                }
152        }
153
154        ui_debug "  accepted"
155        return 1
156}
157
158proc _variant_in_variant_list {needle haystack} {
159        foreach variant $haystack {
160                if {$variant eq $needle} {
161                        return 1
162                }
163        }
164        return 0
165}
166
167# global list holding all items should be checked for and cause an error if
168# not present
169set _require_active_variants_list [list]
170
171proc require_active_variants {depspec required {forbidden {}}} {
172        global _require_active_variants_list
173        lappend _require_active_variants_list [list $depspec $required $forbidden]
174}
175
176# function to be called in pre-configure to check for all items added using
177# require_active_variants
178proc _check_require_active_variants {method} {
179        global _require_active_variants_list PortInfo
180
181        # build a list of all dependencies to be checked in this pass
182        set depends {}
183        set deptypes {}
184
185        # determine the type of dependencies we need to consider
186        switch $method {
187                source {
188                        set deptypes "depends_fetch depends_extract depends_lib depends_build depends_run"
189                }
190                activate -
191                archivefetch {
192                        set deptypes "depends_lib depends_run"
193                }
194                default {
195                        error "active_variants 1.1: internal error: _check_require_active_variants called with unsupported \$method"
196                }
197        }
198
199        # for each type we're considering
200        foreach deptype $deptypes {
201                # check whether there are any dependencies of that type
202                if {[info exists PortInfo($deptype)]} {
203                        # and for each dependency
204                        foreach depspec $PortInfo($deptype) {
205                                # resolve names to actual ports
206                                set depname [_get_dep_port $depspec]
207
208                                # if depname is empty the dependency is already satisfied (e.g.
209                                # with bin: dependencies)
210                                if {$depname ne ""} {
211                                        # if the dependency isn't already in the list
212                                        if {[lsearch -exact $depends $depname] == -1} {
213                                                # append it
214                                                lappend depends $depname
215                                        }
216                                }
217                        }
218                }
219        }
220
221        ui_debug "Active variants check for ${method}-type install considers ${deptypes}: ${depends}"
222
223        foreach _require_active_variant $_require_active_variants_list {
224                set depspec [lindex $_require_active_variant 0]
225                set port [_get_dep_port $depspec]
226                set required [lindex $_require_active_variant 1]
227                set forbidden [lindex $_require_active_variant 2]
228
229                if {[lsearch -exact $depends $port] == -1} {
230                        ui_debug "Ignoring active_variants requirement for ${port} because ${method}-type install only considers ${deptypes} and those do not contain ${port}"
231                        continue
232                }
233
234                if {[catch {set result [active_variants $depspec $required $forbidden]}] != 0} {
235                    set message "${port} is required, but not active."
236                    if {$method eq "activate"} {
237                        ui_msg "Warning: $message"
238                    } else {
239                        error "$message"
240                    }
241                }
242                if {!$result} {
243                        set str_required ""
244                        if {[llength $required] > 0} {
245                                set str_required "with +[join $required +]"
246                        }
247                        set str_forbidden ""
248                        if {[llength $forbidden] > 0} {
249                                set str_forbidden "without +[join $forbidden +]"
250                        }
251                        set str_combine ""
252                        if {$str_required ne "" && $str_forbidden ne ""} {
253                                set str_combine " and "
254                        }
255                        set message "${port} must be installed ${str_required}${str_combine}${str_forbidden}."
256                        if {$method eq "activate"} {
257                            ui_msg "Warning: $message"
258                        } else {
259                            error "$message"
260                        }
261                }
262        }
263}
264
265# register pre-configure handler that checks for all requested variants
266pre-configure {
267        _check_require_active_variants source
268}
269
270# register pre-archivefetch handler that checks for all requested variants
271# this is required when downloading binary archives for a package, because
272# pre-configure is never run for those
273pre-archivefetch {
274        _check_require_active_variants archivefetch
275}
276
277# be sure that a required variant was not changed since this port was built or fetched
278pre-activate {
279        _check_require_active_variants activate
280}
Note: See TracBrowser for help on using the repository browser.