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

Last change on this file since 100302 was 100302, checked in by cal@…, 7 years ago

active_variants 1.1: fix incorrect attempt at putting require_active_variants into pre-configure automatically

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 7.2 KB
Line 
1# $Id: active_variants-1.1.tcl 100302 2012-12-07 21:46:00Z cal@macports.org $
2#
3# Copyright (c) 2012 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 $name $required $forbidden]}]} {
35#   if {$result} {
36#     # code to be executed if $name is active with at least all variants in
37#     # $required and none from $forbidden
38#   } else {
39#     # code to be executed if $name 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 $name isn't active
44# }
45#
46# where
47#  $name
48#    is the name of the port you're trying to check (required)
49#  $required
50#    is a list of variants that must be enabled for the test to succeed
51#    (required; remember this can also be a space-separated string or just
52#    a string for a single value. It's iterpreted as list, though.)
53#  $forbidden
54#    is a list of variants that may not be enabled for the test to succeed
55#    (default is empty list, see description of $required for values that can be
56#    interpreted as list by Tcl)
57#
58#
59# In situations where you know that a version of the port is active (e.g., when
60# checking in pre-configure of a port and the checked port is a dependency),
61# this can be simplified to:
62# if {[active_variants $name $required $forbidden]} {
63#   # code to be run if $name is active with all from $required and none from
64#   # $forbidden
65# } else {
66#   # code to be run if $name is active, but either not with all variants in
67#   # $required or any variant in $forbidden
68# }
69#
70# If all you want to do is bail out when the condition isn't fulfilled, there's
71# a convience wrapper available. If the condition isn't met it will print an
72# error message and exit in a pre-configure phase. This can't be run any
73# earlier, because not all dependency types are installed before configure
74# phase. Previous versions of this PortGroup required you to manually put
75# require_active_variants in a pre-configure block. This is now done
76# automatically.
77#
78# require_active_variants $name $required $forbidden
79#
80# ChangeLog:
81#  v1.1:
82#   - require_active_variants no longer needs to be used in a pre-configure
83#     phase manually, because it automatically wraps itself in pre-configure.
84
85proc active_variants {name required {forbidden {}}} {
86        # registry_active comes from a list of aliased procedures in
87        # macports1.0/macports.tcl, line 1238 - 1303.
88        #
89        # It actually calls registry::active, which is defined in
90        # registry2.0/registry.tcl, line 173 and does some error handling plus
91        # passing the call to the appropriate registry backend (flat file or
92        # sqlite).
93        #
94        # In the SQLite case the call goes to registry2.0/receipt_sqlite.tcl,
95        # line 45, proc active, which in turn calls registry::entry installed
96        # $name, which comes from registry2.0/entry.c, line 387. I won't dig
97        # deeper than that, since that's as far as we need to go to handle this
98        # correctly.
99        #
100        # When looking at registry2.0/receipt_sqlite.tcl, line 53 and following,
101        # we can see the structure returned by this call: it's a list of
102        # registry entries (in the case of active, there can only be one, since
103        # there can never be multiple versions of the same port active at the
104        # same time). This explains the [lindex $active_list 0] in the following
105        # block.
106
107        # this will throw if $name isn't active
108        set installed [lindex [registry_active $name] 0]
109
110        # In $installed there are in order: name, version, revision, variants,
111        # a boolean indicating whether the port is installed and the epoch. So,
112        # we're interested in the field at offset 3.
113        set variants [lindex $installed 3]
114        ui_debug "$name is installed with the following variants: $variants"
115        ui_debug "  required: $required, forbidden: $forbidden"
116
117        # split by "+" into the separate variant names
118        set variant_list [split $variants +]
119
120        # check that each required variant is there
121        foreach required_variant $required {
122                if {![_variant_in_variant_list $required_variant $variant_list]} {
123                        ui_debug "  rejected, because required variant $required_variant is missing"
124                        return 0
125                }
126        }
127
128        # check that no forbidden variant is there
129        foreach forbidden_variant $forbidden {
130                if {[_variant_in_variant_list $forbidden_variant $variant_list]} {
131                        ui_debug "  rejected, because forbidden variant $forbidden_variant is present"
132                        return 0
133                }
134        }
135
136        ui_debug "  accepted"
137        return 1
138}
139
140proc _variant_in_variant_list {needle haystack} {
141        foreach variant $haystack {
142                if {$variant == $needle} {
143                        return 1
144                }
145        }
146        return 0
147}
148
149# global list holding all items the should be checked for and cause an error if
150# not present
151set _require_active_variants_list [list]
152
153proc require_active_variants {name required {forbidden {}}} {
154        global _require_active_variants_list
155        lappend _require_active_variants_list [list $name $required $forbidden]
156}
157
158# function to be called in pre-configure to check for all items added using
159# require_active_variants
160proc _check_require_active_variants {} {
161        global _require_active_variants_list
162        foreach _require_active_variant $_require_active_variants_list {
163                set name [lindex $_require_active_variant 0]
164                set required [lindex $_require_active_variant 1]
165                set forbidden [lindex $_require_active_variant 2]
166                if {[catch {set result [active_variants $name $required $forbidden]}] != 0} {
167                        error "$name is required, but not active."
168                }
169                if {!$result} {
170                        set str_required ""
171                        if {[llength $required] > 0} {
172                                set str_required "with +[join $required +]"
173                        }
174                        set str_forbidden ""
175                        if {[llength $forbidden] > 0} {
176                                set str_forbidden "without +[join $forbidden +]"
177                        }
178                        set str_combine ""
179                        if {$str_required != "" && $str_forbidden != ""} {
180                                set str_combine " and "
181                        }
182                        error "$name must be installed ${str_required}${str_combine}${str_forbidden}."
183                }
184        }
185}
186
187# register pre-configure handler that checks for all requested variants
188pre-configure {
189        _check_require_active_variants
190}
Note: See TracBrowser for help on using the repository browser.