source: trunk/dports/_resources/port1.0/group/active_variants-1.0.tcl @ 97987

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

active_variants-1.0.tcl: fix copyright year

  • Property svn:eol-style set to native
File size: 6.2 KB
Line 
1# $Id: haskell-1.0.tcl 96776 2012-08-19 05:52:01Z blair@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.0
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. This will also error out, if the port $name isn't
73# active, so you should probably not be using this before configure phase.
74#
75# require_active_variants $name $required $forbidden
76#
77
78proc active_variants {name required {forbidden {}}} {
79        # registry_active comes from a list of aliased procedures in
80        # macports1.0/macports.tcl, line 1238 - 1303.
81        #
82        # It actually calls registry::active, which is defined in
83        # registry2.0/registry.tcl, line 173 and does some error handling plus
84        # passing the call to the appropriate registry backend (flat file or
85        # sqlite).
86        #
87        # In the SQLite case the call goes to registry2.0/receipt_sqlite.tcl,
88        # line 45, proc active, which in turn calls registry::entry installed
89        # $name, which comes from registry2.0/entry.c, line 387. I won't dig
90        # deeper than that, since that's as far as we need to go to handle this
91        # correctly.
92        #
93        # When looking at registry2.0/receipt_sqlite.tcl, line 53 and following,
94        # we can see the structure returned by this call: it's a list of
95        # registry entries (in the case of active, there can only be one, since
96        # there can never be multiple versions of the same port active at the
97        # same time). This explains the [lindex $active_list 0] in the following
98        # block.
99
100        # this will throw if $name isn't active
101        set installed [lindex [registry_active $name] 0]
102
103        # In $installed there are in order: name, version, revision, variants,
104        # a boolean indicating whether the port is installed and the epoch. So,
105        # we're interested in the field at offset 3.
106        set variants [lindex $installed 3]
107        ui_debug "$name is installed with the following variants: $variants"
108        ui_debug "  required: $required, forbidden: $forbidden"
109
110        # split by "+" into the separate variant names
111        set variant_list [split $variants +]
112
113        # check that each required variant is there
114        foreach required_variant $required {
115                if {![_variant_in_variant_list $required_variant $variant_list]} {
116                        ui_debug "  rejected, because required variant $required_variant is missing"
117                        return 0
118                }
119        }
120
121        # check that no forbidden variant is there
122        foreach forbidden_variant $forbidden {
123                if {[_variant_in_variant_list $forbidden_variant $variant_list]} {
124                        ui_debug "  rejected, because forbidden variant $forbidden_variant is present"
125                        return 0
126                }
127        }
128
129        ui_debug "  accepted"
130        return 1
131}
132
133proc require_active_variants {name required {forbidden {}}} {
134        if {[catch {set result [active_variants $name $required $forbidden]}] != 0} {
135                error "$name is required, but not active."
136        }
137        if {!$result} {
138                set str_required ""
139                if {[llength $required] > 0} {
140                        set str_required "with +[join $required +]"
141                }
142                set str_forbidden ""
143                if {[llength $forbidden] > 0} {
144                        set str_forbidden "without +[join $forbidden +]"
145                }
146                set str_combine ""
147                if {$str_required != "" && $str_forbidden != ""} {
148                        set str_combine " and "
149                }
150                error "$name must be installed ${str_required}${str_combine}${str_forbidden}."
151        }
152}
153
154proc _variant_in_variant_list {needle haystack} {
155        foreach variant $haystack {
156                if {$variant == $needle} {
157                        return 1
158                }
159        }
160        return 0
161}
Note: See TracBrowser for help on using the repository browser.