File Coverage

File:Dpkg/BuildProfiles.pm
Coverage:95.8%

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
16package Dpkg::BuildProfiles;
17
18
2
2
2
2
4
2
23
use strict;
19
2
2
2
2
2
4
64
use warnings;
20
21our $VERSION = '1.00';
22our @EXPORT_OK = qw(
23    get_build_profiles
24    set_build_profiles
25    parse_build_profiles
26    evaluate_restriction_formula
27);
28
29
2
2
2
2
4
1
28
use Exporter qw(import);
30
2
2
2
2
3
1
50
use List::Util qw(any);
31
32
2
2
2
2
119
2
451
use Dpkg::Build::Env;
33
34my $cache_profiles;
35my @build_profiles;
36
37=encoding utf8
38
39 - 57
=head1 NAME

Dpkg::BuildProfiles - handle build profiles

=head1 DESCRIPTION

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

=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
58
59sub get_build_profiles {
60
2
100
2
1
4
    return @build_profiles if $cache_profiles;
61
62
1
50
2
    if (Dpkg::Build::Env::has('DEB_BUILD_PROFILES')) {
63
1
1
        @build_profiles = split ' ', Dpkg::Build::Env::get('DEB_BUILD_PROFILES');
64    }
65
1
1
    $cache_profiles = 1;
66
67
1
2
    return @build_profiles;
68}
69
70 - 75
=item set_build_profiles(@profiles)

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

=cut
76
77sub set_build_profiles {
78
1
1
1
2
    my (@profiles) = @_;
79
80
1
0
    $cache_profiles = 1;
81
1
2
    @build_profiles = @profiles;
82
1
2
    Dpkg::Build::Env::set('DEB_BUILD_PROFILES', join ' ', @profiles);
83}
84
85 - 89
=item @profiles = parse_build_profiles($string)

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

=cut
90
91sub parse_build_profiles {
92
139
139
1
84
    my $string = shift;
93
94
139
192
    $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/;
95
96
139
195
152
270
    return map { [ split ' ' ] } split /\s*>\s+<\s*/, $string;
97}
98
99 - 104
=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
105
106sub evaluate_restriction_formula {
107
124
124
1
68
    my ($formula, $profiles) = @_;
108
109    # Restriction formulas are in disjunctive normal form:
110    # (foo AND bar) OR (blub AND bla)
111
124
124
62
61
    foreach my $restrlist (@{$formula}) {
112
150
73
        my $seen_profile = 1;
113
114
150
71
        foreach my $restriction (@$restrlist) {
115
168
50
172
            next if $restriction !~ m/^(!)?(.+)/;
116
117
168
67
181
            my $negated = defined $1 && $1 eq '!';
118
168
87
            my $profile = $2;
119
168
130
168
130
141
69
120
            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
168
100
164
            if ($found == $negated) {
124
84
39
                $seen_profile = 0;
125
84
45
                last;
126            }
127        }
128
129        # This conjunction evaluated to true so we don't have to evaluate
130        # the others.
131
150
100
125
        return 1 if $seen_profile;
132    }
133
58
48
    return 0;
134}
135
136=back
137
138 - 144
=head1 CHANGES

=head2 Version 1.00 (dpkg 1.17.17)

Mark the module as public.

=cut
145
1461;