File Coverage

blib/lib/Dpkg/BuildOptions.pm
Criterion Covered Total %
statement 66 69 95.6
branch 18 22 81.8
condition 12 15 80.0
subroutine 14 14 100.0
pod 9 9 100.0
total 119 129 92.2


line stmt bran cond sub pod time code
1             # Copyright © 2007 Frank Lichtenheld
2             # Copyright © 2008, 2012-2017 Guillem Jover
3             # Copyright © 2010 Raphaël Hertzog
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 .
17              
18             package Dpkg::BuildOptions;
19              
20 3     3   721 use strict;
  3         5  
  3         104  
21 3     3   16 use warnings;
  3         6  
  3         116  
22              
23             our $VERSION = '1.02';
24              
25 3     3   97 use Dpkg::Gettext;
  3         8  
  3         197  
26 3     3   18 use Dpkg::ErrorHandling;
  3         5  
  3         237  
27 3     3   493 use Dpkg::Build::Env;
  3         6  
  3         2862  
28              
29             =encoding utf8
30              
31             =head1 NAME
32              
33             Dpkg::BuildOptions - parse and update build options
34              
35             =head1 DESCRIPTION
36              
37             This class 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 12     12 1 566 my ($this, %opts) = @_;
55 12   33     55 my $class = ref($this) || $this;
56              
57             my $self = {
58             options => {},
59             source => {},
60 12   100     68 envvar => $opts{envvar} // 'DEB_BUILD_OPTIONS',
61             };
62 12         24 bless $self, $class;
63 12         48 $self->merge(Dpkg::Build::Env::get($self->{envvar}), $self->{envvar});
64 12         46 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 2     2 1 4 my $self = shift;
75 2         6 $self->{options} = {};
76 2         6 $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 13     13 1 26 my ($self, $content, $source) = @_;
92 13 100       32 return 0 unless defined $content;
93 5         9 my $count = 0;
94 5         26 foreach (split(/\s+/, $content)) {
95 15 100       96 unless (/^([a-z][a-z0-9_-]*)(?:=(\S*))?$/) {
96 3         7 warning(g_('invalid flag in %s: %s'), $source, $_);
97 3         6 next;
98             }
99 12         26 $count += $self->set($1, $2, $source);
100             }
101 5         10 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 19     19 1 1834 my ($self, $key, $value, $source) = @_;
119              
120             # Sanity checks
121 19 100 100     84 if ($key =~ /^(noopt|nostrip|nocheck)$/ && defined($value)) {
    100          
122 1         3 $value = undef;
123             } elsif ($key eq 'parallel') {
124 4   100     12 $value //= '';
125 4 50       14 return 0 if $value !~ /^\d*$/;
126             }
127              
128 19         44 $self->{options}{$key} = $value;
129 19         30 $self->{source}{$key} = $source;
130              
131 19         36 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 43     43 1 80 my ($self, $key) = @_;
144 43         176 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 18     18 1 48 my ($self, $key) = @_;
155 18         82 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” can be used to act
165             on all known features.
166              
167             Unknown or malformed features will emit warnings.
168              
169             =cut
170              
171             sub parse_features {
172 34     34 1 58 my ($self, $option, $use_feature) = @_;
173              
174 34   100     72 foreach my $feature (split(/,/, $self->get($option) // '')) {
175 7         23 $feature = lc $feature;
176 7 50       26 if ($feature =~ s/^([+-])//) {
177 7 100       19 my $value = ($1 eq '+') ? 1 : 0;
178 7 100       12 if ($feature eq 'all') {
179 3         4 $use_feature->{$_} = $value foreach keys %{$use_feature};
  3         14  
180             } else {
181 4 50       10 if (exists $use_feature->{$feature}) {
182 4         11 $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             =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 3     3 1 8 my ($self, $fh) = @_;
205 3         3 my $o = $self->{options};
206 3 100       16 my $res = join(' ', map { defined($o->{$_}) ? $_ . '=' . $o->{$_} : $_ } sort keys %$o);
  6         23  
207 3 50       7 print { $fh } $res if defined $fh;
  0         0  
208 3         10 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 2     2 1 1093 my ($self, $var) = @_;
221 2   66     9 $var //= $self->{envvar};
222 2         5 my $content = $self->output();
223 2         6 Dpkg::Build::Env::set($var, $content);
224 2         5 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;