[97795] trunk/dports/_resources/port1.0/group/active_variants-1.0.tcl

[cal at macports.org]

Revision: 97795
          http://trac.macports.org//changeset/97795
Author:   cal at macports.org
Date:     2012-09-15 14:48:04 -0700 (Sat, 15 Sep 2012)
Log Message:
-----------
active_variants: new portgroup to check whether a specific port is active with a given list of variants

Added Paths:
-----------
    trunk/dports/_resources/port1.0/group/active_variants-1.0.tcl

Added: trunk/dports/_resources/port1.0/group/active_variants-1.0.tcl
===================================================================
--- trunk/dports/_resources/port1.0/group/active_variants-1.0.tcl	                        (rev 0)
+++ trunk/dports/_resources/port1.0/group/active_variants-1.0.tcl	2012-09-15 21:48:04 UTC (rev 97795)
@@ -0,0 +1,113 @@
+# $Id: haskell-1.0.tcl 96776 2012-08-19 05:52:01Z blair at macports.org $
+#
+# Copyright (c) 2009 The MacPorts Project
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+#
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+# 3. Neither the name of The MacPorts Project nor the names of its
+#    contributors may be used to endorse or promote products derived from
+#    this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+#
+# Usage:
+# PortGroup       active_variants 1.0
+# if {[catch {set result [active_variants $name $required $forbidden]}]} {
+#   if {$result} {
+#     # code to be executed if $name is active with at least all variants in
+#     # $required and none from $forbidden
+#   } else {
+#     # code to be executed if $name is active, but either not with all
+#     # variants in $required or any variant in $forbidden
+#   }
+# } else {
+#   # code to be executed if $name isn't active
+# }
+#
+# where
+#  $name
+#    is the name of the port you're trying to check (required)
+#  $required
+#    is a list of variants that must be enabled for the test to succeed
+#    (required; remember this can also be a space-separated string or just
+#    a string for a single value. It's iterpreted as list, though.)
+#  $forbidden
+#    is a list of variants that may not be enabled for the test to succeed
+#    (default is empty list, see description of $required for values that can be
+#    interpreted as list by Tcl)
+
+proc active_variants {name required {forbidden {}}} {
+	# registry_active comes from a list of aliased procedures in
+	# macports1.0/macports.tcl, line 1238 - 1303.
+	#
+	# It actually calls registry::active, which is defined in
+	# registry2.0/registry.tcl, line 173 and does some error handling plus
+	# passing the call to the appropriate registry backend (flat file or
+	# sqlite).
+	#
+	# In the SQLite case the call goes to registry2.0/receipt_sqlite.tcl,
+	# line 45, proc active, which in turn calls registry::entry installed
+	# $name, which comes from registry2.0/entry.c, line 387. I won't dig
+	# deeper than that, since that's as far as we need to go to handle this
+	# correctly.
+	#
+	# When looking at registry2.0/receipt_sqlite.tcl, line 53 and following,
+	# we can see the structure returned by this call: it's a list of
+	# registry entries (in the case of active, there can only be one, since
+	# there can never be multiple versions of the same port active at the
+	# same time). This explains the [lindex $active_list 0] in the following
+	# block.
+
+	# this will throw if $name isn't active
+	set installed [lindex [registry_active $name] 0]
+
+	# In $installed there are in order: name, version, revision, variants,
+	# a boolean indicating whether the port is installed and the epoch. So,
+	# we're interested in the field at offset 3.
+	set variants [lindex $installed 3]
+
+	# split by "+" into the separate variant names
+	set variant_list [split $variants +]
+
+	# check that each required variant is there
+	foreach required_variant $required {
+		if {![_variant_in_variant_list $required_variant $variant_list]} {
+			return 0
+		}
+	}
+
+	# check that no forbidden variant is there
+	foreach forbidden_variant $forbidden {
+		if {[_variant_in_variant_list $forbidden_variant $variant_list]} {
+			return 0
+		}
+	}
+}
+
+proc _variant_in_variant_list {needle haystack} {
+	foreach variant $haystack {
+		if {$variant == $needle} {
+			return 1
+		}
+	}
+	return 0
+}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20120915/831d510f/attachment-0001.html>