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

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

active_variants: new portgroup to check whether a specific port is active with a given list of variants

File size: 4.5 KB
Line 
1# $Id: haskell-1.0.tcl 96776 2012-08-19 05:52:01Z blair@macports.org $
2#
3# Copyright (c) 2009 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
58proc active_variants {name required {forbidden {}}} {
59        # registry_active comes from a list of aliased procedures in
60        # macports1.0/macports.tcl, line 1238 - 1303.
61        #
62        # It actually calls registry::active, which is defined in
63        # registry2.0/registry.tcl, line 173 and does some error handling plus
64        # passing the call to the appropriate registry backend (flat file or
65        # sqlite).
66        #
67        # In the SQLite case the call goes to registry2.0/receipt_sqlite.tcl,
68        # line 45, proc active, which in turn calls registry::entry installed
69        # $name, which comes from registry2.0/entry.c, line 387. I won't dig
70        # deeper than that, since that's as far as we need to go to handle this
71        # correctly.
72        #
73        # When looking at registry2.0/receipt_sqlite.tcl, line 53 and following,
74        # we can see the structure returned by this call: it's a list of
75        # registry entries (in the case of active, there can only be one, since
76        # there can never be multiple versions of the same port active at the
77        # same time). This explains the [lindex $active_list 0] in the following
78        # block.
79
80        # this will throw if $name isn't active
81        set installed [lindex [registry_active $name] 0]
82
83        # In $installed there are in order: name, version, revision, variants,
84        # a boolean indicating whether the port is installed and the epoch. So,
85        # we're interested in the field at offset 3.
86        set variants [lindex $installed 3]
87
88        # split by "+" into the separate variant names
89        set variant_list [split $variants +]
90
91        # check that each required variant is there
92        foreach required_variant $required {
93                if {![_variant_in_variant_list $required_variant $variant_list]} {
94                        return 0
95                }
96        }
97
98        # check that no forbidden variant is there
99        foreach forbidden_variant $forbidden {
100                if {[_variant_in_variant_list $forbidden_variant $variant_list]} {
101                        return 0
102                }
103        }
104}
105
106proc _variant_in_variant_list {needle haystack} {
107        foreach variant $haystack {
108                if {$variant == $needle} {
109                        return 1
110                }
111        }
112        return 0
113}
Note: See TracBrowser for help on using the repository browser.