File Coverage

File:Dpkg/BuildProfiles.pm
Coverage:97.2%

linestmtbrancondsubpodtimecode
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 - 27
=head1 NAME

Dpkg::BuildProfiles - handle build profiles

=head1 DESCRIPTION

The Dpkg::BuildProfiles module provides functions to handle the build
profiles.

=cut
28
29package Dpkg::BuildProfiles 1.00;
30
31
15
15
15
15
46
15
295
use strict;
32
15
15
15
15
28
7
633
use warnings;
33
34our @EXPORT_OK = qw(
35    get_build_profiles
36    set_build_profiles
37    parse_build_profiles
38    evaluate_restriction_formula
39);
40
41
15
15
15
15
38
11
254
use Exporter qw(import);
42
15
15
15
15
34
21
463
use List::Util qw(any);
43
44
15
15
15
15
343
10
4388
use Dpkg::BuildEnv;
45
46my $cache_profiles;
47my @build_profiles;
48
49 - 58
=head1 FUNCTIONS

=over 4

=item @profiles = get_build_profiles()

Get an array with the currently active build profiles, taken from
the environment variable B<DEB_BUILD_PROFILES>.

=cut
59
60sub get_build_profiles {
61
27
100
27
1
77
    return @build_profiles if $cache_profiles;
62
63
6
100
26
    if (Dpkg::BuildEnv::has('DEB_BUILD_PROFILES')) {
64
3
5
        @build_profiles = split ' ', Dpkg::BuildEnv::get('DEB_BUILD_PROFILES');
65    }
66
6
10
    $cache_profiles = 1;
67
68
6
17
    return @build_profiles;
69}
70
71 - 76
=item set_build_profiles(@profiles)

Set C<@profiles> as the current active build profiles, by setting
the environment variable B<DEB_BUILD_PROFILES>.

=cut
77
78sub set_build_profiles {
79
3
3
1
8
    my (@profiles) = @_;
80
81
3
2
    $cache_profiles = 1;
82
3
5
    @build_profiles = @profiles;
83
3
8
    Dpkg::BuildEnv::set('DEB_BUILD_PROFILES', join ' ', @profiles);
84}
85
86 - 90
=item @profiles = parse_build_profiles($string)

Parses a build profiles specification, into an array of array references.

=cut
91
92sub parse_build_profiles {
93
417
417
1
334
    my $string = shift;
94
95
417
869
    $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/;
96
97
417
585
602
1176
    return map { [ split ' ' ] } split /\s*>\s+<\s*/, $string;
98}
99
100 - 105
=item evaluate_restriction_formula(\@formula, \@profiles)

Evaluate whether a restriction formula of the form "<foo bar> <baz>", given as
a nested array, is true or false, given the array of enabled build profiles.

=cut
106
107sub evaluate_restriction_formula {
108
372
372
1
227
    my ($formula, $profiles) = @_;
109
110    # Restriction formulas are in disjunctive normal form:
111    # (foo AND bar) OR (blub AND bla)
112
372
372
231
259
    foreach my $restrlist (@{$formula}) {
113
450
256
        my $seen_profile = 1;
114
115
450
276
        foreach my $restriction (@$restrlist) {
116
504
50
670
            next if $restriction !~ m/^(!)?(.+)/;
117
118            ## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
119
504
67
677
            my $negated = defined $1 && $1 eq '!';
120
504
334
            my $profile = $2;
121
504
390
504
390
611
281
450
            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
504
100
684
            if ($found == $negated) {
126
252
142
                $seen_profile = 0;
127
252
193
                last;
128            }
129        }
130
131        # This conjunction evaluated to true so we don't have to evaluate
132        # the others.
133
450
100
502
        return 1 if $seen_profile;
134    }
135
174
191
    return 0;
136}
137
138=back
139
140 - 146
=head1 CHANGES

=head2 Version 1.00 (dpkg 1.17.17)

Mark the module as public.

=cut
147
1481;