diff options
-rw-r--r-- | scripts/Dpkg/BuildFlags.pm | 266 | ||||
-rw-r--r-- | scripts/Makefile.am | 1 | ||||
-rw-r--r-- | scripts/po/POTFILES.in | 1 |
3 files changed, 268 insertions, 0 deletions
diff --git a/scripts/Dpkg/BuildFlags.pm b/scripts/Dpkg/BuildFlags.pm new file mode 100644 index 000000000..9114f0c1b --- /dev/null +++ b/scripts/Dpkg/BuildFlags.pm @@ -0,0 +1,266 @@ +# Copyright © 2010 Raphaël Hertzog <hertzog@debian.org> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <http://www.gnu.org/licenses/>. + +package Dpkg::BuildFlags; + +use strict; +use warnings; + +our $VERSION = "1.00"; + +use Dpkg::Gettext; +use Dpkg::BuildOptions; +use Dpkg::ErrorHandling; +use Dpkg::Vendor qw(run_vendor_hook); + +=encoding utf8 + +=head1 NAME + +Dpkg::BuildFlags - query build flags + +=head1 DESCRIPTION + +The Dpkg::BuildFlags object is used by dpkg-buildflags and can be used +to query the same information. + +=head1 FUNCTIONS + +=over 4 + +=item my $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 + +sub new { + my ($this, %opts) = @_; + my $class = ref($this) || $this; + + my $self = { + }; + bless $self, $class; + $self->load_vendor_defaults(); + return $self; +} + +=item $bf->load_vendor_defaults() + +Reset the flags stored to the default set provided by the vendor. + +=cut + +sub load_vendor_defaults { + my ($self) = @_; + $self->{'options'} = {}; + $self->{'source'} = {}; + my $build_opts = Dpkg::BuildOptions->new(); + my $default_flags = $build_opts->has("noopt") ? "-g -O0" : "-g -O2"; + $self->{flags} = { + CPPFLAGS => '', + CFLAGS => $default_flags, + CXXFLAGS => $default_flags, + FFLAGS => $default_flags, + LDFLAGS => '', + }; + $self->{origin} = { + CPPFLAGS => 'vendor', + CFLAGS => 'vendor', + CXXFLAGS => 'vendor', + FFLAGS => 'vendor', + LDFLAGS => 'vendor', + }; + run_vendor_hook("update-buildflags", $self->{flags}, $self->{origin}); +} + +=item $bf->load_system_config() + +Update flags from the system configuration. + +=cut + +sub load_system_config { + my ($self) = @_; + $self->update_from_conffile("/etc/dpkg/buildflags.conf", "system"); +} + +=item $bf->load_user_config() + +Update flags from the user configuration. + +=cut + +sub load_user_config { + my ($self) = @_; + $self->update_from_conffile($ENV{"HOME"} . "/.config/dpkg-buildflags.conf", "user"); +} + +=item $bf->load_environment_config() + +Update flags based on directives stored in the environment. See +dpkg-buildflags(1) for details. + +=cut + +sub load_environment_config { + my ($self) = @_; + foreach my $flag (keys %{$self->{flags}}) { + my $envvar = "DEB_" . $flag . "_SET"; + if (exists $ENV{$envvar}) { + $self->set($flag, $ENV{$envvar}, "env"); + } + $envvar = "DEB_" . $flag . "_APPEND"; + if (exists $ENV{$envvar}) { + $self->append($flag, $ENV{$envvar}, "env"); + } + } +} + +=item $bf->load_config() + +Call successively load_system_config(), load_user_config() and +load_environment_config() to update the default build flags +defined by the vendor. + +=cut + +sub load_config { + my ($self) = @_; + $self->load_system_config(); + $self->load_user_config(); + $self->load_environment_config(); +} + +=item $bf->set($flag, $value, $source) + +Update the build flag $flag with value $value and record its origin as $source. + +=cut + +sub set { + my ($self, $flag, $value, $src) = @_; + $self->{flags}->{$flag} = $value; + $self->{origin}->{$flag} = $src; +} + +=item $bf->append($flag, $value, $source) + +Append the options listed in $value to the current value of the flag $flag. +Record its origin as $source. + +=cut + +sub append { + my ($self, $flag, $value, $src) = @_; + if (length($self->{flags}->{$flag})) { + $self->{flags}->{$flag} .= " $value"; + } else { + $self->{flags}->{$flag} = $value; + } + $self->{origin}->{$flag} = $src; +} + +=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 + +sub update_from_conffile { + my ($self, $file, $src) = @_; + return unless -e $file; + open(CNF, "<", $file) or syserr(_g("cannot read %s"), $file); + while(<CNF>) { + chomp; + next if /^\s*#/; # Skip comments + next if /^\s*$/; # Skip empty lines + if (/^(append|set)\s+(\S+)\s+(\S.*\S)\s*$/i) { + my ($op, $flag, $value) = ($1, $2, $3); + unless (exists $self->{flags}->{$flag}) { + warning(_g("line %d of %s mentions unknown flag %s"), $., $file, $flag); + $self->{flags}->{$flag} = ""; + } + if (lc($op) eq "set") { + $self->set($flag, $value, $src); + } elsif (lc($op) eq "append") { + $self->append($flag, $value, $src); + } + } else { + warning(_g("line %d of %s is invalid, it has been ignored."), $., $file); + } + } + close(CNF); +} + +=item $bf->get($flag) + +Return the value associated to the flag. It might be undef if the +flag doesn't exist. + +=cut + +sub get { + my ($self, $key) = @_; + return $self->{'flags'}{$key}; +} + +=item $bf->get_origin($flag) + +Return the origin associated to the flag. It might be undef if the +flag doesn't exist. + +=cut + +sub get_origin { + my ($self, $key) = @_; + return $self->{'origin'}{$key}; +} + +=item $bf->has($option) + +Returns a boolean indicating whether the flags exists in the object. + +=cut + +sub has { + my ($self, $key) = @_; + return exists $self->{'flags'}{$key}; +} + +=item my @flags = $bf->list() + +Returns the list of flags stored in the object. + +=cut + +sub list { + my ($self) = @_; + return sort keys %{$self->{'flags'}}; +} + +=back + +=head1 AUTHOR + +Raphaël Hertzog <hertzog@debian.org> + +=cut + +1; diff --git a/scripts/Makefile.am b/scripts/Makefile.am index 025871b98..d70af7e55 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -56,6 +56,7 @@ CLEANFILES = \ perllibdir = $(PERL_LIBDIR) nobase_dist_perllib_DATA = \ Dpkg/Arch.pm \ + Dpkg/BuildFlags.pm \ Dpkg/BuildOptions.pm \ Dpkg/Changelog.pm \ Dpkg/Changelog/Debian.pm \ diff --git a/scripts/po/POTFILES.in b/scripts/po/POTFILES.in index d45ba10b6..9b7483cd9 100644 --- a/scripts/po/POTFILES.in +++ b/scripts/po/POTFILES.in @@ -15,6 +15,7 @@ scripts/dpkg-shlibdeps.pl scripts/dpkg-source.pl scripts/changelog/debian.pl scripts/Dpkg/Arch.pm +scripts/Dpkg/BuildFlags.pm scripts/Dpkg/BuildOptions.pm scripts/Dpkg/Compression.pm scripts/Dpkg/Compression/FileHandle.pm |