summaryrefslogtreecommitdiff
path: root/util/perl
diff options
context:
space:
mode:
authorRichard Levitte <levitte@openssl.org>2020-04-09 12:10:24 +0200
committerRichard Levitte <levitte@openssl.org>2020-04-09 12:10:24 +0200
commit8519b244bc6c38f265bf9bad80c52bd7c0ff469f (patch)
treeb2f64ecbc92e8e466417d2d261bb90a341312b8c /util/perl
parentae3254287ff87e484c7fd8f757cad1440ee8f5ff (diff)
downloadopenssl-new-8519b244bc6c38f265bf9bad80c52bd7c0ff469f.tar.gz
OpenSSL::OID: Don't use List::Util
It turns out that the pairwise functions of List::Util came into perl far later than 5.10.0. We can't use that under those conditions, so must revert to a quick internal implementation of the functions we're after. Reviewed-by: Tomas Mraz <tmraz@fedoraproject.org> (Merged from https://github.com/openssl/openssl/pull/11503)
Diffstat (limited to 'util/perl')
-rw-r--r--util/perl/OpenSSL/OID.pm35
1 files changed, 31 insertions, 4 deletions
diff --git a/util/perl/OpenSSL/OID.pm b/util/perl/OpenSSL/OID.pm
index a4d1049c2c..910c9bb5f7 100644
--- a/util/perl/OpenSSL/OID.pm
+++ b/util/perl/OpenSSL/OID.pm
@@ -22,7 +22,13 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
registered_oid_arcs registered_oid_leaves);
@EXPORT_OK = qw(encode_oid_nums);
-use List::Util;
+# Unfortunately, the pairwise List::Util functionality came with perl
+# v5.19.3, and I want to target absolute compatibility with perl 5.10
+# and up. That means I have to implement quick pairwise functions here.
+
+#use List::Util;
+sub _pairs (@);
+sub _pairmap (&@);
=head1 NAME
@@ -163,7 +169,8 @@ sub parse_oid {
# As we currently only support a name without number as first
# component, the easiest is to have a direct look at it and
# hack it.
- my @first = List::Util::pairmap {
+ my @first = _pairmap {
+ my ($a, $b) = @$_;
return $b if $b ne '';
return @{$name2oid{$a}->{nums}} if $a ne '' && defined $name2oid{$a};
croak "Undefined identifier $a" if $a ne '';
@@ -173,7 +180,8 @@ sub parse_oid {
my @numbers =
(
@first,
- List::Util::pairmap {
+ _pairmap {
+ my ($a, $b) = @$_;
return $b if $b ne '';
croak "Unsupported relative OID $a" if $a ne '';
croak "Empty OID element (how's that possible?)";
@@ -277,6 +285,25 @@ Richard levitte, C<< <richard at levitte.org> >>
=cut
+######## Helpers
+
+sub _pairs (@) {
+ croak "Odd number of arguments" if @_ & 1;
+
+ my @pairlist = ();
+
+ while (@_) {
+ my $x = [ shift, shift ];
+ push @pairlist, $x;
+ }
+ return @pairlist;
+}
+
+sub _pairmap (&@) {
+ my $block = shift;
+ map { $block->($_) } _pairs @_;
+}
+
######## UNIT TESTING
use Test::More;
@@ -309,7 +336,7 @@ sub TEST {
+ scalar @bad_cases;
note 'Predefine a few names OIDs';
- foreach my $pair ( List::Util::pairs @predefined ) {
+ foreach my $pair ( _pairs @predefined ) {
ok( defined eval { register_oid(@$pair) },
"Registering $pair->[0] => $pair->[1]" );
}