dpkg (1.18.25) stretch; urgency=medium
[dpkg] / scripts / Dpkg / BuildOptions.pm
CommitLineData
1479465f
GJ
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
20use strict;
21use warnings;
22
23our $VERSION = '1.02';
24
25use Dpkg::Gettext;
26use Dpkg::ErrorHandling;
27use Dpkg::Build::Env;
28
29=encoding utf8
30
31=head1 NAME
32
33Dpkg::BuildOptions - parse and update build options
34
35=head1 DESCRIPTION
36
37The Dpkg::BuildOptions object can be used to manipulate options stored
38in environment variables like DEB_BUILD_OPTIONS and
39DEB_BUILD_MAINT_OPTIONS.
40
41=head1 METHODS
42
43=over 4
44
45=item $bo = Dpkg::BuildOptions->new(%opts)
46
47Create a new Dpkg::BuildOptions object. It will be initialized based
48on the value of the environment variable named $opts{envvar} (or
49DEB_BUILD_OPTIONS if that option is not set).
50
51=cut
52
53sub new {
54 my ($this, %opts) = @_;
55 my $class = ref($this) || $this;
56
57 my $self = {
58 options => {},
59 source => {},
60 envvar => $opts{envvar} // 'DEB_BUILD_OPTIONS',
61 };
62 bless $self, $class;
63 $self->merge(Dpkg::Build::Env::get($self->{envvar}), $self->{envvar});
64 return $self;
65}
66
67=item $bo->reset()
68
69Reset the object to not have any option (it's empty).
70
71=cut
72
73sub reset {
74 my $self = shift;
75 $self->{options} = {};
76 $self->{source} = {};
77}
78
79=item $bo->merge($content, $source)
80
81Merge the options set in $content and record that they come from the
82source $source. $source is mainly used in warning messages currently
83to indicate where invalid options have been detected.
84
85$content is a space separated list of options with optional assigned
86values like "nocheck parallel=2".
87
88=cut
89
90sub merge {
91 my ($self, $content, $source) = @_;
92 return 0 unless defined $content;
93 my $count = 0;
94 foreach (split(/\s+/, $content)) {
95 unless (/^([a-z][a-z0-9_-]*)(?:=(\S*))?$/) {
96 warning(g_('invalid flag in %s: %s'), $source, $_);
97 next;
98 }
99 $count += $self->set($1, $2, $source);
100 }
101 return $count;
102}
103
104=item $bo->set($option, $value, [$source])
105
106Store the given option in the object with the given value. It's legitimate
107for a value to be undefined if the option is a simple boolean (its
108presence means true, its absence means false). The $source is optional
109and indicates where the option comes from.
110
111The known options have their values checked for sanity. Options without
112values have their value removed and options with invalid values are
113discarded.
114
115=cut
116
117sub set {
118 my ($self, $key, $value, $source) = @_;
119
120 # Sanity checks
121 if ($key =~ /^(noopt|nostrip|nocheck)$/ && defined($value)) {
122 $value = undef;
123 } elsif ($key eq 'parallel') {
124 $value //= '';
125 return 0 if $value !~ /^\d*$/;
126 }
127
128 $self->{options}{$key} = $value;
129 $self->{source}{$key} = $source;
130
131 return 1;
132}
133
134=item $bo->get($option)
135
136Return the value associated to the option. It might be undef even if the
137option exists. You might want to check with $bo->has($option) to verify if
138the option is stored in the object.
139
140=cut
141
142sub get {
143 my ($self, $key) = @_;
144 return $self->{options}{$key};
145}
146
147=item $bo->has($option)
148
149Returns a boolean indicating whether the option is stored in the object.
150
151=cut
152
153sub has {
154 my ($self, $key) = @_;
155 return exists $self->{options}{$key};
156}
157
158=item $bo->parse_features($option, $use_feature)
159
160Parse the $option values, as a set of known features to enable or disable,
161as specified in the $use_feature hash reference.
162
163Each feature is prefixed with a ‘B<+>’ or a ‘B<->’ character as a marker
164to enable or disable it. The special feature “B<all>” can be used to act
165on all known features.
166
167Unknown of malformed features will emit warnings.
168
169=cut
170
171sub parse_features {
172 my ($self, $option, $use_feature) = @_;
173
174 foreach my $feature (split(/,/, $self->get($option) // '')) {
175 $feature = lc $feature;
176 if ($feature =~ s/^([+-])//) {
177 my $value = ($1 eq '+') ? 1 : 0;
178 if ($feature eq 'all') {
179 $use_feature->{$_} = $value foreach keys %{$use_feature};
180 } else {
181 if (exists $use_feature->{$feature}) {
182 $use_feature->{$feature} = $value;
183 } else {
184 warning(g_('unknown %s feature in %s variable: %s'),
185 $option, $self->{envvar}, $feature);
186 }
187 }
188 } else {
189 warning(g_('incorrect value in %s option of %s variable: %s'),
190 $option, $self->{envvar}, $feature);
191 }
192 }
193}
194
195=item $string = $bo->output($fh)
196
197Return a string representation of the build options suitable to be
198assigned to an environment variable. Can optionally output that string to
199the given filehandle.
200
201=cut
202
203sub output {
204 my ($self, $fh) = @_;
205 my $o = $self->{options};
206 my $res = join(' ', map { defined($o->{$_}) ? $_ . '=' . $o->{$_} : $_ } sort keys %$o);
207 print { $fh } $res if defined $fh;
208 return $res;
209}
210
211=item $bo->export([$var])
212
213Export the build options to the given environment variable. If omitted,
214the environment variable defined at creation time is assumed. The value
215set to the variable is also returned.
216
217=cut
218
219sub export {
220 my ($self, $var) = @_;
221 $var //= $self->{envvar};
222 my $content = $self->output();
223 Dpkg::Build::Env::set($var, $content);
224 return $content;
225}
226
227=back
228
229=head1 CHANGES
230
231=head2 Version 1.02 (dpkg 1.18.19)
232
233New method: $bo->parse_features().
234
235=head2 Version 1.01 (dpkg 1.16.1)
236
237Enable to use another environment variable instead of DEB_BUILD_OPTIONS.
238Thus add support for the "envvar" option at creation time.
239
240=head2 Version 1.00 (dpkg 1.15.6)
241
242Mark the module as public.
243
244=cut
245
2461;