# These are tools that must be included in ppport.h. It doesn't work if given # a .pl suffix 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, (5, major, minor) from the input, 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 =~ /^(5)(\d{3})(\d{3})$/ # 5029010, from the file # names in our # parts/base/ and # parts/todo directories or ($r, $v, $s) = $ver =~ /^(\d+)\.(\d+)\.(\d+)$/ # 5.25.7 or ($r, $v, $s) = $ver =~ /^(\d+)\.(\d{3})(\d{3})$/ # 5.025008, from the # output of $] or ($r, $v, $s) = $ver =~ /^(\d+)\.(\d{1,3})()$/ # 5.24, 5.004 or ($r, $v, $s) = $ver =~ /^(\d+)\.(00[1-5])_?(\d{2})$/ # 5.003_07 ) { $s = 0 unless $s; die "Only Perl 5 is supported '$ver'\n" if $r != 5; die "Invalid version number: $ver\n" if $v >= 1000 || $s >= 1000; return (5, 0 + $v, 0 + $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 dictionary_order($$) # Sort caselessly, ignoring punct { my ($lc_a, $lc_b); my ($squeezed_a, $squeezed_b); my ($valid_a, $valid_b); # Meaning valid for all releases # On early perls, the implicit pass by reference doesn't work, so we have # to use the globals to initialize. if ("$]" < "5.006" ) { $valid_a = $a; $valid_b = $b; } else { ($valid_a, $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;