chiark - git - mdw - dpkg/blob - 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 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;