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 29bde1f2ab8ead9780a6c2391dc64221ee325659..87352620eb2b47638896aa849d143525264dc2e0 100644 (file)
--- 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;
+}