Better sort order for releases, in test results

This commit is contained in:
Laurent Rineau 2019-12-17 09:44:44 +01:00
parent 2e3cf8e7c0
commit 904df880c8
1 changed files with 20 additions and 11 deletions

View File

@ -48,9 +48,10 @@ sub sort_releases($$)
my $b = $_[0]; my $b = $_[0];
my $a = $_[1]; my $a = $_[1];
#take only the numbers from release id, skipping I and Ic #take only the numbers from release id, skipping the bug-fix
my @A = ($a =~ /\d+/g); #number, and I and Ic
my @B = ($b =~ /\d+/g); my @A = ($a =~ /(\d+)\.(\d+)\.?(:?\d+)?(:?-Ic?-)?(\d+)?/a);
my @B = ($b =~ /(\d+)\.(\d+)\.?(:?\d+)?(:?-Ic?-)?(\d+)?/a);
while(@A and @B) { while(@A and @B) {
my $av = shift(@A); my $av = shift(@A);
@ -67,8 +68,8 @@ sub write_selects()
print OUTPUTV "<p>You can browse the test results of a different version :</p>"; print OUTPUTV "<p>You can browse the test results of a different version :</p>";
my %releases; my %releases;
foreach $_ (glob("results-*.shtml")) { foreach $_ (glob("results-*.shtml")) {
$_ =~ /results-([^I]*)((-Ic?)-([^I].*))\.shtml/; $_ =~ /results-(\d+.\d+)([^I]*)((-Ic?)-([^I].*))\.shtml/a;
$releases{"$1$3"}=1; $releases{"$1"}=1;
} }
print OUTPUTV "<table><tr>\n"; print OUTPUTV "<table><tr>\n";
print OUTPUTV " <th>All releases (<a href=\"${test_results_url}\">last one</a>)</th>\n"; print OUTPUTV " <th>All releases (<a href=\"${test_results_url}\">last one</a>)</th>\n";
@ -79,7 +80,7 @@ sub write_selects()
} }
print OUTPUTV "</tr>\n"; print OUTPUTV "</tr>\n";
print OUTPUTV "<tr>\n"; print OUTPUTV "<tr>\n";
write_select("sel", ".*"); write_select("sel");
$count = 0; $count = 0;
foreach $_ (sort sort_releases (keys %releases)) { foreach $_ (sort sort_releases (keys %releases)) {
write_select("sel" . $count, $_); write_select("sel" . $count, $_);
@ -91,19 +92,27 @@ sub write_selects()
sub write_select() sub write_select()
{ {
my $id = shift(@_); my $id = shift(@_);
my $pattern = shift(@_); my $pattern = ".*";
if (@_ != 0) {
$pattern = quotemeta(shift(@_));
}
my($filename, @result); my($filename, @result);
print OUTPUTV " <td><select id=\"$id\" onchange=\"sel=document.getElementById(\'$id\'); top.location.href=sel.options[sel.selectedIndex].value\">\n"; print OUTPUTV " <td><select id=\"$id\" onchange=\"sel=document.getElementById(\'$id\'); top.location.href=sel.options[sel.selectedIndex].value\">\n";
print OUTPUTV '<option value="">', "</option>\n"; print OUTPUTV '<option disabled selected value="">(select a release)', "</option>\n";
foreach $_ (sort sort_releases (glob("results-*.shtml"))) { my %results;
$_ =~ /results-${pattern}(-.*|)\.shtml/ || next; foreach $_ (glob("results-*.shtml")) {
my $ctime = (stat($_))[10];
$results{$_} = $ctime;
}
foreach $_ (sort { $results{$b} <=> $results{$a} } keys %results) {
$_ =~ /results-${pattern}(\.\d+)?(-.*|)\.shtml/ || next;
my $ctime = (stat($_))[10]; my $ctime = (stat($_))[10];
my $date = time2str('%a %Y/%m/%d', $ctime); my $date = time2str('%a %Y/%m/%d', $ctime);
print OUTPUTV '<option value="', $_, '">'; print OUTPUTV '<option value="', $_, '">';
($filename) = m/results-(.*?)\.shtml\s*/; ($filename) = m/results-(.*?)\.shtml\s*/;
# printf OUTPUTV "%-20s (last modified: %s)</option>\n", $filename, $date; # printf OUTPUTV "%-20s (last modified: %s)</option>\n", $filename, $date;
printf OUTPUTV '%2$s: %1$s</option> printf OUTPUTV '%1$s (%2$s)</option>
', $filename, $date; ', $filename, $date;
} }
print OUTPUTV "</select></td>"; print OUTPUTV "</select></td>";