This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
parts/inc/inctools: Add sort fcn of API lines
[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{
a65af1ba
KW
23 # Returns a triplet, (5, major, minor) from the input, which can be in any
24 # of several typical formats
3976648e 25
a65af1ba
KW
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);
3976648e
KW
47 }
48
a65af1ba
KW
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}
3976648e 53
911af882
KW
54sub int_parse_version
55{
56 # Returns integer 7 digit human-readable version, suitable for use in file
57 # names in parts/todo parts/base.
3976648e 58
911af882 59 return 0 + join "", map { sprintf("%03d", $_) } parse_version(shift);
3976648e 60
3976648e
KW
61}
62
55179e46
KW
63sub dictionary_order($$) # Sort caselessly, ignoring punct
64{
65 my ($lc_a, $lc_b);
66 my ($squeezed_a, $squeezed_b);
67 my ($valid_a, $valid_b); # Meaning valid for all releases
68
69 # On early perls, the implicit pass by reference doesn't work, so we have
70 # to use the globals to initialize.
71 if ("$]" < "5.006" ) {
72 $valid_a = $a; $valid_b = $b;
73 }
74 else {
75 ($valid_a, $valid_b) = @_;
76 }
77
78 $lc_a = lc $valid_a;
79 $lc_b = lc $valid_b;
80
81 $squeezed_a = $lc_a;
82 $squeezed_a =~ s/[\W_]//g; # No punct, including no underscore
83 $squeezed_b = $lc_b;
84 $squeezed_b =~ s/[\W_]//g;
85
86 return( $squeezed_a cmp $squeezed_b
87 or $lc_a cmp $lc_b
88 or $valid_a cmp $valid_b);
89}
90
4289720c
KW
91sub sort_api_lines # Sort lines of the form flags|return|name|args...
92 # by 'name'
93{
94 $a =~ / ^ [^|]* \| [^|]* \| (\w+) /x; # 3rd field '|' is sep
95 my $a_name = $1;
96 $b =~ / ^ [^|]* \| [^|]* \| (\w+) /x;
97 my $b_name = $1;
98 return dictionary_order($a_name, $b_name);
99}
100
3976648e 1011;