1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
# These are tools that must be included in ppport.h. It doesn't work if given
# a .pl suffix.
#
# WARNING: Use only constructs that are legal as far back as D:P handles, as
# this is run in the perl version being tested.
# What revisions are legal, to be output as-is and converted into a pattern
# that matches them precisely
my $r_pat = "[57]";
sub format_version
{
# Given an input version that is acceptable to parse_version(), return a
# string of the standard representation of it.
my($r,$v,$s) = parse_version(shift);
if ($r < 5 || ($r == 5 && $v < 6)) {
my $ver = sprintf "%d.%03d", $r, $v;
$s > 0 and $ver .= sprintf "_%02d", $s;
return $ver;
}
return sprintf "%d.%d.%d", $r, $v, $s;
}
sub parse_version
{
# Returns a triplet, (revision, major, minor) from the input, treated as a
# string, which can be in any of several typical formats.
my $ver = shift;
$ver = "" unless defined $ver;
my($r,$v,$s);
if ( ($r, $v, $s) = $ver =~ /^([0-9]+)([0-9]{3})([0-9]{3})$/ # 5029010, from the file
# names in our
# parts/base/ and
# parts/todo directories
or ($r, $v, $s) = $ver =~ /^([0-9]+)\.([0-9]+)\.([0-9]+)$/ # 5.25.7
or ($r, $v, $s) = $ver =~ /^([0-9]+)\.([0-9]{3})([0-9]{3})$/ # 5.025008, from the
# output of $]
or ($r, $v, $s) = $ver =~ /^([0-9]+)\.([0-9]{1,3})()$/ # 5.24, 5.004
or ($r, $v, $s) = $ver =~ /^([0-9]+)\.(00[1-5])_?([0-9]{2})$/ # 5.003_07
) {
$s = 0 unless $s;
die "Only Perl $r_pat are supported '$ver'\n" unless $r =~ / ^ $r_pat $ /x;
die "Invalid version number: $ver\n" if $v >= 1000 || $s >= 1000;
return (0 +$r, 0 + $v, 0 + $s);
}
# For some safety, don't assume something is a version number if it has a
# literal dot as one of the three characters. This will have to be fixed
# when we reach x.46 (since 46 is ord('.'))
if ($ver !~ /\./ && (($r, $v, $s) = $ver =~ /^(.)(.)(.)$/)) # vstring 5.25.7
{
$r = ord $r;
$v = ord $v;
$s = ord $s;
die "Only Perl $r_pat are supported '$ver'\n" unless $r =~ / ^ $r_pat $ /x;
return ($r, $v, $s);
}
my $mesg = "";
$mesg = ". (In 5.00x_yz, x must be 1-5.)" if $ver =~ /_/;
die "Invalid version number format: '$ver'$mesg\n";
}
sub int_parse_version
{
# Returns integer 7 digit human-readable version, suitable for use in file
# names in parts/todo parts/base.
return 0 + join "", map { sprintf("%03d", $_) } parse_version(shift);
}
sub ivers # Shorter name for int_parse_version
{
return int_parse_version(shift);
}
sub format_version_line
{
# Returns a floating point representation of the input version
my $version = int_parse_version(shift);
$version =~ s/ ^ ( $r_pat ) \B /$1./x;
return $version;
}
BEGIN {
if ("$]" < "5.006" ) {
# On early perls, the implicit pass by reference doesn't work, so we have
# to use the globals to initialize.
eval q[sub dictionary_order($$) { _dictionary_order($a, $b) } ];
} elsif ("$]" < "5.022" ) {
eval q[sub dictionary_order($$) { _dictionary_order(@_) } ];
} else {
eval q[sub dictionary_order :prototype($$) { _dictionary_order(@_) } ];
}
}
sub _dictionary_order { # Sort caselessly, ignoring punct
my ($valid_a, $valid_b) = @_;
my ($lc_a, $lc_b);
my ($squeezed_a, $squeezed_b);
$valid_a = '' unless defined $valid_a;
$valid_b = '' unless defined $valid_b;
$lc_a = lc $valid_a;
$lc_b = lc $valid_b;
$squeezed_a = $lc_a;
$squeezed_a =~ s/[\W_]//g; # No punct, including no underscore
$squeezed_b = $lc_b;
$squeezed_b =~ s/[\W_]//g;
return( $squeezed_a cmp $squeezed_b
or $lc_a cmp $lc_b
or $valid_a cmp $valid_b);
}
sub sort_api_lines # Sort lines of the form flags|return|name|args...
# by 'name'
{
$a =~ / ^ [^|]* \| [^|]* \| (\w+) /x; # 3rd field '|' is sep
my $a_name = $1;
$b =~ / ^ [^|]* \| [^|]* \| (\w+) /x;
my $b_name = $1;
return dictionary_order($a_name, $b_name);
}
1;
|
