#!/usr/bonsaitools/bin/perl --
# -*- 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):
use lib '../bonsai';
require 'tbglobals.pl';
require 'lloydcgi.pl';
require 'imagelog.pl';
require 'header.pl';
# Hack this until I can figure out how to do get default root. -slamm
$default_root = '/cvsroot';
# Show 12 hours by default
#
$nowdate = time;
if (not defined($maxdate = $form{maxdate})) {
$maxdate = $nowdate;
}
if ($form{showall}) {
$mindate = 0;
}
else {
$default_hours = 12;
$hours = $default_hours;
$hours = $form{hours} if $form{hours};
$mindate = $maxdate - ($hours*60*60);
}
%colormap = (
success => '11DD11',
busted => 'EE0000',
building => 'EEFF00',
testfailed => 'FFAA00'
);
%images = (
flames => '1afi003r.gif',
star => 'star.gif'
);
$tree = $form{tree};
# $rel_path is the relative path to webtools/tinderbox used for links.
# It changes to "../" if the page is generated statically, because then
# it is placed in tinderbox/$tree.
$rel_path = '';
&show_tree_selector, exit if $form{tree} eq '';
&do_quickparse, exit if $form{quickparse};
&do_express, exit if $form{express};
&do_rdf, exit if $form{rdf};
&do_static, exit if $form{static};
&do_flash, exit if $form{flash};
&do_panel, exit if $form{panel};
&do_hdml, exit if $form{hdml};
&do_tinderbox, exit;
# end of main
#=====================================================================
sub make_tree_list {
my @result;
while(<*>) {
if( -d $_ && $_ ne 'data' && $_ ne 'CVS' && -f "$_/treedata.pl") {
push @result, $_;
}
}
return @result;
}
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 "
";
}
sub do_static {
local *OUT;
$form{nocrap}=1;
my @pages = ( ['index.html', 'do_tinderbox'],
['flash.rdf', 'do_flash'],
['panel.html', 'do_panel'],
['stats.hdml', 'do_hdml'] );
$rel_path = '../';
while (($key, $value) = each %images) {
$images{$key} = "$rel_path$value";
}
my $oldfh = select;
foreach $pair (@pages) {
my ($page, $call) = @{$pair};
my $outfile = "$form{tree}/$page";
open(OUT,">$outfile.$$");
select OUT;
eval "$call";
close(OUT);
system "mv $outfile.$$ $outfile";
}
select $oldfh;
}
sub do_tinderbox {
my $tinderbox_data = &tb_load_data;
&print_page_head;
&print_table_header;
&print_table_body($tinderbox_data);
&print_table_footer;
}
sub print_page_head {
print "Content-type: text/html\n\n\n" unless $form{static};
use POSIX qw(strftime);
# Print time in format, "HH:MM timezone"
my $now = strftime("%H:%M %Z", localtime);
EmitHtmlTitleAndHeader("tinderbox: $tree", "tinderbox",
"tree: $tree ($now)");
&print_javascript;
# Get the message of the day only on the first pageful
do "$tree/mod.pl" if $nowdate eq $maxdate;
print "$message_of_day\n"; # from $tree/mod.pl
# Quote and Lengend
#
unless ($form{nocrap}) {
my ($imageurl,$imagewidth,$imageheight,$quote) = &get_image;
print qq{
';
# Build Status
#
for (my $build_index=0; $build_index < $name_count; $build_index++) {
if (not defined($br = $build_table->[$tt][$build_index])) {
# No build data for this time
print "
\n";
next;
}
next if $br == -1; # rowspan has covered this row
my $rowspan = $br->{rowspan};
$rowspan = $mindate_time_count - $tt + 1
if $tt + $rowspan - 1 > $mindate_time_count;
print "
{buildstatus}}>\n";
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 "{noteid},'$logfile');\">",
"\n";
}
# Build Log
#
# Uncomment this line to print logfile names in build rectangle.
# print "$logfile ";
print ""
."L";
# What Changed
#
# Only add the "C" link if there have been changes since the last build.
if ($br->{previousbuildtime}) {
my $previous_br = $build_table->[$tt+$rowspan][$build_index];
my $previous_rowspan = $previous_br->{rowspan};
if (&has_who_list($tt+$rowspan,
$tt+$rowspan+$previous_rowspan-1)) {
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";
}
# Leak/Bloat
if (defined $td->{bloaty}{$logfile}) {
my ($leaks, $bloat, $leaks_cmp, $bloat_cmp)
= @{ $td->{bloaty}{$logfile} };
print " Lk:", print_bloat_delta($leaks, $leaks_cmp),
" Bl:", print_bloat_delta($bloat, $bloat_cmp);
}
# Warnings
if (defined $td->{warnings}{$logfile}) {
my ($warning_count) = $td->{warnings}{$logfile};
my $warn_file = "$tree/warn$logfile";
$warn_file =~ s/\.gz$/.html/;
print "