pjs/webtools/bonsai/toplevel.cgi

#!/usr/bonsaitools/bin/perl
# -*- 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';

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();


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 $tree (@::TreeList) {
     unless (exists $::TreeInfo{$tree}{nobonsai}) {
          $c = '';
          $c = "SELECTED" if ($tree eq $::TreeID);
          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("%D %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("%D %T %Z", $::LastGoodTimeStamp) . "</tt>.<br>";
print "<hr><pre variable>$::MOTD</pre><hr>";
print "<br clear=all>";

$bid_part = BatchIdPart('?');
print "<b><a href=editwhiteboard.cgi$bid_part>
Free-for-all whiteboard:</a></b>
<pre>" . html_quote($::WhiteBoard) . "</pre><hr>\n";


foreach $checkin (@::CheckInList) {
     my $info = eval("\\\%$checkin");
     my $addr = EmailFromUsername($$info{'person'});
     
     $username{$addr} = $$info{'person'};
     $people{$addr} .= " " if $people{$addr};
     $people{$addr} .= "$checkin";
     $closedcheckin{$addr} .= " $checkin" unless $$info{'treeopen'};
}


$ldaperror = 0;

if (%people) {
     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 %people);
     
     @list = @peoplelist;
     while (1) {
          last if ($#list < 0);
          $end = 19;
          $end = $#list if ($end >= $#list);
          GetInfoForPeople(splice(@list, 0, $end + 1));
     }

     print "<font color=red>
Can't contact the directory server at $ldapserver:$ldapport -- $errvar
</font>\n" if ($ldaperror);

     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})) {
               my $n = split(/\s+/, $closedcheckin{$p});
               $extra = " <font color=red>($n while tree closed!)</font>";
          }

          $uname = $username{$p};
          ($namepart = $p) =~ s/\@.*//;
          $checkins = split(/\s+/, $people{$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";

     $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.";
}


$cvsqueryurl = "cvsqueryform.cgi?" .
               "cvsroot=$::TreeInfo{$::TreeID}{repository}" .
               "&module=$::TreeID";
$cvsqueryurl.= "&branch=$::TreeInfo{$::TreeID}{branch}"
     if ($::TreeInfo{$::TreeID}{branch});
$bip = BatchIdPart('?');
$tinderboxbase = Param('tinderboxbase');
$tinderboxlink = '';
$tinderboxlink = "<a href=\"$tinderbox_base/showbuilds.cgi\">Tinderbox
        continuous builds</a><br>" if ($tinderboxbase);

$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);
     }
}