chiark - git - mdw - dpkg/blob - scripts/Dpkg/BuildProfiles.pm

   1 # Copyright © 2013 Guillem Jover <guillem@debian.org>
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 package Dpkg::BuildProfiles;
  17
  18 use strict;
  19 use warnings;
  20
  21 our $VERSION = '1.00';
  22 our @EXPORT_OK = qw(
  23     get_build_profiles
  24     set_build_profiles
  25     parse_build_profiles
  26     evaluate_restriction_formula
  27 );
  28
  29 use Exporter qw(import);
  30
  31 use Dpkg::Util qw(:list);
  32 use Dpkg::Build::Env;
  33
  34 my $cache_profiles;
  35 my @build_profiles;
  36
  37 =encoding utf8
  38
  39 =head1 NAME
  40
  41 Dpkg::BuildProfiles - handle build profiles
  42
  43 =head1 DESCRIPTION
  44
  45 The Dpkg::BuildProfiles module provides functions to handle the build
  46 profiles.
  47
  48 =head1 FUNCTIONS
  49
  50 =over 4
  51
  52 =item @profiles = get_build_profiles()
  53
  54 Get an array with the currently active build profiles, taken from
  55 the environment variable B<DEB_BUILD_PROFILES>.
  56
  57 =cut
  58
  59 sub get_build_profiles {
  60     return @build_profiles if $cache_profiles;
  61
  62     if (Dpkg::Build::Env::has('DEB_BUILD_PROFILES')) {
  63         @build_profiles = split /\s+/, Dpkg::Build::Env::get('DEB_BUILD_PROFILES');
  64     }
  65     $cache_profiles = 1;
  66
  67     return @build_profiles;
  68 }
  69
  70 =item set_build_profiles(@profiles)
  71
  72 Set C<@profiles> as the current active build profiles, by setting
  73 the environment variable B<DEB_BUILD_PROFILES>.
  74
  75 =cut
  76
  77 sub set_build_profiles {
  78     my (@profiles) = @_;
  79
  80     $cache_profiles = 1;
  81     @build_profiles = @profiles;
  82     Dpkg::Build::Env::set('DEB_BUILD_PROFILES', join ' ', @profiles);
  83 }
  84
  85 =item @profiles = parse_build_profiles($string)
  86
  87 Parses a build profiles specification, into an array of array references.
  88
  89 =cut
  90
  91 sub parse_build_profiles {
  92     my $string = shift;
  93
  94     $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/;
  95
  96     return map { [ split /\s+/ ] } split /\s*>\s+<\s*/, $string;
  97 }
  98
  99 =item evaluate_restriction_formula(\@formula, \@profiles)
 100
 101 Evaluate whether a restriction formula of the form "<foo bar> <baz>", given as
 102 a nested array, is true or false, given the array of enabled build profiles.
 103
 104 =cut
 105
 106 sub evaluate_restriction_formula {
 107     my ($formula, $profiles) = @_;
 108
 109     # Restriction formulas are in disjunctive normal form:
 110     # (foo AND bar) OR (blub AND bla)
 111     foreach my $restrlist (@{$formula}) {
 112         my $seen_profile = 1;
 113
 114         foreach my $restriction (@$restrlist) {
 115             next if $restriction !~ m/^(!)?(.+)/;
 116
 117             my $negated = defined $1 && $1 eq '!';
 118             my $profile = $2;
 119             my $found = any { $_ eq $profile } @{$profiles};
 120
 121             # If a negative set profile is encountered, stop processing.
 122             # If a positive unset profile is encountered, stop processing.
 123             if ($found == $negated) {
 124                 $seen_profile = 0;
 125                 last;
 126             }
 127         }
 128
 129         # This conjunction evaluated to true so we don't have to evaluate
 130         # the others.
 131         return 1 if $seen_profile;
 132     }
 133     return 0;
 134 }
 135
 136 =back
 137
 138 =head1 CHANGES
 139
 140 =head2 Version 1.00 (dpkg 1.17.17)
 141
 142 Mark the module as public.
 143
 144 =cut
 145
 146 1;