File Coverage

File:Dpkg/BuildFlags.pm
Coverage:73.5%

linestmtbrancondsubpodtimecode
1# Copyright © 2010-2011 Raphaël Hertzog <hertzog@debian.org>
2#
3# This program is free software; you can redistribute it and/or modify
4# it under the terms of the GNU General Public License as published by
5# the Free Software Foundation; either version 2 of the License, or
6# (at your option) any later version.
7#
8# This program is distributed in the hope that it will be useful,
9# but WITHOUT ANY WARRANTY; without even the implied warranty of
10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11# GNU General Public License for more details.
12#
13# You should have received a copy of the GNU General Public License
14# along with this program.  If not, see <https://www.gnu.org/licenses/>.
15
16package Dpkg::BuildFlags;
17
18
3
3
3
7
2
34
use strict;
19
3
3
3
4
2
66
use warnings;
20
21our $VERSION = '1.04';
22
23
3
3
3
242
4
27
use Dpkg ();
24
3
3
3
225
2
69
use Dpkg::Gettext;
25
3
3
3
231
2
33
use Dpkg::Build::Env;
26
3
3
3
224
3
97
use Dpkg::ErrorHandling;
27
3
3
3
370
2
2260
use Dpkg::Vendor qw(run_vendor_hook);
28
29=encoding utf8
30
31 - 49
=head1 NAME

Dpkg::BuildFlags - query build flags

=head1 DESCRIPTION

This class is used by dpkg-buildflags and can be used
to query the same information.

=head1 METHODS

=over 4

=item $bf = Dpkg::BuildFlags->new()

Create a new Dpkg::BuildFlags object. It will be initialized based
on the value of several configuration files and environment variables.

=cut
50
51sub new {
52
4
1
5
    my ($this, %opts) = @_;
53
4
13
    my $class = ref($this) || $this;
54
55
4
4
    my $self = {
56    };
57
4
5
    bless $self, $class;
58
4
6
    $self->load_vendor_defaults();
59
4
11
    return $self;
60}
61
62 - 66
=item $bf->load_vendor_defaults()

Reset the flags stored to the default set provided by the vendor.

=cut
67
68sub load_vendor_defaults {
69
4
1
3
    my $self = shift;
70
71
4
8
    $self->{features} = {};
72    $self->{flags} = {
73
4
15
        ASFLAGS => '',
74        CPPFLAGS => '',
75        CFLAGS   => '',
76        CXXFLAGS => '',
77        OBJCFLAGS   => '',
78        OBJCXXFLAGS => '',
79        GCJFLAGS => '',
80        DFLAGS   => '',
81        FFLAGS   => '',
82        FCFLAGS  => '',
83        LDFLAGS  => '',
84    };
85    $self->{origin} = {
86
4
14
        ASFLAGS => 'vendor',
87        CPPFLAGS => 'vendor',
88        CFLAGS   => 'vendor',
89        CXXFLAGS => 'vendor',
90        OBJCFLAGS   => 'vendor',
91        OBJCXXFLAGS => 'vendor',
92        GCJFLAGS => 'vendor',
93        DFLAGS   => 'vendor',
94        FFLAGS   => 'vendor',
95        FCFLAGS  => 'vendor',
96        LDFLAGS  => 'vendor',
97    };
98    $self->{maintainer} = {
99
4
11
        ASFLAGS => 0,
100        CPPFLAGS => 0,
101        CFLAGS   => 0,
102        CXXFLAGS => 0,
103        OBJCFLAGS   => 0,
104        OBJCXXFLAGS => 0,
105        GCJFLAGS => 0,
106        DFLAGS   => 0,
107        FFLAGS   => 0,
108        FCFLAGS  => 0,
109        LDFLAGS  => 0,
110    };
111    # The vendor hook will add the feature areas build flags.
112
4
4
    run_vendor_hook('update-buildflags', $self);
113}
114
115 - 119
=item $bf->load_system_config()

Update flags from the system configuration.

=cut
120
121sub load_system_config {
122
1
1
0
    my $self = shift;
123
124
1
3
    $self->update_from_conffile("$Dpkg::CONFDIR/buildflags.conf", 'system');
125}
126
127 - 131
=item $bf->load_user_config()

Update flags from the user configuration.

=cut
132
133sub load_user_config {
134
1
1
22
    my $self = shift;
135
136
1
2
    my $confdir = $ENV{XDG_CONFIG_HOME};
137
1
3
    $confdir ||= $ENV{HOME} . '/.config' if length $ENV{HOME};
138
1
1
    if (length $confdir) {
139
1
21
        $self->update_from_conffile("$confdir/dpkg/buildflags.conf", 'user');
140    }
141}
142
143 - 148
=item $bf->load_environment_config()

Update flags based on user directives stored in the environment. See
dpkg-buildflags(1) for details.

=cut
149
150sub load_environment_config {
151
1
1
1
    my $self = shift;
152
153
1
1
1
1
    foreach my $flag (keys %{$self->{flags}}) {
154
11
6
        my $envvar = 'DEB_' . $flag . '_SET';
155
11
7
        if (Dpkg::Build::Env::has($envvar)) {
156
0
0
            $self->set($flag, Dpkg::Build::Env::get($envvar), 'env');
157        }
158
11
6
        $envvar = 'DEB_' . $flag . '_STRIP';
159
11
6
        if (Dpkg::Build::Env::has($envvar)) {
160
0
0
            $self->strip($flag, Dpkg::Build::Env::get($envvar), 'env');
161        }
162
11
4
        $envvar = 'DEB_' . $flag . '_APPEND';
163
11
8
        if (Dpkg::Build::Env::has($envvar)) {
164
0
0
            $self->append($flag, Dpkg::Build::Env::get($envvar), 'env');
165        }
166
11
7
        $envvar = 'DEB_' . $flag . '_PREPEND';
167
11
7
        if (Dpkg::Build::Env::has($envvar)) {
168
0
0
            $self->prepend($flag, Dpkg::Build::Env::get($envvar), 'env');
169        }
170    }
171}
172
173 - 178
=item $bf->load_maintainer_config()

Update flags based on maintainer directives stored in the environment. See
dpkg-buildflags(1) for details.

=cut
179
180sub load_maintainer_config {
181
1
1
1
    my $self = shift;
182
183
1
1
0
2
    foreach my $flag (keys %{$self->{flags}}) {
184
11
7
        my $envvar = 'DEB_' . $flag . '_MAINT_SET';
185
11
5
        if (Dpkg::Build::Env::has($envvar)) {
186
0
0
            $self->set($flag, Dpkg::Build::Env::get($envvar), undef, 1);
187        }
188
11
4
        $envvar = 'DEB_' . $flag . '_MAINT_STRIP';
189
11
8
        if (Dpkg::Build::Env::has($envvar)) {
190
0
0
            $self->strip($flag, Dpkg::Build::Env::get($envvar), undef, 1);
191        }
192
11
5
        $envvar = 'DEB_' . $flag . '_MAINT_APPEND';
193
11
7
        if (Dpkg::Build::Env::has($envvar)) {
194
0
0
            $self->append($flag, Dpkg::Build::Env::get($envvar), undef, 1);
195        }
196
11
6
        $envvar = 'DEB_' . $flag . '_MAINT_PREPEND';
197
11
5
        if (Dpkg::Build::Env::has($envvar)) {
198
0
0
            $self->prepend($flag, Dpkg::Build::Env::get($envvar), undef, 1);
199        }
200    }
201}
202
203
204 - 210
=item $bf->load_config()

Call successively load_system_config(), load_user_config(),
load_environment_config() and load_maintainer_config() to update the
default build flags defined by the vendor.

=cut
211
212sub load_config {
213
1
1
1
    my $self = shift;
214
215
1
2
    $self->load_system_config();
216
1
1
    $self->load_user_config();
217
1
1
    $self->load_environment_config();
218
1
1
    $self->load_maintainer_config();
219}
220
221 - 225
=item $bf->unset($flag)

Unset the build flag $flag, so that it will not be known anymore.

=cut
226
227sub unset {
228
0
1
0
    my ($self, $flag) = @_;
229
230
0
0
    delete $self->{flags}->{$flag};
231
0
0
    delete $self->{origin}->{$flag};
232
0
0
    delete $self->{maintainer}->{$flag};
233}
234
235 - 241
=item $bf->set($flag, $value, $source, $maint)

Update the build flag $flag with value $value and record its origin as
$source (if defined). Record it as maintainer modified if $maint is
defined and true.

=cut
242
243sub set {
244
8
1
3
    my ($self, $flag, $value, $src, $maint) = @_;
245
8
8
    $self->{flags}->{$flag} = $value;
246
8
8
    $self->{origin}->{$flag} = $src if defined $src;
247
8
5
    $self->{maintainer}->{$flag} = $maint if $maint;
248}
249
250 - 256
=item $bf->set_feature($area, $feature, $enabled)

Update the boolean state of whether a specific feature within a known
feature area has been enabled. The only currently known feature areas
are "future", "qa", "sanitize", "optimize", "hardening" and "reproducible".

=cut
257
258sub set_feature {
259
72
1
43
    my ($self, $area, $feature, $enabled) = @_;
260
72
62
    $self->{features}{$area}{$feature} = $enabled;
261}
262
263 - 269
=item $bf->strip($flag, $value, $source, $maint)

Update the build flag $flag by stripping the flags listed in $value and
record its origin as $source (if defined). Record it as maintainer modified
if $maint is defined and true.

=cut
270
271sub strip {
272
1
1
26
    my ($self, $flag, $value, $src, $maint) = @_;
273
1
2
    foreach my $tostrip (split(/\s+/, $value)) {
274
1
2
        next unless length $tostrip;
275
1
26
        $self->{flags}->{$flag} =~ s/(^|\s+)\Q$tostrip\E(\s+|$)/ /g;
276    }
277
1
1
    $self->{flags}->{$flag} =~ s/^\s+//g;
278
1
2
    $self->{flags}->{$flag} =~ s/\s+$//g;
279
1
2
    $self->{origin}->{$flag} = $src if defined $src;
280
1
1
    $self->{maintainer}->{$flag} = $maint if $maint;
281}
282
283 - 289
=item $bf->append($flag, $value, $source, $maint)

Append the options listed in $value to the current value of the flag $flag.
Record its origin as $source (if defined). Record it as maintainer modified
if $maint is defined and true.

=cut
290
291sub append {
292
117
1
68
    my ($self, $flag, $value, $src, $maint) = @_;
293
117
81
    if (length($self->{flags}->{$flag})) {
294
77
57
        $self->{flags}->{$flag} .= " $value";
295    } else {
296
40
31
        $self->{flags}->{$flag} = $value;
297    }
298
117
65
    $self->{origin}->{$flag} = $src if defined $src;
299
117
109
    $self->{maintainer}->{$flag} = $maint if $maint;
300}
301
302 - 308
=item $bf->prepend($flag, $value, $source, $maint)

Prepend the options listed in $value to the current value of the flag $flag.
Record its origin as $source (if defined). Record it as maintainer modified
if $maint is defined and true.

=cut
309
310sub prepend {
311
3
1
3
    my ($self, $flag, $value, $src, $maint) = @_;
312
3
4
    if (length($self->{flags}->{$flag})) {
313
3
6
        $self->{flags}->{$flag} = "$value " . $self->{flags}->{$flag};
314    } else {
315
0
0
        $self->{flags}->{$flag} = $value;
316    }
317
3
2
    $self->{origin}->{$flag} = $src if defined $src;
318
3
6
    $self->{maintainer}->{$flag} = $maint if $maint;
319}
320
321
322 - 329
=item $bf->update_from_conffile($file, $source)

Update the current build flags based on the configuration directives
contained in $file. See dpkg-buildflags(1) for the format of the directives.

$source is the origin recorded for any build flag set or modified.

=cut
330
331sub update_from_conffile {
332
2
1
2
    my ($self, $file, $src) = @_;
333
2
2
    local $_;
334
335
2
10
    return unless -e $file;
336
0
0
    open(my $conf_fh, '<', $file) or syserr(g_('cannot read %s'), $file);
337
0
0
    while (<$conf_fh>) {
338
0
0
        chomp;
339
0
0
        next if /^\s*#/; # Skip comments
340
0
0
        next if /^\s*$/; # Skip empty lines
341
0
0
        if (/^(append|prepend|set|strip)\s+(\S+)\s+(\S.*\S)\s*$/i) {
342
0
0
            my ($op, $flag, $value) = ($1, $2, $3);
343
0
0
            unless (exists $self->{flags}->{$flag}) {
344
0
0
                warning(g_('line %d of %s mentions unknown flag %s'), $., $file, $flag);
345
0
0
                $self->{flags}->{$flag} = '';
346            }
347
0
0
            if (lc($op) eq 'set') {
348
0
0
                $self->set($flag, $value, $src);
349            } elsif (lc($op) eq 'strip') {
350
0
0
                $self->strip($flag, $value, $src);
351            } elsif (lc($op) eq 'append') {
352
0
0
                $self->append($flag, $value, $src);
353            } elsif (lc($op) eq 'prepend') {
354
0
0
                $self->prepend($flag, $value, $src);
355            }
356        } else {
357
0
0
            warning(g_('line %d of %s is invalid, it has been ignored'), $., $file);
358        }
359    }
360
0
0
    close($conf_fh);
361}
362
363 - 368
=item $bf->get($flag)

Return the value associated to the flag. It might be undef if the
flag doesn't exist.

=cut
369
370sub get {
371
37
1
26
    my ($self, $key) = @_;
372
37
32
    return $self->{flags}{$key};
373}
374
375 - 380
=item $bf->get_feature_areas()

Return the feature areas (i.e. the area values has_features will return
true for).

=cut
381
382sub get_feature_areas {
383
1
1
0
    my $self = shift;
384
385
1
1
1
5
    return keys %{$self->{features}};
386}
387
388 - 393
=item $bf->get_features($area)

Return, for the given area, a hash with keys as feature names, and values
as booleans indicating whether the feature is enabled or not.

=cut
394
395sub get_features {
396
6
1
6
    my ($self, $area) = @_;
397
6
6
3
12
    return %{$self->{features}{$area}};
398}
399
400 - 405
=item $bf->get_origin($flag)

Return the origin associated to the flag. It might be undef if the
flag doesn't exist.

=cut
406
407sub get_origin {
408
5
1
5
    my ($self, $key) = @_;
409
5
7
    return $self->{origin}{$key};
410}
411
412 - 416
=item $bf->is_maintainer_modified($flag)

Return true if the flag is modified by the maintainer.

=cut
417
418sub is_maintainer_modified {
419
4
1
3
    my ($self, $key) = @_;
420
4
6
    return $self->{maintainer}{$key};
421}
422
423 - 429
=item $bf->has_features($area)

Returns true if the given area of features is known, and false otherwise.
The only currently recognized feature areas are "future", "qa", "sanitize",
"hardening" and "reproducible".

=cut
430
431sub has_features {
432
6
1
5
    my ($self, $area) = @_;
433
6
9
    return exists $self->{features}{$area};
434}
435
436 - 440
=item $bf->has($option)

Returns a boolean indicating whether the flags exists in the object.

=cut
441
442sub has {
443
1
1
1
    my ($self, $key) = @_;
444
1
2
    return exists $self->{flags}{$key};
445}
446
447 - 451
=item @flags = $bf->list()

Returns the list of flags stored in the object.

=cut
452
453sub list {
454
1
1
1
    my $self = shift;
455
1
1
0
3
    my @list = sort keys %{$self->{flags}};
456
1
3
    return @list;
457}
458
459=back
460
461 - 491
=head1 CHANGES

=head2 Version 1.04 (dpkg 1.20.0)

New method: $bf->unset().

=head2 Version 1.03 (dpkg 1.16.5)

New method: $bf->get_feature_areas() to list possible values for
$bf->get_features.

New method $bf->is_maintainer_modified() and new optional parameter to
$bf->set(), $bf->append(), $bf->prepend(), $bf->strip().

=head2 Version 1.02 (dpkg 1.16.2)

New methods: $bf->get_features(), $bf->has_features(), $bf->set_feature().

=head2 Version 1.01 (dpkg 1.16.1)

New method: $bf->prepend() very similar to append(). Implement support of
the prepend operation everywhere.

New method: $bf->load_maintainer_config() that update the build flags
based on the package maintainer directives.

=head2 Version 1.00 (dpkg 1.15.7)

Mark the module as public.

=cut
492
4931;