The following commit has been merged in the master branch:
commit 4c1743cb6ec8478fc099201a7811caa0d892ebaa
Author: Raphaël Hertzog <[email protected]>
Date: Sun Apr 11 17:14:34 2010 +0200
Dpkg::BuildFlags: new module to query/manage build flags
diff --git a/scripts/Dpkg/BuildFlags.pm b/scripts/Dpkg/BuildFlags.pm
new file mode 100644
index 0000000..9114f0c
--- /dev/null
+++ b/scripts/Dpkg/BuildFlags.pm
@@ -0,0 +1,266 @@
+# Copyright © 2010 Raphaël Hertzog <[email protected]>
+#
+# 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 <[email protected]>
+
+=cut
+
+1;
diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index 025871b..d70af7e 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 d45ba10..9b7483c 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
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
