Commit | Line | Data |
---|---|---|
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 | ||
18 | package Dpkg::BuildOptions; | |
19 | ||
20 | use strict; | |
21 | use warnings; | |
22 | ||
23 | our $VERSION = '1.02'; | |
24 | ||
25 | use Dpkg::Gettext; | |
26 | use Dpkg::ErrorHandling; | |
27 | use Dpkg::Build::Env; | |
28 | ||
29 | =encoding utf8 | |
30 | ||
31 | =head1 NAME | |
32 | ||
33 | Dpkg::BuildOptions - parse and update build options | |
34 | ||
35 | =head1 DESCRIPTION | |
36 | ||
37 | The Dpkg::BuildOptions object can be used to manipulate options stored | |
38 | in environment variables like DEB_BUILD_OPTIONS and | |
39 | DEB_BUILD_MAINT_OPTIONS. | |
40 | ||
41 | =head1 METHODS | |
42 | ||
43 | =over 4 | |
44 | ||
45 | =item $bo = Dpkg::BuildOptions->new(%opts) | |
46 | ||
47 | Create a new Dpkg::BuildOptions object. It will be initialized based | |
48 | on the value of the environment variable named $opts{envvar} (or | |
49 | DEB_BUILD_OPTIONS if that option is not set). | |
50 | ||
51 | =cut | |
52 | ||
53 | sub 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 | ||
69 | Reset the object to not have any option (it's empty). | |
70 | ||
71 | =cut | |
72 | ||
73 | sub reset { | |
74 | my $self = shift; | |
75 | $self->{options} = {}; | |
76 | $self->{source} = {}; | |
77 | } | |
78 | ||
79 | =item $bo->merge($content, $source) | |
80 | ||
81 | Merge the options set in $content and record that they come from the | |
82 | source $source. $source is mainly used in warning messages currently | |
83 | to indicate where invalid options have been detected. | |
84 | ||
85 | $content is a space separated list of options with optional assigned | |
86 | values like "nocheck parallel=2". | |
87 | ||
88 | =cut | |
89 | ||
90 | sub 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 | ||
106 | Store the given option in the object with the given value. It's legitimate | |
107 | for a value to be undefined if the option is a simple boolean (its | |
108 | presence means true, its absence means false). The $source is optional | |
109 | and indicates where the option comes from. | |
110 | ||
111 | The known options have their values checked for sanity. Options without | |
112 | values have their value removed and options with invalid values are | |
113 | discarded. | |
114 | ||
115 | =cut | |
116 | ||
117 | sub 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 | ||
136 | Return the value associated to the option. It might be undef even if the | |
137 | option exists. You might want to check with $bo->has($option) to verify if | |
138 | the option is stored in the object. | |
139 | ||
140 | =cut | |
141 | ||
142 | sub get { | |
143 | my ($self, $key) = @_; | |
144 | return $self->{options}{$key}; | |
145 | } | |
146 | ||
147 | =item $bo->has($option) | |
148 | ||
149 | Returns a boolean indicating whether the option is stored in the object. | |
150 | ||
151 | =cut | |
152 | ||
153 | sub has { | |
154 | my ($self, $key) = @_; | |
155 | return exists $self->{options}{$key}; | |
156 | } | |
157 | ||
158 | =item $bo->parse_features($option, $use_feature) | |
159 | ||
160 | Parse the $option values, as a set of known features to enable or disable, | |
161 | as specified in the $use_feature hash reference. | |
162 | ||
163 | Each feature is prefixed with a ‘B<+>’ or a ‘B<->’ character as a marker | |
164 | to enable or disable it. The special feature “B<all>” can be used to act | |
165 | on all known features. | |
166 | ||
167 | Unknown of malformed features will emit warnings. | |
168 | ||
169 | =cut | |
170 | ||
171 | sub 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 | ||
197 | Return a string representation of the build options suitable to be | |
198 | assigned to an environment variable. Can optionally output that string to | |
199 | the given filehandle. | |
200 | ||
201 | =cut | |
202 | ||
203 | sub 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 | ||
213 | Export the build options to the given environment variable. If omitted, | |
214 | the environment variable defined at creation time is assumed. The value | |
215 | set to the variable is also returned. | |
216 | ||
217 | =cut | |
218 | ||
219 | sub 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 | ||
233 | New method: $bo->parse_features(). | |
234 | ||
235 | =head2 Version 1.01 (dpkg 1.16.1) | |
236 | ||
237 | Enable to use another environment variable instead of DEB_BUILD_OPTIONS. | |
238 | Thus add support for the "envvar" option at creation time. | |
239 | ||
240 | =head2 Version 1.00 (dpkg 1.15.6) | |
241 | ||
242 | Mark the module as public. | |
243 | ||
244 | =cut | |
245 | ||
246 | 1; |