scripts/Dpkg/BuildOptions.pm

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