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 =encoding utf8
  17
  18 =head1 NAME
  19
  20 Dpkg::BuildProfiles - handle build profiles
  21
  22 =head1 DESCRIPTION
  23
  24 The Dpkg::BuildProfiles module provides functions to handle the build
  25 profiles.
  26
  27 =cut
  28
  29 package Dpkg::BuildProfiles 1.00;
  30
  31 use strict;
  32 use warnings;
  33
  34 our @EXPORT_OK = qw(
  35     get_build_profiles
  36     set_build_profiles
  37     parse_build_profiles
  38     evaluate_restriction_formula
  39 );
  40
  41 use Exporter qw(import);
  42 use List::Util qw(any);
  43
  44 use Dpkg::BuildEnv;
  45
  46 my $cache_profiles;
  47 my @build_profiles;
  48
  49 =head1 FUNCTIONS
  50
  51 =over 4
  52
  53 =item @profiles = get_build_profiles()
  54
  55 Get an array with the currently active build profiles, taken from
  56 the environment variable B<DEB_BUILD_PROFILES>.
  57
  58 =cut
  59
  60 sub get_build_profiles {
  61     return @build_profiles if $cache_profiles;
  62
  63     if (Dpkg::BuildEnv::has('DEB_BUILD_PROFILES')) {
  64         @build_profiles = split ' ', Dpkg::BuildEnv::get('DEB_BUILD_PROFILES');
  65     }
  66     $cache_profiles = 1;
  67
  68     return @build_profiles;
  69 }
  70
  71 =item set_build_profiles(@profiles)
  72
  73 Set C<@profiles> as the current active build profiles, by setting
  74 the environment variable B<DEB_BUILD_PROFILES>.
  75
  76 =cut
  77
  78 sub set_build_profiles {
  79     my (@profiles) = @_;
  80
  81     $cache_profiles = 1;
  82     @build_profiles = @profiles;
  83     Dpkg::BuildEnv::set('DEB_BUILD_PROFILES', join ' ', @profiles);
  84 }
  85
  86 =item @profiles = parse_build_profiles($string)
  87
  88 Parses a build profiles specification, into an array of array references.
  89
  90 =cut
  91
  92 sub parse_build_profiles {
  93     my $string = shift;
  94
  95     $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/;
  96
  97     return map { [ split ' ' ] } split /\s*>\s+<\s*/, $string;
  98 }
  99
 100 =item evaluate_restriction_formula(\@formula, \@profiles)
 101
 102 Evaluate whether a restriction formula of the form "<foo bar> <baz>", given as
 103 a nested array, is true or false, given the array of enabled build profiles.
 104
 105 =cut
 106
 107 sub evaluate_restriction_formula {
 108     my ($formula, $profiles) = @_;
 109
 110     # Restriction formulas are in disjunctive normal form:
 111     # (foo AND bar) OR (blub AND bla)
 112     foreach my $restrlist (@{$formula}) {
 113         my $seen_profile = 1;
 114
 115         foreach my $restriction (@$restrlist) {
 116             next if $restriction !~ m/^(!)?(.+)/;
 117
 118             ## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
 119             my $negated = defined $1 && $1 eq '!';
 120             my $profile = $2;
 121             my $found = any { $_ eq $profile } @{$profiles};
 122
 123             # If a negative set profile is encountered, stop processing.
 124             # If a positive unset profile is encountered, stop processing.
 125             if ($found == $negated) {
 126                 $seen_profile = 0;
 127                 last;
 128             }
 129         }
 130
 131         # This conjunction evaluated to true so we don't have to evaluate
 132         # the others.
 133         return 1 if $seen_profile;
 134     }
 135     return 0;
 136 }
 137
 138 =back
 139
 140 =head1 CHANGES
 141
 142 =head2 Version 1.00 (dpkg 1.17.17)
 143
 144 Mark the module as public.
 145
 146 =cut
 147
 148 1;