Bläddra i källkod

Dpkg::Util: Add new module

Add two trivial list utility functions, mimicking the ones from
List::MoreUtils, as that is not a core module and we want to avoid
the additional dependency.
Guillem Jover 13 år sedan
förälder
incheckning
2622fcbb40
3 ändrade filer med 91 tillägg och 0 borttagningar
  1. 51 0
      scripts/Dpkg/Util.pm
  2. 2 0
      scripts/Makefile.am
  3. 38 0
      scripts/t/550_Dpkg_Util.t

+ 51 - 0
scripts/Dpkg/Util.pm

@@ -0,0 +1,51 @@
+# Copyright © 2013 Guillem Jover <guillem@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::Util;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Exporter qw(import);
+our @EXPORT_OK = qw(any none);
+our %EXPORT_TAGS = (list => [ qw(any none) ]);
+
+# XXX: Ideally we would use List::MoreUtils, but that's not a core module,
+# so to avoid the additional dependency we'll make do with the following
+# trivial reimplementations.
+
+sub any(&@) {
+    my $code = shift;
+
+    foreach (@_) {
+        return 1 if $code->();
+    }
+
+    return 0;
+}
+
+sub none(&@) {
+    my $code = shift;
+
+    foreach (@_) {
+        return 0 if $code->();
+    }
+
+    return 1;
+}
+
+1;

+ 2 - 0
scripts/Makefile.am

@@ -102,6 +102,7 @@ nobase_dist_perllib_DATA = \
 	Dpkg/Source/Patch.pm \
 	Dpkg/Source/Quilt.pm \
 	Dpkg/Substvars.pm \
+	Dpkg/Util.pm \
 	Dpkg/Vars.pm \
 	Dpkg/Vendor.pm \
 	Dpkg/Vendor/Debian.pm \
@@ -189,6 +190,7 @@ test_cases = \
 	t/300_Dpkg_BuildOptions.t \
 	t/400_Dpkg_Deps.t \
 	t/500_Dpkg_Path.t \
+	t/550_Dpkg_Util.t \
 	t/600_Dpkg_Changelog.t \
 	t/600_Dpkg_Changelog_Ubuntu.t \
 	t/700_Dpkg_Control.t \

+ 38 - 0
scripts/t/550_Dpkg_Util.t

@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+#
+# 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/>.
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+BEGIN {
+    use_ok('Dpkg::Util', qw(:list));
+}
+
+my @array = qw(foo bar quux baz);
+my %hash = (foo => 1, bar => 10, quux => 100, baz => 200);
+
+ok(any { 'bar' eq $_ } @array, 'array has item');
+
+ok(!any { 'notfound' eq $_ } @array, 'array does not have item');
+ok(none { 'notfound' eq $_ } @array, 'array lacks item');
+
+ok(any { m/^quu/ } @array, 'array has item matching regexp');
+ok(none { m/^notfound/ } @array, 'array lacks item matching regexp');
+
+ok(any { m/^quu/ } keys %hash, 'hash has item matching regexp');
+
+1;