| 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 | # Returns a triplet, (5, major, minor) from the input, which can be in any |
| 24 | # of several typical formats |
| 25 | |
| 26 | my $ver = shift; |
| 27 | $ver = "" unless defined $ver; |
| 28 | |
| 29 | my($r,$v,$s); |
| 30 | |
| 31 | if ( ($r, $v, $s) = $ver =~ /^(5)(\d{3})(\d{3})$/ # 5029010, from the file |
| 32 | # names in our |
| 33 | # parts/base/ and |
| 34 | # parts/todo directories |
| 35 | or ($r, $v, $s) = $ver =~ /^(\d+)\.(\d+)\.(\d+)$/ # 5.25.7 |
| 36 | or ($r, $v, $s) = $ver =~ /^(\d+)\.(\d{3})(\d{3})$/ # 5.025008, from the |
| 37 | # output of $] |
| 38 | or ($r, $v, $s) = $ver =~ /^(\d+)\.(\d{1,3})()$/ # 5.24, 5.004 |
| 39 | or ($r, $v, $s) = $ver =~ /^(\d+)\.(00[1-5])_?(\d{2})$/ # 5.003_07 |
| 40 | ) { |
| 41 | |
| 42 | $s = 0 unless $s; |
| 43 | |
| 44 | die "Only Perl 5 is supported '$ver'\n" if $r != 5; |
| 45 | die "Invalid version number: $ver\n" if $v >= 1000 || $s >= 1000; |
| 46 | return (5, 0 + $v, 0 + $s); |
| 47 | } |
| 48 | |
| 49 | my $mesg = ""; |
| 50 | $mesg = ". (In 5.00x_yz, x must be 1-5.)" if $ver =~ /_/; |
| 51 | die "Invalid version number format: '$ver'$mesg\n"; |
| 52 | } |
| 53 | |
| 54 | |
| 55 | |
| 56 | } |
| 57 | |
| 58 | sub dictionary_order($$) # Sort caselessly, ignoring punct |
| 59 | { |
| 60 | my ($lc_a, $lc_b); |
| 61 | my ($squeezed_a, $squeezed_b); |
| 62 | my ($valid_a, $valid_b); # Meaning valid for all releases |
| 63 | |
| 64 | # On early perls, the implicit pass by reference doesn't work, so we have |
| 65 | # to use the globals to initialize. |
| 66 | if ("$]" < "5.006" ) { |
| 67 | $valid_a = $a; $valid_b = $b; |
| 68 | } |
| 69 | else { |
| 70 | ($valid_a, $valid_b) = @_; |
| 71 | } |
| 72 | |
| 73 | $lc_a = lc $valid_a; |
| 74 | $lc_b = lc $valid_b; |
| 75 | |
| 76 | $squeezed_a = $lc_a; |
| 77 | $squeezed_a =~ s/[\W_]//g; # No punct, including no underscore |
| 78 | $squeezed_b = $lc_b; |
| 79 | $squeezed_b =~ s/[\W_]//g; |
| 80 | |
| 81 | return( $squeezed_a cmp $squeezed_b |
| 82 | or $lc_a cmp $lc_b |
| 83 | or $valid_a cmp $valid_b); |
| 84 | } |
| 85 | |
| 86 | 1; |