#!/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'
);
%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'
);
$::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 $::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_vxml, exit if $form{vxml};
&do_wml, exit if $form{wml};
&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 "
';
# 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 (e.g. no build after this time).
print "
\n";
next;
}
next if $br == -1; # Covered by rowspan
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 qq|
|;
}
# Build Log
#
# Uncomment this line to print logfile names in build rectangle.
# print "$logfile ";
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_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";
}
# 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 "