dpkg-gencontrol: now indicates which package is concerned by the substvars warnings

Enhance Dpkg::Substvarst to be able to display a prefix before its
warnings and errors and make use of that facility in dpkg-gencontrol to be
explicit about where the substitution is done.

4 files changed, 31 insertions, 9 deletions

diff --git a/debian/changelog b/debian/changelog
index 02f05290e..8be2c8b0b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -41,6 +41,8 @@ dpkg (1.15.6) UNRELEASED; urgency=low
   * dpkg-gencontrol no longer warns if a substitution variable provided by -V
     is not used (the warning is meant to catch unused substitutions coming
     from the file, those are package specific with debhelper). Closes: #557133
+  * dpkg-gencontrol now indicates which package is concerned by the substvars
+    warning that it displays. Closes: #566837
 
   [ Guillem Jover ]
   * Handle argument parsing in dpkg-checkbuilddeps and dpkg-scanpackages
diff --git a/scripts/Dpkg/Control/Hash.pm b/scripts/Dpkg/Control/Hash.pm
index 6b9f9d5de..b613da40d 100644
--- a/scripts/Dpkg/Control/Hash.pm
+++ b/scripts/Dpkg/Control/Hash.pm
@@ -339,7 +339,7 @@ the corresponding value stored in the Dpkg::Substvars object.
 =cut
 
 sub apply_substvars {
-    my ($self, $substvars) = @_;
+    my ($self, $substvars, %opts) = @_;
 
     # Add substvars to refer to other fields
     foreach my $f (keys %$self) {
@@ -348,7 +348,7 @@ sub apply_substvars {
     }
 
     foreach my $f (keys %$self) {
-        my $v = $substvars->substvars($self->{$f});
+        my $v = $substvars->substvars($self->{$f}, %opts);
 	if ($v ne $self->{$f}) {
 	    # If we replaced stuff, ensure we're not breaking
 	    # a dependency field by introducing empty lines, or multiple
diff --git a/scripts/Dpkg/Substvars.pm b/scripts/Dpkg/Substvars.pm
index 081c9ffbc..65ccdd284 100644
--- a/scripts/Dpkg/Substvars.pm
+++ b/scripts/Dpkg/Substvars.pm
@@ -70,6 +70,7 @@ sub new {
             "dpkg:Upstream-Version" => $version,
             },
         used => {},
+	msg_prefix => "",
     };
     $self->{'vars'}{'dpkg:Upstream-Version'} =~ s/-[^-]+$//;
     bless $self, $class;
@@ -196,11 +197,13 @@ Substitutes variables in $string and return the result in $newstring.
 =cut
 
 sub substvars {
-    my ($self, $v) = @_;
+    my ($self, $v, %opts) = @_;
     my $lhs;
     my $vn;
     my $rhs = '';
     my $count = 0;
+    $opts{msg_prefix} = $self->{msg_prefix} unless exists $opts{msg_prefix};
+    $opts{no_warn} = 0 unless exists $opts{no_warn};
 
     while ($v =~ m/^(.*?)\$\{([-:0-9a-z]+)\}(.*)$/si) {
         # If we have consumed more from the leftover data, then
@@ -208,14 +211,16 @@ sub substvars {
         $count = 0 if (length($3) < length($rhs));
 
         $count < $maxsubsts ||
-            error(_g("too many substitutions - recursive ? - in \`%s'"), $v);
+            error($opts{msg_prefix} .
+	          _g("too many substitutions - recursive ? - in \`%s'"), $v);
         $lhs = $1; $vn = $2; $rhs = $3;
         if (defined($self->{'vars'}{$vn})) {
             $v = $lhs . $self->{'vars'}{$vn} . $rhs;
 	    $self->no_warn($vn);
             $count++;
         } else {
-            warning(_g("unknown substitution variable \${%s}"), $vn);
+            warning($opts{msg_prefix} . _g("unknown substitution variable \${%s}"),
+	            $vn) unless $opts{no_warn};
             $v = $lhs . $rhs;
         }
     }
@@ -229,7 +234,8 @@ Issues warning about any variables that were set, but not used
 =cut
 
 sub warn_about_unused {
-    my ($self) = @_;
+    my ($self, %opts) = @_;
+    $opts{msg_prefix} = $self->{msg_prefix} unless exists $opts{msg_prefix};
 
     foreach my $vn (keys %{$self->{'vars'}}) {
         next if $self->{'used'}{$vn};
@@ -237,10 +243,22 @@ sub warn_about_unused {
         # that they are not required in the current situation
         # (example: debhelper's misc:Depends in many cases)
         next if $self->{'vars'}{$vn} eq "";
-        warning(_g("unused substitution variable \${%s}"), $vn);
+        warning($opts{msg_prefix} . _g("unused substitution variable \${%s}"), $vn);
     }
 }
 
+=item $s->set_msg_prefix($prefix)
+
+Define a prefix displayed before all warnings/error messages output
+by the module.
+
+=cut
+
+sub set_msg_prefix {
+    my ($self, $prefix) = @_;
+    $self->{msg_prefix} = $prefix;
+}
+
 =item $s->save($file)
 
 Store all substitutions variables except the automatic ones in the
diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl
index 9e30d90bd..5ef79f183 100755
--- a/scripts/dpkg-gencontrol.pl
+++ b/scripts/dpkg-gencontrol.pl
@@ -156,6 +156,7 @@ if (defined($oppackage)) {
               "@packages");
     $pkg = $control->get_pkg_by_idx(1);
 }
+$substvars->set_msg_prefix(sprintf(_g("package %s: "), $pkg->{Package}));
 
 # Scan source package
 my $src_fields = $control->get_source();
@@ -221,7 +222,7 @@ $fields->{'Version'} = $forceversion if defined($forceversion);
 my $facts = Dpkg::Deps::KnownFacts->new();
 $facts->add_installed_package($fields->{'Package'}, $fields->{'Version'});
 if (exists $pkg->{"Provides"}) {
-    my $provides = deps_parse($substvars->substvars($pkg->{"Provides"}),
+    my $provides = deps_parse($substvars->substvars($pkg->{"Provides"}, no_warn => 1),
                               reduce_arch => 1, union => 1);
     if (defined $provides) {
 	foreach my $subdep ($provides->get_deps()) {
@@ -240,7 +241,8 @@ foreach my $field (field_list_pkg_dep()) {
     my $reduce_arch = debarch_eq('all', $pkg->{Architecture} || "all") ? 0 : 1;
     if (exists $pkg->{$field}) {
 	my $dep;
-	my $field_value = $substvars->substvars($pkg->{$field});
+	my $field_value = $substvars->substvars($pkg->{$field},
+	    msg_prefix => sprintf(_g("%s field of package %s: "), $field, $pkg->{Package}));
 	if (field_get_dep_type($field) eq 'normal') {
 	    $dep = deps_parse($field_value, use_arch => 1,
 			      reduce_arch => $reduce_arch);