gecko-dev/webtools/bonsai/toplevel.cgi

288 строки
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.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 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.
#
# Contributor(s):
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);
}
}