| 1 | # These are tools that must be included in ppport.h. It doesn't work if given |
| 2 | # a .pl suffix |
| 3 | |
| 4 | sub format_version |
| 5 | { |
| 6 | # Given an input version that is acceptable to parse_version(), return a |
| 7 | # string of the standard representation of it. |
| 8 | |
| 9 | my($r,$v,$s) = parse_version(shift); |
| 10 | |
| 11 | if ($r < 5 || ($r == 5 && $v < 6)) { |
| 12 | my $ver = sprintf "%d.%03d", $r, $v; |
| 13 | $s > 0 and $ver .= sprintf "_%02d", $s; |
| 14 | |
| 15 | return $ver; |
| 16 | } |
| 17 | |
| 18 | return sprintf "%d.%d.%d", $r, $v, $s; |
| 19 | } |
| 20 | |
| 21 | sub parse_version |
| 22 | { |
| 23 | my $ver = shift; |
| 24 | |
| 25 | if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { |
| 26 | return ($1, $2, $3); |
| 27 | } |
| 28 | elsif ($ver !~ /^\d+\.\d{3}(?:_\d{2})?$/) { |
| 29 | die "cannot parse version '$ver'\n"; |
| 30 | } |
| 31 | |
| 32 | $ver =~ s/_//g; |
| 33 | $ver =~ s/$/000000/; |
| 34 | |
| 35 | my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; |
| 36 | |
| 37 | $v = int $v; |
| 38 | $s = int $s; |
| 39 | |
| 40 | if ($r < 5 || ($r == 5 && $v < 6)) { |
| 41 | if ($s % 10) { |
| 42 | die "cannot parse version '$ver'\n"; |
| 43 | } |
| 44 | $s /= 10; |
| 45 | } |
| 46 | |
| 47 | return ($r, $v, $s); |
| 48 | } |
| 49 | |
| 50 | sub dictionary_order($$) # Sort caselessly, ignoring punct |
| 51 | { |
| 52 | my ($lc_a, $lc_b); |
| 53 | my ($squeezed_a, $squeezed_b); |
| 54 | my ($valid_a, $valid_b); # Meaning valid for all releases |
| 55 | |
| 56 | # On early perls, the implicit pass by reference doesn't work, so we have |
| 57 | # to use the globals to initialize. |
| 58 | if ("$]" < "5.006" ) { |
| 59 | $valid_a = $a; $valid_b = $b; |
| 60 | } |
| 61 | else { |
| 62 | ($valid_a, $valid_b) = @_; |
| 63 | } |
| 64 | |
| 65 | $lc_a = lc $valid_a; |
| 66 | $lc_b = lc $valid_b; |
| 67 | |
| 68 | $squeezed_a = $lc_a; |
| 69 | $squeezed_a =~ s/[\W_]//g; # No punct, including no underscore |
| 70 | $squeezed_b = $lc_b; |
| 71 | $squeezed_b =~ s/[\W_]//g; |
| 72 | |
| 73 | return( $squeezed_a cmp $squeezed_b |
| 74 | or $lc_a cmp $lc_b |
| 75 | or $valid_a cmp $valid_b); |
| 76 | } |
| 77 | |
| 78 | 1; |