# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s):
require 'header.pl';
%colormap = (
null => 'a5a5a5',
success => '11DD11',
busted => 'EE0000',
building => 'EEFF00',
testfailed => 'FFAA00'
);
%titlemap = (
success => 'success',
busted => 'busted',
building => 'building',
testfailed => 'testfailed',
flames => 'burning',
star => ''
);
%textmap = (
success => 'L',
busted => 'L!',
building => 'L/',
testfailed => 'L-',
flames => '%',
star => '*'
);
%images = (
flames => '1afi003r.gif',
star => 'star.gif'
);
sub tb_build_static {
$form{static} = 1;
$form{tree} = $tree;
&do_static;
}
sub show_tree_selector {
print "Content-type: text/html\n\n";
&EmitHtmlHeader("tinderbox");
print "
";
print "
Select one of the following trees:
";
print "
\n";
print "
\n";
my @list = make_tree_list();
foreach (@list) {
print "
';
# Build Status
#
for (my $build_index=0; $build_index < $name_count; $build_index++) {
$br = $build_table->[$tt][$build_index];
if (not defined($br)) {
# No build data for this time (e.g. no build after this time).
print "
\n";
next;
}
next if $br == -1; # Covered by rowspan
my $rowspan = $br->{rowspan};
# This appears to be designed to keep the rowspan from running beyond
# the length of the displayed table. I'm not certain that can happen
# in a table. Besides, if rowspan is set to that sort of invalid value,
# that's more of a sign that there's a bug in tbglobals.pl.
#
if ( $rowspan > $mindate_time_count - $tt + 1 ) {
$rowspan = $mindate_time_count - $tt + 1
}
print "
{buildstatus}}\">\n";
if ( $br->{buildstatus} eq "null" ) {
print "
\n";
next;
}
my $logfile = $br->{logfile};
my $buildtree = $br->{td}->{name};
print "\n";
# Build Note
#
my $logurl = "${rel_path}showlog.cgi?log=$buildtree/$logfile";
if ($br->{hasnote}) {
print qq|
|;
}
# Build Log
#
# Uncomment this line to print logfile names in build rectangle.
# print "$logfile ";
if ( 1 ) {
# Add build start, end, and elapsed time where possible.
my($start, $end, $elapsed);
# Treat buildtime as the build's start and mailtime as the build's
# end. We should add in explicit setting of endtime in the client
# scripts if they don't already have it and then use that here.
my $start_timet = $br->{buildtime};
my $end_timet = $br->{endtime};
# If either of the times aren't today, we need to qualify both with
# the month and day-of-month.
my $need_to_qualify;
if ( both_are_today($start_timet, $end_timet) ) {
$need_to_qualify = 0;
} else {
$need_to_qualify = 1;
}
# Grab the human-readable start time.
$start = get_local_hms($start_timet, $need_to_qualify);
# If we're still building, the mailtime only reflects the opening
# mail that the build has started, not the time at which the build
# ended. In that case, don't use it. Use the current time, instead.
my $time_info = "";
if ($br->{buildstatus} eq 'building') {
$elapsed = get_time_difference(time(), $start_timet);
$time_info = "Started $start, still building..";
} else {
$end = get_local_hms($end_timet, $need_to_qualify);
$elapsed = get_time_difference($end_timet, $start_timet);
$time_info = "Started $start, finished $end";
}
print qq|
$textmap{$br->{buildstatus}}
|;
} else {
print qq|
$textmap{$br->{buildstatus}}
|;
}
# What Changed
#
# Only add the "C" link if there have been changes since the last build.
if ($br->{previousbuildtime}) {
my $previous_buildtime_index = $build_time_index->{$br->{previousbuildtime}};
my $this_buildtime_index = $build_time_index->{$br->{buildtime}} + 1;
if (&has_who_list($this_buildtime_index,
$previous_buildtime_index)) {
print "\n", &query_ref($br->{td},
$br->{previousbuildtime},
$br->{buildtime} - 1);
print "C";
}
}
# Binary URL
#
# Only add the "D" link if there is a url to a downloadable binary
if( $br->{binaryurl} ){
$binaryurl = $br->{binaryurl};
print" D";
}
# Scrape data
if (defined $td->{scrape}{$logfile}) {
my (@scrape_data)
= @{ $td->{scrape}{$logfile} };
# ex: Tp:5.45s
my $i;
foreach $i (@scrape_data) {
print " $i";
}
}
# Warnings
if (defined $td->{warnings}{$logfile}) {
my ($warning_count) = $td->{warnings}{$logfile};
my $warn_file = "$::tree/warn$logfile";
$warn_file =~ s/\.gz$/.html/;
print "