File Coverage

File:Dpkg/BuildOptions.pm
Coverage:92.5%

linestmtbrancondsubpodtimecode
1# Copyright © 2007 Frank Lichtenheld <djpig@debian.org>
2# Copyright © 2008, 2012-2017 Guillem Jover <guillem@debian.org>
3# Copyright © 2010 Raphaël Hertzog <hertzog@debian.org>
4#
5# This program is free software; you can redistribute it and/or modify
6# it under the terms of the GNU General Public License as published by
7# the Free Software Foundation; either version 2 of the License, or
8# (at your option) any later version.
9#
10# This program is distributed in the hope that it will be useful,
11# but WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13# GNU General Public License for more details.
14#
15# You should have received a copy of the GNU General Public License
16# along with this program.  If not, see <https://www.gnu.org/licenses/>.
17
18=encoding utf8
19
20 - 30
=head1 NAME

Dpkg::BuildOptions - parse and update build options

=head1 DESCRIPTION

This class can be used to manipulate options stored
in environment variables like DEB_BUILD_OPTIONS and
DEB_BUILD_MAINT_OPTIONS.

=cut
31
32package Dpkg::BuildOptions 1.02;
33
34
12
12
12
12
37
11
262
use strict;
35
12
12
12
12
23
9
375
use warnings;
36
37
12
12
12
12
24
11
408
use List::Util qw(any);
38
39
12
12
12
12
26
11
380
use Dpkg::Gettext;
40
12
12
12
12
48
10
436
use Dpkg::ErrorHandling;
41
12
12
12
12
879
10
6010
use Dpkg::BuildEnv;
42
43 - 53
=head1 METHODS

=over 4

=item $bo = Dpkg::BuildOptions->new(%opts)

Create a new Dpkg::BuildOptions object. It will be initialized based
on the value of the environment variable named $opts{envvar} (or
DEB_BUILD_OPTIONS if that option is not set).

=cut
54
55sub new {
56
174
174
1
232
    my ($this, %opts) = @_;
57
174
33
484
    my $class = ref($this) || $this;
58
59    my $self = {
60        options => {},
61        source => {},
62
174
100
485
        envvar => $opts{envvar} // 'DEB_BUILD_OPTIONS',
63    };
64
174
168
    bless $self, $class;
65
174
276
    $self->merge(Dpkg::BuildEnv::get($self->{envvar}), $self->{envvar});
66
174
289
    return $self;
67}
68
69 - 73
=item $bo->reset()

Reset the object to not have any option (it's empty).

=cut
74
75sub reset {
76
6
6
1
8
    my $self = shift;
77
6
10
    $self->{options} = {};
78
6
15
    $self->{source} = {};
79}
80
81 - 90
=item $bo->merge($content, $source)

Merge the options set in $content and record that they come from the
source $source. $source is mainly used in warning messages currently
to indicate where invalid options have been detected.

$content is a space separated list of options with optional assigned
values like "nocheck parallel=2".

=cut
91
92sub merge {
93
177
177
1
206
    my ($self, $content, $source) = @_;
94
177
100
250
    return 0 unless defined $content;
95
66
64
    my $count = 0;
96
66
151
    foreach (split(/\s+/, $content)) {
97
102
100
456
        unless (/^([a-z][a-z0-9_-]*)(?:=(\S*))?$/) {
98
9
25
            warning(g_('invalid flag in %s: %s'), $source, $_);
99
9
10
            next;
100        }
101        ## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
102
93
144
        $count += $self->set($1, $2, $source);
103    }
104
66
76
    return $count;
105}
106
107 - 118
=item $bo->set($option, $value, [$source])

Store the given option in the object with the given value. It's legitimate
for a value to be undefined if the option is a simple boolean (its
presence means true, its absence means false). The $source is optional
and indicates where the option comes from.

The known options have their values checked for sanity. Options without
values have their value removed and options with invalid values are
discarded.

=cut
119
120sub set {
121
114
114
1
241
    my ($self, $key, $value, $source) = @_;
122
123    # Sanity checks
124
114
432
100
100
100
432
403
499
    if (any { $_ eq $key } qw(terse noopt nostrip nocheck) and defined $value) {
125
3
3
        $value = undef;
126    } elsif ($key eq 'parallel')  {
127
12
100
22
        $value //= '';
128
12
50
26
        return 0 if $value !~ /^\d*$/;
129    }
130
131
114
262
    $self->{options}{$key} = $value;
132
114
130
    $self->{source}{$key} = $source;
133
134
114
149
    return 1;
135}
136
137 - 143
=item $bo->get($option)

Return the value associated to the option. It might be undef even if the
option exists. You might want to check with $bo->has($option) to verify if
the option is stored in the object.

=cut
144
145sub get {
146
1173
1173
1
827
    my ($self, $key) = @_;
147
1173
2723
    return $self->{options}{$key};
148}
149
150 - 154
=item $bo->has($option)

Returns a boolean indicating whether the option is stored in the object.

=cut
155
156sub has {
157
111
111
1
122
    my ($self, $key) = @_;
158
111
205
    return exists $self->{options}{$key};
159}
160
161 - 172
=item $bo->parse_features($option, $use_feature)

Parse the $option values, as a set of known features to enable or disable,
as specified in the $use_feature hash reference.

Each feature is prefixed with a 'B<+>' or a 'B<->' character as a marker
to enable or disable it. The special feature "B<all>" can be used to act
on all known features.

Unknown or malformed features will emit warnings.

=cut
173
174sub parse_features {
175
1146
1146
1
836
    my ($self, $option, $use_feature) = @_;
176
177
1146
100
890
    foreach my $feature (split(/,/, $self->get($option) // '')) {
178
81
88
        $feature = lc $feature;
179
81
50
242
        if ($feature =~ s/^([+-])//) {
180
81
100
150
            my $value = ($1 eq '+') ? 1 : 0;
181
81
100
50
153
            if ($feature eq 'all') {
182
9
9
9
29
                $use_feature->{$_} = $value foreach keys %{$use_feature};
183            } elsif (exists $use_feature->{$feature}) {
184
72
139
                $use_feature->{$feature} = $value;
185            } else {
186                warning(g_('unknown %s feature in %s variable: %s'),
187
0
0
                        $option, $self->{envvar}, $feature);
188            }
189        } else {
190            warning(g_('incorrect value in %s option of %s variable: %s'),
191
0
0
                    $option, $self->{envvar}, $feature);
192        }
193    }
194}
195
196 - 202
=item $string = $bo->output($fh)

Return a string representation of the build options suitable to be
assigned to an environment variable. Can optionally output that string to
the given filehandle.

=cut
203
204sub output {
205
9
9
1
7
    my ($self, $fh) = @_;
206
9
8
    my $o = $self->{options};
207
9
18
100
21
36
    my $res = join(' ', map { defined($o->{$_}) ? $_ . '=' . $o->{$_} : $_ } sort keys %$o);
208
9
0
50
12
0
    print { $fh } $res if defined $fh;
209
9
14
    return $res;
210}
211
212 - 218
=item $bo->export([$var])

Export the build options to the given environment variable. If omitted,
the environment variable defined at creation time is assumed. The value
set to the variable is also returned.

=cut
219
220sub export {
221
6
6
1
5
    my ($self, $var) = @_;
222
6
67
18
    $var //= $self->{envvar};
223
6
7
    my $content = $self->output();
224
6
11
    Dpkg::BuildEnv::set($var, $content);
225
6
8
    return $content;
226}
227
228=back
229
230 - 245
=head1 CHANGES

=head2 Version 1.02 (dpkg 1.18.19)

New method: $bo->parse_features().

=head2 Version 1.01 (dpkg 1.16.1)

Enable to use another environment variable instead of DEB_BUILD_OPTIONS.
Thus add support for the "envvar" option at creation time.

=head2 Version 1.00 (dpkg 1.15.6)

Mark the module as public.

=cut
246
2471;