The following commit has been merged in the master branch:
commit 2622fcbb40385a14373ba9532d7628e1d1f214b1
Author: Guillem Jover <[email protected]>
Date: Wed Jul 10 01:21:36 2013 +0200
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.
diff --git a/scripts/Dpkg/Package.pm b/scripts/Dpkg/Util.pm
similarity index 56%
copy from scripts/Dpkg/Package.pm
copy to scripts/Dpkg/Util.pm
index 2a4b439..614e585 100644
--- a/scripts/Dpkg/Package.pm
+++ b/scripts/Dpkg/Util.pm
@@ -1,5 +1,4 @@
-# Copyright © 2006 Frank Lichtenheld <[email protected]>
-# Copyright © 2007,2012 Guillem Jover <[email protected]>
+# Copyright © 2013 Guillem Jover <[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
@@ -14,29 +13,39 @@
# 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::Package;
+package Dpkg::Util;
use strict;
use warnings;
our $VERSION = '0.01';
-use Dpkg::Gettext;
-
use Exporter qw(import);
-our @EXPORT = qw(pkg_name_is_illegal);
+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 pkg_name_is_illegal($) {
- my $name = shift || '';
+sub none(&@) {
+ my $code = shift;
- $name eq '' &&
- return _g('may not be empty string');
- $name =~ m/[^-+.0-9a-z]/o &&
- return sprintf(_g("character '%s' not allowed"), $&);
- $name =~ m/^[0-9a-z]/o ||
- return _g('must start with an alphanumeric character');
+ foreach (@_) {
+ return 0 if $code->();
+ }
- return;
+ return 1;
}
1;
diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index 0cec354..0a9fb7f 100644
--- a/scripts/Makefile.am
+++ b/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 \
diff --git a/test/000_pod.t b/scripts/t/550_Dpkg_Util.t
similarity index 56%
copy from test/000_pod.t
copy to scripts/t/550_Dpkg_Util.t
index 902a793..0aebb29 100644
--- a/test/000_pod.t
+++ b/scripts/t/550_Dpkg_Util.t
@@ -16,17 +16,23 @@
use strict;
use warnings;
-use Test::More;
+use Test::More tests => 7;
-eval 'use Test::Pod 1.00';
-plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@;
-
-if (defined $ENV{srcdir}) {
- chdir $ENV{srcdir} or die "cannot chdir to source directory: $!";
+BEGIN {
+ use_ok('Dpkg::Util', qw(:list));
}
-my @dirs = qw(scripts/Dpkg);
-my @files = qw(scripts/Dpkg.pm);
-push @files, all_pod_files(@dirs);
+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');
-all_pod_files_ok(@files);
+1;
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
