This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
parts/inc/parse_version: Call fcn to not duplicate logic
[perl5.git] / dist / Devel-PPPort / parts / inc / inctools
CommitLineData
3976648e
KW
1# These are tools that must be included in ppport.h. It doesn't work if given
2# a .pl suffix
3
4sub format_version
5{
4208c867
KW
6 # Given an input version that is acceptable to parse_version(), return a
7 # string of the standard representation of it.
3976648e 8
4208c867 9 my($r,$v,$s) = parse_version(shift);
3976648e
KW
10
11 if ($r < 5 || ($r == 5 && $v < 6)) {
4208c867 12 my $ver = sprintf "%d.%03d", $r, $v;
3976648e
KW
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
21sub 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
55179e46
KW
50sub 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
3976648e 781;