Dpkg::Substvars: Add new filter() method

debian/changelog

@@ -102,6 +102,7 @@ dpkg (1.18.0) UNRELEASED; urgency=low
     - Always sort the Dpkg::Dist::Files files list on output, instead of
       preserving the insertion order, which is not reproducible with parallel
       builds. Reported by Jérémy Bobbio <lunar@debian.org>.
+    - Add new filter() method to Dpkg::Substvars.
   * Test suite:
     - Check perl code compilation, warnings and strictness.
     - Fix dpkg-divert unit test to work on BSD «rm -rf» that cannot traverse

scripts/Dpkg/Substvars.pm

@@ -1,4 +1,4 @@
-# Copyright © 2006-2009,2012-2014 Guillem Jover <guillem@debian.org>
+# Copyright © 2006-2009, 2012-2015 Guillem Jover <guillem@debian.org>
 # Copyright © 2007-2010 Raphaël Hertzog <hertzog@debian.org>
 #
 # This program is free software; you can redistribute it and/or modify
@@ -19,7 +19,7 @@ package Dpkg::Substvars;
 use strict;
 use warnings;
 
-our $VERSION = '1.03';
+our $VERSION = '1.04';
 
 use POSIX qw(:errno_h);
 use Carp;
@@ -336,6 +336,25 @@ sub set_msg_prefix {
     $self->{msg_prefix} = $prefix;
 }
 
+=item $s->filter(remove => $rmfunc)
+=item $s->filter(keep => $keepfun)
+
+Filter the substitution variables, either removing or keeping all those
+that return true when &$rmfunc($key) or &keepfunc($key) is called.
+
+=cut
+
+sub filter {
+    my ($self, %opts) = @_;
+
+    my $remove = $opts{remove} // sub { 0 };
+    my $keep = $opts{keep} // sub { 1 };
+
+    foreach my $vn (keys %{$self->{vars}}) {
+        $self->delete($vn) if &$remove($vn) or not &$keep($vn);
+    }
+}
+
 =item $s->save($file)
 
 Store all substitutions variables except the automatic ones in the
@@ -370,6 +389,10 @@ sub output {
 
 =head1 CHANGES
 
+=head2 Version 1.04
+
+New method: $s->filter().
+
 =head2 Version 1.03
 
 New method: $s->set_as_auto().

scripts/Makefile.am

@@ -291,6 +291,7 @@ test_data = \
 	t/Dpkg_Control/bogus-armor-spaces.dsc \
 	t/Dpkg_Source_Quilt/parse/debian/patches/series \
 	t/Dpkg_Substvars/substvars1 \
+	t/Dpkg_Substvars/substvars2 \
 	t/Dpkg_Dist_Files/files-byhand \
 	t/merge_changelogs/ch-old \
 	t/merge_changelogs/ch-a \

scripts/t/Dpkg_Substvars.t

@@ -16,7 +16,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 32;
+use Test::More tests => 35;
 
 use Dpkg ();
 use Dpkg::Arch qw(get_host_arch);
@@ -26,6 +26,8 @@ use_ok('Dpkg::Substvars');
 my $srcdir = $ENV{srcdir} || '.';
 my $datadir = $srcdir . '/t/Dpkg_Substvars';
 
+my $expected;
+
 my $s = Dpkg::Substvars->new();
 
 $s->load("$datadir/substvars1");
@@ -109,3 +111,35 @@ $SIG{__WARN__} = sub { $output .= $_[0] };
 $s->warn_about_unused();
 delete $SIG{__WARN__};
 is($output, '', 'disabled unused variables warnings');
+
+# Variable filters
+my $sf;
+
+$expected = <<'VARS';
+name3=Yet another value
+name4=Name value
+otherprefix:var7=Quux
+var1=Some value
+var2=Some other value
+VARS
+$sf = Dpkg::Substvars->new("$datadir/substvars2");
+$sf->filter(remove => sub { $_[0] =~ m/^prefix:/ });
+is($sf->output(), $expected, 'Filter remove variables');
+
+$expected = <<'VARS';
+otherprefix:var7=Quux
+prefix:var5=Foo
+var1=Some value
+var2=Some other value
+VARS
+$sf = Dpkg::Substvars->new("$datadir/substvars2");
+$sf->filter(keep => sub { $_[0] =~ m/var/ });
+is($sf->output(), $expected, 'Filter keep variables');
+
+$expected = <<'VARS';
+prefix:name6=Bar
+VARS
+$sf = Dpkg::Substvars->new("$datadir/substvars2");
+$sf->filter(remove => sub { $_[0] =~ m/var/ },
+            keep => sub { $_[0] =~ m/^prefix:/ });
+is($sf->output(), $expected, 'Filter keep and remove variables');

scripts/t/Dpkg_Substvars/substvars2

@@ -0,0 +1,7 @@
+var1=Some value
+var2=Some other value
+name3=Yet another value
+name4=Name value
+prefix:var5=Foo
+prefix:name6=Bar
+otherprefix:var7=Quux