#!/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 ""; Lock(); LoadCheckins(); LoadMOTD(); LoadWhiteboard(); LoadTreeConfig(); Unlock(); my $openword; if ($::TreeOpen) { $openword = 'OPEN'; } else { $openword = 'CLOSED'; } print "

\n"; if (Param('readonly')) { print "

Be aware that you are looking at an old hook!

\n"; } print "" . time2str("%m/%d/%Y %T %Z", time()) . ": The tree is currently $openword
\n"; unless ($::TreeOpen) { print "The tree has been closed since " . MyFmtClock($::CloseTimeStamp) . ".
\n"; } print "The last known good tree had a timestamp of "; print time2str("%m/%d/%Y %T %Z", $::LastGoodTimeStamp) . ".
"; print "
$::MOTD

"; print "
"; my $bid_part = BatchIdPart('?'); print " Free-for-all whiteboard:
" . html_quote($::WhiteBoard) . "

\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:

\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 " Can't contact the directory server at $ldapserver:$ldapport\n"; } print " \n"; print "\n" if $ldapserver; foreach $p (@peoplelist) { my ($uname, $namepart, $extra) = ('', '', ''); if (exists($closedcheckin{$p})) { $extra = " ($closedcheckin{$p} while tree closed!)"; } $uname = $username{$p}; ($namepart = $p) =~ s/\@.*//; $checkins = $checkincount{$p}; print "\n"; print "\n"; print "\n"; print "\n"; print "\n\n"; } print "
WhoWhatHow to contact
$fullname{$p}" . GenerateUserLookUp($uname, $namepart, $p) . " $checkins "; print Pluralize('change', $checkins) . "$extra$curcontact{$p}\n" if $ldapserver; print "
\n\n"; $checkins = @::CheckInList; print Pluralize("$checkins checkin", $checkins) . ".

\n"; my $mailaddr = join(',', @peoplelist) . "?subject=Hook%3a%20Build%20Problem"; $mailaddr .= "&cc=$::TreeInfo{$::TreeID}{cchookmail}" if (exists($::TreeInfo{$::TreeID}{cchookmail})); print " Show all checkins.
Send mail to \"the hook\".
\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 = "Tinderbox continuous builds
" if ($tinderboxbase); my $otherrefs = Param('other_ref_urls'); print "


Useful links Help and Documentation
CVS Query Tool
Switch to look at a different tree or branch
$tinderboxlink Time warp -- view a different day's hook.
See some stupid statistics about recent checkins.
Administration menu.
$otherrefs
" ; 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 () { 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); } }