gecko-dev/webtools/bonsai/toplevel.cgi
terry%mozilla.org 149960696a Fix some Y2K issues! Now, don't freak out. The only real bug was
that lists of checkins would have started displaying the year as "100"
in the year 2000.  I have changed to display 4-digit years throughout.
1999-08-05 22:43:45 +00:00

285 lines
7.7 KiB
Perl
Executable File

#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (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 Bonsai CVS 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.
require 'CGI.pl';
use diagnostics;
use strict;
sub StupidFuncToShutUpWarningsByUsingVarsAgain {
my $z;
$z = $::CloseTimeStamp;
$z = $::LastGoodTimeStamp;
$z = $::MOTD;
$z = $::WhiteBoard;
$z = $::TreeList;
}
print "Content-type: text/html\nRefresh: 300\n\n";
PutsHeader("Bonsai -- the art of effectively controlling trees",
"Bonsai", "CVS Tree Control");
print "<IMG ALIGN=right SRC=bonsai.gif>";
Lock();
LoadCheckins();
LoadMOTD();
LoadWhiteboard();
LoadTreeConfig();
Unlock();
my $openword;
if ($::TreeOpen) {
$openword = '<b><FONT SIZE=+2>OPEN</FONT></B>';
} else {
$openword = '<b><FONT SIZE=+3 COLOR=RED>CLOSED</FONT></B>';
}
print "
<FORM name=treeform>
<H3>
<SELECT name=treeid size=1 onchange='submit();'>
";
foreach my $tree (@::TreeList) {
unless (exists $::TreeInfo{$tree}{nobonsai}) {
my $c = ($tree eq $::TreeID) ? 'Selected' : '';
print "<OPTION VALUE=\"$tree\" $c>$::TreeInfo{$tree}{description}\n";
}
}
print "</SELECT></H3></FORM>\n";
if (Param('readonly')) {
print "<h2><font color=red>
Be aware that you are looking at an old hook!</font></h2>\n";
}
print "<tt>" . time2str("%m/%d/%Y %T %Z", time()) .
"</tt>: The tree is currently $openword<br>\n";
unless ($::TreeOpen) {
print "The tree has been closed since <tt>" .
MyFmtClock($::CloseTimeStamp) . "</tt>.<BR>\n";
}
print "The last known good tree had a timestamp of <tt>";
print time2str("%m/%d/%Y %T %Z", $::LastGoodTimeStamp) . "</tt>.<br>";
print "<hr><pre variable>$::MOTD</pre><hr>";
print "<br clear=all>";
my $bid_part = BatchIdPart('?');
print "<b><a href=editwhiteboard.cgi$bid_part>
Free-for-all whiteboard:</a></b>
<pre>" . html_quote($::WhiteBoard) . "</pre><hr>\n";
my %username;
my %checkincount;
my %closedcheckin;
my %fullname;
my %curcontact;
foreach my $checkin (@::CheckInList) {
my $info = eval("\\\%$checkin");
my $addr = EmailFromUsername($info->{'person'});
$username{$addr} = $info->{'person'};
if (!exists $checkincount{$addr}) {
$checkincount{$addr} = 1;
} else {
$checkincount{$addr}++;
}
if (!$info->{'treeopen'}) {
if (!defined $closedcheckin{$addr}) {
$closedcheckin{$addr} = 1;
} else {
$closedcheckin{$addr}++;
}
}
}
my $ldaperror = 0;
if (%checkincount) {
my (@peoplelist, @list, $p, $i, $end, $checkins);
my $ldapserver = Param('ldapserver');
my $ldapport = Param('ldapport');
print "
The following people are on \"the hook\", since they have made
checkins to the tree since it last opened: <p>\n";
@peoplelist = sort(keys %checkincount);
@list = @peoplelist;
while (1) {
last if ($#list < 0);
$end = 19;
$end = $#list if ($end >= $#list);
GetInfoForPeople(splice(@list, 0, $end + 1));
}
if ($ldaperror) {
print "<font color=red>
Can't contact the directory server at $ldapserver:$ldapport</font>\n";
}
print "
<table border cellspacing=2>
<th colspan=2>Who</th><th>What</th>\n";
print "<th>How to contact</th>\n" if $ldapserver;
foreach $p (@peoplelist) {
my ($uname, $namepart, $extra) = ('', '', '');
if (exists($closedcheckin{$p})) {
$extra = " <font color=red>($closedcheckin{$p} while tree closed!)</font>";
}
$uname = $username{$p};
($namepart = $p) =~ s/\@.*//;
$checkins = $checkincount{$p};
print "<tr>\n";
print "<td>$fullname{$p}</td>\n";
print "<td>" . GenerateUserLookUp($uname, $namepart, $p) . "</td>\n";
print "<td><a href=\"showcheckins.cgi?person=" . url_quote($uname);
print BatchIdPart() . "\"> $checkins ";
print Pluralize('change', $checkins) . "</a>$extra</td>\n";
print "<td>$curcontact{$p}\n" if $ldapserver;
print "</tr>\n\n";
}
print "</table>\n\n";
$checkins = @::CheckInList;
print Pluralize("$checkins checkin", $checkins) . ".<p>\n";
my $mailaddr =
join(',', @peoplelist) . "?subject=Hook%3a%20Build%20Problem";
$mailaddr .= "&cc=$::TreeInfo{$::TreeID}{cchookmail}"
if (exists($::TreeInfo{$::TreeID}{cchookmail}));
print "
<a href=showcheckins.cgi" . BatchIdPart('?') . ">Show all checkins.</a><br>
<a href=\"mailto:$mailaddr\">Send mail to \"the hook\".</a><br>\n";
} else {
print "Nobody seems to have made any changes since the tree opened.";
}
my $cvsqueryurl = "cvsqueryform.cgi?" .
"cvsroot=$::TreeInfo{$::TreeID}{repository}" .
"&module=$::TreeInfo{$::TreeID}{module}";
$cvsqueryurl.= "&branch=$::TreeInfo{$::TreeID}{branch}"
if ($::TreeInfo{$::TreeID}{branch});
my $bip = BatchIdPart('?');
my $tinderboxbase = Param('tinderboxbase');
my $tinderboxlink = '';
$tinderboxlink = "<a href=\"$tinderboxbase/showbuilds.cgi\">Tinderbox
continuous builds</a><br>" if ($tinderboxbase);
my $otherrefs = Param('other_ref_urls');
print "
<hr>
<table>
<tr>
<th>Useful links </th><th width=10%></th><th>Help and Documentation</th>
</tr>
<tr>
<td valign=top>
<a href=\"$cvsqueryurl\"><b>CVS Query Tool</b></a><br>
<a href=\"switchtree.cgi$bip\">Switch to look at a different tree or branch</a><br>
$tinderboxlink
<a href=\"viewold.cgi$bip\">Time warp -- view a different day's hook.</a><br>
<a href=\"countcheckins.cgi$bip\">See some stupid statistics about recent checkins.</a><br>
<a href=\"admin.cgi$bip\">Administration menu.</a><br>
</td><td>
</td><td valign=top>
$otherrefs
</td>
</tr></table>
" ;
exit 0;
sub GetInfoForPeople {
my (@peoplelist) = @_;
my ($p, $query, $isempty);
my $ldapserver = Param('ldapserver');
my $ldapport = Param('ldapport');
my $ldapcmd;
$query = "(| ";
$isempty = 1;
foreach $p (@peoplelist) {
$query .= "(mail=$p) ";
$fullname{$p} = "";
$curcontact{$p} = "";
}
$query .= ")";
return if ($ldaperror || ($ldapserver eq ''));
$ldapcmd = "./data/ldapsearch -b \"dc=netscape,dc=com\" " .
"-h $ldapserver -p $ldapport -s sub " .
"-S mail \"$query\" mail cn nscpcurcontactinfo";
unless (open(LDAP, "$ldapcmd |")) {
$ldaperror = 1;
} else {
my $doingcontactinfo = 0;
my $curperson;
while (<LDAP>) {
chop;
if ($doingcontactinfo) {
if (/^ (.*)$/) {
$curcontact{$curperson} .= "$1\n";
next;
}
$doingcontactinfo = 0;
}
if (/^mail: (.*\@.*)$/) {
$curperson = $1;
} elsif (/^cn: (.*)$/) {
$fullname{$curperson} = $1;
} elsif (/^nscpcurcontactinfo: (.*)$/) {
$curcontact{$curperson} = "$1\n";
$doingcontactinfo = 1;
}
}
close(LDAP);
}
}