Commit | Line | Data |
---|---|---|
1479465f GJ |
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; |