File Coverage

File:Dpkg/BuildOptions.pm
Coverage:92.2%

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
18package Dpkg::BuildOptions;
19
20
4
4
4
4
8
3
48
use strict;
21
4
4
4
4
12
1
91
use warnings;
22
23our $VERSION = '1.02';
24
25
4
4
4
4
7
4
101
use Dpkg::Gettext;
26
4
4
4
4
8
2
105
use Dpkg::ErrorHandling;
27
4
4
4
4
174
3
1571
use Dpkg::Build::Env;
28
29=encoding utf8
30
31 - 51
=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.

=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
52
53sub new {
54
14
14
1
16
    my ($this, %opts) = @_;
55
14
33
35
    my $class = ref($this) || $this;
56
57    my $self = {
58        options => {},
59        source => {},
60
14
100
33
        envvar => $opts{envvar} // 'DEB_BUILD_OPTIONS',
61    };
62
14
11
    bless $self, $class;
63
14
20
    $self->merge(Dpkg::Build::Env::get($self->{envvar}), $self->{envvar});
64
14
18
    return $self;
65}
66
67 - 71
=item $bo->reset()

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

=cut
72
73sub reset {
74
2
2
1
1
    my $self = shift;
75
2
3
    $self->{options} = {};
76
2
2
    $self->{source} = {};
77}
78
79 - 88
=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
89
90sub merge {
91
15
15
1
12
    my ($self, $content, $source) = @_;
92
15
100
18
    return 0 unless defined $content;
93
5
3
    my $count = 0;
94
5
7
    foreach (split(/\s+/, $content)) {
95
15
100
30
        unless (/^([a-z][a-z0-9_-]*)(?:=(\S*))?$/) {
96
3
3
            warning(g_('invalid flag in %s: %s'), $source, $_);
97
3
3
            next;
98        }
99
12
10
        $count += $self->set($1, $2, $source);
100    }
101
5
5
    return $count;
102}
103
104 - 115
=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
116
117sub set {
118
19
19
1
20
    my ($self, $key, $value, $source) = @_;
119
120    # Sanity checks
121
19
100
100
100
46
    if ($key =~ /^(terse|noopt|nostrip|nocheck)$/ && defined($value)) {
122
1
0
        $value = undef;
123    } elsif ($key eq 'parallel')  {
124
4
100
6
        $value //= '';
125
4
50
5
        return 0 if $value !~ /^\d*$/;
126    }
127
128
19
19
    $self->{options}{$key} = $value;
129
19
13
    $self->{source}{$key} = $source;
130
131
19
14
    return 1;
132}
133
134 - 140
=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
141
142sub get {
143
61
61
1
41
    my ($self, $key) = @_;
144
61
93
    return $self->{options}{$key};
145}
146
147 - 151
=item $bo->has($option)

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

=cut
152
153sub has {
154
20
20
1
18
    my ($self, $key) = @_;
155
20
31
    return exists $self->{options}{$key};
156}
157
158 - 169
=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
170
171sub parse_features {
172
52
52
1
26
    my ($self, $option, $use_feature) = @_;
173
174
52
100
33
    foreach my $feature (split(/,/, $self->get($option) // '')) {
175
7
5
        $feature = lc $feature;
176
7
50
12
        if ($feature =~ s/^([+-])//) {
177
7
100
8
            my $value = ($1 eq '+') ? 1 : 0;
178
7
100
5
            if ($feature eq 'all') {
179
3
3
3
6
                $use_feature->{$_} = $value foreach keys %{$use_feature};
180            } else {
181
4
50
4
                if (exists $use_feature->{$feature}) {
182
4
3
                    $use_feature->{$feature} = $value;
183                } else {
184                    warning(g_('unknown %s feature in %s variable: %s'),
185
0
0
                            $option, $self->{envvar}, $feature);
186                }
187            }
188        } else {
189            warning(g_('incorrect value in %s option of %s variable: %s'),
190
0
0
                    $option, $self->{envvar}, $feature);
191        }
192    }
193}
194
195 - 201
=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
202
203sub output {
204
3
3
1
2
    my ($self, $fh) = @_;
205
3
2
    my $o = $self->{options};
206
3
6
100
7
9
    my $res = join(' ', map { defined($o->{$_}) ? $_ . '=' . $o->{$_} : $_ } sort keys %$o);
207
3
0
50
3
0
    print { $fh } $res if defined $fh;
208
3
2
    return $res;
209}
210
211 - 217
=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
218
219sub export {
220
2
2
1
2
    my ($self, $var) = @_;
221
2
67
4
    $var //= $self->{envvar};
222
2
2
    my $content = $self->output();
223
2
3
    Dpkg::Build::Env::set($var, $content);
224
2
2
    return $content;
225}
226
227=back
228
229 - 244
=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
245
2461;