#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; 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.
source CGI.tcl
Lock
LoadCheckins
LoadMOTD
LoadWhiteboard
LoadTreeConfig
Unlock
if {$treeopen} {
set openword Open
} else {
set openword Closed
}
puts "Content-type: text/html
Refresh: 300
($openword) Bonsai -- the art of effectively controlling trees
Bonsai -- Tree Control
"
if {$readonly} {
puts "Be aware that you are looking at an old hook!
"
}
puts "[fmtclock [getclock] "%R"]: The tree is currently "
if {$treeopen} {
puts "OPEN
"
} else {
puts "CLOSED
"
}
if {!$treeopen} {
puts "The tree has been closed since [MyFmtClock $closetimestamp]."
}
puts "
"
puts "The last known good tree had a timestamp "
puts "of [fmtclock $lastgoodtimestamp "%D %T %Z"].
"
puts "
$motd
"
puts "
"
# if {[info exists FORM(whitedelta)]} {
# set delta $FORM(whitedelta)
# } else {
# set delta [expr 24 * 60 * 60]
# }
#
# set fileok 0
# set filename [DataDir]/whitedelta-$delta
# if {[file exists $filename]} {
# if {[file mtime $filename] > [file mtime [DataDir]/whiteboard]} {
# set fileok 1
# }
# }
#
# if {!$fileok} {
# set tmp [DataDir]/tmpwhite.[id process]
# Lock
# set date [fmtclock [expr [getclock] - $delta] "%a %b %d %H:%M:%S LT %Y"]
# catch {exec co -q -d$date -p [DataDir]/whiteboard > $tmp 2> /dev/null}
# catch {chmod 0666 $tmp}
# exec ./changebar.tcl $tmp [DataDir]/whiteboard > $filename
# unlink $tmp
# catch {chmod 0666 $filename}
# Unlock
# }
#puts "Free-for-all whiteboard: (Changebars indicate changes within last [PrettyDelta $delta])[html_quote [read_file $filename]]
"
puts "Free-for-all whiteboard:[html_quote $whiteboard]
"
foreach c $checkinlist {
upvar #0 $c info
set addr [EmailFromUsername $info(person)]
set username($addr) $info(person)
lappend people($addr) $c
if {!$info(treeopen)} {
lappend closedcheckin($addr) $c
}
}
proc GetInfoForPeople {peoplelist} {
global ldaperror fullname curcontact errvar ldapserver ldapport
set query "(| "
set isempty 1
foreach p $peoplelist {
append query "(mail=$p) "
set fullname($p) ""
set curcontact($p) ""
}
append query ")"
if {$ldaperror} {
return
}
if {[cequal $ldapserver ""]} {
return
}
if {[catch {set fid [open "|./data/ldapsearch -b \"dc=netscape,dc=com\" -h $ldapserver -p $ldapport -s sub -S mail \"$query\" mail cn nscpcurcontactinfo" r]} errvar]} {
set ldaperror 1
} else {
set doingcontactinfo 0
while {[gets $fid line] >= 0} {
if {$doingcontactinfo} {
if {[regexp -- {^ (.*)$} $line foo n]} {
append curcontact($curperson) $n
continue
}
set doingcontactinfo 0
}
if {[regexp -- {^mail: (.*@.*)$} $line foo n]} {
set curperson $n
} elseif {[regexp -- {^cn: (.*)$} $line foo n]} {
set fullname($curperson) $n
} elseif {[regexp -- {^nscpcurcontactinfo: (.*)$} $line foo n]} {
set curcontact($curperson) $n
set doingcontactinfo 1
}
}
if {[catch {close $fid} errvar]} {
set ldaperror 1
}
}
}
set ldaperror 0
if {[info exists people]} {
puts "The following people are on \"the hook\", since they have made"
puts "checkins to the tree since it last opened: "
puts ""
set peoplelist [lsort [array names people]]
set list $peoplelist
while {![lempty $list]} {
GetInfoForPeople [lrange $list 0 19]
set list [lrange $list 20 end]
}
if {$ldaperror} {
puts "Can't contact the directory server at $ldapserver:$ldapport -- $errvar"
}
puts "
"
puts "| Who | What | "
if {![cequal $ldapserver ""]} {
puts "How to contact | "
}
foreach p $peoplelist {
if {[info exists closedcheckin($p)]} {
set extra " ([llength $closedcheckin($p)] while tree closed!)"
} else {
set extra ""
}
set uname $username($p)
set namepart $p
regsub {@.*$} $namepart {} namepart
puts "
| $fullname($p) |
$uname |
[llength $people($p)]
[Pluralize change [llength $people($p)]]$extra | "
puts "
$curcontact($p)
|
"
}
puts "
"
puts "[llength $checkinlist] checkins."
if {[cequal $treeid default]} {
set mailaddr "bonsai-hook@warp"
} else {
set mailaddr [join $peoplelist ","]
}
puts ""
puts "Show all checkins.
"
if {[cequal $treeid default]} {
puts ""
} else {
puts ""
}
puts "Send mail to \"the hook\".
"
} else {
puts "Nobody seems to have made any changes since the tree opened."
}
set cvsqueryurl "cvsqueryform.cgi?cvsroot=$treeinfo($treeid,repository)&module=$treeinfo($treeid,module)"
if {[clength $treeinfo($treeid,branch)] > 0} {
append cvsqueryurl "&branch=$treeinfo($treeid,branch)"
}
puts "
"
exit