From: Michael Tremer <michael.tremer@ipfire.org>
Date: Wed, 11 Jan 2023 09:25:06 +0000 (+0000)
Subject: perl: Correctly decode Perl versions
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=b2693b2c5b13732930b51997f92e3c386e786e1b;p=people%2Fstevee%2Fpakfire.git

perl: Correctly decode Perl versions

Signed-off-by: Michael Tremer <michael.tremer@ipfire.org>
---

diff --git a/src/scripts/perl.req b/src/scripts/perl.req
index 29bde1f2..87352620 100644
--- a/src/scripts/perl.req
+++ b/src/scripts/perl.req
@@ -327,6 +327,16 @@ sub process_file {
 
 			$module =~ s/\(\s*\)$//;
 
+			# if module is a number then both require and use interpret that
+			# to mean that a particular version of perl is specified
+			if ($module =~ m/^(v?[0-9._]+)$/) {
+				my $pkg_version = &vsp($1);
+				if (defined $pkg_version) {
+					add_perlreq("$pkg_version");
+					next;
+				}
+			};
+
 			# ph files do not use the package name inside the file.
 			# perlmodlib documentation says:
 
@@ -388,3 +398,92 @@ sub process_file {
 
 	return;
 }
+
+sub vsp {
+	my ($input, $short) = @_;
+
+	if (!defined $input) {
+		return undef;
+	}
+
+	# Remove underscore parts
+	$input =~ s/_.*//;
+
+	if (!defined $input || $input eq '') {
+		return undef;
+	}
+
+	# Dot is a delimiter
+	my @parts = split(/\./, $input);
+	# XXX: splitting '.' returns (), splitting '.1' returns ('', '1'),
+	# handle them specially
+	if (@parts == 0) {
+		@parts = ('0');
+	} elsif ($parts[0] eq '') {
+		$parts[0] = '0';
+	}
+
+	# Preserve leading part
+	my $output = shift @parts;
+
+	# Is this version string or fraction string?
+	my $is_vstring = $output =~ s/^v// || @parts != 1;
+
+	# Reformat parts after leading dot
+	if (!$is_vstring) {
+		# If it's not a vstring and there is only one part after leading
+		# dot, it's a fraction number
+		my $fraction = $parts[0];
+		@parts = ();
+
+		# Augment digits to factor of 3
+		my @digits = split('', $fraction);
+		my $trailer = ($#digits + 1) % 3;
+		if ($trailer) {
+			push @digits, '0';
+			if ($trailer == 1) {
+				push @digits, '0';
+			}
+		}
+
+		# Split it into triples
+		my $i = 0;
+		my $triple = '';
+		for (@digits) {
+			$i++;
+			$triple .= $_;
+			if ($i == 3) {
+				$i = 0;
+				push @parts, $triple;
+				$triple = '';
+			}
+		}
+	}
+
+	# Append necessary number of parts to get X.Y.Z format
+	if (@parts < 2) {
+		push @parts, '0';
+		if (@parts < 2) {
+			push @parts, '0';
+		}
+	}
+
+	# Concatenate parts
+	for my $part (@parts) {
+		# Strip leading zeros
+		$part =~ s/^0*(?=.)//;
+		$output .= '.' . $part;
+	}
+
+	# Shorten if requested
+	if ($short) {
+		# Cut off all trailing zero groups
+		$output =~ s/(?:\.0*)*$//;
+		# Drop 0 integer
+		if ($output =~ /^0+\.?$/) {
+			$output = undef;
+		}
+	}
+
+	return $output;
+}