зеркало из https://github.com/mozilla/pjs.git
Massive patch (mostly from Dieter Weber <dieter@Compatible.COM>) -- ported all TCL code to Perl.
This commit is contained in:
terry%mozilla.org
Родитель
a84263044e
Коммит
d1360d1cc4
|
|
@ -0,0 +1,480 @@
|
|||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla 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/MPL/
|
||||
#
|
||||
# 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 Bugzilla Bug Tracking System.
|
||||
#
|
||||
# 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): Terry Weissman <terry@mozilla.org>
|
||||
|
||||
# Contains some global routines used throughout the CGI scripts of Bugzilla.
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
use CGI::Carp qw(fatalsToBrowser);
|
||||
|
||||
require 'globals.pl';
|
||||
|
||||
##
|
||||
## Utility routines to convert strings
|
||||
##
|
||||
|
||||
# Get rid of all the %xx encoding and the like from the given URL.
|
||||
sub url_decode {
|
||||
my ($todecode) = (@_);
|
||||
$todecode =~ tr/+/ /; # pluses become spaces
|
||||
$todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
|
||||
return $todecode;
|
||||
}
|
||||
|
||||
# Quotify a string, suitable for putting into a URL.
|
||||
sub url_quote {
|
||||
my($toencode) = (@_);
|
||||
$toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
|
||||
return $toencode;
|
||||
}
|
||||
|
||||
# Quotify a string, suitable for output as form values
|
||||
sub value_quote {
|
||||
my ($var) = (@_);
|
||||
$var =~ s/\&/\&/g;
|
||||
$var =~ s/</\</g;
|
||||
$var =~ s/>/\>/g;
|
||||
$var =~ s/\"/\"/g;
|
||||
$var =~ s/\n/\
/g;
|
||||
$var =~ s/\r/\
/g;
|
||||
return $var;
|
||||
}
|
||||
|
||||
sub url_encode2 {
|
||||
my ($s) = @_;
|
||||
|
||||
$s =~ s/\%/\%25/g;
|
||||
$s =~ s/\=/\%3d/g;
|
||||
$s =~ s/\?/\%3f/g;
|
||||
$s =~ s/ /\%20/g;
|
||||
$s =~ s/\n/\%0a/g;
|
||||
$s =~ s/\r//g;
|
||||
$s =~ s/\"/\%22/g;
|
||||
$s =~ s/\'/\%27/g;
|
||||
$s =~ s/\|/\%7c/g;
|
||||
$s =~ s/\&/\%26/g;
|
||||
$s =~ s/\+/\%2b/g;
|
||||
return $s;
|
||||
}
|
||||
|
||||
sub url_encode3 {
|
||||
my ($s) = @_;
|
||||
|
||||
$s =~ s/\n/\%0a/g;
|
||||
$s =~ s/\r//g;
|
||||
$s =~ s/\"/\%22/g;
|
||||
$s =~ s/\+/\%2b/g;
|
||||
return $s;
|
||||
}
|
||||
|
||||
|
||||
##
|
||||
## Routines to generate html as part of Bonsai
|
||||
##
|
||||
|
||||
# Create the URL that has the correct tree and batch information
|
||||
sub BatchIdPart {
|
||||
my ($initstr) = @_;
|
||||
my ($result, $ro) = ("", Param('readonly'));
|
||||
|
||||
$initstr = "" unless (defined($initstr) && $initstr);
|
||||
|
||||
$result = $initstr if (($::TreeID ne "default") || $ro);
|
||||
$result .= "&treeid=$::TreeID" if ($::TreeID ne "default");
|
||||
$result .= "&batchid=$::BatchID" if ($ro);
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
# Create a generic page header for bonsai pages
|
||||
sub PutsHeader {
|
||||
my ($title, $h1, $h2) = (@_);
|
||||
|
||||
if (!defined $h1) {
|
||||
$h1 = $title;
|
||||
}
|
||||
if (!defined $h2) {
|
||||
$h2 = "";
|
||||
}
|
||||
|
||||
print "<HTML><HEAD>\n<TITLE>$title</TITLE>\n";
|
||||
print $::Setup_String if (defined($::Setup_String) && $::Setup_String);
|
||||
print Param("headerhtml") . "\n</HEAD>\n";
|
||||
print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\"\n";
|
||||
print "LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
|
||||
|
||||
print PerformSubsts(Param("bannerhtml"), undef);
|
||||
|
||||
print "<TABLE BORDER=0 CELLPADDING=12 CELLSPACING=0 WIDTH=\"100%\">\n";
|
||||
print " <TR>\n";
|
||||
print " <TD>\n";
|
||||
print " <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=2>\n";
|
||||
print " <TR><TD VALIGN=TOP ALIGN=CENTER NOWRAP>\n";
|
||||
print " <FONT SIZE=\"+3\"><B><NOBR>$h1</NOBR></B></FONT>\n";
|
||||
print " </TD></TR><TR><TD VALIGN=TOP ALIGN=CENTER>\n";
|
||||
print " <B>$h2</B>\n";
|
||||
print " </TD></TR>\n";
|
||||
print " </TABLE>\n";
|
||||
print " </TD>\n";
|
||||
print " <TD>\n";
|
||||
|
||||
print Param("blurbhtml");
|
||||
|
||||
print "</TD></TR></TABLE>\n";
|
||||
}
|
||||
|
||||
# Create a generic page trailer for bonsai pages
|
||||
sub PutsTrailer {
|
||||
my $args = BatchIdPart('?');
|
||||
my $maintainer = Param('maintainer');
|
||||
my $email = '';
|
||||
|
||||
|
||||
if ($maintainer) {
|
||||
$email = "<br>" . ConstructMailTo($maintainer, "Bonsai Comments");
|
||||
$email .= "with comments/questions about this page.\n";
|
||||
}
|
||||
|
||||
print "
|
||||
<br clear=all>
|
||||
<hr>
|
||||
<a href=\"toplevel.cgi$args\" target=_top>
|
||||
Back to the top of Bonsai</a>
|
||||
$email
|
||||
</html>
|
||||
";
|
||||
}
|
||||
|
||||
|
||||
sub GeneratePersonInput {
|
||||
my ($field, $required, $def_value, $extraJavaScript) = (@_);
|
||||
if (!defined $extraJavaScript) {
|
||||
$extraJavaScript = "";
|
||||
}
|
||||
if ($extraJavaScript ne "") {
|
||||
$extraJavaScript = "onChange=\" $extraJavaScript \"";
|
||||
}
|
||||
return "<INPUT NAME=\"$field\" SIZE=32 $extraJavaScript VALUE=\"$def_value\">";
|
||||
}
|
||||
|
||||
sub GeneratePeopleInput {
|
||||
my ($field, $def_value) = (@_);
|
||||
return "<INPUT NAME=\"$field\" SIZE=45 VALUE=\"$def_value\">";
|
||||
}
|
||||
|
||||
|
||||
sub make_options {
|
||||
my ($src,$default,$isregexp) = (@_);
|
||||
my $last = "";
|
||||
my $popup = "";
|
||||
my $found = 0;
|
||||
|
||||
if ($src) {
|
||||
foreach my $item (@$src) {
|
||||
if ($item eq "-blank-" || $item ne $last) {
|
||||
if ($item eq "-blank-") {
|
||||
$item = "";
|
||||
}
|
||||
$last = $item;
|
||||
if ($isregexp ? $item =~ $default : $default eq $item) {
|
||||
$popup .= "<OPTION SELECTED VALUE=\"$item\">$item";
|
||||
$found = 1;
|
||||
} else {
|
||||
$popup .= "<OPTION VALUE=\"$item\">$item";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (!$found && $default ne "") {
|
||||
$popup .= "<OPTION SELECTED>$default";
|
||||
}
|
||||
return $popup;
|
||||
}
|
||||
|
||||
sub make_popup {
|
||||
my ($name,$src,$default,$listtype,$onchange) = (@_);
|
||||
my $popup = "<SELECT NAME=$name";
|
||||
if ($listtype > 0) {
|
||||
$popup .= " SIZE=5";
|
||||
if ($listtype == 2) {
|
||||
$popup .= " MULTIPLE";
|
||||
}
|
||||
}
|
||||
if (defined $onchange && $onchange ne "") {
|
||||
$popup .= " onchange=$onchange";
|
||||
}
|
||||
$popup .= ">" . make_options($src, $default,
|
||||
($listtype == 2 && $default ne ""));
|
||||
$popup .= "</SELECT>";
|
||||
return $popup;
|
||||
}
|
||||
|
||||
sub make_cgi_args {
|
||||
my ($k,$v,$ret);
|
||||
|
||||
for $k (sort keys %::FORM){
|
||||
$ret .= ($ret eq "" ? '?' : '&');
|
||||
$v = $::FORM{$k};
|
||||
$ret .= &url_encode2($k);
|
||||
$ret .= '=';
|
||||
$ret .= &url_encode2($v);
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub cvsmenu {
|
||||
my ($extra) = @_;
|
||||
my ($pass, $i, $page, $title);
|
||||
my ($desc, $branch, $root, $module, $maintainer);
|
||||
|
||||
LoadTreeConfig();
|
||||
|
||||
print "<table border=1 bgcolor=#ffffcc $extra>\n";
|
||||
print "<tr><th>Menu</tr><tr><td><p>\n<dl>\n";
|
||||
|
||||
foreach $pass ("cvsqueryform|Query",
|
||||
"rview|Browse",
|
||||
"moduleanalyse|Examine Modules") {
|
||||
($page, $title) = split(/\|/, $pass);
|
||||
$page .= ".cgi";
|
||||
print "<b>$title</b><br><ul>\n";
|
||||
foreach $i (@::TreeList) {
|
||||
$branch = '';
|
||||
$branch = "&branch=$::TreeInfo{$i}{'branch'}"
|
||||
if $::TreeInfo{$i}{'branch'};
|
||||
|
||||
$desc = $::TreeInfo{$i}{'shortdesc'};
|
||||
$desc = $::TreeInfo{$i}{'description'} unless $desc;
|
||||
|
||||
$root = "cvsroot=$::TreeInfo{$i}{'repository'}";
|
||||
$module = "module=$i";
|
||||
print "<li><a href=\"$page?$root&$module$branch\">$desc</a>\n";
|
||||
};
|
||||
print "</ul>\n";
|
||||
};
|
||||
|
||||
if (open(EXTRA, "<data/cvsmenuextra")) {
|
||||
while (<EXTRA>) {
|
||||
print $_;
|
||||
}
|
||||
close EXTRA;
|
||||
}
|
||||
|
||||
$maintainer = Param('maintainer');
|
||||
print "</dl>
|
||||
<p></tr><tr><td>
|
||||
<font size=-1> Questions, Comments, Feature requests?
|
||||
mail <a href=maito:$maintainer>$maintainer</a>
|
||||
</font>
|
||||
</tr></table>
|
||||
";
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
##
|
||||
## Routines to handle initializing CGI form data, cookies, etc...
|
||||
##
|
||||
|
||||
sub ProcessFormFields {
|
||||
my ($buffer) = (@_);
|
||||
undef %::FORM;
|
||||
undef %::MFORM;
|
||||
|
||||
my %isnull;
|
||||
my $remaining = $buffer;
|
||||
while ($remaining ne "") {
|
||||
my $item;
|
||||
if ($remaining =~ /^([^&]*)&(.*)$/) {
|
||||
$item = $1;
|
||||
$remaining = $2;
|
||||
} else {
|
||||
$item = $remaining;
|
||||
$remaining = "";
|
||||
}
|
||||
|
||||
my $name;
|
||||
my $value;
|
||||
if ($item =~ /^([^=]*)=(.*)$/) {
|
||||
$name = $1;
|
||||
$value = url_decode($2);
|
||||
} else {
|
||||
$name = $item;
|
||||
$value = "";
|
||||
}
|
||||
if ($value ne "") {
|
||||
if (defined $::FORM{$name}) {
|
||||
$::FORM{$name} .= $value;
|
||||
my $ref = $::MFORM{$name};
|
||||
push @$ref, $value;
|
||||
} else {
|
||||
$::FORM{$name} = $value;
|
||||
$::MFORM{$name} = [$value];
|
||||
}
|
||||
} else {
|
||||
$isnull{$name} = 1;
|
||||
}
|
||||
}
|
||||
if (defined %isnull) {
|
||||
foreach my $name (keys(%isnull)) {
|
||||
if (!defined $::FORM{$name}) {
|
||||
$::FORM{$name} = "";
|
||||
$::MFORM{$name} = [];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub ProcessMultipartFormFields {
|
||||
my ($boundary) = (@_);
|
||||
$boundary =~ s/^-*//;
|
||||
my $remaining = $ENV{"CONTENT_LENGTH"};
|
||||
my $inheader = 1;
|
||||
my $itemname = "";
|
||||
|
||||
while ($remaining > 0 && ($_ = <STDIN>)) {
|
||||
$remaining -= length($_);
|
||||
if ($_ =~ m/^-*$boundary/) {
|
||||
$inheader = 1;
|
||||
$itemname = "";
|
||||
next;
|
||||
}
|
||||
|
||||
if ($inheader) {
|
||||
if (m/^\s*$/) {
|
||||
$inheader = 0;
|
||||
$::FORM{$itemname} = "";
|
||||
}
|
||||
if (m/^Content-Disposition:\s*form-data\s*;\s*name\s*=\s*"([^\"]+)"/i) {
|
||||
$itemname = $1;
|
||||
if (m/;\s*filename\s*=\s*"([^\"]+)"/i) {
|
||||
$::FILENAME{$itemname} = $1;
|
||||
}
|
||||
}
|
||||
|
||||
next;
|
||||
}
|
||||
$::FORM{$itemname} .= $_;
|
||||
}
|
||||
delete $::FORM{""};
|
||||
|
||||
# Get rid of trailing newlines.
|
||||
foreach my $i (keys %::FORM) {
|
||||
chomp($::FORM{$i});
|
||||
$::FORM{$i} =~ s/\r$//;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub FormData {
|
||||
my ($field) = (@_);
|
||||
|
||||
unless (defined($::FORM{$field})) {
|
||||
print "\n<b>Error: Form field `<tt>$field</tt>' is not defined</b>\n";
|
||||
exit 0;
|
||||
}
|
||||
return $::FORM{$field};
|
||||
}
|
||||
|
||||
|
||||
sub CheckEmailSyntax {
|
||||
my ($addr) = (@_);
|
||||
if ($addr !~ /^[^@, ]*@[^@, ]*\.[^@, ]*$/) {
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
print "<H1>Invalid e-mail address entered.</H1>\n";
|
||||
print "The e-mail address you entered\n";
|
||||
print "(<b>$addr</b>) didn't match our minimal\n";
|
||||
print "syntax checking for a legal email address. A legal\n";
|
||||
print "address must contain exactly one '\@', and at least one\n";
|
||||
print "'.' after the \@, and may not contain any commas or.\n";
|
||||
print "spaces.\n";
|
||||
print "<p>Please click <b>back</b> and try again.\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
############# Live code below here (that is, not subroutine defs) #############
|
||||
|
||||
|
||||
$| = 1;
|
||||
|
||||
# Uncommenting this next line can help debugging.
|
||||
# print "Content-type: text/html\n\nHello mom\n";
|
||||
|
||||
# foreach my $k (sort(keys %ENV)) {
|
||||
# print "$k $ENV{$k}<br>\n";
|
||||
# }
|
||||
|
||||
if (defined $ENV{"REQUEST_METHOD"}) {
|
||||
if ($ENV{"REQUEST_METHOD"} eq "GET") {
|
||||
if (defined $ENV{"QUERY_STRING"}) {
|
||||
$::buffer = $ENV{"QUERY_STRING"};
|
||||
} else {
|
||||
$::buffer = "";
|
||||
}
|
||||
ProcessFormFields $::buffer;
|
||||
} else {
|
||||
if ($ENV{"CONTENT_TYPE"} =~
|
||||
m@multipart/form-data; boundary=\s*([^; ]+)@) {
|
||||
ProcessMultipartFormFields($1);
|
||||
$::buffer = "";
|
||||
} else {
|
||||
read STDIN, $::buffer, $ENV{"CONTENT_LENGTH"} ||
|
||||
die "Couldn't get form data";
|
||||
ProcessFormFields $::buffer;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if (defined $ENV{"HTTP_COOKIE"}) {
|
||||
foreach my $pair (split(/;/, $ENV{"HTTP_COOKIE"})) {
|
||||
$pair = trim($pair);
|
||||
if ($pair =~ /^([^=]*)=(.*)$/) {
|
||||
$::COOKIE{$1} = $2;
|
||||
} else {
|
||||
$::COOKIE{$pair} = "";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if (defined $::FORM{'treeid'} && $::FORM{'treeid'} ne "") {
|
||||
$::TreeID = $::FORM{'treeid'};
|
||||
}
|
||||
|
||||
if (defined $::FORM{'batchid'}) {
|
||||
LoadBatchID();
|
||||
if ($::BatchID != $::FORM{'batchid'}) {
|
||||
$::BatchID = $::FORM{'batchid'};
|
||||
|
||||
# load parameters first to prevent overwriting
|
||||
Param('readonly');
|
||||
$::param{'readonly'} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -11,6 +11,30 @@ will tell you what has been changed in the last week.
|
|||
|
||||
|
||||
|
||||
7/9/99 Ported completely to perl! (Due to heroic efforts by Dieter
|
||||
Weber <dieter@Compatible.COM>). Among the things you need to do to
|
||||
get this to work are:
|
||||
|
||||
- Realize that this installation will clear the "hook", and will
|
||||
prevent you from seeing any old hooks that were created by the old
|
||||
TCL code.
|
||||
- Create a treeconfig.pl, based on the tree data in your old
|
||||
(now obsolete) configdata.
|
||||
- Make sure your perl contains the MailDate and libnet CPAN modules
|
||||
(see INSTALL for how to get these)
|
||||
- Add a new column to the descs table (Dieter added this to speedup
|
||||
database rebuilds). Feed this to mysql:
|
||||
|
||||
alter table descs add column hash bigint not null;
|
||||
|
||||
- Go visit the new editparams.cgi page, and adjust everything.
|
||||
- Change your mail alias to point to the new handleCheckinMail.pl
|
||||
script (instead of handleCheckinMail.tcl)
|
||||
- If you use the "administrator mail" feature, change its mail alias to
|
||||
point to the new handleAdminMail.pl (instead of handleAdminMail.tcl).
|
||||
|
||||
|
||||
|
||||
4/30/99 Now uses autoconf, and comes with a configure script. A few
|
||||
new variables can be defined in your configdata file, and probably
|
||||
need to be. See the file configdata.in for a list of the new parameters.
|
||||
|
|
|
|||
|
|
@ -61,12 +61,9 @@ the scripts. There are more things you will have to get and install.
|
|||
The short list of the things you will need:
|
||||
|
||||
1) MySQL database server.
|
||||
2) Tcl 7.6
|
||||
3) TclX 7.6
|
||||
4) mysqltcl program (hmm.. This was tricky.. Read on)
|
||||
5) Perl 5.004+ with Mysql module (included with MySQL).
|
||||
6) Date::Parse module for Perl
|
||||
7) Some kind of HTTP server so you could use CGI scripts
|
||||
2) Perl 5.004+ with Mysql module (included with MySQL).
|
||||
3) Date::Parse module for Perl
|
||||
4) Some kind of HTTP server so you could use CGI scripts
|
||||
|
||||
You could try running the ./configure script to see what tools it
|
||||
complains about right now. Mind you, it won't check for the MySQL
|
||||
|
|
@ -86,40 +83,9 @@ writable by all users on your machine and change access level
|
|||
later. This would save you a lot of time trying to guess whether it's
|
||||
permissions or a mistake in the script that make things fail.
|
||||
|
||||
1.2-3 Getting and building Tcl & TclX 8.0.4
|
||||
1.2 Perl + Mysql
|
||||
|
||||
Bonsai works with Tcl & TclX 7.6 too, but if you need to build,
|
||||
you might as well get the latest stable versions.
|
||||
Tcl homepage is at http://www.scriptics.com. You may get sources
|
||||
for UNIX from ftp://ftp.scriptics.com/pub/tcl/tcl8_0/tcl8.0.4.tar.gz.
|
||||
TclX is an extension for Tcl that adds a lot of useful functions that
|
||||
are heavily used in Bonsai tool.
|
||||
TclX page is http://www.neosoft.com/tclx. Download sources from
|
||||
ftp://ftp.neosoft.com/pub/tcl/TclX/tclX8.0.4.tar.gz. Watch out for the
|
||||
case of the letters in URL. These guys are going to bring some fun
|
||||
into your life by spelling their program name in various ways.
|
||||
|
||||
Now you've probably got both Tcl and TclX 8.0.4. You may try to use
|
||||
later versions but I'm not sure about results. Unfortunately I'm not an
|
||||
expert in "Tcl&Co.".
|
||||
|
||||
Build and install Tcl first. Then build and install TclX. This
|
||||
should go without serious problems
|
||||
|
||||
1.4 mysqltcl - the tricky part
|
||||
|
||||
Grab mysqltcl 1.53 from MySQL site's contributed software area
|
||||
(http://www.tcx.se/Contrib/) I've used version 1.53 and it works for
|
||||
me, though you may try more recent version at your own risk. You're
|
||||
risking anyway.
|
||||
|
||||
You will need to patch mysqltcl to include support for TclX. A
|
||||
patch is provided in Appendix A.
|
||||
|
||||
1.5 Perl + Mysql
|
||||
|
||||
Besides mysqltcl you will need Perl 5.004 with DB and Mysql
|
||||
extensions.
|
||||
You will need Perl 5.004 with DB and Mysql extensions.
|
||||
|
||||
DB is required to use LXR browser and crossreferencer for storing
|
||||
its database. Mysql is used by Bonsai.
|
||||
|
|
@ -148,7 +114,10 @@ Go to CPAN search page
|
|||
(http://theory.uwinnipeg.ca/search/cpan-search.html) and search for
|
||||
the "TimeDate" module. Then get it and install.
|
||||
|
||||
1.6 HTTP server
|
||||
You also need to get the libnet and MailTools CPAN modules. They can
|
||||
both be found on CPAN at CPAN/modules/by-authors/id/GBARR.
|
||||
|
||||
1.3 HTTP server
|
||||
|
||||
You have a freedom of choice here - Apache, Netscape or any other
|
||||
server on UNIX would do. The only thing - to make configuration easier
|
||||
|
|
@ -219,9 +188,9 @@ configuration mechanism is introduced.
|
|||
install Bonsai in another place than /usr/local, e.g. /var/www. It
|
||||
will make a new directory named "bonsai" in the prefix directory you specify.
|
||||
|
||||
Edit data/configdata file as described in README file. Create
|
||||
Edit data/treeconfig.pl file as described in README file. Create
|
||||
appropriate data/XXX directory for each tree XXX you've configured
|
||||
in 'configdata'.
|
||||
in 'treeconfig.pl'.
|
||||
|
||||
Go to the data directory and run
|
||||
|
||||
|
|
@ -229,29 +198,6 @@ in 'configdata'.
|
|||
|
||||
it will set up admin's password.
|
||||
|
||||
file: cvsblame.cgi
|
||||
@line 202: you may add your own translation to help find
|
||||
appropriate RCS file for the given source file.
|
||||
TODO: We'd better get this information from CVS/Repository
|
||||
file. It's more generic than hardcoded tweaks.
|
||||
|
||||
file: cvslog.cgi
|
||||
@line 154: the same tweaks to find RCS file for given source file
|
||||
@ line 475: add translations to $lxr_path to help find source
|
||||
file for given RCS file.
|
||||
TODO: This should be done using information in
|
||||
$CVSROOT/CVSROOT/modules file. Typical example is the
|
||||
following line: 'mymodule -d mydir repositorydir' which
|
||||
causes files for module mymodule from repositorydir to be
|
||||
placed in mydir. This contains enough information about
|
||||
backward translation mydir/file->repositorydir/file,v
|
||||
|
||||
|
||||
file: cvsquery.cgi
|
||||
@line 25: There are some cases when cvsroot is not passed as
|
||||
parameter for cvsquery.cgi. You should better check for
|
||||
empty CVS_ROOT and set it to your CVSROOT path.
|
||||
|
||||
That's basically it. With some luck and persistence you will have 90%
|
||||
working system at this point. A lot of these things are just asking to be
|
||||
fixed in near feature. And I hope they will be.
|
||||
|
|
@ -313,85 +259,3 @@ be nice. It might be also nice to borrow syntax highliting from LSN.
|
|||
time trying. Or just reading.
|
||||
|
||||
Any suggestions/additions are welcome.
|
||||
|
||||
|
||||
*******************************************************
|
||||
APPENDIXES
|
||||
*******************************************************
|
||||
|
||||
APPENDIX 1. Patch to build mysqltcl with TclX
|
||||
---------------------------------------------
|
||||
|
||||
diff -u -r mysqltcl-1.53/Makefile mysqltcl-1.53p/Makefile
|
||||
--- mysqltcl-1.53/Makefile Mon Jul 6 18:11:55 1998
|
||||
+++ mysqltcl-1.53p/Makefile Wed Apr 28 09:48:55 1999
|
||||
@@ -10,7 +10,7 @@
|
||||
TKHOME = /usr
|
||||
MYSQLHOME = /usr/local/mysql
|
||||
|
||||
-SHARED = yes
|
||||
+SHARED = no
|
||||
#PLATFORM=SunOS-5.5.1-sparc
|
||||
#PLATFORM=SunOS-5.6-sparc
|
||||
PLATFORM=Linux-2.0-i586
|
||||
@@ -59,7 +59,7 @@
|
||||
CPPFLAGS = -I$(XHOME)/include -I$(TCLHOME)/include -I$(TKHOME)/include \
|
||||
-I$(MYSQLHOME)/include
|
||||
LOADLIBES = -L$(XHOME)/lib -L$(TCLHOME)/lib -L$(TKHOME)/lib \
|
||||
- -L$(MYSQLHOME)/lib -lmysqlclient -ltk8.0 -ltcl8.0 -lX11 -lm -ldl $(LIBS)
|
||||
+ -L$(MYSQLHOME)/lib -lmysqlclient -ltclx8.0.4 -ltk8.0 -ltcl8.0 -lX11 -lm -ldl $(LIBS)
|
||||
|
||||
all: $(OUTPUT)
|
||||
|
||||
diff -u -r mysqltcl-1.53/mysqltcl.c mysqltcl-1.53p/mysqltcl.c
|
||||
--- mysqltcl-1.53/mysqltcl.c Mon Jul 6 17:35:17 1998
|
||||
+++ mysqltcl-1.53p/mysqltcl.c Mon Apr 26 11:21:10 1999
|
||||
@@ -27,7 +27,7 @@
|
||||
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
-#include <tcl.h>
|
||||
+#include <tclExtend.h>
|
||||
#include <mysql.h>
|
||||
|
||||
#include <errno.h>
|
||||
diff -u -r mysqltcl-1.53/mysqltclsh.c mysqltcl-1.53p/mysqltclsh.c
|
||||
--- mysqltcl-1.53/mysqltclsh.c Wed Mar 18 13:44:55 1998
|
||||
+++ mysqltcl-1.53p/mysqltclsh.c Mon Apr 26 11:26:26 1999
|
||||
@@ -17,7 +17,7 @@
|
||||
#include <X11/Intrinsic.h>
|
||||
#endif
|
||||
|
||||
-#include "tcl.h"
|
||||
+#include "tclExtend.h"
|
||||
|
||||
/*
|
||||
* The following variable is a special hack that is needed in order for
|
||||
@@ -61,7 +61,7 @@
|
||||
#ifdef TCL_XT_TEST
|
||||
XtToolkitInitialize();
|
||||
#endif
|
||||
- Tcl_Main(argc, argv, Tcl_AppInit);
|
||||
+ TclX_Main(argc, argv, Tcl_AppInit);
|
||||
return 0; /* Needed only to prevent compiler warning. */
|
||||
}
|
||||
|
||||
@@ -92,6 +92,10 @@
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
+ if (Tclx_Init(interp) == TCL_ERROR) {
|
||||
+ return TCL_ERROR;
|
||||
+ }
|
||||
+
|
||||
#ifdef TCL_TEST
|
||||
#ifdef TCL_XT_TEST
|
||||
if (Tclxttest_Init(interp) == TCL_ERROR) {
|
||||
@@ -135,6 +139,6 @@
|
||||
* then no user-specific startup file will be run under any conditions.
|
||||
*/
|
||||
|
||||
- Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
|
||||
+/* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);*/
|
||||
return TCL_OK;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@
|
|||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
|
||||
# This Makefile helps you install Bonsai. Define PERL and MYSQLTCL to
|
||||
# This Makefile helps you install Bonsai. Define PERL to
|
||||
# the full pathnames of where you have these utilities. Define PREFIX
|
||||
# to where you will install the running Bonsai. Then "make install" should
|
||||
# copy things for you.
|
||||
|
|
@ -28,8 +28,6 @@ CFLAGS = @CFLAGS@
|
|||
LDFLAGS = @LIBS@
|
||||
# /usr/bin/perl
|
||||
PERL = @PERL@
|
||||
# /usr/local/src/mysqltcl-1.53/mysqltclsh
|
||||
MYSQLTCL = @MYSQLTCL@
|
||||
# /var/www/bonsai
|
||||
PREFIX = @prefix@/bonsai
|
||||
|
||||
|
|
@ -37,22 +35,19 @@ CVS=@CVS@
|
|||
RLOG=@RLOG@
|
||||
CO=@CO@
|
||||
RCSDIFF=@RCSDIFF@
|
||||
SENDMAIL=@SENDMAIL@
|
||||
|
||||
FILES = CGI.tcl \
|
||||
FILES = CGI.pl \
|
||||
SourceChecker.cgi \
|
||||
SourceChecker.pm \
|
||||
addcheckin.tcl \
|
||||
addcheckin.pl \
|
||||
admin.cgi \
|
||||
adminfuncs.tcl \
|
||||
adminmail.tcl \
|
||||
adminfuncs.pl \
|
||||
branchspam.cgi \
|
||||
branchspammer.cgi \
|
||||
changebar.tcl \
|
||||
closemessage \
|
||||
contacthelp.html \
|
||||
countcheckins.cgi \
|
||||
createlegaldirs.tcl \
|
||||
createlegaldirs.pl \
|
||||
cvsblame.cgi \
|
||||
cvsblame.pl \
|
||||
cvsguess.cgi \
|
||||
|
|
@ -67,34 +62,26 @@ FILES = CGI.tcl \
|
|||
doadmin.cgi \
|
||||
doeditcheckin.cgi \
|
||||
doeditmessage.cgi \
|
||||
doeditprofile.cgi \
|
||||
doeditwhiteboard.cgi \
|
||||
dolog.pl \
|
||||
dotweak.cgi \
|
||||
editcheckin.cgi \
|
||||
editmessage.cgi \
|
||||
editprofile.cgi \
|
||||
editwhiteboard.cgi \
|
||||
globals.tcl \
|
||||
handleAdminMail.tcl \
|
||||
handleCheckinMail.tcl \
|
||||
globals.pl \
|
||||
handleAdminMail.pl \
|
||||
handleCheckinMail.pl \
|
||||
header.pl \
|
||||
index.html \
|
||||
indextest.pl \
|
||||
lloydcgi.pl \
|
||||
localprofile.cgi \
|
||||
maketables.sh \
|
||||
moduleanalyse.cgi \
|
||||
modules.pl \
|
||||
multidiff.cgi \
|
||||
myglobrecur.tcl \
|
||||
openmessage \
|
||||
perlifyconfig.tcl \
|
||||
processqueue.pl \
|
||||
profile.cgi \
|
||||
rebuildcvshistory.cgi \
|
||||
rebuilddatabase.tcl \
|
||||
rebuildtaginfo.cgi \
|
||||
repophook.cgi \
|
||||
reposfiles.pl \
|
||||
rview.cgi \
|
||||
|
|
@ -106,26 +93,26 @@ FILES = CGI.tcl \
|
|||
utils.pl \
|
||||
viewold.cgi
|
||||
|
||||
all: trapdoor configdata
|
||||
all: trapdoor treeconfig.pl params
|
||||
|
||||
trapdoor: trapdoor.o
|
||||
$(CC) -o trapdoor trapdoor.o $(LDFLAGS)
|
||||
|
||||
configdata: configdata.in
|
||||
treeconfig.pl: treeconfig.pl.in
|
||||
cp treeconfig.pl.in treeconfig.pl
|
||||
|
||||
params: params.in
|
||||
sed -e s#_CVS_#$(CVS)#g \
|
||||
-e s#_RLOG_#$(RLOG)#g \
|
||||
-e s#_CO_#$(CO)#g \
|
||||
-e s#_RCSDIFF_#$(RCSDIFF)#g \
|
||||
-e s#_SENDMAIL_#$(SENDMAIL)#g \
|
||||
$< >$@
|
||||
|
||||
install: trapdoor configdata
|
||||
install: all
|
||||
-mkdir -p $(PREFIX)
|
||||
@for I in $(FILES); do \
|
||||
echo Installing $$I && \
|
||||
sed -e s#/usr/bonsaitools/bin/perl#$(PERL)#g \
|
||||
-e s#/usr/bonsaitools/bin/mysqltcl#$(MYSQLTCL)#g \
|
||||
-e s#/usr/lib/sendmail#$(SENDMAIL)#g \
|
||||
-e s#/tools/ns/bin/perl5#$(PERL)#g \
|
||||
$$I > $(PREFIX)/$$I && \
|
||||
chmod 755 $(PREFIX)/$$I; done
|
||||
|
|
@ -133,20 +120,25 @@ install: trapdoor configdata
|
|||
cp trapdoor $(PREFIX)/data
|
||||
cp bonsai.gif $(PREFIX)
|
||||
chmod 755 $(PREFIX)/bonsai.gif
|
||||
@if test ! -r $(PREFIX)/data/configdata ; then \
|
||||
echo "Installing configdata" && \
|
||||
cp configdata $(PREFIX)/data ; \
|
||||
@if test ! -r $(PREFIX)/data/treeconfig.pl ; then \
|
||||
echo "Installing treeconfig.pl" && \
|
||||
cp treeconfig.pl $(PREFIX)/data ; \
|
||||
else \
|
||||
echo ; \
|
||||
echo "Not replacing existing configdata" ; \
|
||||
echo "Check configdata in build directory for new features" ; \
|
||||
echo "Not replacing existing treeconfig.pl" ; \
|
||||
echo "Check treeconfig.pl in build directory for new features" ; \
|
||||
fi
|
||||
@if test ! -r $(PREFIX)/data/params ; then \
|
||||
echo "Installing params" && \
|
||||
cp params $(PREFIX)/data ; \
|
||||
else \
|
||||
echo ; \
|
||||
echo "Not replacing existing params" ; \
|
||||
fi
|
||||
@echo
|
||||
@echo "If you are installing a new Bonsai (not upgrading), you should"
|
||||
@echo "run maketables.sh to create database tables, then customize the"
|
||||
@echo "Bonsai configuration in $(PREFIX)/data/configdata"
|
||||
@echo "Bonsai configuration in $(PREFIX)/data/treeconfig.pl"
|
||||
|
||||
clean:
|
||||
rm -f trapdoor trapdoor.o configdata
|
||||
|
||||
|
||||
rm -f trapdoor trapdoor.o treeconfig.pl params
|
||||
|
|
|
|||
|
|
@ -30,42 +30,43 @@ ought to be split into different directories, but that hasn't happened
|
|||
yet.
|
||||
|
||||
Some of these files are:
|
||||
treeconfig.pl: some Perl source that defines @::TreeList, a list of trees you
|
||||
want to track, and %::TreeInfo, information about each of those
|
||||
trees. A sample treeconfig.pl:
|
||||
|
||||
configdata: some TCL source that defines treelist, a list of trees you want
|
||||
to track, and treedata, information about each of those trees.
|
||||
A sample configdata:
|
||||
@::TreeList = ('default', 'other');
|
||||
|
||||
set treelist {default newlayout}
|
||||
%::TreeInfo = (
|
||||
default => {
|
||||
branch => '',
|
||||
description => 'My CVS repository',
|
||||
module => 'All',
|
||||
repository => '/d2/cvsroot',
|
||||
shortdesc => 'Mine',
|
||||
},
|
||||
other => {
|
||||
branch => '',
|
||||
description => 'Other CVS repository',
|
||||
module => 'All',
|
||||
repository => '/d2/otherroot',
|
||||
shortdesc => 'Other',
|
||||
},
|
||||
|
||||
|
||||
set treeinfo(default,module) MozillaSource
|
||||
set treeinfo(default,branch) {}
|
||||
set treeinfo(default,repository) {/cvsroot}
|
||||
set treeinfo(default,description) {Mozilla Source Code}
|
||||
set treeinfo(default,shortdesc) {Mozilla}
|
||||
);
|
||||
|
||||
set treeinfo(newlayout,module) Raptor
|
||||
set treeinfo(newlayout,branch) {}
|
||||
set treeinfo(newlayout,repository) {/cvsroot}
|
||||
set treeinfo(newlayout,description) {New Layout -- Main Line}
|
||||
set treeinfo(newlayout,shortdesc) {New Layout}
|
||||
1;
|
||||
|
||||
Also, you can specify where Bonsai will look for some utilities
|
||||
on your system, and a couple other behaviors. You will
|
||||
probably have to override many of these; the default values are
|
||||
not that reasonable.
|
||||
|
||||
The default values are:
|
||||
|
||||
set cvscommand /tools/ns/bin/cvs
|
||||
set rlogcommand /tools/ns/bin/rlog
|
||||
set rcsdiffcommand /tools/ns/bin/rcsdiff
|
||||
set cocommand /tools/ns/bin/co
|
||||
set sendmailcommand /usr/lib/sendmail
|
||||
set lxr_base http://cvs-mirror.mozilla.org/webtools/lxr/source
|
||||
set mozilla_lxr_kludge TRUE
|
||||
params: This file contains many operating parameters. This can be
|
||||
edited using the editparams.cgi webpage; you should probably
|
||||
not edit it directory.
|
||||
|
||||
The ./configure script will make a guess on these commands from
|
||||
your PATH, so if it complains, add the directories in which these
|
||||
The ./configure script will make a guess on the paramaters
|
||||
that control paths for scripts to execute, and create an
|
||||
initial params file for you. It looks for things on your
|
||||
PATH, so if it complains, add the directories in which these
|
||||
commands reside to your PATH, or override the path check, for
|
||||
example:
|
||||
|
||||
|
|
@ -89,6 +90,9 @@ This is a rough first pass at cataloging and documenting the Bonsai
|
|||
sources. Many hands have been in this code over the years, and it has
|
||||
accreted wildly. There is probably quite a lot of dead code in here.
|
||||
|
||||
THIS LIST IS PRETTY OLD AND OUT OF DATE. In particular, we don't have
|
||||
any more TCL code; it's all either gone or ported to Perl.
|
||||
|
||||
|
||||
CGI.tcl ???
|
||||
|
||||
|
|
|
|||
|
|
@ -1,49 +1,6 @@
|
|||
dnl autoconf tests for bonsai
|
||||
dnl Pontus Lidman 99-05-04
|
||||
dnl
|
||||
dnl Check if mysqltclsh is compiled with tclX support
|
||||
dnl
|
||||
dnl AC_PROG_MYSQLTCL_TCLX([ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
|
||||
dnl Test for mysqltclsh compiled with tclX and define MYSQLTCL
|
||||
dnl
|
||||
AC_DEFUN(AC_PROG_MYSQLTCL_TCLX,
|
||||
[dnl
|
||||
dnl Get the cflags and libraries from the gtk-config script
|
||||
dnl
|
||||
AC_PATH_PROGS(MYSQLTCL, mysqltclsh mysqltcl, no)
|
||||
AC_MSG_CHECKING(for tclX flock in mysqltclsh)
|
||||
no_mysqltclsh=""
|
||||
|
||||
if test "$MYSQLTCL" = "no" ; then
|
||||
no_mysqltclsh=yes
|
||||
else
|
||||
dnl
|
||||
dnl Perform test
|
||||
dnl
|
||||
changequote(<<,>>)
|
||||
have_flock=`echo "echo [infox have_flock]" | $MYSQLTCL 2>/dev/null`
|
||||
changequote([,])
|
||||
if test "x$have_flock" != "x1" ; then
|
||||
no_mysqltclsh=yes
|
||||
fi
|
||||
fi
|
||||
if test "x$no_mysqltclsh" = x ; then
|
||||
AC_MSG_RESULT(yes)
|
||||
ifelse([$1], , :, [$1])
|
||||
else
|
||||
AC_MSG_RESULT(no)
|
||||
if test "$MYSQLTCL" = "no" ; then
|
||||
echo "*** mysqltclsh could not be found"
|
||||
echo "*** make sure it is installed and in your PATH, then try again"
|
||||
else
|
||||
echo "*** mysqltclsh is not compiled with tclX support"
|
||||
echo "*** see the file INSTALL for additional information"
|
||||
fi
|
||||
ifelse([$2], , :, [$2])
|
||||
fi
|
||||
AC_SUBST(MYSQLTCL)
|
||||
])
|
||||
dnl
|
||||
dnl check if Perl::DB is installed
|
||||
dnl
|
||||
AC_DEFUN(AC_PERL_DB,
|
||||
|
|
|
|||
|
|
@ -0,0 +1,237 @@
|
|||
#!/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 'globals.pl';
|
||||
|
||||
use vars qw($BatchID @TreeList @LegalDirs);
|
||||
|
||||
if (@::CheckInList) {
|
||||
die '@::CheckInList is valid ?!?';
|
||||
}
|
||||
|
||||
my $inheader = 1;
|
||||
my $foundlogline = 0;
|
||||
my @filelist = ();
|
||||
my $log = '';
|
||||
my $appendjunk = '';
|
||||
my $repository = pickDefaultRepository();
|
||||
my %group = ();
|
||||
my $forcetreeid = '';
|
||||
my ($chtype, $date, $name, $dir, $file);
|
||||
my ($version, $sticky, $branch, $addlines, $removelines);
|
||||
my ($key, $junk, $tagtime, $tagname, @data);
|
||||
my ($mungedname, $filename, @treestocheck);
|
||||
my (@files, @fullinfo, $i, $okdir, $f, $full, $d, $info, $id);
|
||||
my ($mail, %substs, %headers, $body);
|
||||
|
||||
|
||||
if (($#ARGV >= 1) && ($ARGV[0] eq '-treeid')) {
|
||||
$forcetreeid = $ARGV[1];
|
||||
shift; shift;
|
||||
}
|
||||
|
||||
# Read in from remaining file arguments
|
||||
DATAFILE:
|
||||
for ( ; $#ARGV >= 0; shift) {
|
||||
next DATAFILE
|
||||
unless (open(FILE, $ARGV[0]));
|
||||
|
||||
LINE:
|
||||
while (<FILE>) {
|
||||
my $line = $_;
|
||||
chop($line);
|
||||
$line = trim($line);
|
||||
|
||||
if ($inheader) {
|
||||
$inheader = 0 if ($line =~ /^$/);
|
||||
next LINE;
|
||||
}
|
||||
|
||||
unless ($foundlogline) {
|
||||
if ($line =~ /^.\|/) {
|
||||
$appendjunk .= "$line\n";
|
||||
($chtype, $date, $name, $repository, $dir, $file,
|
||||
$version, $sticky, $branch, $addlines, $removelines) =
|
||||
split(/\|/, $line);
|
||||
$key = "$date|$branch|$repository|$dir|$name";
|
||||
$group{$key} .=
|
||||
"$file|$version|$addlines|$removelines|$sticky\n";
|
||||
} elsif ($line =~ /^Tag\|/) {
|
||||
($junk, $repository, $tagtime, $tagname, @data) =
|
||||
split(/\|/, $line);
|
||||
|
||||
($mungedname = $repository) =~ s!/!_!g;
|
||||
$filename = "data/taginfo/$mungedname/" .
|
||||
MungeTagName($tagname);
|
||||
|
||||
Lock();
|
||||
unless (-d "data/taginfo/$mungedname") {
|
||||
system("mkdir -p data/taginfo/$mungedname");
|
||||
system("chmod -R 777 data/taginfo/$mungedname");
|
||||
}
|
||||
if (open(TAGFILE, ">> $filename")) {
|
||||
print TAGFILE "$tagtime|" . join('|', @data) . "\n";
|
||||
close(TAGFILE);
|
||||
chmod(0666, $filename);
|
||||
}
|
||||
Unlock();
|
||||
} elsif ($line =~ /^LOGCOMMENT/) {
|
||||
$foundlogline = 1;
|
||||
}
|
||||
next LINE;
|
||||
}
|
||||
|
||||
last LINE if ($line eq ":ENDLOGCOMMENT");
|
||||
$log .= "$line\n";
|
||||
}
|
||||
|
||||
close(FILE);
|
||||
# unlink($ARGV[0]);
|
||||
|
||||
my $plainlog = $log;
|
||||
$log = MarkUpText(html_quote(trim($log)));
|
||||
|
||||
next DATAFILE unless ($plainlog && $appendjunk);
|
||||
|
||||
Lock();
|
||||
LoadTreeConfig();
|
||||
unless ($forcetreeid) {
|
||||
($mungedname = $repository) =~ s!/!_!g;
|
||||
$mungedname =~ s!^_!!;
|
||||
$filename = "data/checkinlog/$mungedname";
|
||||
unless (-d "data/checkinlog") {
|
||||
system("mkdir -p data/checkinlog");
|
||||
system("chmod -R 777 data/checkinlog");
|
||||
}
|
||||
if (open(TID, ">> $filename")) {
|
||||
print TID "${appendjunk}LOGCOMMENT\n$plainlog:ENDLOGCOMMENT\n";
|
||||
close(TID);
|
||||
chmod(0666, $filename);
|
||||
}
|
||||
|
||||
ConnectToDatabase();
|
||||
AddToDatabase($appendjunk, $plainlog);
|
||||
@treestocheck = @::TreeList;
|
||||
}
|
||||
Unlock();
|
||||
|
||||
@treestocheck = ($forcetreeid) if $forcetreeid;
|
||||
|
||||
|
||||
foreach $key (keys(%group)) {
|
||||
($date, $branch, $repository, $dir, $name) = split(/\|/, $key);
|
||||
|
||||
@files = ();
|
||||
@fullinfo = ();
|
||||
|
||||
foreach $i (split(/\n/, $group{$key})) {
|
||||
($file, $version, $addlines, $removelines) = split(/\|/, $i);
|
||||
push @files, $file;
|
||||
push @fullinfo, $i;
|
||||
}
|
||||
|
||||
TREE:
|
||||
foreach $::TreeID (@treestocheck) {
|
||||
next TREE if exists($::TreeInfo{$::TreeID}{nobonsai});
|
||||
next TREE
|
||||
unless ($branch =~ /^.?$::TreeInfo{$::TreeID}{branch}$/);
|
||||
next TREE
|
||||
unless ($repository eq $::TreeInfo{$::TreeID}{repository});
|
||||
|
||||
LoadDirList();
|
||||
$okdir = 0;
|
||||
|
||||
FILE:
|
||||
foreach $f (@files) {
|
||||
$full = "$dir/$f";
|
||||
LEGALDIR:
|
||||
foreach $d (sort( grep(!/\*$/, @::LegalDirs))) {
|
||||
if ($full =~ m!^$d\b!) {
|
||||
$okdir = 1;
|
||||
last LEGALDIR;
|
||||
}
|
||||
}
|
||||
last FILE if $okdir;
|
||||
}
|
||||
|
||||
next TREE unless $okdir;
|
||||
|
||||
Lock();
|
||||
undef $::BatchID;
|
||||
undef @::CheckInList;
|
||||
LoadCheckins();
|
||||
$id = "::checkin_${date}_$$";
|
||||
push @::CheckInList, $id;
|
||||
|
||||
$info = eval("\\\%$id");
|
||||
%$info = (
|
||||
person => $name,
|
||||
date => $date,
|
||||
dir => $dir,
|
||||
files => join('!NeXt!', @files),
|
||||
'log' => $log,
|
||||
treeopen => $::TreeOpen,
|
||||
fullinfo => join('!NeXt!', @fullinfo)
|
||||
);
|
||||
WriteCheckins();
|
||||
Log("Added checkin $name $dir " . join(' + ', @files));
|
||||
Unlock();
|
||||
|
||||
if ($::TreeOpen) {
|
||||
$filename = DataDir() . "/openmessage";
|
||||
foreach $i (@::CheckInList) {
|
||||
$filename = "this file doesn't exist"
|
||||
# XXX verify...
|
||||
if ((eval("\$$i{person}") eq $name) &&
|
||||
($i ne $id));
|
||||
}
|
||||
} else {
|
||||
$filename = DataDir() . "/closemessage";
|
||||
}
|
||||
|
||||
if (!$forcetreeid && -f $filename && open(MAIL, "$filename")) {
|
||||
$mail = join("", <MAIL>);
|
||||
close(MAIL);
|
||||
|
||||
%substs = (
|
||||
profile => GenerateProfileHTML($name),
|
||||
nextclose => "We don't remember close " .
|
||||
"times any more...",
|
||||
name => EmailFromUsername($name),
|
||||
dir => $dir,
|
||||
files => join(',', @files),
|
||||
'log' => $log,
|
||||
);
|
||||
$mail = PerformSubsts($mail, \%substs);
|
||||
|
||||
%headers = ParseMailHeaders($mail);
|
||||
%headers = CleanMailHeaders(%headers);
|
||||
$body = FindMailBody($mail);
|
||||
|
||||
my $mail_relay = Param("mailrelay");
|
||||
my $mailer = Mail::Mailer->new("smtp",
|
||||
Server => $mail_relay);
|
||||
$mailer->open(\%headers)
|
||||
or warn "Can't send hook mail: $!\n";
|
||||
print $mailer "$body\n";
|
||||
$mailer->close();
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,118 +17,174 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
Lock
|
||||
LoadCheckins
|
||||
LoadMOTD
|
||||
LoadTreeConfig
|
||||
Unlock
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
LoadMOTD();
|
||||
LoadTreeConfig();
|
||||
Unlock();
|
||||
|
||||
puts "Content-type: text/html
|
||||
$BIP = BatchIdPart('?');
|
||||
$BIP_nohook = BatchIdPart();
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
PutsHeader("Bonsai Administration [`$::TreeID' Tree]",
|
||||
"Bonsai Administration",
|
||||
"Administrating `$::TreeID' Tree");
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>Bonsai administration</title>
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<h1>Bonsai administration</h1>
|
||||
|
||||
print <<EOF ;
|
||||
<pre>
|
||||
</pre>
|
||||
<center><b>
|
||||
You realize, of course, that you have to know the magic password to do
|
||||
anything from here.
|
||||
</b></center>
|
||||
<pre>
|
||||
|
||||
</pre>
|
||||
<hr>
|
||||
<a href=showcheckins.cgi?tweak=1[BatchIdPart]>Go tweak bunches of checkins at once.</a>
|
||||
EOF
|
||||
|
||||
|
||||
TweakCheckins();
|
||||
CloseTree();
|
||||
TweakTimestamps();
|
||||
ChangeMOTD();
|
||||
EditEmailMessage();
|
||||
RebuildHook();
|
||||
RebuildTags();
|
||||
RebuildHistory();
|
||||
ChangePasswd();
|
||||
|
||||
PutsTrailer();
|
||||
exit 0;
|
||||
|
||||
|
||||
|
||||
sub TweakCheckins {
|
||||
print qq(
|
||||
|
||||
<a href="showcheckins.cgi?tweak=1$BIP_nohook">
|
||||
Go tweak bunches of checkins at once.</a><br>
|
||||
<a href="editparams.cgi">
|
||||
Edit Bonsai operating parameters.</a>
|
||||
<hr>
|
||||
|
||||
"
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
puts "
|
||||
sub CloseTree { # Actually opens tree also
|
||||
my $timestamp = value_quote(MyFmtClock(time));
|
||||
|
||||
print qq(
|
||||
|
||||
<FORM method=get action=\"doadmin.cgi\">
|
||||
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
|
||||
"
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
);
|
||||
|
||||
if {$treeopen} {
|
||||
puts "
|
||||
if ($::TreeOpen) {
|
||||
print qq(
|
||||
<INPUT TYPE=HIDDEN NAME=command VALUE=close>
|
||||
<B>Closing time stamp is:</B>
|
||||
<INPUT NAME=closetimestamp VALUE=\"[value_quote [MyFmtClock [getclock]]]\"><BR>
|
||||
<INPUT NAME=closetimestamp VALUE=\"$timestamp\"><BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Close the tree\">
|
||||
"
|
||||
} else {
|
||||
puts "
|
||||
);
|
||||
} else {
|
||||
print qq(
|
||||
<INPUT TYPE=HIDDEN NAME=command VALUE=open>
|
||||
<B>The new \"good\" timestamp is:</B>
|
||||
<INPUT NAME=lastgood VALUE=\"[value_quote [MyFmtClock [getclock]]]\">
|
||||
<BR>
|
||||
<INPUT NAME=lastgood VALUE=\"$timestamp\"><BR>
|
||||
<INPUT TYPE=CHECKBOX NAME=doclear CHECKED>Clear the list of checkins.<BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Open the tree\">
|
||||
"
|
||||
}
|
||||
puts "
|
||||
</FORM>
|
||||
);
|
||||
}
|
||||
|
||||
<hr>
|
||||
print qq(</FORM>\n<hr>\n\n);
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub TweakTimestamps {
|
||||
my $lg_timestamp = value_quote(MyFmtClock($::LastGoodTimeStamp));
|
||||
my $c_timestamp = value_quote(MyFmtClock($::CloseTimeStamp));
|
||||
|
||||
print qq(
|
||||
|
||||
<FORM method=get action=\"doadmin.cgi\">
|
||||
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
<INPUT TYPE=HIDDEN NAME=command VALUE=tweaktimes>
|
||||
<TABLE>
|
||||
<TR>
|
||||
<TD><B>Last good timestamp:</B></TD>
|
||||
<TD><INPUT NAME=lastgood VALUE=\"[value_quote [MyFmtClock $lastgoodtimestamp]]\"></TD>
|
||||
<TD><INPUT NAME=lastgood VALUE=\"$lg_timestamp\"></TD>
|
||||
</TR><TR>
|
||||
|
||||
<TD><B>Last close timestamp:</B></TD>
|
||||
<TD><INPUT NAME=lastclose VALUE=\"[value_quote [MyFmtClock $closetimestamp]]\"></TD>
|
||||
<TD><INPUT NAME=lastclose VALUE=\"$c_timestamp\"></TD>
|
||||
</TR>
|
||||
</TABLE>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Tweak the timestamps\">
|
||||
</FORM>
|
||||
|
||||
|
||||
<hr>
|
||||
|
||||
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
sub ChangeMOTD {
|
||||
my $motd = value_quote($::MOTD);
|
||||
|
||||
print qq(
|
||||
|
||||
<FORM method=get action=\"doadmin.cgi\">
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
|
||||
<INPUT TYPE=HIDDEN NAME=command VALUE=editmotd>
|
||||
|
||||
Change the message-of-the-day:<br>
|
||||
<INPUT TYPE=HIDDEN NAME=origmotd VALUE=\"[value_quote $motd]\">
|
||||
<TEXTAREA NAME=motd ROWS=10 COLS=50>$motd</TEXTAREA><BR>
|
||||
<INPUT TYPE=HIDDEN NAME=origmotd VALUE=\"$motd\">
|
||||
<TEXTAREA NAME=motd ROWS=10 COLS=50>$::MOTD</TEXTAREA><BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Change the MOTD\">
|
||||
</FORM>
|
||||
|
||||
|
||||
<hr>
|
||||
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
sub EditEmailMessage {
|
||||
print qq(
|
||||
|
||||
<FORM method=get action=\"editmessage.cgi\">
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
|
||||
Change the e-mail message sent:
|
||||
<SELECT NAME=msgname SIZE=1>
|
||||
<OPTION VALUE=openmessage>when a checkin is made when the tree is open.
|
||||
<OPTION VALUE=closemessage>when a checkin is made when the tree is closed.
|
||||
<OPTION VALUE=treeopened>to the hook when the tree opens
|
||||
<OPTION VALUE=treeopenedsamehook>to the hook when the tree opens and the hook isn't cleared
|
||||
<OPTION VALUE=treeopenedsamehook>to the hook when the tree opens and the hook isn\'t cleared
|
||||
<OPTION VALUE=treeclosed>to the hook when the tree closes
|
||||
</SELECT>
|
||||
<br>
|
||||
</SELECT><br>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Edit a message\">
|
||||
|
||||
</FORM>
|
||||
|
||||
|
||||
<hr>
|
||||
|
||||
);
|
||||
}
|
||||
|
||||
sub RebuildHook {
|
||||
my $lg_timestamp = value_quote(MyFmtClock($::LastGoodTimeStamp));
|
||||
|
||||
print qq(
|
||||
|
||||
<FORM method=get action=\"repophook.cgi\">
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
|
||||
<INPUT TYPE=HIDDEN NAME=command VALUE=repophook>
|
||||
Repopulate the hook from scratch.<p>
|
||||
|
|
@ -136,18 +192,24 @@ Repopulate the hook from scratch.<p>
|
|||
usually only need to do this to populate a new Bonsai branch.
|
||||
<p>
|
||||
<b>Use any checkin since:</b>
|
||||
<INPUT NAME=startfrom VALUE=\"[value_quote [MyFmtClock $lastgoodtimestamp]]\">
|
||||
<INPUT NAME=startfrom VALUE=\"$lg_timestamp\">
|
||||
<br>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Rebuild the hook\">
|
||||
</FORM>
|
||||
|
||||
<hr>
|
||||
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
sub RebuildTags {
|
||||
print qq(
|
||||
|
||||
<FORM method=get action=\"rebuildtaginfo.cgi\">
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
|
||||
<INPUT TYPE=HIDDEN NAME=command VALUE=rebuildtaginfo>
|
||||
Recreate the entire table of tags for the $treeinfo($treeid,repository)
|
||||
Recreate the entire table of tags for the $::TreeInfo{$::TreeID}{repository}
|
||||
repository from scratch.
|
||||
<p>
|
||||
<font color=red size=+2>This can take a very, very long time.</font> You
|
||||
|
|
@ -158,15 +220,23 @@ don't bother unless you know what you're doing.)
|
|||
<br>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Rebuild tag information\">
|
||||
</FORM>
|
||||
|
||||
<hr>
|
||||
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
sub RebuildHistory {
|
||||
my $timestamp = value_quote(MyFmtClock(0));
|
||||
|
||||
print qq(
|
||||
|
||||
<FORM method=get action=\"rebuildcvshistory.cgi\">
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
|
||||
<INPUT TYPE=HIDDEN NAME=command VALUE=rebuildcvs>
|
||||
Recreate the entire list of every checkin ever done to the
|
||||
$treeinfo($treeid,repository) repository from scratch.
|
||||
$::TreeInfo{$::TreeID}{repository} repository from scratch.
|
||||
<p>
|
||||
<font color=red size=+2>This can take an incredibly long time.</font> You
|
||||
should
|
||||
|
|
@ -174,20 +244,28 @@ usually only need to do this when first introducing an entire CVS repository
|
|||
into Bonsai.
|
||||
<p>
|
||||
<b>Ignore checkins earlier than:</b>
|
||||
<INPUT NAME=startfrom VALUE=\"[value_quote [MyFmtClock 0]]\">
|
||||
<INPUT NAME=startfrom VALUE=\"$timestamp\">
|
||||
<br>
|
||||
<b>Ignore files before (must be full path starting with $treeinfo($treeid,repository); leave blank to do everything):</b>
|
||||
<b>Ignore files before (must be full path starting
|
||||
with $::TreeInfo{$::TreeID}{repository}; leave blank to do everything):</b>
|
||||
<INPUT NAME=firstfile VALUE=\"\" size=50>
|
||||
<br>
|
||||
<b>Only do files within the subdirectory of $treeinfo($treeid,repository) named:</b>
|
||||
<b>Only do files within the subdirectory of
|
||||
$::TreeInfo{$::TreeID}{repository} named:</b>
|
||||
<INPUT NAME=subdir VALUE=\".\" size=50>
|
||||
<br>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Rebuild cvs history\">
|
||||
</FORM>
|
||||
|
||||
<hr>
|
||||
|
||||
);
|
||||
}
|
||||
|
||||
sub ChangePasswd {
|
||||
print qq(
|
||||
|
||||
<FORM method=post action=\"doadmin.cgi\">
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
<INPUT TYPE=HIDDEN NAME=command VALUE=changepassword>
|
||||
Change password.<BR>
|
||||
<B>Old password:</B> <INPUT NAME=password TYPE=password> <BR>
|
||||
|
|
@ -197,9 +275,5 @@ Change password.<BR>
|
|||
<INPUT TYPE=RADIO NAME=doglobal VALUE=1>Change master Bonsai password<BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Change the password\">
|
||||
</FORM>
|
||||
"
|
||||
|
||||
|
||||
PutsTrailer
|
||||
|
||||
exit
|
||||
);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,123 @@
|
|||
# -*- 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 'globals.pl';
|
||||
|
||||
use Mail::Internet;
|
||||
use Mail::Header;
|
||||
|
||||
sub MakeHookList {
|
||||
my ($checkin, $person, %people, @addrs);
|
||||
|
||||
# First, empty the arrays
|
||||
undef %people; undef @addrs;
|
||||
|
||||
foreach $checkin (@::CheckInList) {
|
||||
my $info = eval("\\\%$checkin");
|
||||
|
||||
$people{$$info{'person'}} = 1;
|
||||
}
|
||||
|
||||
foreach $person (sort(keys(%people))) {
|
||||
push @addrs, EmailFromUsername($person);
|
||||
}
|
||||
return @addrs;
|
||||
}
|
||||
|
||||
|
||||
sub SendHookMail {
|
||||
my ($filename) = @_;
|
||||
my $hooklist = join(', ', MakeHookList());
|
||||
my (%substs, %headers, $body, $mail);
|
||||
local *MAIL;
|
||||
|
||||
$pathname = DataDir() . "/$filename";
|
||||
|
||||
print 'a';
|
||||
return unless $hooklist;
|
||||
print 'b';
|
||||
return unless -f $pathname;
|
||||
print 'c';
|
||||
return unless open(MAIL, "< $pathname");
|
||||
print 'd';
|
||||
$mail = join("", <MAIL>);
|
||||
print 'e';
|
||||
close (MAIL);
|
||||
print 'f';
|
||||
|
||||
%substs = ();
|
||||
print 'g';
|
||||
$substs{'hooklist'} = $hooklist;
|
||||
print 'h';
|
||||
$mail = PerformSubsts($mail, \%substs);
|
||||
print 'i';
|
||||
|
||||
%headers = ParseMailHeaders($mail);
|
||||
print 'j';
|
||||
%headers = CleanMailHeaders(%headers);
|
||||
print 'k';
|
||||
$body = FindMailBody($mail);
|
||||
print 'l';
|
||||
|
||||
my $mail_relay = Param("mailrelay");
|
||||
print 'm';
|
||||
my $mailer = Mail::Mailer->new("smtp", Server => $mail_relay);
|
||||
print 'n';
|
||||
$mailer->open(\%headers)
|
||||
or warn "Can't send hook mail: $!\n";
|
||||
print 'o';
|
||||
print $mailer "$body\n";
|
||||
print 'p';
|
||||
$mailer->close();
|
||||
print 'q';
|
||||
}
|
||||
|
||||
|
||||
sub AdminOpenTree {
|
||||
my ($lastgood, $clearp) = @_;
|
||||
|
||||
return if $::TreeOpen;
|
||||
|
||||
$::LastGoodTimeStamp = $lastgood;
|
||||
$::TreeOpen = 1;
|
||||
|
||||
PickNewBatchID();
|
||||
|
||||
if ($clearp) {
|
||||
SendHookMail('treeopened');
|
||||
@::CheckInList = ();
|
||||
} else {
|
||||
SendHookMail('treeopenedsamehook');
|
||||
}
|
||||
|
||||
Log("Tree opened. \$::LastGoodTimeStamp is " .
|
||||
MyFmtClock($::LastGoodTimeStamp));
|
||||
}
|
||||
|
||||
|
||||
sub AdminCloseTree {
|
||||
my ($closetime) = @_;
|
||||
|
||||
return unless $::TreeOpen;
|
||||
|
||||
$::CloseTimeStamp = $closetime;
|
||||
$::TreeOpen = 0;
|
||||
SendHookMail('treeclosed');
|
||||
Log("Tree $::TreeID closed. \$::CloseTimeStamp is " .
|
||||
MyFmtClock($::CloseTimeStamp));
|
||||
}
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
#!/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 'globals.pl';
|
||||
require 'adminfuncs.pl';
|
||||
|
||||
use strict;
|
||||
use diagnostics;
|
||||
|
||||
|
||||
sub GetDate {
|
||||
my ($line) = (@_);
|
||||
my $date;
|
||||
if ($line =~ /([0-9].*)$/) {
|
||||
$date = str2time($1);
|
||||
} else {
|
||||
$date = time();
|
||||
}
|
||||
return $date;
|
||||
}
|
||||
|
||||
|
||||
|
||||
Lock();
|
||||
|
||||
open(FID, "<$ARGV[0]") || die "Can't open $ARGV[0]";
|
||||
|
||||
while (<FID>) {
|
||||
chomp();
|
||||
my $line = $_;
|
||||
if ($line =~ /^([^ ]*)\s+([^ ]*)/) {
|
||||
my $foobar = $1;
|
||||
$::TreeID = $2;
|
||||
$::TreeID = $2; # Duplicate line to avoid stupid perl warning.
|
||||
undef @::CheckInList;
|
||||
undef @::CheckInList; # Duplicate line to avoid stupid perl warning.
|
||||
if ($foobar =~ /^opennoclear$/i) {
|
||||
LoadCheckins();
|
||||
AdminOpenTree(GetDate($line), 0);
|
||||
WriteCheckins();
|
||||
} elsif ($foobar =~ /^open$/i) {
|
||||
LoadCheckins();
|
||||
AdminOpenTree(GetDate($line), 1);
|
||||
WriteCheckins();
|
||||
} elsif ($foobar =~ /^close$/i) {
|
||||
LoadCheckins();
|
||||
AdminCloseTree(GetDate($line));
|
||||
WriteCheckins();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
Unlock();
|
||||
|
|
@ -1,91 +0,0 @@
|
|||
#!/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.
|
||||
|
||||
# Query the CVS database.
|
||||
#
|
||||
$|=1;
|
||||
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>";
|
||||
|
||||
require 'modules.pl';
|
||||
|
||||
|
||||
print "
|
||||
<HEAD>
|
||||
<TITLE>The CVS Branch Spammer (TM)</TITLE>
|
||||
</HEAD>
|
||||
<H1>The CVS Branch Spammer (TM)</H1>
|
||||
<p> Questions, Comments, Feature requests? mail <a href=mailto:ltabb>ltabb</a>
|
||||
<h3>What this tool does</h3>
|
||||
|
||||
<p>In the course of software development, it is necessary to form a branch
|
||||
to do development on for a period of time. Sometimes you want to merge these
|
||||
changes back into the trunk in one shot. Sometime you want to have the developers
|
||||
merge the changes themselves, individually. This tool makes sure the developers
|
||||
have merged their changes in individually.
|
||||
|
||||
<p>The CVS Branch Spammer goes out and figures out what changes were made on
|
||||
a branch and then looks to see if these changes where also made on the tip. It
|
||||
formulates a mail message and send the mail to the indivual developers. The
|
||||
individual developers look at the mail and reply that they have made their
|
||||
changes in the tip.
|
||||
|
||||
<p>To run this program answer the following questions and bonk the spam button.
|
||||
|
||||
|
||||
<p>
|
||||
<FORM METHOD=GET ACTION='branchspammer.cgi'>
|
||||
";
|
||||
|
||||
|
||||
#
|
||||
# module selector
|
||||
#
|
||||
print "
|
||||
|
||||
<nobr><b>Pick the name of the CVS Module you use to pull your source</b>
|
||||
<SELECT name='module' size=5>
|
||||
<OPTION SELECTED VALUE='all'>All Files in the Repository
|
||||
<OPTION SELECTED VALUE='Client40All'>Client40All
|
||||
";
|
||||
|
||||
#
|
||||
# Print out all the Different Modules
|
||||
#
|
||||
for $k (sort( keys( %$modules ) ) ){
|
||||
print "<OPTION value='$k'>$k\n";
|
||||
}
|
||||
|
||||
print "</SELECT></NOBR>\n";
|
||||
|
||||
#
|
||||
# Branch
|
||||
#
|
||||
print "<br><nobr><b>What is the name of your branch:</b> <input type=text name=branch size=25></nobr>\n";
|
||||
|
||||
print "<br><nobr><b>Who should the email message be from?:</b> <input type=text name=whofrom size=25></nobr>\n";
|
||||
|
||||
print "
|
||||
<br>
|
||||
<br>
|
||||
<INPUT TYPE=SUBMIT VALUE='Run the Branchspammer'>
|
||||
</FORM>";
|
||||
|
||||
|
|
@ -1,100 +0,0 @@
|
|||
#!/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 'lloydcgi.pl';
|
||||
require 'timelocal.pl';
|
||||
require 'cvsquery.pl';
|
||||
|
||||
$| = 1;
|
||||
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>";
|
||||
|
||||
$CHECKIN_DATA_FILE = 'data/checkinlog_m_src';
|
||||
$CHECKIN_INDEX_FILE = 'data/index_m_src';
|
||||
|
||||
#
|
||||
# build a module map
|
||||
#
|
||||
$query_module = $form{'module'};
|
||||
|
||||
@query_dirs = split(/[;, \t]+/, $form{'dir'});
|
||||
|
||||
$query_date_type = $form{'date'};
|
||||
$query_date_min = time-(24*60*60*15);
|
||||
$query_who ='' ;
|
||||
$query_branch = $form{'branch'};
|
||||
|
||||
|
||||
print "<h1>Running Query, this may take a while...</h1>";
|
||||
|
||||
$result= &query_checkins( $mod_map );
|
||||
|
||||
#
|
||||
# Test code to print the results
|
||||
#
|
||||
|
||||
if( 0 ) {
|
||||
if( $form{"sortby"} eq "Who" ){
|
||||
$result = [sort {
|
||||
$a->[$CI_WHO] cmp $b->[$CI_WHO]
|
||||
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
|
||||
} @{$result}] ;
|
||||
$head_who = $SORT_HEAD;
|
||||
}
|
||||
elsif( $form{"sortby"} eq "File" ){
|
||||
$result = [sort {
|
||||
$a->[$CI_FILE] cmp $b->[$CI_FILE]
|
||||
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
|
||||
|| $a->[$CI_DIRECTORY] cmp $b->[$CI_DIRECTORY]
|
||||
} @{$result}] ;
|
||||
$head_file = $SORT_HEAD;
|
||||
}
|
||||
elsif( $form{"sortby"} eq "Directory" ){
|
||||
$result = [sort {
|
||||
$a->[$CI_DIRECTORY] cmp $b->[$CI_DIRECTORY]
|
||||
|| $a->[$CI_FILE] cmp $b->[$CI_FILE]
|
||||
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
|
||||
} @{$result}] ;
|
||||
$head_directory = $SORT_HEAD;
|
||||
}
|
||||
elsif( $form{"sortby"} eq "Change Size" ){
|
||||
$result = [sort {
|
||||
|
||||
($b->[$CI_LINES_ADDED]- $b->[$CI_LINES_REMOVED])
|
||||
<=> ($a->[$CI_LINES_ADDED]- $a->[$CI_LINES_REMOVED])
|
||||
#|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
|
||||
} @{$result}] ;
|
||||
$head_delta = $SORT_HEAD;
|
||||
}
|
||||
else{
|
||||
$result = [sort {$b->[$CI_DATE] <=> $a->[$CI_DATE]} @{$result}] ;
|
||||
$head_date = $SORT_HEAD;
|
||||
}
|
||||
}
|
||||
|
||||
print "<pre>";
|
||||
for $ci (@$result) {
|
||||
$ci->[$CI_LOG] = '';
|
||||
$s = join("|",@$ci);
|
||||
print "$s\n";
|
||||
}
|
||||
|
||||
|
|
@ -720,76 +720,9 @@ else
|
|||
echo "$ac_t""no" 1>&6
|
||||
fi
|
||||
|
||||
for ac_prog in mysqltclsh mysqltcl
|
||||
do
|
||||
# Extract the first word of "$ac_prog", so it can be a program name with args.
|
||||
set dummy $ac_prog; ac_word=$2
|
||||
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
|
||||
echo "configure:729: checking for $ac_word" >&5
|
||||
if eval "test \"`echo '$''{'ac_cv_path_MYSQLTCL'+set}'`\" = set"; then
|
||||
echo $ac_n "(cached) $ac_c" 1>&6
|
||||
else
|
||||
case "$MYSQLTCL" in
|
||||
/*)
|
||||
ac_cv_path_MYSQLTCL="$MYSQLTCL" # Let the user override the test with a path.
|
||||
;;
|
||||
*)
|
||||
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
|
||||
for ac_dir in $PATH; do
|
||||
test -z "$ac_dir" && ac_dir=.
|
||||
if test -f $ac_dir/$ac_word; then
|
||||
ac_cv_path_MYSQLTCL="$ac_dir/$ac_word"
|
||||
break
|
||||
fi
|
||||
done
|
||||
IFS="$ac_save_ifs"
|
||||
;;
|
||||
esac
|
||||
fi
|
||||
MYSQLTCL="$ac_cv_path_MYSQLTCL"
|
||||
if test -n "$MYSQLTCL"; then
|
||||
echo "$ac_t""$MYSQLTCL" 1>&6
|
||||
else
|
||||
echo "$ac_t""no" 1>&6
|
||||
fi
|
||||
|
||||
test -n "$MYSQLTCL" && break
|
||||
done
|
||||
test -n "$MYSQLTCL" || MYSQLTCL="no"
|
||||
|
||||
echo $ac_n "checking for tclX flock in mysqltclsh""... $ac_c" 1>&6
|
||||
echo "configure:762: checking for tclX flock in mysqltclsh" >&5
|
||||
no_mysqltclsh=""
|
||||
|
||||
if test "$MYSQLTCL" = "no" ; then
|
||||
no_mysqltclsh=yes
|
||||
else
|
||||
|
||||
have_flock=`echo "echo [infox have_flock]" | $MYSQLTCL 2>/dev/null`
|
||||
|
||||
if test "x$have_flock" != "x1" ; then
|
||||
no_mysqltclsh=yes
|
||||
fi
|
||||
fi
|
||||
if test "x$no_mysqltclsh" = x ; then
|
||||
echo "$ac_t""yes" 1>&6
|
||||
:
|
||||
else
|
||||
echo "$ac_t""no" 1>&6
|
||||
if test "$MYSQLTCL" = "no" ; then
|
||||
echo "*** mysqltclsh could not be found"
|
||||
echo "*** make sure it is installed and in your PATH, then try again"
|
||||
else
|
||||
echo "*** mysqltclsh is not compiled with tclX support"
|
||||
echo "*** see the file INSTALL for additional information"
|
||||
fi
|
||||
:
|
||||
fi
|
||||
|
||||
|
||||
|
||||
echo $ac_n "checking for perl DBD::mysql module""... $ac_c" 1>&6
|
||||
echo "configure:793: checking for perl DBD::mysql module" >&5
|
||||
echo "configure:726: checking for perl DBD::mysql module" >&5
|
||||
$PERL -w -c -e 'use DBD::mysql' 2>/dev/null; has_dbd=$?
|
||||
if test "x$has_dbd" = "x0" ; then
|
||||
echo "$ac_t""yes" 1>&6
|
||||
|
|
@ -802,7 +735,7 @@ echo "configure:793: checking for perl DBD::mysql module" >&5
|
|||
|
||||
|
||||
echo $ac_n "checking for perl Date::Parse module""... $ac_c" 1>&6
|
||||
echo "configure:806: checking for perl Date::Parse module" >&5
|
||||
echo "configure:739: checking for perl Date::Parse module" >&5
|
||||
$PERL -w -c -e 'use Date::Parse' 2>/dev/null; has_dateparse=$?
|
||||
if test "x$has_dateparse" = "x0" ; then
|
||||
echo "$ac_t""yes" 1>&6
|
||||
|
|
@ -817,7 +750,7 @@ echo "configure:806: checking for perl Date::Parse module" >&5
|
|||
# Extract the first word of "co", so it can be a program name with args.
|
||||
set dummy co; ac_word=$2
|
||||
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
|
||||
echo "configure:821: checking for $ac_word" >&5
|
||||
echo "configure:754: checking for $ac_word" >&5
|
||||
if eval "test \"`echo '$''{'ac_cv_path_CO'+set}'`\" = set"; then
|
||||
echo $ac_n "(cached) $ac_c" 1>&6
|
||||
else
|
||||
|
|
@ -848,7 +781,7 @@ fi
|
|||
# Extract the first word of "cvs", so it can be a program name with args.
|
||||
set dummy cvs; ac_word=$2
|
||||
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
|
||||
echo "configure:852: checking for $ac_word" >&5
|
||||
echo "configure:785: checking for $ac_word" >&5
|
||||
if eval "test \"`echo '$''{'ac_cv_path_CVS'+set}'`\" = set"; then
|
||||
echo $ac_n "(cached) $ac_c" 1>&6
|
||||
else
|
||||
|
|
@ -879,7 +812,7 @@ fi
|
|||
# Extract the first word of "rlog", so it can be a program name with args.
|
||||
set dummy rlog; ac_word=$2
|
||||
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
|
||||
echo "configure:883: checking for $ac_word" >&5
|
||||
echo "configure:816: checking for $ac_word" >&5
|
||||
if eval "test \"`echo '$''{'ac_cv_path_RLOG'+set}'`\" = set"; then
|
||||
echo $ac_n "(cached) $ac_c" 1>&6
|
||||
else
|
||||
|
|
@ -910,7 +843,7 @@ fi
|
|||
# Extract the first word of "rcsdiff", so it can be a program name with args.
|
||||
set dummy rcsdiff; ac_word=$2
|
||||
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
|
||||
echo "configure:914: checking for $ac_word" >&5
|
||||
echo "configure:847: checking for $ac_word" >&5
|
||||
if eval "test \"`echo '$''{'ac_cv_path_RCSDIFF'+set}'`\" = set"; then
|
||||
echo $ac_n "(cached) $ac_c" 1>&6
|
||||
else
|
||||
|
|
@ -938,41 +871,10 @@ else
|
|||
echo "$ac_t""no" 1>&6
|
||||
fi
|
||||
|
||||
# Extract the first word of "sendmail", so it can be a program name with args.
|
||||
set dummy sendmail; ac_word=$2
|
||||
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
|
||||
echo "configure:945: checking for $ac_word" >&5
|
||||
if eval "test \"`echo '$''{'ac_cv_path_SENDMAIL'+set}'`\" = set"; then
|
||||
echo $ac_n "(cached) $ac_c" 1>&6
|
||||
else
|
||||
case "$SENDMAIL" in
|
||||
/*)
|
||||
ac_cv_path_SENDMAIL="$SENDMAIL" # Let the user override the test with a path.
|
||||
;;
|
||||
*)
|
||||
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
|
||||
for ac_dir in $PATH; do
|
||||
test -z "$ac_dir" && ac_dir=.
|
||||
if test -f $ac_dir/$ac_word; then
|
||||
ac_cv_path_SENDMAIL="$ac_dir/$ac_word"
|
||||
break
|
||||
fi
|
||||
done
|
||||
IFS="$ac_save_ifs"
|
||||
;;
|
||||
esac
|
||||
fi
|
||||
SENDMAIL="$ac_cv_path_SENDMAIL"
|
||||
if test -n "$SENDMAIL"; then
|
||||
echo "$ac_t""$SENDMAIL" 1>&6
|
||||
else
|
||||
echo "$ac_t""no" 1>&6
|
||||
fi
|
||||
|
||||
|
||||
|
||||
echo $ac_n "checking for crypt in -lcrypt""... $ac_c" 1>&6
|
||||
echo "configure:976: checking for crypt in -lcrypt" >&5
|
||||
echo "configure:878: checking for crypt in -lcrypt" >&5
|
||||
ac_lib_var=`echo crypt'_'crypt | sed 'y%./+-%__p_%'`
|
||||
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
|
||||
echo $ac_n "(cached) $ac_c" 1>&6
|
||||
|
|
@ -980,7 +882,7 @@ else
|
|||
ac_save_LIBS="$LIBS"
|
||||
LIBS="-lcrypt $LIBS"
|
||||
cat > conftest.$ac_ext <<EOF
|
||||
#line 984 "configure"
|
||||
#line 886 "configure"
|
||||
#include "confdefs.h"
|
||||
/* Override any gcc2 internal prototype to avoid an error. */
|
||||
/* We use char because int might match the return type of a gcc2
|
||||
|
|
@ -991,7 +893,7 @@ int main() {
|
|||
crypt()
|
||||
; return 0; }
|
||||
EOF
|
||||
if { (eval echo configure:995: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
|
||||
if { (eval echo configure:897: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
|
||||
rm -rf conftest*
|
||||
eval "ac_cv_lib_$ac_lib_var=yes"
|
||||
else
|
||||
|
|
@ -1166,12 +1068,10 @@ s%@infodir@%$infodir%g
|
|||
s%@mandir@%$mandir%g
|
||||
s%@CC@%$CC%g
|
||||
s%@PERL@%$PERL%g
|
||||
s%@MYSQLTCL@%$MYSQLTCL%g
|
||||
s%@CO@%$CO%g
|
||||
s%@CVS@%$CVS%g
|
||||
s%@RLOG@%$RLOG%g
|
||||
s%@RCSDIFF@%$RCSDIFF%g
|
||||
s%@SENDMAIL@%$SENDMAIL%g
|
||||
|
||||
CEOF
|
||||
EOF
|
||||
|
|
|
|||
|
|
@ -4,7 +4,6 @@ AC_INIT(trapdoor.c)
|
|||
dnl Checks for programs.
|
||||
AC_PROG_CC
|
||||
AC_PATH_PROG(PERL,perl)
|
||||
AC_PROG_MYSQLTCL_TCLX
|
||||
AC_PERL_DB
|
||||
AC_PERL_DATEPARSE
|
||||
|
||||
|
|
@ -12,7 +11,6 @@ AC_PATH_PROG(CO,co)
|
|||
AC_PATH_PROG(CVS,cvs)
|
||||
AC_PATH_PROG(RLOG,rlog)
|
||||
AC_PATH_PROG(RCSDIFF,rcsdiff)
|
||||
AC_PATH_PROG(SENDMAIL,sendmail)
|
||||
|
||||
|
||||
dnl Checks for libraries.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,72 +17,71 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
set maxsize 400
|
||||
use vars qw($CloseTimeStamp);
|
||||
|
||||
LoadCheckins
|
||||
print "Content-type: text/html\n\n";
|
||||
LoadCheckins();
|
||||
|
||||
puts "Content-type: text/html
|
||||
my $maxsize = 400;
|
||||
|
||||
<HTML>
|
||||
<TITLE>Beancounter central.</TITLE>
|
||||
|
||||
<H1>Meaningless checkin statistics</H1>
|
||||
PutsHeader("Beancounter central", "Meaningless checkin statistics");
|
||||
|
||||
print "
|
||||
<TABLE BORDER CELLSPACING=2><TR>
|
||||
<TH>Tree closed</TH>
|
||||
<TH>Number<BR>of<BR>people<BR>making<BR>changes</TH>
|
||||
<TH COLSPAN=2>Number of checkins</TH>
|
||||
</TR>
|
||||
"
|
||||
</TR>\n";
|
||||
|
||||
set list {}
|
||||
my @list = ();
|
||||
my $globstr = DataDir() . '/batch-*[0-9].pl';
|
||||
|
||||
|
||||
foreach i [glob "[DataDir]/batch-*\[0-9\]"] {
|
||||
regexp -- {[0-9]*$} $i n
|
||||
lappend list $n
|
||||
foreach my $i (glob($globstr )) {
|
||||
if ($i =~ /(\d+)/) {
|
||||
push @list, $1;
|
||||
}
|
||||
}
|
||||
|
||||
set list [lsort -integer -decreasing $list]
|
||||
@list = sort { $b <=> $a } @list;
|
||||
my $first = 1;
|
||||
my $biggest = 1;
|
||||
my %minfo; # meaninglesss info
|
||||
|
||||
set first 1
|
||||
foreach my $i (@list) {
|
||||
my $batch = DataDir() . "/batch-$i.pl";
|
||||
require $batch;
|
||||
|
||||
set biggest 1
|
||||
$minfo{$i}{num} = scalar @::CheckInList;
|
||||
$biggest = $minfo{$i}{num} if ($minfo{$i}{num} > $biggest);
|
||||
if ($first) {
|
||||
$minfo{$i}{donetime} = "Current hook";
|
||||
$first = 0;
|
||||
} else {
|
||||
$minfo{$i}{donetime} = MyFmtClock($::CloseTimeStamp);
|
||||
}
|
||||
|
||||
foreach i $list {
|
||||
source [DataDir]/batch-$i
|
||||
set num($i) [llength $checkinlist]
|
||||
if {$num($i) > $biggest} {
|
||||
set biggest $num($i)
|
||||
}
|
||||
if {$first} {
|
||||
set donetime($i) "Current hook"
|
||||
set first 0
|
||||
} else {
|
||||
set donetime($i) [MyFmtClock $closetimestamp]
|
||||
}
|
||||
catch {unset people}
|
||||
set people(zzz) 1
|
||||
unset people(zzz)
|
||||
foreach c $checkinlist {
|
||||
upvar #0 $c info
|
||||
set people($info(person)) 1
|
||||
}
|
||||
set numpeople($i) [array size people]
|
||||
my %people = ();
|
||||
foreach my $checkin (@::CheckInList) {
|
||||
my $info = eval("\\\%$checkin");
|
||||
$people{$$info{'person'}} = 1;
|
||||
}
|
||||
$minfo{$i}{numpeople} = scalar keys(%people);
|
||||
}
|
||||
|
||||
foreach i $list {
|
||||
puts "<TR>"
|
||||
puts "<TD>$donetime($i)</TD>"
|
||||
puts "<TD ALIGN=RIGHT>$numpeople($i)</TD>"
|
||||
puts "<TD ALIGN=RIGHT>$num($i)</TD>"
|
||||
puts "<TD><table WIDTH=[expr $num($i) * $maxsize / $biggest] bgcolor=green><tr><td> </td></tr></table></TD>"
|
||||
puts "</TR>"
|
||||
|
||||
foreach my $i (@list) {
|
||||
print "<tr>\n";
|
||||
print "<TD>$minfo{$i}{donetime}</TD>\n";
|
||||
print "<TD ALIGN=RIGHT>$minfo{$i}{numpeople}</TD>\n";
|
||||
print "<TD ALIGN=RIGHT>$minfo{$i}{num}</TD>\n";
|
||||
printf "<TD><table WIDTH=%d bgcolor=green>\n",
|
||||
($minfo{$i}{num} * $maxsize) / $biggest;
|
||||
print "<tr><td> </td></tr></table></TD>\n";
|
||||
print "</TR>\n";
|
||||
}
|
||||
puts "</TABLE>"
|
||||
|
||||
PutsTrailer
|
||||
|
||||
exit
|
||||
print "</table>\n";
|
||||
PutsTrailer();
|
||||
exit;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,124 @@
|
|||
#!/usr/bonsaitools/bin/perl
|
||||
#
|
||||
# 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 'globals.pl';
|
||||
|
||||
sub add_module {
|
||||
my ($str) = @_;
|
||||
my $module;
|
||||
|
||||
$str =~ s/^\s*(\S+)\s*(-\S*\s*)?//;
|
||||
$module = $1;
|
||||
|
||||
$::Modules{$module} = $str;
|
||||
}
|
||||
|
||||
sub init_modules {
|
||||
my ($cvsroot, $curline);
|
||||
my $cvscommand = Param('cvscommand');
|
||||
|
||||
undef %::Modules;
|
||||
$cvsroot = $::TreeInfo{$::TreeID}{'repository'};
|
||||
|
||||
$::CVSCOMMAND = "$cvscommand -d $cvsroot checkout -c";
|
||||
open(MODULES, "$::CVSCOMMAND |") ||
|
||||
die "Unable to read modules list from CVS\n";
|
||||
|
||||
$curline = "";
|
||||
while (<MODULES>) {
|
||||
chop;
|
||||
|
||||
if (/^\s+/) {
|
||||
$curline .= $_;
|
||||
} else {
|
||||
add_module($curline) if ($curline);
|
||||
$curline = $_;
|
||||
}
|
||||
}
|
||||
add_module($curline) if ($curline);
|
||||
close(MODULES);
|
||||
}
|
||||
|
||||
sub init {
|
||||
$::TreeID = $ARGV[0];
|
||||
die "Must specify a treeid...\n"
|
||||
unless ($::TreeID);
|
||||
|
||||
LoadTreeConfig();
|
||||
|
||||
$::ModuleName = $::TreeInfo{$::TreeID}{'module'};
|
||||
init_modules();
|
||||
die "modules file no longer includes `$::ModuleName' ???
|
||||
Used `$::CVSCOMMAND' to try to find it\n"
|
||||
unless (exists($::Modules{$::ModuleName}));
|
||||
|
||||
$::DataDir = DataDir();
|
||||
}
|
||||
|
||||
sub find_dirs {
|
||||
my ($oldlist, $list, $i);
|
||||
|
||||
$oldlist = '';
|
||||
$list = $::ModuleName;
|
||||
|
||||
until ($list eq $oldlist) {
|
||||
$oldlist = $list;
|
||||
$list = '';
|
||||
foreach $i (split(/\s+/, $oldlist)) {
|
||||
if (exists($::Modules{$i})) {
|
||||
$list .= "$::Modules{$i} ";
|
||||
# Do an undef to prevent infinite recursion.
|
||||
undef($::Modules{$i});
|
||||
} else {
|
||||
$list .= "$i ";
|
||||
}
|
||||
}
|
||||
|
||||
$list =~ s/\s+$//;
|
||||
}
|
||||
|
||||
return ($list);
|
||||
}
|
||||
|
||||
sub create_legal_dirs {
|
||||
my ($dirs);
|
||||
|
||||
$list = find_dirs();
|
||||
Lock();
|
||||
unless (open(LDIR, "> $::DataDir/legaldirs")) {
|
||||
Unlock();
|
||||
die "Couldn't create $::DataDir/legaldirs";
|
||||
}
|
||||
chmod(0666,"$::DataDir/legaldirs");
|
||||
|
||||
foreach $i (split(/\s+/, $list)) {
|
||||
print LDIR "$i\n";
|
||||
print LDIR "$i/*\n";
|
||||
}
|
||||
close(LDIR);
|
||||
Unlock();
|
||||
}
|
||||
|
||||
##
|
||||
## Main program...
|
||||
##
|
||||
Log("Attempting to recreate legaldirs...");
|
||||
init();
|
||||
create_legal_dirs();
|
||||
Log("...legaldirs recreated.");
|
||||
exit(0);
|
||||
|
|
@ -37,9 +37,8 @@
|
|||
# mark - highlight a line
|
||||
#
|
||||
|
||||
require 'lloydcgi.pl';
|
||||
require 'CGI.pl';
|
||||
require 'cvsblame.pl';
|
||||
require 'utils.pl';
|
||||
use SourceChecker;
|
||||
|
||||
$| = 1;
|
||||
|
|
@ -48,9 +47,9 @@ $| = 1;
|
|||
# any errors result, they will show up for the user.
|
||||
|
||||
print "Content-Type:text/html\n";
|
||||
if ($ENV{"REQUEST_METHOD"} eq 'POST' && defined($form{'set_line'})) {
|
||||
if ($ENV{"REQUEST_METHOD"} eq 'POST' && defined($::FORM{'set_line'})) {
|
||||
# Expire the cookie 5 months from now
|
||||
print "Set-Cookie: line_nums=$form{'set_line'}; expires="
|
||||
print "Set-Cookie: line_nums=$::FORM{'set_line'}; expires="
|
||||
. toGMTString(time + 86400 * 152) . "; path=/\n";
|
||||
}
|
||||
print "\n";
|
||||
|
|
@ -58,6 +57,8 @@ print "\n";
|
|||
|
||||
# Some Globals
|
||||
#
|
||||
$Head = 'CVS Blame';
|
||||
$SubHead = '';
|
||||
|
||||
@src_roots = getRepositoryList();
|
||||
|
||||
|
|
@ -70,7 +71,7 @@ if (not $user_agent =~ m@^Mozilla/4.@ or $user_agent =~ /MSIE/) {
|
|||
|
||||
# Init sanitiazation source checker
|
||||
#
|
||||
$sanitization_dictionary = $form{'sanitize'};
|
||||
$sanitization_dictionary = $::FORM{'sanitize'};
|
||||
$opt_sanitize = defined $sanitization_dictionary;
|
||||
if ( $opt_sanitize )
|
||||
{
|
||||
|
|
@ -85,7 +86,7 @@ $opt_html_comments = &html_comments_init();
|
|||
# Handle the "file" argument
|
||||
#
|
||||
$filename = '';
|
||||
$filename = $form{'file'} if defined($form{'file'});
|
||||
$filename = $::FORM{'file'} if defined($::FORM{'file'});
|
||||
if ($filename eq '')
|
||||
{
|
||||
&print_usage;
|
||||
|
|
@ -95,7 +96,8 @@ if ($filename eq '')
|
|||
|
||||
# Handle the "rev" argument
|
||||
#
|
||||
$opt_rev = $form{rev} if defined($form{rev} && $form{rev} ne 'HEAD');
|
||||
$opt_rev = '';
|
||||
$opt_rev = $::FORM{'rev'} if defined($::FORM{'rev'} && $::FORM{'rev'} ne 'HEAD');
|
||||
$browse_revtag = "HEAD";
|
||||
$browse_revtag = $opt_rev if ($opt_rev =~ /[A-Za-z]/);
|
||||
$revision = '';
|
||||
|
|
@ -103,7 +105,7 @@ $revision = '';
|
|||
|
||||
# Handle the "root" argument
|
||||
#
|
||||
if (defined($root = $form{'root'}) && $root ne '') {
|
||||
if (defined($root = $::FORM{'root'}) && $root ne '') {
|
||||
$root =~ s|/$||;
|
||||
validateRepository($root);
|
||||
if (-d $root) {
|
||||
|
|
@ -123,13 +125,14 @@ if (defined($root = $form{'root'}) && $root ne '') {
|
|||
foreach (@src_roots) {
|
||||
$root = $_;
|
||||
$rcs_filename = "$root/$filename,v";
|
||||
$rcs_filename = Fix_BonsaiLink($rcs_filename);
|
||||
goto found_file if -r $rcs_filename;
|
||||
$rcs_filename = "$root/${file_head}Attic/$file_tail,v";
|
||||
goto found_file if -r $rcs_filename;
|
||||
}
|
||||
# File not found
|
||||
&print_top;
|
||||
print "Rcs file, $filename, does not exist.<BR><BR>\n";
|
||||
print "Rcs file, $filename, does not exist.<pre>rcs_filename => '$rcs_filename'\nroot => '$root'</pre><BR><BR>\n";
|
||||
print "</BODY></HTML>\n";
|
||||
&print_bottom;
|
||||
exit;
|
||||
|
|
@ -149,13 +152,18 @@ $file_rev = $revision;
|
|||
# Handle the "line_nums" argument
|
||||
#
|
||||
$opt_line_nums = 1;
|
||||
$opt_line_nums = 1 if $cookie_jar{'line_nums'} eq 'on';
|
||||
$opt_line_nums = 0 if $form{'line_nums'} =~ /off|no|0/i;
|
||||
$opt_line_nums = 1 if $form{'line_nums'} =~ /on|yes|1/i;
|
||||
if (exists($::COOKIE{'line_nums'})) {
|
||||
$opt_line_nums = 1 if $::COOKIE{'line_nums'} eq 'on';
|
||||
}
|
||||
if (exists($::FORM{'line_nums'})) {
|
||||
$opt_line_nums = 0 if $::FORM{'line_nums'} =~ /off|no|0/i;
|
||||
$opt_line_nums = 1 if $::FORM{'line_nums'} =~ /on|yes|1/i;
|
||||
}
|
||||
|
||||
# Option to make links to included files
|
||||
$opt_includes = 0;
|
||||
$opt_includes = 1 if $form{'includes'} =~ /on|yes|1/i;
|
||||
$opt_includes = 1 if (exists($::FORM{'includes'}) &&
|
||||
$::FORM{'includes'} =~ /on|yes|1/i);
|
||||
$opt_includes = 1 if $opt_includes && $file_tail =~ /(.c|.h|.cpp)$/;
|
||||
|
||||
@text = &extract_revision($revision);
|
||||
|
|
@ -165,7 +173,7 @@ die "$progname: Internal consistency error" if ($#text != $#revision_map);
|
|||
# Handle the "mark" argument
|
||||
#
|
||||
$mark_arg = '';
|
||||
$mark_arg = $form{'mark'} if defined($form{'mark'});
|
||||
$mark_arg = $::FORM{'mark'} if defined($::FORM{'mark'});
|
||||
foreach $mark (split(',',$mark_arg)) {
|
||||
if (($begin, $end) = $mark =~ /(\d*)\-(\d*)/) {
|
||||
$begin = 1 if $begin eq '';
|
||||
|
|
@ -181,9 +189,7 @@ foreach $mark (split(',',$mark_arg)) {
|
|||
# Start printing out the page
|
||||
#
|
||||
&print_top;
|
||||
|
||||
open(BANNER, "<data/banner.html");
|
||||
print while <BANNER>;
|
||||
print Param('bannerhtml', 1);
|
||||
|
||||
# Print link at top for directory browsing
|
||||
#
|
||||
|
|
@ -200,10 +206,11 @@ print q(
|
|||
foreach $path (split('/',$rcs_path)) {
|
||||
|
||||
# Customize this translation
|
||||
$link_path .= url_encode2($path).'/' if $path ne 'mozilla';
|
||||
print "<A HREF='$lxr_base/$link_path'>$path</a>/ ";
|
||||
$link_path .= url_encode2($path).'/';
|
||||
$lxr_path = Fix_LxrLink($link_path);
|
||||
print "<A HREF='$lxr_path'>$path</a>/ ";
|
||||
}
|
||||
print "<A HREF='$lxr_base/$link_path$file_tail'>$file_tail</a> ";
|
||||
print "<A HREF='$link_path$file_tail'>$file_tail</a> ";
|
||||
|
||||
print " (<A HREF='cvsblame.cgi?file=$filename&rev=$revision&root=$root'";
|
||||
print " onmouseover='return log(event,\"$prev_revision{$revision}\",\"$revision\");'" if $useLayers;
|
||||
|
|
@ -212,6 +219,7 @@ print "$browse_revtag:" unless $browse_revtag eq 'HEAD';
|
|||
print $revision if $revision;
|
||||
print "</A>)";
|
||||
|
||||
$lxr_path = Fix_LxrLink("$link_path$file_tail");
|
||||
print qq(
|
||||
</B>
|
||||
</TD>
|
||||
|
|
@ -222,7 +230,7 @@ print qq(
|
|||
<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
|
||||
<TR>
|
||||
<TD NOWRAP>
|
||||
<A HREF="$lxr_base/$link_path$file_tail">LXR: Cross Reference</A>
|
||||
<A HREF="$lxr_path">LXR: Cross Reference</A>
|
||||
</TD>
|
||||
</TR><TR>
|
||||
<TD NOWRAP>
|
||||
|
|
@ -316,6 +324,7 @@ foreach $revision (@revision_map)
|
|||
$output .= "<A HREF=\"cvsview2.cgi?diff_mode=context&whitespace_mode=show&root=$root&subdir=$rcs_path&command=DIFF_FRAMESET&file=$file_tail&rev2=$revision&rev1=$prev_revision{$revision}\"";
|
||||
} else {
|
||||
$output .= "<A HREF=\"cvsview2.cgi?root=$root&subdir=$rcs_path&command=DIRECTORY&files=$file_tail\"";
|
||||
$prev_revision{$revision} = '';
|
||||
}
|
||||
$output .= " onmouseover='return log(event,\"$prev_revision{$revision}\",\"$revision\");'" if $useLayers;
|
||||
$output .= ">";
|
||||
|
|
@ -361,15 +370,16 @@ if ($useLayers) {
|
|||
|
||||
$log = $revision_log{$revision};
|
||||
$log =~ s/([^\n\r]{80})([^\n\r]*)/$1\n$2/g;
|
||||
eval ('$log =~ s@\d{4,6}@' . $BUGSYSTEMEXPR . '@g;');
|
||||
$log = MarkUpText($log);
|
||||
$log =~ s/\n|\r|\r\n/<BR>/g;
|
||||
$log =~ s/"/\\"/g;
|
||||
|
||||
# Write JavaScript variable for log entry (e.g. log1_1 = "New File")
|
||||
$author = $revision_author{$revision};
|
||||
$author =~ tr/%/@/;
|
||||
$author_email = EmailFromUsername($author);
|
||||
print "log$revisionName = \""
|
||||
."<b>$revision</b> <<a href='mailto:$author'>$author</a>>"
|
||||
."<b>$revision</b> <<a href='mailto:$author_email'>$author</a>>"
|
||||
." <b>$revision_ctime{$revision}</b><BR>"
|
||||
."<SPACER TYPE=VERTICAL SIZE=5>$log\";\n";
|
||||
}
|
||||
|
|
@ -477,15 +487,15 @@ sub print_usage {
|
|||
my ($new_linenum, $src_roots_list);
|
||||
my ($title_text) = "Usage";
|
||||
|
||||
if ($ENV{"REQUEST_METHOD"} eq 'POST' && defined($form{'set_line'})) {
|
||||
if ($ENV{"REQUEST_METHOD"} eq 'POST' && defined($::FORM{'set_line'})) {
|
||||
|
||||
# Expire the cookie 5 months from now
|
||||
$set_cookie = "Set-Cookie: line_nums=$form{'set_line'}; expires="
|
||||
$set_cookie = "Set-Cookie: line_nums=$::FORM{'set_line'}; expires="
|
||||
.&toGMTString(time + 86400 * 152)."; path=/";
|
||||
}
|
||||
if (!defined($cookie_jar{'line_nums'}) && !defined($form{'set_line'})) {
|
||||
if (!defined($cookie_jar{'line_nums'}) && !defined($::FORM{'set_line'})) {
|
||||
$new_linenum = 'on';
|
||||
} elsif ($cookie_jar{'line_nums'} eq 'off' || $form{'set_line'} eq 'off') {
|
||||
} elsif ($cookie_jar{'line_nums'} eq 'off' || $::FORM{'set_line'} eq 'off') {
|
||||
$linenum_message = 'Line numbers are currently <b>off</b>.';
|
||||
$new_linenum = 'on';
|
||||
} else {
|
||||
|
|
@ -578,11 +588,13 @@ __USAGE__
|
|||
} # sub print_usage
|
||||
|
||||
sub print_bottom {
|
||||
print <<__BOTTOM__;
|
||||
my $maintainer = Param('maintainer');
|
||||
|
||||
print <<__BOTTOM__;
|
||||
<HR WIDTH="100%">
|
||||
<FONT SIZE=-1>
|
||||
<A HREF="cvsblame.cgi">Page configuration and help</A>.
|
||||
Mail feedback to <A HREF="mailto:slamm?subject=About the cvsblame script"><slamm\@netscape.com></A>.
|
||||
Mail feedback to <A HREF="mailto:$maintainer?subject=About the cvsblame script"><$maintainer></A>.
|
||||
</FONT></BODY>
|
||||
</HTML>
|
||||
__BOTTOM__
|
||||
|
|
@ -607,7 +619,7 @@ sub link_includes {
|
|||
}
|
||||
|
||||
sub html_comments_init {
|
||||
return 0 unless defined($form{'use_html'}) && $form{'use_html'};
|
||||
return 0 unless defined($::FORM{'use_html'}) && $::FORM{'use_html'};
|
||||
|
||||
# Initialization for C comment context switching
|
||||
$in_comments = 0;
|
||||
|
|
|
|||
|
|
@ -32,9 +32,10 @@ use Time::Local qw(timegm); # timestamps
|
|||
use POSIX qw(strftime); # human-readable dates
|
||||
|
||||
$debug = 0;
|
||||
$opt_m = 0 unless (defined($opt_m));
|
||||
|
||||
# Extract base part of this script's name
|
||||
($progname) = $0 =~ /([^\/]+)$/;
|
||||
($progname = $0) =~ /([^\/]+)$/;
|
||||
|
||||
&cvsblame_init;
|
||||
|
||||
|
|
@ -102,6 +103,7 @@ sub traverse_cvs_tree {
|
|||
# Unescape string tokens, if necessary.
|
||||
sub get_token {
|
||||
# Erase all-whitespace lines.
|
||||
$line_buffer = '' unless (defined($line_buffer));
|
||||
while ($line_buffer =~ /^$/) {
|
||||
die ("Unexpected EOF") if eof(RCSFILE);
|
||||
$line_buffer = <RCSFILE>;
|
||||
|
|
@ -515,7 +517,8 @@ sub parse_cvs_file {
|
|||
|
||||
# The primordial revision is not always 1.1! Go find it.
|
||||
my $primordial = $revision;
|
||||
while ($prev_revision{$primordial} != "") {
|
||||
while (exists($prev_revision{$primordial}) &&
|
||||
$prev_revision{$primordial} ne "") {
|
||||
$primordial = $prev_revision{$primordial};
|
||||
}
|
||||
|
||||
|
|
@ -526,7 +529,13 @@ sub parse_cvs_file {
|
|||
# Figure out how many lines were in the primordial, i.e. version 1.1,
|
||||
# check-in by moving backward in time from the head revision to the
|
||||
# first revision.
|
||||
$line_count = split(/^/, $revision_deltatext{$head_revision});
|
||||
$line_count = 0;
|
||||
if (exists ($revision_deltatext{$head_revision}) &&
|
||||
$revision_deltatext{$head_revision}) {
|
||||
my @tmp_array = split(/^/, $revision_deltatext{$head_revision});
|
||||
$line_count = @tmp_array;
|
||||
}
|
||||
$skip = 0 unless (defined($skip));
|
||||
for ($rev = $prev_revision{$head_revision}; $rev;
|
||||
$rev = $prev_revision{$rev}) {
|
||||
@diffs = split(/^/, $revision_deltatext{$rev});
|
||||
|
|
|
|||
|
|
@ -17,38 +17,38 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
require 'lloydcgi.pl';
|
||||
require 'utils.pl';
|
||||
require 'CGI.pl';
|
||||
|
||||
$file= $form{'file'};
|
||||
$mark= $form{'mark'};
|
||||
$ln = ($mark > 10 ? $mark-10 : 1 );
|
||||
$rev = $form{'rev'};
|
||||
$debug = $form{'debug'};
|
||||
my $file= $::FORM{'file'};
|
||||
my $mark= $::FORM{'mark'};
|
||||
my $ln = ($mark > 10 ? $mark-10 : 1 );
|
||||
my $rev = $::FORM{'rev'};
|
||||
my $debug = $::FORM{'debug'};
|
||||
|
||||
print "Content-Type: text/html\n\n";
|
||||
|
||||
$CVS_ROOT = $form{'root'};
|
||||
my $CVS_ROOT = $::FORM{'root'};
|
||||
if( $CVS_ROOT eq '' ){
|
||||
$CVS_ROOT = pickDefaultRepository();
|
||||
}
|
||||
validateRepository($CVS_ROOT);
|
||||
|
||||
$CVS_REPOS_SUFIX = $CVS_ROOT;
|
||||
my $CVS_REPOS_SUFIX = $CVS_ROOT;
|
||||
$CVS_REPOS_SUFIX =~ s/\//_/g;
|
||||
|
||||
$db = ConnectToDatabase();
|
||||
ConnectToDatabase();
|
||||
|
||||
$f = SqlQuote($file);
|
||||
$qstring = "select distinct dirs.dir from checkins,dirs,files,repositories where dirs.id=dirid and files.id=fileid and repositories.id=repositoryid and repositories.repository='$CVS_ROOT' and files.file='$f' order by dirs.dir";
|
||||
my $f = SqlQuote($file);
|
||||
$qstring = "select distinct dirs.dir from checkins,dirs,files,repositories where dirs.id=dirid and files.id=fileid and repositories.id=repositoryid and repositories.repository='$CVS_ROOT' and files.file=$f order by dirs.dir";
|
||||
|
||||
if ($debug) {
|
||||
print "<pre wrap>$qstring</pre>\n";
|
||||
}
|
||||
|
||||
$query = $db->Query($qstring) || die $Mysql::db_errstr;
|
||||
my (@row, $d, @fl, $s);
|
||||
|
||||
while(@row = $query->fetchrow){
|
||||
SendSQL($qstring);
|
||||
while(@row = FetchSQLData()){
|
||||
$d = $row[0];
|
||||
push @fl, "$d/$file";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -29,14 +29,12 @@
|
|||
# author - filter based on author
|
||||
#
|
||||
|
||||
require 'lloydcgi.pl';
|
||||
require 'CGI.pl';
|
||||
require 'cvsblame.pl';
|
||||
require 'utils.pl';
|
||||
use SourceChecker;
|
||||
|
||||
# Some Globals
|
||||
#
|
||||
|
||||
$| = 1;
|
||||
|
||||
print "Content-Type:text/html\n\n";
|
||||
|
|
@ -47,7 +45,7 @@ print "Content-Type:text/html\n\n";
|
|||
# Handle the "file" argument
|
||||
#
|
||||
$filename = '';
|
||||
$filename = $form{'file'} if defined($form{'file'});
|
||||
$filename = $::FORM{'file'} if defined($::FORM{'file'});
|
||||
if ($filename eq '')
|
||||
{
|
||||
&print_usage;
|
||||
|
|
@ -58,7 +56,7 @@ if ($filename eq '')
|
|||
|
||||
# Handle the "rev" argument
|
||||
#
|
||||
$opt_rev = $form{'rev'} if defined($form{'rev'} && $form{'rev'} ne 'HEAD');
|
||||
$opt_rev = $::FORM{'rev'} if defined($::FORM{'rev'} && $::FORM{'rev'} ne 'HEAD');
|
||||
$browse_revtag = 'HEAD';
|
||||
$browse_revtag = $opt_rev if ($opt_rev =~ /[A-Za-z]/);
|
||||
$revision = '';
|
||||
|
|
@ -66,7 +64,7 @@ $revision = '';
|
|||
|
||||
# Handle the "root" argument
|
||||
#
|
||||
if (defined($root = $form{'root'}) && $root ne '') {
|
||||
if (defined($root = $::FORM{'root'}) && $root ne '') {
|
||||
$root =~ s|/$||;
|
||||
validateRepository($root);
|
||||
if (-d $root) {
|
||||
|
|
@ -87,6 +85,7 @@ if (defined($root = $form{'root'}) && $root ne '') {
|
|||
foreach (@src_roots) {
|
||||
$root = $_;
|
||||
$rcs_filename = "$root/$filename,v";
|
||||
$rcs_filename = Fix_BonsaiLink($rcs_filename);
|
||||
goto found_file if -r $rcs_filename;
|
||||
$rcs_filename = "$root/${file_head}Attic/$file_tail,v";
|
||||
goto found_file if -r $rcs_filename;
|
||||
|
|
@ -111,7 +110,7 @@ $file_rev = $revision;
|
|||
# Handle the "mark" argument
|
||||
#
|
||||
$mark_arg = '';
|
||||
$mark_arg = $form{'mark'} if defined($form{'mark'});
|
||||
$mark_arg = $::FORM{'mark'} if defined($::FORM{'mark'});
|
||||
foreach $rev (split(',',$mark_arg)) {
|
||||
$mark{$rev} = 1;
|
||||
}
|
||||
|
|
@ -120,7 +119,7 @@ foreach $rev (split(',',$mark_arg)) {
|
|||
# Handle the "author" argument
|
||||
#
|
||||
$author_arg = '';
|
||||
$author_arg = $form{'author'} if defined($form{'author'});
|
||||
$author_arg = $::FORM{'author'} if defined($::FORM{'author'});
|
||||
foreach $author (split(',',$author_arg)) {
|
||||
$use_author{$author} = 1;
|
||||
}
|
||||
|
|
@ -128,15 +127,14 @@ foreach $author (split(',',$author_arg)) {
|
|||
|
||||
# Handle the "sort" argument
|
||||
$opt_sort = '';
|
||||
$opt_sort = $form{'sort'};
|
||||
$opt_sort = $::FORM{'sort'};
|
||||
|
||||
|
||||
# Start printing out the page
|
||||
#
|
||||
&print_top;
|
||||
print Param('bannerhtml', 1);
|
||||
|
||||
open(BANNER, "<data/banner.html");
|
||||
print while <BANNER>;
|
||||
|
||||
# Print link at top for directory browsing
|
||||
#
|
||||
|
|
@ -151,10 +149,12 @@ print q(
|
|||
);
|
||||
|
||||
foreach $path (split('/',$rcs_path)) {
|
||||
$link_path .= url_encode2($path).'/' if $path ne 'mozilla';
|
||||
print "<A HREF='$lxr_base/$link_path'>$path</a>/ ";
|
||||
$link_path .= url_encode2($path).'/';
|
||||
$lxr_path = Fix_LxrLink($link_path);
|
||||
print "<A HREF='$lxr_path'>$path</a>/ ";
|
||||
}
|
||||
print "<A HREF='$lxr_base/$link_path$file_tail'>$file_tail</a> ";
|
||||
$lxr_path = Fix_LxrLink("$link_path$file_tail");
|
||||
print "<A HREF='$lxr_path'>$file_tail</a> ";
|
||||
|
||||
print " (";
|
||||
print "$browse_revtag:" unless $browse_revtag eq 'HEAD';
|
||||
|
|
@ -172,7 +172,7 @@ print qq(
|
|||
<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
|
||||
<TR>
|
||||
<TD>
|
||||
<A HREF="$lxr_base/$link_path$file_tail">lxr</A>
|
||||
<A HREF="$lxr_path">lxr</A>
|
||||
</TD><TD NOWRAP>
|
||||
Browse the source code as hypertext.
|
||||
</TD>
|
||||
|
|
@ -234,7 +234,7 @@ foreach $revision (@revisions)
|
|||
$log =~ s/&/&/g;
|
||||
$log =~ s/</</g;
|
||||
$log =~ s/>/>/g;
|
||||
eval ('$log =~ s@\d{4,6}@' . $BUGSYSTEMEXPR . '@g;');
|
||||
$log = MarkUpText($log);
|
||||
$log =~ s/\n|\r|\r\n/<BR>/g;
|
||||
|
||||
if ($bgcolor eq '') {
|
||||
|
|
@ -450,11 +450,13 @@ __USAGE__
|
|||
} # sub print_usage
|
||||
|
||||
sub print_bottom {
|
||||
print <<__BOTTOM__;
|
||||
my $maintainer = Param('maintainer');
|
||||
|
||||
print <<__BOTTOM__;
|
||||
<HR WIDTH="100%">
|
||||
<FONT SIZE=-1>
|
||||
<A HREF="cvslog.cgi">Page configuration and help</A>.
|
||||
Mail feedback to <A HREF="mailto:slamm\@netscape.com?subject=About the cvslog script"><slamm\@netscape.com></A>.
|
||||
Mail feedback to <A HREF="mailto:$maintainer?subject=About the cvslog script"><$maintainer></A>.
|
||||
</FONT></BODY>
|
||||
</HTML>
|
||||
__BOTTOM__
|
||||
|
|
@ -468,14 +470,8 @@ sub print_useful_links {
|
|||
my $diff_base = "cvsview2.cgi";
|
||||
my $blame_base = "cvsblame.cgi";
|
||||
|
||||
# total kludge!! lxr omits the top-level "mozilla" directory...
|
||||
my $lxr_path = $path;
|
||||
if ($mozilla_lxr_kludge eq 'TRUE') {
|
||||
$lxr_path =~ s@^ns/@@;
|
||||
$lxr_path =~ s@^mozilla/@@;
|
||||
}
|
||||
|
||||
my $lxr_link = "$lxr_base/$lxr_path";
|
||||
my $lxr_link = Fix_LxrLink($lxr_path);
|
||||
my $diff_link = "$diff_base?command=DIRECTORY\&subdir=$dir\&files=$file";
|
||||
my $blame_link = "$blame_base?root=$CVS_ROOT\&file=$path";
|
||||
|
||||
|
|
|
|||
|
|
@ -17,22 +17,28 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
require 'lloydcgi.pl';
|
||||
require 'utils.pl';
|
||||
use Date::Parse;
|
||||
|
||||
loadConfigData();
|
||||
$CVS_ROOT = $form{"cvsroot"};
|
||||
|
||||
require 'timelocal.pl';
|
||||
require 'CGI.pl';
|
||||
require 'cvsquery.pl';
|
||||
|
||||
$CVS_ROOT = $::FORM{'cvsroot'};
|
||||
$CVS_ROOT = pickDefaultRepository() unless $CVS_ROOT;
|
||||
$::TreeID = $::FORM{'module'}
|
||||
if (!exists($::FORM{'treeid'}) &&
|
||||
exists($::FORM{'module'}) &&
|
||||
exists($::TreeInfo{$::FORM{'module'}}{'repository'}));
|
||||
$::TreeID = 'default'
|
||||
if (!exists($::TreeInfo{$::TreeID}{'repository'}) ||
|
||||
exists($::TreeInfo{$::TreeID}{'nobonsai'}));
|
||||
|
||||
LoadTreeConfig();
|
||||
|
||||
my $userdomain = Param('userdomain');
|
||||
$| = 1;
|
||||
|
||||
$sm_font_tag = "<font face='Arial,Helvetica' size=-2>";
|
||||
|
||||
my $generateBackoutCVSCommands = 0;
|
||||
if (defined $form{'generateBackoutCVSCommands'}) {
|
||||
if (defined $::FORM{'generateBackoutCVSCommands'}) {
|
||||
$generateBackoutCVSCommands = 1;
|
||||
}
|
||||
|
||||
|
|
@ -61,42 +67,40 @@ $SORT_HEAD="bgcolor=\"#DDDDDD\"";
|
|||
|
||||
#
|
||||
# Log the query
|
||||
open( LOG, ">>data/querylog.txt");
|
||||
$t = time;
|
||||
print LOG "$ENV{'REMOTE_ADDR'} $t $ENV{'QUERY_STRING'}\n";
|
||||
close(LOG);
|
||||
Log("Query [$ENV{'REMOTE_ADDR'}]: $ENV{'QUERY_STRING'}");
|
||||
|
||||
#
|
||||
# build a module map
|
||||
#
|
||||
$query_module = $form{'module'};
|
||||
$query_module = $::FORM{'module'};
|
||||
|
||||
#
|
||||
# allow ?file=/a/b/c/foo.c to be synonymous with ?dir=/a/b/c&file=foo.c
|
||||
#
|
||||
if ( $form{'dir'} eq '' ) {
|
||||
if ($form{'file'} =~ m@(.*?/)([^/]*)$@) {
|
||||
$form{'dir'} = $1;
|
||||
$form{'file'} = $2;
|
||||
if ( $::FORM{'dir'} eq '' ) {
|
||||
$::FORM{'file'} = Fix_BonsaiLink($::FORM{'file'});
|
||||
if ($::FORM{'file'} =~ m@(.*?/)([^/]*)$@) {
|
||||
$::FORM{'dir'} = $1;
|
||||
$::FORM{'file'} = $2;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# build a directory map
|
||||
#
|
||||
@query_dirs = split(/[;, \t]+/, $form{'dir'});
|
||||
@query_dirs = split(/[;, \t]+/, $::FORM{'dir'});
|
||||
|
||||
$query_file = $form{'file'};
|
||||
$query_filetype = $form{'filetype'};
|
||||
$query_logexpr = $form{'logexpr'};
|
||||
$query_file = $::FORM{'file'};
|
||||
$query_filetype = $::FORM{'filetype'};
|
||||
$query_logexpr = $::FORM{'logexpr'};
|
||||
|
||||
#
|
||||
# date
|
||||
#
|
||||
$query_date_type = $form{'date'};
|
||||
$query_date_type = $::FORM{'date'};
|
||||
if( $query_date_type eq 'hours' ){
|
||||
$query_date_min = time - $form{'hours'}*60*60;
|
||||
}
|
||||
$query_date_min = time - $::FORM{'hours'}*60*60;
|
||||
}
|
||||
elsif( $query_date_type eq 'day' ){
|
||||
$query_date_min = time - 24*60*60;
|
||||
}
|
||||
|
|
@ -110,12 +114,12 @@ elsif( $query_date_type eq 'all' ){
|
|||
$query_date_min = 0;
|
||||
}
|
||||
elsif( $query_date_type eq 'explicit' ){
|
||||
if ($form{'mindate'} ne "") {
|
||||
$query_date_min = parse_date($form{'mindate'});
|
||||
if ($::FORM{'mindate'} ne "") {
|
||||
$query_date_min = parse_date($::FORM{'mindate'});
|
||||
}
|
||||
|
||||
if ($form{'maxdate'} ne "") {
|
||||
$query_date_max = parse_date($form{'maxdate'});
|
||||
if ($::FORM{'maxdate'} ne "") {
|
||||
$query_date_max = parse_date($::FORM{'maxdate'});
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
|
@ -125,27 +129,29 @@ else {
|
|||
#
|
||||
# who
|
||||
#
|
||||
$query_who = $form{'who'};
|
||||
$query_whotype = $form{'whotype'};
|
||||
$query_who = $::FORM{'who'};
|
||||
$query_whotype = $::FORM{'whotype'};
|
||||
|
||||
|
||||
$show_raw = $form{'raw'} ne '';
|
||||
$show_raw = 0;
|
||||
$show_raw = $::FORM{'raw'} ne ''
|
||||
if $::FORM{'raw'};
|
||||
|
||||
#
|
||||
# branch
|
||||
#
|
||||
$query_branch = $form{'branch'};
|
||||
$query_branch = $::FORM{'branch'};
|
||||
if (!defined $query_branch) {
|
||||
$query_branch = 'HEAD';
|
||||
}
|
||||
$query_branchtype = $form{'branchtype'};
|
||||
$query_branchtype = $::FORM{'branchtype'};
|
||||
|
||||
|
||||
#
|
||||
# tags
|
||||
#
|
||||
$query_begin_tag = $form{'begin_tag'};
|
||||
$query_end_tag = $form{'end_tag'};
|
||||
$query_begin_tag = $::FORM{'begin_tag'};
|
||||
$query_end_tag = $::FORM{'end_tag'};
|
||||
|
||||
|
||||
#
|
||||
|
|
@ -154,9 +160,10 @@ $query_end_tag = $form{'end_tag'};
|
|||
$t = $e = &query_to_english;
|
||||
$t =~ s/<[^>]*>//g;
|
||||
|
||||
$query_debug = $form{'debug'};
|
||||
$query_debug = $::FORM{'debug'};
|
||||
|
||||
$result= &query_checkins( $mod_map );
|
||||
my %mod_map = ();
|
||||
$result= &query_checkins( %mod_map );
|
||||
|
||||
for $i (@{$result}) {
|
||||
$w{"$i->[$CI_WHO]\@$userdomain"} = 1;
|
||||
|
|
@ -177,11 +184,11 @@ my $menu = "
|
|||
<br><a href=cvsquery.cgi?$ENV{QUERY_STRING}&generateBackoutCVSCommands=1>I want to back out these changes</a>
|
||||
";
|
||||
|
||||
if (defined $form{'generateBackoutCVSCommands'}) {
|
||||
if (defined $::FORM{'generateBackoutCVSCommands'}) {
|
||||
print "Content-type: text/plain
|
||||
|
||||
# This page can be saved as a shell script and executed. It should be
|
||||
# run at the top of your CVS work area. It will update your workarea to
|
||||
# This page can be saved as a shell script and executed. It should be
|
||||
# run at the top of your CVS work area. It will update your workarea to
|
||||
# backout the changes selected by your query.
|
||||
|
||||
";
|
||||
|
|
@ -195,9 +202,9 @@ if (defined $form{'generateBackoutCVSCommands'}) {
|
|||
}
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
EmitHtmlTitleAndHeader($t, "CVS Checkins", "$menu");
|
||||
|
||||
PutsHeader($t, "CVS Checkins", "$menu");
|
||||
|
||||
#
|
||||
# Test code to print the results
|
||||
|
|
@ -205,16 +212,22 @@ EmitHtmlTitleAndHeader($t, "CVS Checkins", "$menu");
|
|||
|
||||
$|=1;
|
||||
|
||||
$head_who = '';
|
||||
$head_file = '';
|
||||
$head_directory = '';
|
||||
$head_delta = '';
|
||||
$head_date = '';
|
||||
|
||||
if( !$show_raw ) {
|
||||
|
||||
if( $form{"sortby"} eq "Who" ){
|
||||
if( $::FORM{"sortby"} eq "Who" ){
|
||||
$result = [sort {
|
||||
$a->[$CI_WHO] cmp $b->[$CI_WHO]
|
||||
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
|
||||
} @{$result}] ;
|
||||
$head_who = $SORT_HEAD;
|
||||
}
|
||||
elsif( $form{"sortby"} eq "File" ){
|
||||
elsif( $::FORM{"sortby"} eq "File" ){
|
||||
$result = [sort {
|
||||
$a->[$CI_FILE] cmp $b->[$CI_FILE]
|
||||
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
|
||||
|
|
@ -222,7 +235,7 @@ if( !$show_raw ) {
|
|||
} @{$result}] ;
|
||||
$head_file = $SORT_HEAD;
|
||||
}
|
||||
elsif( $form{"sortby"} eq "Directory" ){
|
||||
elsif( $::FORM{"sortby"} eq "Directory" ){
|
||||
$result = [sort {
|
||||
$a->[$CI_DIRECTORY] cmp $b->[$CI_DIRECTORY]
|
||||
|| $a->[$CI_FILE] cmp $b->[$CI_FILE]
|
||||
|
|
@ -230,10 +243,10 @@ if( !$show_raw ) {
|
|||
} @{$result}] ;
|
||||
$head_directory = $SORT_HEAD;
|
||||
}
|
||||
elsif( $form{"sortby"} eq "Change Size" ){
|
||||
elsif( $::FORM{"sortby"} eq "Change Size" ){
|
||||
$result = [sort {
|
||||
|
||||
($b->[$CI_LINES_ADDED]- $b->[$CI_LINES_REMOVED])
|
||||
($b->[$CI_LINES_ADDED]- $b->[$CI_LINES_REMOVED])
|
||||
<=> ($a->[$CI_LINES_ADDED]- $a->[$CI_LINES_REMOVED])
|
||||
#|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
|
||||
} @{$result}] ;
|
||||
|
|
@ -255,89 +268,6 @@ else {
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# code to debug the modules_map
|
||||
#
|
||||
#print "<PRE>\n";
|
||||
#while( ($k,$v) = each(%{$mod_map})) {
|
||||
# print "$k=$v\n";
|
||||
#}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
sub print_tcl {
|
||||
local($result) = @_;
|
||||
local($t, $count,$first,$i, $k, $files);
|
||||
|
||||
$t = time;
|
||||
print TCLOUT "set treeopen 0\n" .
|
||||
"set lastgoodtimestamp $t\n" .
|
||||
"set closetimestamp $t\n";
|
||||
$count = 0;
|
||||
$first = 0;
|
||||
$i = 1;
|
||||
|
||||
|
||||
$max = @{$result}+1;
|
||||
|
||||
while( $i < $max ){
|
||||
$c1 = $result->[$first];
|
||||
$c2 = $result->[$i];
|
||||
if( $i == $max-1
|
||||
|| $c1->[$CI_DATE] != $c2->[$CI_DATE]
|
||||
|| $c1->[$CI_DIR] ne $c2->[$CI_DIR]
|
||||
|| $c1->[$CI_WHO] ne $c2->[$CI_WHO]
|
||||
) {
|
||||
$files = '{';
|
||||
$fu = '{';
|
||||
$k = $first;
|
||||
while( $k < $i ){
|
||||
$files .= $result->[$k][$CI_FILE] . " ";
|
||||
$fu .= &make_fullinfo( $result->[$k] );
|
||||
$k++;
|
||||
}
|
||||
$files .= '}';
|
||||
$fu .= '}';
|
||||
print TCLOUT "set ci-${count}(date) $c1->[$CI_DATE]\n" .
|
||||
"set ci-${count}(dir) $c1->[$CI_DIR]\n" .
|
||||
"set ci-${count}(person) $c1->[$CI_WHO]\n" .
|
||||
"set ci-${count}(files) $files\n" .
|
||||
"set ci-${count}(fullinfo) $fu\n" .
|
||||
"set ci-${count}(log) \{$c1->[$CI_LOG]\}\n" .
|
||||
"set ci-${count}(treeopen) 1\n";
|
||||
$count++;
|
||||
$first = $i;
|
||||
}
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
|
||||
sub make_fullinfo{
|
||||
local( $ci ) = @_;
|
||||
local( $s );
|
||||
|
||||
$a = &tcl_value( $ci->[$CI_FILE] );
|
||||
$b = &tcl_value( $ci->[$CI_REV] );
|
||||
$c = &tcl_value( $ci->[$CI_LINES_ADDED] );
|
||||
$d = &tcl_value( $ci->[$CI_LINES_REMOVED] );
|
||||
$e = &tcl_value( $ci->[$CI_STICKY] );
|
||||
|
||||
return "{$a $b $c $d $e}";
|
||||
}
|
||||
|
||||
sub tcl_value {
|
||||
local( $a ) = @_;
|
||||
|
||||
if( $a eq '' ){
|
||||
return '{}';
|
||||
}
|
||||
else {
|
||||
return $a;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
|
@ -355,8 +285,8 @@ sub print_result {
|
|||
$ci = $result->[$k];
|
||||
$span = 1;
|
||||
if( ($l = $ci->[$CI_LOG]) ne '' ){
|
||||
#
|
||||
# Calculate the number of consequitive logs that are
|
||||
#
|
||||
# Calculate the number of consequitive logs that are
|
||||
# the same and nuke them
|
||||
#
|
||||
$j = $k+1;
|
||||
|
|
@ -365,7 +295,7 @@ sub print_result {
|
|||
$j++;
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
# Make sure we don't break over a description block
|
||||
#
|
||||
$span = $j-$k;
|
||||
|
|
@ -375,7 +305,7 @@ sub print_result {
|
|||
}
|
||||
|
||||
&print_ci( $ci, $span );
|
||||
|
||||
|
||||
|
||||
if( $i <= 0 ){
|
||||
$i = 20;
|
||||
|
|
@ -394,7 +324,7 @@ sub print_ci {
|
|||
local($ci, $span) = @_;
|
||||
local($sec,$minute,$hour,$mday,$mon,$year,$t);
|
||||
local($log);
|
||||
|
||||
|
||||
($sec,$minute,$hour,$mday,$mon,$year) = localtime( $ci->[$CI_DATE] );
|
||||
$t = sprintf("%02d/%02d/%02d %02d:%02d",$mon+1,$mday,$year,$hour,$minute);
|
||||
|
||||
|
|
@ -402,12 +332,11 @@ sub print_ci {
|
|||
$rev = $ci->[$CI_REV];
|
||||
|
||||
print "<tr>\n";
|
||||
|
||||
print "<TD>${sm_font_tag}$t</font>";
|
||||
print "<TD><a href='../registry/who.cgi?email=$ci->[$CI_WHO]' "
|
||||
print "<TD width=2%>${sm_font_tag}$t</font>";
|
||||
print "<TD width=2%><a href='../registry/who.cgi?email=$ci->[$CI_WHO]' "
|
||||
. "onClick=\"return js_who_menu('$ci->[$CI_WHO]','',event);\" >"
|
||||
. "$ci->[$CI_WHO]</a>\n";
|
||||
print "<TD><a href='cvsview2.cgi?subdir=$ci->[$CI_DIR]&files=$ci->[$CI_FILE]\&command=DIRECTORY&branch=$query_branch&root=$CVS_ROOT'\n"
|
||||
print "<TD width=45%><a href='cvsview2.cgi?subdir=$ci->[$CI_DIR]&files=$ci->[$CI_FILE]\&command=DIRECTORY&branch=$query_branch&root=$CVS_ROOT'\n"
|
||||
. " onclick=\"return js_file_menu('$CVS_ROOT', '$ci->[$CI_DIR]','$ci->[$CI_FILE]','$ci->[$CI_REV]','$query_branch',event)\">\n";
|
||||
# if( (length $ci->[$CI_FILE]) + (length $ci->[$CI_DIR]) > 30 ){
|
||||
# $d = $ci->[$CI_DIR];
|
||||
|
|
@ -429,32 +358,32 @@ sub print_ci {
|
|||
|
||||
if( $rev ne '' ){
|
||||
$prevrev = &PrevRev( $rev );
|
||||
print "<TD>${sm_font_tag}<a href='cvsview2.cgi?diff_mode=".
|
||||
print "<TD width=2%>${sm_font_tag}<a href='cvsview2.cgi?diff_mode=".
|
||||
"context\&whitespace_mode=show\&subdir=".
|
||||
$ci->[$CI_DIR] . "\&command=DIFF_FRAMESET\&file=" .
|
||||
$ci->[$CI_FILE] . "\&rev1=$prevrev&rev2=$rev&root=$CVS_ROOT'>$rev</a></font>\n";
|
||||
}
|
||||
else {
|
||||
print "<TD>\ \n";
|
||||
print "<TD width=2%>\ \n";
|
||||
}
|
||||
|
||||
if( !$query_branch_head ){
|
||||
print "<TD><TT><FONT SIZE=-1>$ci->[$CI_BRANCH] </FONT></TT>\n";
|
||||
if( !$query_branch_head ){
|
||||
print "<TD width=2%><TT><FONT SIZE=-1>$ci->[$CI_BRANCH] </FONT></TT>\n";
|
||||
}
|
||||
print "<TD>${sm_font_tag}$ci->[$CI_LINES_ADDED]/$ci->[$CI_LINES_REMOVED]</font> \n";
|
||||
|
||||
print "<TD width=2%>${sm_font_tag}$ci->[$CI_LINES_ADDED]/$ci->[$CI_LINES_REMOVED]</font> \n";
|
||||
if( $log ne '' ){
|
||||
eval ('$log =~ s@\d{4,6}@' . $BUGSYSTEMEXPR . '@g;');
|
||||
$log =~ s/([ #\t])([0-9][0-9][0-9][0-9][0-9])([^0-9])/$1<a href='http:\/\/scopus.mcom.com\/bugsplat\/show_bug.cgi?id=$2'>$2<\/a>$3/g;
|
||||
$log = MarkUpText($log);
|
||||
# Makes numbers into links to bugsplat.
|
||||
|
||||
$log =~ s/\n/<BR>/g;
|
||||
# Makes newlines into <BR>'s
|
||||
|
||||
|
||||
if( $span > 1 ){
|
||||
print "<TD VALIGN=TOP ROWSPAN=$span>$log\n";
|
||||
print "<TD WIDTH=$descwidth% VALIGN=TOP ROWSPAN=$span>$log\n";
|
||||
}
|
||||
else {
|
||||
print "<TD VALIGN=TOP>$log\n";
|
||||
print "<TD WIDTH=$descwidth% VALIGN=TOP>$log\n";
|
||||
}
|
||||
}
|
||||
print "</tr>\n";
|
||||
|
|
@ -475,26 +404,22 @@ $anchor = $ENV{QUERY_STRING};
|
|||
$anchor =~ s/\&sortby\=[A-Za-z\ \+]*//g;
|
||||
$anchor = "<a href=cvsquery.cgi?$anchor";
|
||||
|
||||
print "
|
||||
<TABLE border cellspacing=2>
|
||||
<b><TR ALIGN=LEFT>
|
||||
<TH width=2% $head_date>$anchor>When</a>
|
||||
<TH width=2% $head_who>${anchor}&sortby=Who>Who</a>
|
||||
<TH width=45% $head_file>${anchor}&sortby=File>File</a>
|
||||
<TH width=2%>Rev
|
||||
";
|
||||
print "<TABLE border cellspacing=2>\n";
|
||||
print "<b><TR ALIGN=LEFT>\n";
|
||||
print "<TH width=2% $head_date>$anchor>When</a>\n";
|
||||
print "<TH width=2% $head_who>${anchor}&sortby=Who>Who</a>\n";
|
||||
print "<TH width=45% $head_file>${anchor}&sortby=File>File</a>\n";
|
||||
print "<TH width=2%>Rev\n";
|
||||
|
||||
$descwidth = 47;
|
||||
if( !$query_branch_head ){
|
||||
if( !$query_branch_head ){
|
||||
print "<TH width=2%>Branch\n";
|
||||
$descwidth -= 2;
|
||||
}
|
||||
|
||||
print "
|
||||
<TH width=2% $head_delta>${anchor}&sortby=Change+Size>+/-</a>
|
||||
<TH WIDTH=$descwidth%>Description
|
||||
</TR></b>
|
||||
";
|
||||
print "<TH width=2% $head_delta>${anchor}&sortby=Change+Size>+/-</a>\n";
|
||||
print "<TH WIDTH=$descwidth%>Description\n";
|
||||
print "</TR></b>\n";
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -517,7 +442,7 @@ sub PrevRev {
|
|||
@r = split( /\./, $rev );
|
||||
|
||||
$i = @r-1;
|
||||
|
||||
|
||||
$r[$i]--;
|
||||
if( $r[$i] == 0 ){
|
||||
$i -= 2;
|
||||
|
|
@ -559,7 +484,7 @@ function js_who_menu(n,extra,d) {
|
|||
l = document.layers['popup'];
|
||||
l.src="../registry/who.cgi?email="+n+extra;
|
||||
|
||||
if(d.target.y > window.innerHeight + window.pageYOffset - l.clip.height) {
|
||||
if(d.target.y > window.innerHeight + window.pageYOffset - l.clip.height) {
|
||||
l.top = (window.innerHeight + window.pageYOffset - l.clip.height);
|
||||
} else {
|
||||
l.top = d.target.y - 6;
|
||||
|
|
@ -615,12 +540,12 @@ sub query_to_english {
|
|||
elsif( $query_module ne 'all' && @query_dirs == 0 ){
|
||||
$english .= "to module <i>$query_module</i> ";
|
||||
}
|
||||
elsif( $form{dir} ne "" ) {
|
||||
elsif( $::FORM{dir} ne "" ) {
|
||||
my $word = "directory";
|
||||
if (@query_dirs > 1) {
|
||||
$word = "directories";
|
||||
}
|
||||
$english .= "to $word <i>$form{dir}</i> ";
|
||||
$english .= "to $word <i>$::FORM{dir}</i> ";
|
||||
}
|
||||
|
||||
if ($query_file ne "") {
|
||||
|
|
@ -643,10 +568,10 @@ sub query_to_english {
|
|||
$english .= "by $query_who ";
|
||||
}
|
||||
|
||||
$query_date_type = $form{'date'};
|
||||
$query_date_type = $::FORM{'date'};
|
||||
if( $query_date_type eq 'hours' ){
|
||||
$english .="in the last $form{hours} hours";
|
||||
}
|
||||
$english .="in the last $::FORM{hours} hours";
|
||||
}
|
||||
elsif( $query_date_type eq 'day' ){
|
||||
$english .="in the last day";
|
||||
}
|
||||
|
|
@ -660,7 +585,7 @@ sub query_to_english {
|
|||
$english .="since the beginning of time";
|
||||
}
|
||||
elsif( $query_date_type eq 'explicit' ){
|
||||
if ( $form{mindate} ne "" && $form{maxdate} ne "" ) {
|
||||
if ( $::FORM{mindate} ne "" && $::FORM{maxdate} ne "" ) {
|
||||
$w1 = "between";
|
||||
$w2 = "and" ;
|
||||
}
|
||||
|
|
@ -669,15 +594,15 @@ sub query_to_english {
|
|||
$w2 = "before";
|
||||
}
|
||||
|
||||
if( $form{'mindate'} ne "" ){
|
||||
$dd = &parse_date($form{'mindate'});
|
||||
if( $::FORM{'mindate'} ne "" ){
|
||||
$dd = &parse_date($::FORM{'mindate'});
|
||||
($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
|
||||
$t = sprintf("%02d/%02d/%02d %02d:%02d",$mon+1,$mday,$year,$hour,$minute);
|
||||
$english .= "$w1 <i>$t</i> ";
|
||||
}
|
||||
|
||||
if( $form{'maxdate'} ne "" ){
|
||||
$dd = &parse_date($form{'maxdate'});
|
||||
if( $::FORM{'maxdate'} ne "" ){
|
||||
$dd = &parse_date($::FORM{'maxdate'});
|
||||
($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
|
||||
$t = sprintf("%02d/%02d/%02d %02d:%02d",$mon+1,$mday,$year,$hour,$minute);
|
||||
$english .= "$w2 <i>$t</i> ";
|
||||
|
|
@ -685,3 +610,5 @@ sub query_to_english {
|
|||
}
|
||||
return $english . ":";
|
||||
}
|
||||
|
||||
PutsTrailer();
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
require 'utils.pl';
|
||||
require 'globals.pl';
|
||||
|
||||
#
|
||||
# Constants
|
||||
|
|
@ -37,8 +37,8 @@ $CI_LOG=11;
|
|||
$NOT_LOCAL = 1;
|
||||
$IS_LOCAL = 2;
|
||||
|
||||
chomp($CVS_ROOT);
|
||||
if( $CVS_ROOT eq "" ){
|
||||
chomp($CVS_ROOT) if defined($CVS_ROOT);
|
||||
if (!defined($CVS_ROOT) || $CVS_ROOT eq "" ){
|
||||
$CVS_ROOT = pickDefaultRepository();
|
||||
}
|
||||
|
||||
|
|
@ -47,37 +47,22 @@ if( $CVS_ROOT eq "" ){
|
|||
$lines_added = 0;
|
||||
$lines_removed = 0;
|
||||
|
||||
$modules = {};
|
||||
|
||||
if( $ENV{"OS"} eq "Windows_NT" ){
|
||||
# for debugging purposes
|
||||
$CVS_MODULES='k:/warp/projects/bonsai/modules';
|
||||
}
|
||||
else {
|
||||
$CVS_MODULES="${CVS_ROOT}/CVSROOT/modules";
|
||||
#$CVS_MODULES='data/modules';
|
||||
}
|
||||
|
||||
open( MOD, "<$CVS_MODULES") || die "can't open ${CVS_MODULES}";
|
||||
&parse_modules;
|
||||
close( MOD );
|
||||
|
||||
1;
|
||||
|
||||
#
|
||||
# Actually do the query
|
||||
#
|
||||
sub query_checkins {
|
||||
local($mod_map) = @_;
|
||||
local($ci,$result,$lastlog,$rev,$begin_tag,$end_tag);
|
||||
my (%mod_map) = @_;
|
||||
my ($ci,$result,$lastlog,$rev,$begin_tag,$end_tag);
|
||||
|
||||
if( $query_module ne 'all' && $query_module ne 'allrepositories' && @query_dirs == 0 ){
|
||||
$have_mod_map = 1;
|
||||
$mod_map = &get_module_map( $query_module );
|
||||
%mod_map = &get_module_map( $query_module );
|
||||
}
|
||||
else {
|
||||
$have_mod_map = 0;
|
||||
$mod_map = {};
|
||||
%mod_map = ();
|
||||
}
|
||||
|
||||
for $i (@query_dirs ){
|
||||
|
|
@ -85,10 +70,10 @@ sub query_checkins {
|
|||
$i =~ s:/$::; # Strip trailing slash.
|
||||
|
||||
if( !$have_mod_map ){
|
||||
$mod_map = {};
|
||||
%mod_map = ();
|
||||
$have_mod_map = 1;
|
||||
}
|
||||
$mod_map->{$i} = $NOT_LOCAL;
|
||||
$mod_map{$i} = $NOT_LOCAL;
|
||||
}
|
||||
|
||||
if( $query_branch =~ /^[ ]*HEAD[ ]*$/i ){
|
||||
|
|
@ -98,18 +83,18 @@ sub query_checkins {
|
|||
$begin_tag = "";
|
||||
$end_tag = "";
|
||||
|
||||
if ( $query_begin_tag ne '') {
|
||||
if (defined($query_begin_tag) && $query_begin_tag ne '') {
|
||||
$begin_tag = load_tag($query_begin_tag);
|
||||
}
|
||||
|
||||
if ( $query_end_tag ne '') {
|
||||
if (defined($query_end_tag) && $query_end_tag ne '') {
|
||||
$end_tag = load_tag($query_end_tag);
|
||||
}
|
||||
|
||||
|
||||
$result = [];
|
||||
|
||||
my $db = ConnectToDatabase();
|
||||
ConnectToDatabase();
|
||||
|
||||
my $qstring = "select type, UNIX_TIMESTAMP(when), people.who, repositories.repository, dirs.dir, files.file, revision, stickytag, branches.branch, addedlines, removedlines, descs.description from checkins,people,repositories,dirs,files,branches,descs where people.id=whoid and repositories.id=repositoryid and dirs.id=dirid and files.id=fileid and branches.id=branchid and descs.id=descid";
|
||||
|
||||
|
|
@ -131,58 +116,58 @@ sub query_checkins {
|
|||
my $q = SqlQuote($query_branch);
|
||||
if ($query_branchtype eq 'regexp') {
|
||||
$qstring .=
|
||||
" and branches.branch regexp '$q'";
|
||||
" and branches.branch regexp $q";
|
||||
} elsif ($query_branchtype eq 'notregexp') {
|
||||
$qstring .=
|
||||
" and not (branches.branch regexp '$q') ";
|
||||
" and not (branches.branch regexp $q) ";
|
||||
} else {
|
||||
$qstring .=
|
||||
" and (branches.branch = '$q' or branches.branch = 'T$q')";
|
||||
" and (branches.branch = $q or branches.branch = ";
|
||||
$qstring .= SqlQuote("T$query_branch") . ")";
|
||||
}
|
||||
}
|
||||
|
||||
if( $query_file ne '') {
|
||||
my $q = SqlQuote($query_file);
|
||||
if ($query_filetype eq 'regexp') {
|
||||
$qstring .= " and files.file regexp '$q'";
|
||||
$qstring .= " and files.file regexp $q";
|
||||
} else {
|
||||
$qstring .= " and files.file = '$q'";
|
||||
$qstring .= " and files.file = $q";
|
||||
}
|
||||
}
|
||||
if ($query_who ne '') {
|
||||
my $q = SqlQuote($query_who);
|
||||
if ($query_whotype eq 'regexp') {
|
||||
$qstring .= " and people.who regexp '$q'";
|
||||
$qstring .= " and people.who regexp $q";
|
||||
}
|
||||
elsif ($query_whotype eq 'notregexp') {
|
||||
$qstring .= " and not (people.who regexp '$q')";
|
||||
$qstring .= " and not (people.who regexp $q)";
|
||||
|
||||
} else {
|
||||
$qstring .= " and people.who = '$q'";
|
||||
$qstring .= " and people.who = $q";
|
||||
}
|
||||
}
|
||||
|
||||
if ($query_logexpr ne '') {
|
||||
if (defined($query_logexpr) && $query_logexpr ne '') {
|
||||
my $q = SqlQuote($query_logexpr);
|
||||
$qstring .= " and descs.description regexp '$q'";
|
||||
$qstring .= " and descs.description regexp $q";
|
||||
}
|
||||
|
||||
if ($query_debug) {
|
||||
print "<pre wrap> Query: $qstring</PRE>";
|
||||
}
|
||||
|
||||
$query = $db->prepare($qstring) || die $DBD::mysql::db_errstr;
|
||||
$query->execute;
|
||||
SendSQL($qstring);
|
||||
|
||||
$lastlog = 0;
|
||||
while(@row = $query->fetchrow_array) {
|
||||
# print "<pre>";
|
||||
while (@row = FetchSQLData()) {
|
||||
#print "<pre>";
|
||||
$ci = [];
|
||||
for ($i=0 ; $i<=$CI_LOG ; $i++) {
|
||||
$ci->[$i] = $row[$i];
|
||||
# print "$row[$i] ";
|
||||
#print "$row[$i] ";
|
||||
}
|
||||
# print "</pre>";
|
||||
#print "</pre>";
|
||||
|
||||
|
||||
$key = "$ci->[$CI_DIR]/$ci->[$CI_FILE]";
|
||||
|
|
@ -190,10 +175,8 @@ sub query_checkins {
|
|||
next;
|
||||
}
|
||||
|
||||
|
||||
|
||||
if( $have_mod_map &&
|
||||
!&in_module( $mod_map, $ci->[$CI_DIR], $ci->[$CI_FILE] ) ){
|
||||
!&in_module(\%mod_map, $ci->[$CI_DIR], $ci->[$CI_FILE] ) ){
|
||||
next;
|
||||
}
|
||||
|
||||
|
|
@ -213,7 +196,9 @@ sub query_checkins {
|
|||
}
|
||||
}
|
||||
|
||||
if( $query_logexpr ne '' && !($ci->[$CI_LOG] =~ /$query_logexpr/i) ){
|
||||
if (defined($query_logexpr) &&
|
||||
$query_logexpr ne '' &&
|
||||
!($ci->[$CI_LOG] =~ /$query_logexpr/i) ){
|
||||
next;
|
||||
}
|
||||
|
||||
|
|
@ -229,7 +214,7 @@ sub query_checkins {
|
|||
}
|
||||
|
||||
sub load_tag {
|
||||
my $tagname = @_[0];
|
||||
my ($tagname) = @_;
|
||||
|
||||
my $tagfile;
|
||||
my $cvssuffix;
|
||||
|
|
@ -325,8 +310,11 @@ sub find_date_offset {
|
|||
return 0;
|
||||
}
|
||||
$i = 0;
|
||||
while( ($line = <IDX>) && !$done){
|
||||
while(<IDX>) {
|
||||
last if $done;
|
||||
$line = $_;
|
||||
chop($line);
|
||||
|
||||
($o,$d) = split(/\|/,$line);
|
||||
if( $d && $query_date_min > $d ){
|
||||
$done = 1;
|
||||
|
|
@ -350,11 +338,10 @@ sub in_module {
|
|||
#
|
||||
#quick check if it is already in there.
|
||||
#
|
||||
if( $mod_map{$dirname} ){
|
||||
if( $$mod_map{$dirname} ){
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
@path = split(/\//, $dirname);
|
||||
|
||||
$fp = '';
|
||||
|
|
@ -363,7 +350,7 @@ sub in_module {
|
|||
|
||||
$fp .= ($fp ne '' ? '/' : '') . $path[$i];
|
||||
|
||||
if( $local = $mod_map->{$fp} ){
|
||||
if( $local = $$mod_map{$fp} ){
|
||||
if( $local == $IS_LOCAL ){
|
||||
if( $i == (@path-1) ){
|
||||
return 1;
|
||||
|
|
@ -372,14 +359,15 @@ sub in_module {
|
|||
else {
|
||||
# Add directories to the map as we encounter them so we go
|
||||
# faster
|
||||
if( $mod_map{$dirname} == 0 ){
|
||||
$mod_map{$dirname} = $IS_LOCAL;
|
||||
if (!exists($$mod_map{$dirname}) ||
|
||||
$$mod_map{$dirname} == 0) {
|
||||
$$mod_map{$dirname} = $IS_LOCAL;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
if( $mod_map->{ $fp . '/' . $filename} ) {
|
||||
if( $$mod_map{ $fp . '/' . $filename} ) {
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
|
|
@ -389,77 +377,21 @@ sub in_module {
|
|||
|
||||
|
||||
sub get_module_map {
|
||||
local($name) = @_;
|
||||
local($mod_map);
|
||||
$mod_map = {};
|
||||
&build_map( $name, $mod_map );
|
||||
return $mod_map;
|
||||
my ($name) = @_;
|
||||
my ($mod, $onlyone, %modules);
|
||||
|
||||
$onlyone = 0;
|
||||
%modules = ();
|
||||
LoadDirList();
|
||||
for $mod (sort( grep(!/\*$/, @::LegalDirs))) {
|
||||
$modules{$mod} = $NOT_LOCAL;
|
||||
$onlyone = 1 if ($mod eq $name);
|
||||
}
|
||||
|
||||
if ($onlyone) {
|
||||
%modules = ();
|
||||
$modules{$name} = $NOT_LOCAL;
|
||||
}
|
||||
|
||||
return %modules;
|
||||
}
|
||||
|
||||
|
||||
sub parse_modules {
|
||||
while( $l = &get_line ){
|
||||
($mod_name, $flag, @params) = split(/[ \t]+/,$l);
|
||||
|
||||
if ( $#params eq -1 ) {
|
||||
@params = $flag;
|
||||
$flag = "";
|
||||
}
|
||||
elsif( $flag eq '-d' ){
|
||||
($mod_name, $dummy, $dummy, @params) = split(/[ \t]+/,$l);
|
||||
}
|
||||
elsif( $flag ne '-a' ){
|
||||
next;
|
||||
}
|
||||
$modules->{$mod_name} = [@params];
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub build_map {
|
||||
local($name,$mod_map) = @_;
|
||||
local($bFound, $local);
|
||||
|
||||
$local = $NOT_LOCAL;
|
||||
$bFound = 0;
|
||||
|
||||
for $i ( @{$modules->{$name}} ){
|
||||
$bFound = 1;
|
||||
if( $i eq '-l' ){
|
||||
$local = $IS_LOCAL;
|
||||
}
|
||||
elsif( !build_map($i, $mod_map )){
|
||||
$mod_map->{$i} = $local;
|
||||
}
|
||||
}
|
||||
return $bFound;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub get_line {
|
||||
local($l, $save);
|
||||
|
||||
$bContinue = 1;
|
||||
|
||||
while( $bContinue && ($l = <MOD>) ){
|
||||
chop($l);
|
||||
if( $l =~ /^[ \t]*\#/
|
||||
|| $l =~ /^[ \t]*$/ ){
|
||||
$l='';
|
||||
}
|
||||
elsif( $l =~ /\\[ \t]*$/ ){
|
||||
chop ($l);
|
||||
$save .= $l . ' ';
|
||||
}
|
||||
elsif( $l eq '' && $save eq ''){
|
||||
# ignore blank lines
|
||||
}
|
||||
else {
|
||||
$bContinue = 0;
|
||||
}
|
||||
}
|
||||
return $save . $l;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bonsaitools/bin/perl --
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public License
|
||||
|
|
@ -19,26 +19,28 @@
|
|||
|
||||
# Query the CVS database.
|
||||
#
|
||||
require 'lloydcgi.pl';
|
||||
require 'cvsmenu.pl';
|
||||
require 'utils.pl';
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
use vars qw(@LegalDirs);
|
||||
|
||||
$|=1;
|
||||
|
||||
$CVS_ROOT = $form{"cvsroot"};
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
require 'modules.pl';
|
||||
|
||||
|
||||
EmitHtmlHeader("CVS Query Form", $CVS_ROOT);
|
||||
LoadTreeConfig();
|
||||
$CVS_ROOT = $::FORM{'cvsroot'};
|
||||
$CVS_ROOT = pickDefaultRepository() unless $CVS_ROOT;
|
||||
$::TreeID = $::FORM{'module'}
|
||||
if (exists($::TreeInfo{$::FORM{'module'}}{'repository'}));
|
||||
|
||||
PutsHeader("Bonsai - CVS Query Form", "CVS Query Form",
|
||||
"$CVS_ROOT - $::TreeInfo{$::TreeID}{shortdesc}");
|
||||
|
||||
print "
|
||||
<p>
|
||||
<FORM METHOD=GET ACTION='cvsquery.cgi'>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
<p>
|
||||
<TABLE BORDER CELLPADDING=8 CELLSPACING=0>
|
||||
";
|
||||
|
|
@ -63,31 +65,34 @@ $bMultiRepos = (@reposList > 1);
|
|||
#
|
||||
# This code sucks, I should rewrite it to be shorter
|
||||
#
|
||||
if( $form{module} eq 'all' || $form{module} eq '' ){
|
||||
$Module = 'default';
|
||||
if( $::FORM{module} eq 'all' || $::FORM{module} eq '' ){
|
||||
print "<OPTION SELECTED VALUE='all'>All Files in the Repository\n";
|
||||
if( $bMultiRepos ){
|
||||
print "<OPTION VALUE='allrepositories'>All Files in all Repositories\n";
|
||||
}
|
||||
}
|
||||
elsif( $form{module} eq 'allrepositories' ){
|
||||
elsif( $::FORM{module} eq 'allrepositories' ){
|
||||
print "<OPTION VALUE='all'>All Files in the Repository\n";
|
||||
if( $bMultiRepos ){
|
||||
print "<OPTION SELECTED VALUE='allrepositories'>All Files in all Repositories\n";
|
||||
}
|
||||
}
|
||||
else {
|
||||
$Module = $::FORM{module};
|
||||
print "<OPTION VALUE='all'>All Files in the Repository\n";
|
||||
if( $bMultiRepos ){
|
||||
print "<OPTION VALUE='allrepositories'>All Files in all Repositories\n";
|
||||
}
|
||||
print "<OPTION SELECTED VALUE='$form{module}'>$form{module}\n";
|
||||
print "<OPTION SELECTED VALUE='$::FORM{module}'>$::FORM{module}\n";
|
||||
}
|
||||
|
||||
#
|
||||
# Print out all the Different Modules
|
||||
#
|
||||
for $k (sort( keys( %$modules ) ) ){
|
||||
print "<OPTION value='$k'>$k\n";
|
||||
LoadDirList();
|
||||
for $k (sort( grep(!/\*$/, @::LegalDirs) ) ){
|
||||
print "<OPTION value='$k'>$k\n" if ($k ne $Module);
|
||||
}
|
||||
|
||||
print "</SELECT></td>\n";
|
||||
|
|
@ -98,8 +103,8 @@ print "</td></tr>";
|
|||
#
|
||||
# Branch
|
||||
#
|
||||
if( defined $form{branch} ){
|
||||
$b = $form{branch};
|
||||
if( defined $::FORM{branch} ){
|
||||
$b = $::FORM{branch};
|
||||
}
|
||||
else {
|
||||
$b = "HEAD";
|
||||
|
|
@ -119,7 +124,7 @@ print "
|
|||
<tr>
|
||||
<th align=right>Directory:</th>
|
||||
<td colspan=2>
|
||||
<input type=text name=dir value='$form{dir}' size=45><br>
|
||||
<input type=text name=dir value='$::FORM{dir}' size=45><br>
|
||||
(you can list multiple directories)
|
||||
</td>
|
||||
</tr>
|
||||
|
|
@ -129,7 +134,7 @@ print "
|
|||
<tr>
|
||||
<th align=right>File:</th>
|
||||
<td colspan=2>
|
||||
<input type=text name=file value='$form{file}' size=45><br>" .
|
||||
<input type=text name=file value='$::FORM{file}' size=45><br>" .
|
||||
regexpradio('filetype') . "
|
||||
</td>
|
||||
</tr>
|
||||
|
|
@ -142,7 +147,7 @@ regexpradio('filetype') . "
|
|||
print "
|
||||
<tr>
|
||||
<th align=right>Who:</th>
|
||||
<td colspan=2> <input type=text name=who value='$form{who}' size=45><br>" .
|
||||
<td colspan=2> <input type=text name=who value='$::FORM{who}' size=45><br>" .
|
||||
regexpradio('whotype') . "
|
||||
</td>
|
||||
</tr>";
|
||||
|
|
@ -183,10 +188,13 @@ $CVS_REPOS_SUFFIX =~ s:/:_:g;
|
|||
|
||||
$startdate = fetchCachedStartDate($CVS_ROOT);
|
||||
|
||||
if ($form{date} eq "") {
|
||||
$form{date} = "hours";
|
||||
if (!defined($::FORM{date}) || $::FORM{date} eq "") {
|
||||
$::FORM{date} = "hours";
|
||||
}
|
||||
|
||||
$::FORM{mindate} = '' unless defined($::FORM{mindate});
|
||||
$::FORM{maxdate} = '' unless defined($::FORM{maxdate});
|
||||
|
||||
print "
|
||||
<tr>
|
||||
<th align=right valign=top><br>Date:</th>
|
||||
|
|
@ -212,7 +220,7 @@ print "
|
|||
<td><table BORDER=0 CELLPADDING=0 CELLPSPACING=0>
|
||||
<tr>
|
||||
<TD VALIGN=TOP ALIGN=RIGHT NOWRAP>
|
||||
Between <input type=text name=mindate value='$form{mindate}' size=25></td>
|
||||
Between <input type=text name=mindate value='$::FORM{mindate}' size=25></td>
|
||||
<td valign=top rowspan=2>You can use the form
|
||||
<B><TT><NOBR>mm/dd/yy hh:mm:ss</NOBR></TT></B> or a Unix <TT>time_t</TT>
|
||||
(seconds since the Epoch.)
|
||||
|
|
@ -220,7 +228,7 @@ Between <input type=text name=mindate value='$form{mindate}' size=25></td>
|
|||
</tr>
|
||||
<tr>
|
||||
<td VALIGN=TOP ALIGN=RIGHT NOWRAP>
|
||||
and <input type=text name=maxdate '$form{maxdate}' size=25></td>
|
||||
and <input type=text name=maxdate '$::FORM{maxdate}' size=25></td>
|
||||
</tr>
|
||||
</table>
|
||||
</td>
|
||||
|
|
@ -240,19 +248,21 @@ print "
|
|||
</table>
|
||||
</FORM>";
|
||||
|
||||
|
||||
PutsTrailer();
|
||||
|
||||
sub sortTest {
|
||||
if( $_[0] eq $form{sortby} ){
|
||||
return " SELECTED";
|
||||
}
|
||||
else {
|
||||
return "";
|
||||
}
|
||||
return ""
|
||||
unless (exists($::FORM{sortby}) && defined($_[0]) &&
|
||||
($_[0] ne $::FORM{sortby}));
|
||||
|
||||
return " SELECTED";
|
||||
}
|
||||
|
||||
refigureStartDateIfNecessary($CVS_ROOT);
|
||||
|
||||
sub dateTest {
|
||||
if( $_[0] eq $form{date} ){
|
||||
if( $_[0] eq $::FORM{date} ){
|
||||
return " CHECKED value=$_[0]";
|
||||
}
|
||||
else {
|
||||
|
|
@ -261,13 +271,14 @@ sub dateTest {
|
|||
}
|
||||
|
||||
sub regexpradio {
|
||||
my($name) = @_;
|
||||
my $c1,$c2,$c3;
|
||||
my ($name) = @_;
|
||||
my ($c1, $c2, $c3);
|
||||
|
||||
$c1 = $c2 = $c3 = "";
|
||||
if( $form{$name} eq 'regexp'){
|
||||
if( $::FORM{$name} eq 'regexp'){
|
||||
$c2 = "checked";
|
||||
}
|
||||
elsif( $form{$name} eq 'notregexp'){
|
||||
elsif( $::FORM{$name} eq 'notregexp'){
|
||||
$c3 = "checked";
|
||||
}
|
||||
else {
|
||||
|
|
@ -305,12 +316,13 @@ sub refigureStartDateIfNecessary {
|
|||
return;
|
||||
}
|
||||
|
||||
my $db = ConnectToDatabase();
|
||||
ConnectToDatabase();
|
||||
SendSQL("select min(when)
|
||||
from checkins,repositories
|
||||
where repositories.id = repositoryid and
|
||||
repository = '$CVS_ROOT'");
|
||||
|
||||
my $query = $db->prepare( "select min(when) from checkins,repositories where repositories.id = repositoryid and repository = '$CVS_ROOT'") || die $DBD::mysql::db_errstr;
|
||||
|
||||
my @row = $query->fetchrow();
|
||||
my $startdate = $row[0];
|
||||
my $startdate = FetchOneColumn();
|
||||
if ($startdate eq "") {
|
||||
$startdate = "nonexistant";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -45,12 +45,15 @@ if ($bonsaidir eq '') {
|
|||
}
|
||||
|
||||
chdir $bonsaidir || die "Couldn't chdir to $bonsaidir";
|
||||
require 'utils.pl';
|
||||
require 'CGI.pl';
|
||||
|
||||
loadConfigData();
|
||||
$cocommand = Param('cocommand');
|
||||
$rcsdiffcommand = Param('rcsdiffcommand');
|
||||
|
||||
NEXTTREE: foreach $i (@treelist) {
|
||||
$r = $treeinfo{$i}->{'repository'};
|
||||
LoadTreeConfig();
|
||||
|
||||
NEXTTREE: foreach $i (@::TreeList) {
|
||||
$r = $::TreeInfo{$i}->{'repository'};
|
||||
foreach $j (@SRCROOTS) {
|
||||
if ($r eq $j) {
|
||||
next NEXTTREE;
|
||||
|
|
@ -59,9 +62,18 @@ NEXTTREE: foreach $i (@treelist) {
|
|||
push @SRCROOTS, $r;
|
||||
}
|
||||
|
||||
$opt_rev1 = '';
|
||||
$opt_rev2 = '';
|
||||
$opt_root = '';
|
||||
$opt_files = '';
|
||||
$opt_branch = '';
|
||||
$opt_skip = 0;
|
||||
$debug = 0;
|
||||
|
||||
|
||||
$MAX_REVS = 8;
|
||||
|
||||
|
||||
#
|
||||
# Make sure both kinds of standard output go to STDOUT.
|
||||
# XXX dup stdout onto stderr and flush stdout after the following prints
|
||||
|
|
@ -335,7 +347,8 @@ print "Content-type: text/html\n\n";
|
|||
|
||||
$request_method = $ENV{'REQUEST_METHOD'}; # e.g., "GET", "POST", etc.
|
||||
$script_name = $ENV{'SCRIPT_NAME'};
|
||||
$prefix = $script_name . $ENV{PATH_INFO} . '?'; # prefix for HREF= entries
|
||||
$prefix = $script_name . '?'; # prefix for HREF= entries
|
||||
$prefix = $script_name . $ENV{PATH_INFO} . '?' if (exists($ENV{PATH_INFO}));
|
||||
$query_string = $ENV{QUERY_STRING};
|
||||
|
||||
# Undo % URL-encoding
|
||||
|
|
@ -360,7 +373,7 @@ foreach $option (split(/&/, $query_string)) {
|
|||
eval('$opt_' . $1 . '="' . $2 . '";');
|
||||
}
|
||||
|
||||
if( $opt_branch eq 'HEAD' ) { $opt_branch = ''; }
|
||||
if (defined($opt_branch) && $opt_branch eq 'HEAD' ) { $opt_branch = ''; }
|
||||
|
||||
# Configuration colors for diff output.
|
||||
|
||||
|
|
@ -472,14 +485,8 @@ sub do_diff_links {
|
|||
my $diff_base = "cvsview2.cgi";
|
||||
my $blame_base = "cvsblame.cgi";
|
||||
|
||||
# total kludge!! lxr omits the top-level "mozilla" directory...
|
||||
my $lxr_path = "$opt_subdir/$opt_file";
|
||||
if ($mozilla_lxr_kludge eq 'TRUE') {
|
||||
$lxr_path =~ s@^ns/@@;
|
||||
$lxr_path =~ s@^mozilla/@@;
|
||||
}
|
||||
|
||||
my $lxr_link = "$lxr_base/$lxr_path";
|
||||
my $lxr_link = Fix_LxrLink($lxr_path);
|
||||
my $blame_link = "$blame_base?root=$CVS_ROOT\&file=$opt_subdir/$opt_file";
|
||||
my $diff_link = "$magic_url&command=DIRECTORY&file=$opt_file&rev1=$opt_rev1&rev2=$opt_rev2";
|
||||
$diff_link .= "&root=$opt_root" if defined($opt_root);
|
||||
|
|
@ -645,7 +652,7 @@ sub do_directory {
|
|||
}
|
||||
$output .= "</DIV>";
|
||||
|
||||
EmitHtmlHeader("CVS Differences", $output);
|
||||
PutsHeader("CVS Differences", $output);
|
||||
|
||||
CheckHidden($dir);
|
||||
chdir($dir);
|
||||
|
|
@ -659,14 +666,8 @@ sub do_directory {
|
|||
$path = "$dir/Attic/$file,v" if (! -r $path);
|
||||
&parse_rcs_file($path);
|
||||
|
||||
# total kludge!! lxr omits the top-level "mozilla" directory...
|
||||
my $lxr_path = "$opt_subdir/$file";
|
||||
if (mozilla_lxr_kludge) {
|
||||
$lxr_path =~ s@^ns/@@;
|
||||
$lxr_path =~ s@^mozilla/@@;
|
||||
}
|
||||
|
||||
my $lxr_link = "$lxr_base/$lxr_path";
|
||||
my $lxr_link = Fix_LxrLink($lxr_path);
|
||||
|
||||
print "<TR><TD NOWRAP><B>";
|
||||
print "<A HREF=\"$lxr_link\">$file</A><BR>";
|
||||
|
|
@ -948,13 +949,15 @@ sub print_row {
|
|||
}
|
||||
|
||||
sub print_bottom {
|
||||
print <<__BOTTOM__;
|
||||
my $maintainer = Param('maintainer');
|
||||
|
||||
print <<__BOTTOM__;
|
||||
<P>
|
||||
<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0><TR><TD>
|
||||
<HR>
|
||||
<TR><TD>
|
||||
<FONT SIZE=-1>
|
||||
Mail feedback and feature requests to <A HREF="mailto:slamm\@netscape.com?subject=About the cvs differences script">slamm</A>.
|
||||
Mail feedback and feature requests to <A HREF="mailto:$maintainer?subject=About the cvs differences script">$maintainer</A>.
|
||||
</TABLE>
|
||||
</BODY>
|
||||
</HTML>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,305 @@
|
|||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla 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/MPL/
|
||||
#
|
||||
# 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 Bug Tracking System.
|
||||
#
|
||||
# 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): Terry Weissman <terry@mozilla.org>
|
||||
|
||||
|
||||
# This file defines all the parameters that we have a GUI to edit within
|
||||
# Bonsai.
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
|
||||
sub WriteParams {
|
||||
foreach my $i (@::param_list) {
|
||||
if (!defined $::param{$i}) {
|
||||
$::param{$i} = $::param_default{$i};
|
||||
if (!defined $::param{$i}) {
|
||||
die "No default parameter ever specified for $i";
|
||||
}
|
||||
}
|
||||
}
|
||||
mkdir("data", 0777);
|
||||
chmod 0777, "data";
|
||||
my $tmpname = "data/params.$$";
|
||||
open(PARAM_FID, ">$tmpname") || die "Can't create $tmpname";
|
||||
my $v = $::param{'version'};
|
||||
delete $::param{'version'}; # Don't write the version number out to
|
||||
# the params file.
|
||||
print PARAM_FID GenerateCode('%::param');
|
||||
$::param{'version'} = $v;
|
||||
print PARAM_FID "1;\n";
|
||||
close PARAM_FID;
|
||||
rename $tmpname, "data/params" || die "Can't rename $tmpname to data/params";
|
||||
chmod 0666, "data/params";
|
||||
}
|
||||
|
||||
|
||||
sub DefParam {
|
||||
my ($id, $desc, $type, $default, $checker) = (@_);
|
||||
push @::param_list, $id;
|
||||
$::param_desc{$id} = $desc;
|
||||
$::param_type{$id} = $type;
|
||||
$::param_default{$id} = $default;
|
||||
if (defined $checker) {
|
||||
$::param_checker{$id} = $checker;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub check_numeric {
|
||||
my ($value) = (@_);
|
||||
if ($value !~ /^[0-9]+$/) {
|
||||
return "must be a numeric value";
|
||||
}
|
||||
return "";
|
||||
}
|
||||
|
||||
|
||||
sub check_urlbase {
|
||||
my ($url) = (@_);
|
||||
if ($url !~ m:^(http|/).*/$:) {
|
||||
return "must be a legal URL, that starts with either 'http' or a slash, and ends with a slash.";
|
||||
}
|
||||
return "";
|
||||
}
|
||||
|
||||
|
||||
@::param_list = ();
|
||||
|
||||
|
||||
|
||||
# OK, here are the definitions themselves.
|
||||
#
|
||||
# The type of parameters (the third parameter to DefParam) can be one
|
||||
# of the following:
|
||||
#
|
||||
# t -- A short text entry field (suitable for a single line)
|
||||
# l -- A long text field (suitable for many lines)
|
||||
# b -- A boolean value (either 1 or 0)
|
||||
# i -- An integer.
|
||||
# defenum -- This param defines an enum that defines a column in one of
|
||||
# the database tables. The name of the parameter is of the form
|
||||
# "tablename.columnname".
|
||||
|
||||
DefParam("maintainer",
|
||||
"The email address of the person who maintains this installation of Bonsai.",
|
||||
"t",
|
||||
'THE MAINTAINER HAS NOT YET BEEN SET');
|
||||
|
||||
DefParam("userdomain",
|
||||
"The default domain of the people who don't have an \@ in their email address.",
|
||||
"t",
|
||||
"");
|
||||
|
||||
DefParam("urlbase",
|
||||
"The URL that is the common initial leading part of all Bonsai URLs.",
|
||||
"t",
|
||||
"http://www.mozilla.org/webtools/bonsai/",
|
||||
\&check_urlbase);
|
||||
|
||||
DefParam("toplevel",
|
||||
"What is the top level of bonsai called. Links to
|
||||
the toplevel.cgi script will be named this.",
|
||||
"t",
|
||||
"hooklist");
|
||||
|
||||
DefParam("cvsadmin",
|
||||
"The email address of the person responsible for cvs.",
|
||||
"t",
|
||||
'%maintainer%');
|
||||
|
||||
DefParam("mysqluser",
|
||||
"The username of the bonsai database user.",
|
||||
"t",
|
||||
"nobody");
|
||||
|
||||
DefParam("mysqlpassword",
|
||||
"The password of the bonsai database user.",
|
||||
"t",
|
||||
"");
|
||||
|
||||
DefParam("readonly",
|
||||
"Are the hook files readonly. (This value gets changed on the fly,
|
||||
so it is ok to leave the way it is.)",
|
||||
"b",
|
||||
0);
|
||||
|
||||
|
||||
##
|
||||
## Page configuration (look and feel)
|
||||
##
|
||||
DefParam("headerhtml",
|
||||
"Additional HTML to add to the HEAD area of documents, eg. links to stylesheets.",
|
||||
"l",
|
||||
'');
|
||||
|
||||
|
||||
DefParam("bannerhtml",
|
||||
"The html that gets emitted at the head of every Bonsai page.
|
||||
Anything of the form %<i>word</i>% gets replaced by the defintion of that
|
||||
word (as defined on this page).",
|
||||
"l",
|
||||
q{<TABLE BGCOLOR="#FFFFFF" WIDTH="100%" BORDER=0 CELLPADDING=0 CELLSPACING=0>
|
||||
<TR><TD><!-- insert imagery here --></TD></TR></TABLE>
|
||||
<CENTER><FONT SIZE=-1>Bonsai version %version%
|
||||
</FONT></CENTER>});
|
||||
|
||||
DefParam("blurbhtml",
|
||||
"A blurb that appears as part of the header of every Bonsai page. This is a place to put brief warnings, pointers to one or two related pages, etc.",
|
||||
"l",
|
||||
|
||||
"This is <B>Bonsai</B>: a query interface to the CVS source repository");
|
||||
|
||||
|
||||
|
||||
##
|
||||
## Command addresses/locations
|
||||
##
|
||||
DefParam("mailrelay",
|
||||
"This is the default mail relay (SMTP Server) that we use to transmit email messages.",
|
||||
"t",
|
||||
'localhost');
|
||||
|
||||
DefParam("cvscommand",
|
||||
"This is the location of the CVS command.",
|
||||
"t",
|
||||
'/usr/bin/cvs');
|
||||
|
||||
DefParam("rlogcommand",
|
||||
"This is the location of the rlog command.",
|
||||
"t",
|
||||
'/usr/bin/rlog');
|
||||
|
||||
DefParam("rcsdiffcommand",
|
||||
"This is the location of the rcsdiff command.",
|
||||
"t",
|
||||
'/usr/bin/rcsdiff');
|
||||
|
||||
DefParam("cocommand",
|
||||
"This is the location of the RCS co command.",
|
||||
"t",
|
||||
'/usr/bin/co');
|
||||
|
||||
|
||||
##
|
||||
## Things that we link to on the fly
|
||||
##
|
||||
DefParam("lxr_base",
|
||||
"The URL that is the common initial leading part of all LXR URLs.",
|
||||
"t",
|
||||
"http://lxr.mozilla.org/",
|
||||
\&check_urlbase);
|
||||
|
||||
DefParam("bugs_base",
|
||||
"The URL that is the common initial leading part of all Bugzilla URLs.",
|
||||
"t",
|
||||
"http://bugzilla.mozilla.org/",
|
||||
\&check_urlbase);
|
||||
|
||||
DefParam("bugsmatch",
|
||||
'Bugsmatch defines the number of consecutive digits that identify a bug to link to.',
|
||||
't',
|
||||
2);
|
||||
|
||||
DefParam("bugsystemexpr",
|
||||
'Bugsystemexpr defines what to replace a number found in log
|
||||
messages with. It is used to generate an HTML reference to
|
||||
the bug database in the displayed text. The number of the
|
||||
bug found can be inserted using the %bug_id% substition.',
|
||||
"t",
|
||||
'<A HREF="%bugs_base%show_bug.cgi?id=%bug_id%">%bug_id%</A>');
|
||||
|
||||
|
||||
##
|
||||
## Email Addresses that get sent messages automatically when certain
|
||||
## events happen
|
||||
##
|
||||
DefParam("bonsai-hookinterest",
|
||||
"The email address of the build team interested in the status of the hook.",
|
||||
"t",
|
||||
"bonsai-hookinterest");
|
||||
|
||||
DefParam("bonsai-daemon",
|
||||
"The email address of the sender of Bonsai related mail.",
|
||||
"t",
|
||||
"bonsai-daemon");
|
||||
|
||||
DefParam("bonsai-messageinterest",
|
||||
"The email address of those interested in the status of Bonsai itself.",
|
||||
"t",
|
||||
"bonsai-messageinterest");
|
||||
|
||||
DefParam("bonsai-treeinterest",
|
||||
"The email address of those interested in the status of development trees.",
|
||||
"t",
|
||||
"bonsai-treeinterest");
|
||||
|
||||
DefParam("software",
|
||||
"The email address list of those doing development on the trees.",
|
||||
"t",
|
||||
"software");
|
||||
|
||||
|
||||
##
|
||||
## LDAP configuration
|
||||
##
|
||||
DefParam("ldapserver",
|
||||
"The address ofthe LDAP server containing name information,
|
||||
leave blank if you don't have an LDAP server.",
|
||||
"t",
|
||||
'');
|
||||
|
||||
DefParam("ldapport",
|
||||
"The port of the LDAP server.",
|
||||
"t",
|
||||
389);
|
||||
|
||||
|
||||
##
|
||||
## Other URLs
|
||||
##
|
||||
DefParam("tinderboxbase",
|
||||
"The base URL of the tinderbox build pages. Leave blank if
|
||||
you don't want to use tinderbox.",
|
||||
"t",
|
||||
"");
|
||||
|
||||
DefParam("other_ref_urls",
|
||||
"A list of pointers to other documentation, displayed on main bonsai menu",
|
||||
"l",
|
||||
'<a href=http://www.mozilla.org/hacking/bonsai.html>Mozilla\'s Introduction to Bonsai.</a><br>');
|
||||
|
||||
|
||||
DefParam("phonebookurl",
|
||||
'A URL used to generate lookups for usernames. The following
|
||||
parameters are substituted: %user_name% for the user\'s name
|
||||
in bonsai; %email_name% for the user\'s email address; and
|
||||
%account_name% for the user\'s account name on their email
|
||||
system (ie account_name@some.domain).',
|
||||
"t",
|
||||
# '<a href="http://phonebook/ds/dosearch/phonebook/uid=%account_name%,ou=People,o= Netscape Communications Corp.,c=US">%user_name%</a>'
|
||||
'<a href="mailto:%email_name%">%user_name%</a>'
|
||||
);
|
||||
|
||||
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -18,114 +18,145 @@
|
|||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
|
||||
source CGI.tcl
|
||||
source adminfuncs.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
puts "Content-type: text/html
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
"
|
||||
CheckPassword(FormData('password'));
|
||||
|
||||
CheckPassword $FORM(password)
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
|
||||
Lock
|
||||
LoadCheckins
|
||||
$cmd = FormData('command');
|
||||
|
||||
if ($cmd eq 'close') {
|
||||
close_tree();
|
||||
} elsif ($cmd eq 'open') {
|
||||
open_tree();
|
||||
} elsif ($cmd eq 'tweaktimes') {
|
||||
edit_tree();
|
||||
} elsif ($cmd eq 'editmotd') {
|
||||
edit_motd();
|
||||
} elsif ($cmd eq 'changepassword') {
|
||||
change_passwd();
|
||||
} else {
|
||||
error_screen('Invalid Command',
|
||||
"<b>Invalid Command '<tt>$cmd</tt>'</b>");
|
||||
}
|
||||
|
||||
PutsTrailer();
|
||||
WriteCheckins();
|
||||
Unlock();
|
||||
exit 0;
|
||||
|
||||
|
||||
|
||||
switch -exact -- $FORM(command) {
|
||||
close {
|
||||
AdminCloseTree [ParseTimeAndCheck [FormData closetimestamp]]
|
||||
sub error_screen {
|
||||
my ($title, $err_str) = @_;
|
||||
|
||||
puts "
|
||||
<TITLE>Clang!</TITLE>
|
||||
<H1>The tree is now closed.</H1>
|
||||
Mail has been sent notifying \"the hook\" and anyone subscribed to
|
||||
bonsai-treeinterest.
|
||||
<P>
|
||||
<a href=\"mailto:clienteng?subject=The tree is now closed.\">Click here</a>
|
||||
to send e-mail about it to clienteng.
|
||||
"
|
||||
PutsHeader($title);
|
||||
print "\n<hr>\n$err_str\n\n";
|
||||
PutsTrailer();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
}
|
||||
open {
|
||||
AdminOpenTree [ParseTimeAndCheck [FormData lastgood]] \
|
||||
[info exists FORM(doclear)]
|
||||
puts "
|
||||
<TITLE>The floodgates are open.</TITLE>
|
||||
<H1>The tree is now open.</H1>
|
||||
Mail has been sent notifying \"the hook\" and anyone subscribed to
|
||||
bonsai-treeinterest.
|
||||
<a href=\"mailto:clienteng?subject=The tree is now opened.\">Click here</a>
|
||||
to send e-mail about it to clienteng.
|
||||
"
|
||||
}
|
||||
tweaktimes {
|
||||
set lastgoodtimestamp [ParseTimeAndCheck [FormData lastgood]]
|
||||
set closetimestamp [ParseTimeAndCheck [FormData lastclose]]
|
||||
puts "
|
||||
<TITLE>Let's do the time warp again...</TITLE>
|
||||
<H1>Times have been tweaked.</H1>
|
||||
"
|
||||
Log "Times tweaked: lastgood is [MyFmtClock $lastgoodtimestamp], closetime is [MyFmtClock $closetimestamp]"
|
||||
}
|
||||
editmotd {
|
||||
LoadMOTD
|
||||
if {![cequal [FormData origmotd] $motd]} {
|
||||
puts "
|
||||
<TITLE>Oops!</TITLE>
|
||||
<H1>Someone else has been here!</H1>
|
||||
|
||||
sub close_tree {
|
||||
my $sw = Param("software", 1);
|
||||
my $ti = Param("bonsai-treeinterest", 1);
|
||||
my $href = ConstructMailTo(EmailFromUsername($sw),
|
||||
"The tree is now closed.");
|
||||
|
||||
AdminCloseTree(ParseTimeAndCheck(FormData('closetimestamp')));
|
||||
|
||||
PutsHeader("Clang!", "Clang!", "The tree is now closed.");
|
||||
print "
|
||||
Mail has been sent notifying \"the hook\" and anyone subscribed to $ti.<p>
|
||||
|
||||
$href about the closure.<p>
|
||||
";
|
||||
}
|
||||
|
||||
sub open_tree {
|
||||
my $sw = Param("software", 1);
|
||||
my $ti = Param("bonsai-treeinterest", 1);
|
||||
my $href = ConstructMailTo(EmailFromUsername($sw),
|
||||
"The tree is now open.");
|
||||
|
||||
AdminOpenTree(ParseTimeAndCheck(FormData('lastgood')),
|
||||
exists($::FORM{'doclear'}));
|
||||
|
||||
PutsHeader("The floodgates are open.", "The floodgates are open.");
|
||||
print "
|
||||
Mail has been sent notifying \"the hook\" and anyone subscribed to $ti.<p>
|
||||
|
||||
$href about the new status of the tree.<p>
|
||||
";
|
||||
}
|
||||
|
||||
sub edit_tree {
|
||||
$::LastGoodTimeStamp = ParseTimeAndCheck(FormData('lastgood'));
|
||||
$::CloseTimeStamp = ParseTimeAndCheck(FormData('lastclose'));
|
||||
|
||||
PutsHeader("Let's do the time warp again...",
|
||||
"Times have been tweaked.");
|
||||
|
||||
Log("Times tweaked: \$::LastGoodTimeStamp is " .
|
||||
MyFmtClock($::LastGoodTimeStamp) .
|
||||
", closetime is " .
|
||||
MyFmtClock($::CloseTimeStamp));
|
||||
}
|
||||
|
||||
|
||||
sub edit_motd {
|
||||
LoadMOTD();
|
||||
|
||||
unless (FormData('origmotd') eq $::MOTD) {
|
||||
error_screen("Oops!",
|
||||
"<H1>Someone else has been here!</H1>
|
||||
|
||||
It looks like somebody else has changed the message-of-the-day.
|
||||
Terry was too lazy to implement anything beyond detecting this
|
||||
condition. You'd best go start over -- go back to the top of Bonsai,
|
||||
look at the current message-of-the-day, and decide if you still
|
||||
want to make your edits."
|
||||
PutsTrailer
|
||||
exit
|
||||
}
|
||||
want to make your edits.");
|
||||
}
|
||||
|
||||
MailDiffs "message-of-the-day" $motd [FormData motd]
|
||||
set motd [FormData motd]
|
||||
puts "
|
||||
<TITLE>New MOTD</TITLE>
|
||||
<H1>The message-of-the-day has been changed.</H1>
|
||||
"
|
||||
WriteMOTD
|
||||
Log "New motd: $motd"
|
||||
}
|
||||
changepassword {
|
||||
if {![cequal $FORM(newpassword) $FORM(newpassword2)]} {
|
||||
puts "
|
||||
<TITLE>Oops!</TITLE>
|
||||
<H1>Mismatch!</H1>
|
||||
The two passwords you typed didn't match. Click <b>Back</b> and try again."
|
||||
PutsTrailer
|
||||
exit
|
||||
}
|
||||
if {$FORM(doglobal)} {
|
||||
CheckGlobalPassword $FORM(password)
|
||||
set outfile data/passwd
|
||||
} else {
|
||||
set outfile "[DataDir]/treepasswd"
|
||||
}
|
||||
set encoded [string trim [exec ./data/trapdoor $FORM(newpassword)]]
|
||||
set fid [open $outfile "w"]
|
||||
puts $fid $encoded
|
||||
close $fid
|
||||
catch {chmod 0777 $outfile}
|
||||
puts "
|
||||
<TITLE>Locksmithing complete.</TITLE>
|
||||
<H1>Password changed.</H1>
|
||||
The new password is now in effect."
|
||||
PutsTrailer
|
||||
exit
|
||||
}
|
||||
MailDiffs("message-of-the-day", $::MOTD, FormData('motd'));
|
||||
$::MOTD = FormData('motd');
|
||||
PutsHeader("New MOTD", "New MOTD",
|
||||
"The Message Of The Day has been changed.");
|
||||
WriteMOTD();
|
||||
Log("New motd: $::MOTD");
|
||||
}
|
||||
|
||||
sub change_passwd {
|
||||
my ($outfile, $encoded);
|
||||
local *PASSWD;
|
||||
|
||||
PutsTrailer
|
||||
unless (FormData('newpassword') eq FormData('newpassword2')) {
|
||||
error_screen("Oops -- Mismatch!",
|
||||
"The two passwords you typed didn't match. Click <b>Back</b> and try again.");
|
||||
}
|
||||
|
||||
WriteCheckins
|
||||
Unlock
|
||||
if ($::FORM{'doglobal'}) {
|
||||
CheckGlobalPassword($::FORM{'password'});
|
||||
$outfile = 'data/passwd';
|
||||
} else {
|
||||
$outfile = DataDir() . '/treepasswd';
|
||||
}
|
||||
|
||||
exit
|
||||
$encoded = trim(`./data/trapdoor $::FORM{'newpassword'}`);
|
||||
unless (open(PASSWD, ">$outfile")) {
|
||||
error_screen("Oops -- Couldn't write password file!",
|
||||
"Couldn't open `<tt>$outfile</tt>': $!.");
|
||||
}
|
||||
print PASSWD "$encoded\n";
|
||||
close(PASSWD);
|
||||
chmod(0777, $outfile);
|
||||
|
||||
PutsHeader('Locksmithing complete.', 'Password Changed.',
|
||||
'The new password is now in effect.');
|
||||
PutsTrailer();
|
||||
exit 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,41 +17,41 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
puts "Content-type: text/html
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>"
|
||||
<HTML>";
|
||||
|
||||
CheckPassword $FORM(password)
|
||||
CheckPassword($::FORM{'password'});
|
||||
|
||||
Lock
|
||||
LoadCheckins
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
|
||||
set busted 0
|
||||
my $busted = 0;
|
||||
|
||||
if {![info exists $FORM(id)]} {
|
||||
my $info;
|
||||
|
||||
if (!exists $::FORM{'id'}) {
|
||||
set busted 1
|
||||
} else {
|
||||
|
||||
upvar #0 $FORM(id) info
|
||||
$info = eval("\\%" . $::FORM{'id'});
|
||||
|
||||
if {![info exists info(notes)]} {
|
||||
set info(notes) ""
|
||||
if (!exists $info{'notes'}) {
|
||||
$info{'notes'} = "";
|
||||
}
|
||||
|
||||
foreach i [lsort [array names info]] {
|
||||
if {![cequal [FormData "orig$i"] $info($i)]} {
|
||||
set busted 1
|
||||
set text "Key $i -- orig is [FormData "orig$i"], new is $info($i)"
|
||||
break
|
||||
foreach $i (sort(keys(%$info))) {
|
||||
if (FormData("orig$i") ne $info->{$i}) {
|
||||
$busted = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if {$busted} {
|
||||
Unlock
|
||||
puts "
|
||||
if ($busted) {
|
||||
Unlock();
|
||||
print "
|
||||
<TITLE>Oops!</TITLE>
|
||||
<H1>Someone else has been here!</H1>
|
||||
|
||||
|
|
@ -59,45 +59,33 @@ It looks like somebody else has changed or deleted this checkin.
|
|||
Terry was too lazy to implement anything beyond detecting this
|
||||
condition. You'd best go start over -- go back to the list of
|
||||
checkins, look for this checkin again, and decide if you still want to
|
||||
make your edits."
|
||||
make your edits.";
|
||||
|
||||
PutsTrailer
|
||||
exit
|
||||
PutsTrailer();
|
||||
exit();
|
||||
}
|
||||
|
||||
proc ParseTimeAndCheck {timestr} {
|
||||
if {[catch {set result [convertclock $timestr]}]} {
|
||||
puts "
|
||||
<TITLE>Time trap</TITLE>
|
||||
<H1>Can't grok the time</H1>
|
||||
You entered a time of <tt>$timestr</tt>, and I can't understand it. Please
|
||||
hit <B>Back</B> and try again."
|
||||
exit
|
||||
}
|
||||
return $result
|
||||
}
|
||||
|
||||
if {[info exists FORM(nukeit)]} {
|
||||
Log "A checkin for $info(person) has been nuked."
|
||||
if (exists $::FORM{'nukeit'}) {
|
||||
Log("A checkin for $info->{person} has been nuked.");
|
||||
} else {
|
||||
Log "A checkin for $info(person) has been modified."
|
||||
Log("A checkin for $info->{person} has been modified.");
|
||||
}
|
||||
|
||||
set info(date) [ParseTimeAndCheck [FormData datestring]]
|
||||
foreach i {person dir files notes treeopen log} {
|
||||
set info($i) [FormData $i]
|
||||
$info->{date} = ParseTimeAndCheck(FormData('datestring'));
|
||||
foreach my $i ('person', 'dir', 'files', 'notes', 'treeopen', 'log') {
|
||||
$info->{$i} = FormData($i);
|
||||
}
|
||||
|
||||
if {[info exists FORM(nukeit)]} {
|
||||
set w [lsearch -exact $checkinlist $FORM(id)]
|
||||
if {$w >= 0} {
|
||||
set checkinlist [lreplace $checkinlist $w $w]
|
||||
if (exists $::FORM{'nukeit'}) {
|
||||
my $w = lsearch(\@::CheckInList, $::FORM{'id'});
|
||||
if ($w >= 0) {
|
||||
splice(@::CheckInList, $w, 1);
|
||||
}
|
||||
}
|
||||
|
||||
WriteCheckins
|
||||
WriteCheckins();
|
||||
|
||||
puts "OK, the checkin has been changed."
|
||||
print "OK, the checkin has been changed.";
|
||||
|
||||
PutsTrailer();
|
||||
|
||||
PutsTrailer
|
||||
exit
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,58 +17,42 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
puts "Content-type: text/html
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
"
|
||||
CheckPassword(FormData('password'));
|
||||
my $Filename = FormData('msgname');
|
||||
my $RealFilename = DataDir() . "/$Filename";
|
||||
Lock();
|
||||
|
||||
CheckPassword $FORM(password)
|
||||
|
||||
|
||||
set filename $FORM(msgname)
|
||||
|
||||
set fullfilename [DataDir]/$filename
|
||||
|
||||
Lock
|
||||
|
||||
if {[file exists $fullfilename]} {
|
||||
set text [read_file $fullfilename]
|
||||
} else {
|
||||
set text {}
|
||||
}
|
||||
|
||||
if {![cequal [FormData origtext] $text]} {
|
||||
puts "
|
||||
<TITLE>Oops!</TITLE>
|
||||
<H1>Someone else has been here!</H1>
|
||||
my $Text = '';
|
||||
$Text = `cat $RealFilename` if -f $RealFilename;
|
||||
|
||||
unless (FormData('origtext') eq $Text) {
|
||||
PutsHeader("Oops!", "Oops!", "Someone else has been here!");
|
||||
print "
|
||||
It looks like somebody else has changed this message while you were editing it.
|
||||
Terry was too lazy to implement anything beyond detecting this
|
||||
condition. You'd best go start over -- go back to the top of Bonsai,
|
||||
work your way back to editing the message, and decide if you still
|
||||
want to make your edits."
|
||||
PutsTrailer
|
||||
exit
|
||||
want to make your edits.";
|
||||
|
||||
PutsTrailer();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
$Text = FormData('text');
|
||||
open(FILE, "> $RealFilename")
|
||||
or warn "Unable to open: $RealFilename: $!\n";
|
||||
print FILE $Text;
|
||||
chmod(0666, $RealFilename);
|
||||
close(FILE);
|
||||
Log("$RealFilename set to $text");
|
||||
Unlock();
|
||||
|
||||
set text [FormData text]
|
||||
set fid [open $fullfilename "w"]
|
||||
puts $fid $text
|
||||
catch {chmod 0666 $fullfilename }
|
||||
close $fid
|
||||
|
||||
|
||||
Log "$filename set to $text"
|
||||
|
||||
Unlock
|
||||
|
||||
puts "
|
||||
<TITLE>New $filename</TITLE>
|
||||
<H1>The file <b>$filename</b> has been changed.</H1>
|
||||
"
|
||||
|
||||
PutsTrailer
|
||||
|
||||
exit
|
||||
LoadTreeConfig();
|
||||
PutsHeader("New $Filename", "New $Filename",
|
||||
"$Filename - $::TreeInfo{$::TreeID}{shortdesc}");
|
||||
print "The file <b>$filename</b> has been changed.";
|
||||
PutsTrailer();
|
||||
|
|
|
|||
|
|
@ -0,0 +1,67 @@
|
|||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla 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/MPL/
|
||||
#
|
||||
# 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 Bugzilla Bug Tracking System.
|
||||
#
|
||||
# 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): Terry Weissman <terry@mozilla.org>
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
require "CGI.pl";
|
||||
require "defparams.pl";
|
||||
|
||||
# Shut up misguided -w warnings about "used only once":
|
||||
use vars %::param,
|
||||
%::param_default,
|
||||
@::param_list;
|
||||
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
CheckPassword(FormData('password'));
|
||||
|
||||
PutsHeader("Saving new parameters");
|
||||
|
||||
foreach my $i (@::param_list) {
|
||||
# print "Processing $i...<BR>\n";
|
||||
if (exists $::FORM{"reset-$i"}) {
|
||||
$::FORM{$i} = $::param_default{$i};
|
||||
}
|
||||
$::FORM{$i} =~ s/\r\n/\n/; # Get rid of windows-style line endings.
|
||||
if ($::FORM{$i} ne Param($i)) {
|
||||
if (defined $::param_checker{$i}) {
|
||||
my $ref = $::param_checker{$i};
|
||||
my $ok = &$ref($::FORM{$i});
|
||||
if ($ok ne "") {
|
||||
print "New value for $i is invalid: $ok<p>\n";
|
||||
print "Please hit <b>Back</b> and try again.\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
print "Changed $i.<br>\n";
|
||||
$::param{$i} = $::FORM{$i}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
WriteParams();
|
||||
|
||||
print "OK, done.<p>\n";
|
||||
print "<a href=editparams.cgi>Edit the params some more.</a><p>\n";
|
||||
print "<a href=index.html>Go back to the top.</a>\n";
|
||||
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,18 +17,17 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
Lock
|
||||
LoadWhiteboard
|
||||
Lock();
|
||||
LoadWhiteboard();
|
||||
|
||||
set oldvalue [FormData origwhite]
|
||||
|
||||
|
||||
if {![cequal $oldvalue $whiteboard]} {
|
||||
Unlock
|
||||
puts "Content-type: text/html
|
||||
my $oldvalue = FormData('origwhite');
|
||||
unless ($oldvalue eq $::WhiteBoard) {
|
||||
Unlock();
|
||||
|
||||
print "
|
||||
<TITLE>Error -- pen stolen.</TITLE>
|
||||
<H1>Someone else just changed the whiteboard.</H1>
|
||||
|
||||
|
|
@ -37,48 +36,41 @@ stomp over theirs.
|
|||
<P>
|
||||
The whiteboard now reads:
|
||||
<hr>
|
||||
<PRE VARIABLE>$whiteboard</PRE>
|
||||
<PRE VARIABLE>$::WhiteBoard</PRE>
|
||||
<hr>
|
||||
If you really want to change the whiteboard to your text, click the button
|
||||
below. Or maybe you want to tweak your text first. Or you can forget it and
|
||||
go back to the beginning.
|
||||
|
||||
<FORM method=get action=\"doeditwhiteboard.cgi\">
|
||||
<INPUT TYPE=HIDDEN NAME=origwhite VALUE=\"[value_quote $whiteboard]\">
|
||||
<INPUT TYPE=HIDDEN NAME=origwhite VALUE=\"" . value_quote($::WhiteBoard). "\">
|
||||
|
||||
Change the free-for-all whiteboard:<br>
|
||||
<TEXTAREA NAME=whiteboard ROWS=10 COLS=70>[FormData whiteboard]</TEXTAREA><BR>
|
||||
<TEXTAREA NAME=whiteboard ROWS=10 COLS=70>" . FormData('whiteboard') .
|
||||
"</TEXTAREA><BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Change the Whiteboard\">
|
||||
</FORM>
|
||||
"
|
||||
PutsTrailer
|
||||
exit
|
||||
";
|
||||
PutsTrailer();
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
set newwhiteboard [string trimright [FormData whiteboard]]
|
||||
my $newwhiteboard = trim(FormData('whiteboard'));
|
||||
|
||||
MailDiffs "whiteboard" $whiteboard $newwhiteboard
|
||||
MailDiffs("whiteboard", $whiteboard, $newwhiteboard);
|
||||
|
||||
set whiteboard $newwhiteboard
|
||||
WriteWhiteboard
|
||||
$::WhiteBoard = $newwhiteboard;
|
||||
WriteWhiteboard();
|
||||
Unlock();
|
||||
|
||||
Unlock
|
||||
|
||||
puts "Content-type: text/html
|
||||
|
||||
<TITLE>Where's my blue marker?</TITLE>
|
||||
print "<TITLE>Where's my blue marker?</TITLE>
|
||||
<H1>The whiteboard has been changed.</H1>
|
||||
The whiteboard now reads:
|
||||
<hr>
|
||||
<PRE VARIABLE>$whiteboard</PRE>
|
||||
"
|
||||
<PRE VARIABLE>$::WhiteBoard</PRE>
|
||||
";
|
||||
|
||||
|
||||
|
||||
|
||||
Log "Whiteboard changed to be: $whiteboard"
|
||||
|
||||
PutsTrailer
|
||||
|
||||
exit
|
||||
Log("Whiteboard changed to be: $::WhiteBoard");
|
||||
PutsTrailer();
|
||||
exit;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,105 +17,111 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
puts "Content-type: text/html
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>"
|
||||
<HTML>";
|
||||
|
||||
CheckPassword $FORM(password)
|
||||
CheckPassword($::FORM{'password'});
|
||||
|
||||
Lock
|
||||
LoadCheckins
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
|
||||
if {![info exists FORM(command)]} {
|
||||
set FORM(command) nocommand
|
||||
if (!exists $::FORM{'command'}) {
|
||||
$::FORM{'command'} = 'nocommand';
|
||||
}
|
||||
|
||||
|
||||
set list {}
|
||||
my @list;
|
||||
|
||||
foreach i [array names FORM] {
|
||||
switch -glob -- $i {
|
||||
{checkin-*} {
|
||||
if {[lsearch -exact $checkinlist $i] >= 0} {
|
||||
lappend list $i
|
||||
}
|
||||
foreach my $i (keys %::FORM) {
|
||||
my $j = url_decode($i);
|
||||
if ($j =~ m/^\:\:checkin_/) {
|
||||
if (lsearch(\@::CheckInList, $j) >= 0) {
|
||||
push(@list, $j);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
set origtree $treeid
|
||||
my $origtree = $::TreeID;
|
||||
|
||||
switch -exact -- $FORM(command) {
|
||||
nuke {
|
||||
foreach i $list {
|
||||
set w [lsearch -exact $checkinlist $i]
|
||||
if {$w >= 0} {
|
||||
set checkinlist [lreplace $checkinlist $w $w]
|
||||
my $what = "";
|
||||
|
||||
my $i;
|
||||
|
||||
SWITCH: for ($::FORM{'command'}) {
|
||||
/^nuke$/ && do {
|
||||
foreach $i (@list) {
|
||||
my $w = lsearch(\@::CheckInList, $i);
|
||||
if ($w >= 0) {
|
||||
splice(@::CheckInList, $w, 1);
|
||||
}
|
||||
}
|
||||
set what "deleted."
|
||||
}
|
||||
setopen {
|
||||
foreach i $list {
|
||||
upvar #0 $i info
|
||||
set info(treeopen) 1
|
||||
$what = "deleted.";
|
||||
last SWITCH;
|
||||
};
|
||||
/^setopen$/ && do {
|
||||
foreach $i (@list) {
|
||||
my $info = eval("\\%" . $i);
|
||||
$info->{'treeopen'} = 1;
|
||||
}
|
||||
set what "modified to be open."
|
||||
}
|
||||
$what = "modified to be open.";
|
||||
last SWITCH;
|
||||
};
|
||||
|
||||
setclose {
|
||||
foreach i $list {
|
||||
upvar #0 $i info
|
||||
set info(treeopen) 0
|
||||
/^setclose$/ && do {
|
||||
foreach $i (@list) {
|
||||
my $info = eval("\\%" . $i);
|
||||
$info->{'treeopen'} = 0;
|
||||
}
|
||||
set what "modified to be closed."
|
||||
}
|
||||
movetree {
|
||||
if {[cequal $treeid $FORM(desttree)]} {
|
||||
puts "<H1>Pick a different tree</H1>"
|
||||
puts "You attempted to move checkins into the tree that they're"
|
||||
puts "already in. Hit <b>Back</b> and try again."
|
||||
PutsTrailer
|
||||
exit
|
||||
$what = "modified to be closed.";
|
||||
last SWITCH;
|
||||
};
|
||||
/^movetree$/ && do {
|
||||
if ($treeid eq $::FORM{'desttree'}) {
|
||||
print "<H1>Pick a different tree</H1>\n";
|
||||
print "You attempted to move checkins into the tree that\n";
|
||||
print "they're already in. Hit <b>Back</b> and try again.\n";
|
||||
PutsTrailer();
|
||||
exit();
|
||||
}
|
||||
foreach i $list {
|
||||
set w [lsearch -exact $checkinlist $i]
|
||||
if {$w >= 0} {
|
||||
set checkinlist [lreplace $checkinlist $w $w]
|
||||
foreach $i (@list) {
|
||||
my $w = lsearch(\@::CheckInList, $i);
|
||||
if ($w >= 0) {
|
||||
splice(@::CheckInList, $w, 1);
|
||||
}
|
||||
}
|
||||
WriteCheckins
|
||||
unset checkinlist
|
||||
set treeid $FORM(desttree)
|
||||
unset batchid
|
||||
LoadCheckins
|
||||
LoadTreeConfig
|
||||
foreach i $list {
|
||||
lappend checkinlist $i
|
||||
WriteCheckins();
|
||||
undef @::CheckInList;
|
||||
$::TreeID = $::FORM{'desttree'};
|
||||
undef $::BatchID;
|
||||
LoadCheckins();
|
||||
LoadTreeConfig();
|
||||
foreach $i (@list) {
|
||||
push(@::CheckInList, $i);
|
||||
}
|
||||
set what "moved to the $treeinfo($treeid,description) tree."
|
||||
}
|
||||
default {
|
||||
puts "<h1>No command selected</h1>"
|
||||
puts "You need to select one of the radio command buttons at the"
|
||||
puts "bottom. Hit <b>Back</b> and try again."
|
||||
PutsTrailer
|
||||
exit
|
||||
}
|
||||
$what = "moved to the $::TreeInfo{$::TreeID}->{'description'} tree.";
|
||||
last SWITCH;
|
||||
};
|
||||
# DEFAULT
|
||||
print "<h1>No command selected</h1>\n";
|
||||
print "You need to select one of the radio command buttons at the\n";
|
||||
print "bottom. Hit <b>Back</b> and try again.\n";
|
||||
PutsTrailer();
|
||||
exit();
|
||||
}
|
||||
|
||||
WriteCheckins
|
||||
Unlock
|
||||
WriteCheckins();
|
||||
Unlock();
|
||||
|
||||
puts "
|
||||
print "
|
||||
<H1>OK, done.</H1>
|
||||
The selected checkins have been $what"
|
||||
The selected checkins have been $what
|
||||
";
|
||||
|
||||
set treeid $origtree
|
||||
$::TreeInfo = $origtree;
|
||||
|
||||
PutsTrailer
|
||||
exit
|
||||
PutsTrailer();
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,13 +17,13 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
LoadCheckins
|
||||
LoadCheckins();
|
||||
|
||||
upvar #0 $FORM(id) info
|
||||
my $info = eval("\\%" . $::FORM{'id'});
|
||||
|
||||
puts "Content-type: text/html
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>
|
||||
<TITLE>Say the magic word.</TITLE>
|
||||
|
|
@ -41,51 +41,59 @@ you need to know the magic word to do anything from here.
|
|||
<td><INPUT NAME=password TYPE=password></td>
|
||||
</tr><tr>
|
||||
<td align=right><B>When:</B></td>
|
||||
<td><INPUT NAME=datestring VALUE=\"[value_quote [MyFmtClock $info(date)]]\">
|
||||
<td><INPUT NAME=datestring VALUE=\"" .
|
||||
value_quote(MyFmtClock($info->{'date'})) . "\">
|
||||
</td></tr>
|
||||
"
|
||||
";
|
||||
|
||||
if {![info exists info(notes)]} {
|
||||
set info(notes) ""
|
||||
if (!exists $info->{'notes'}) {
|
||||
$info->{'notes'} = "";
|
||||
}
|
||||
|
||||
foreach i {person dir files notes} {
|
||||
puts "<tr><td align=right><B>$i:</B></td>"
|
||||
puts "<td><INPUT NAME=$i VALUE=\"[value_quote $info($i)]\"></td></tr>"
|
||||
foreach my $i ('person', 'dir', 'files', 'notes') {
|
||||
print "<tr><td align=right><B>$i:</B></td>";
|
||||
print "<td><INPUT NAME=$i VALUE=\"" . value_quote($info->{$i}) .
|
||||
"\"></td></tr>";
|
||||
}
|
||||
|
||||
proc CheckString {value} {
|
||||
if {$value} {
|
||||
return "CHECKED"
|
||||
sub CheckString {
|
||||
my ($value) = (@_);
|
||||
if ($value) {
|
||||
return "CHECKED";
|
||||
} else {
|
||||
return ""
|
||||
return "";
|
||||
}
|
||||
}
|
||||
|
||||
puts "
|
||||
my $isopen = CheckString($info->{'treeopen'});
|
||||
my $isclosed = CheckString(!$info->{'treeopen'});
|
||||
|
||||
print qq{
|
||||
<tr><td align=right><b>Tree state:</b></td>
|
||||
<td><INPUT TYPE=radio NAME=treeopen VALUE=1 [CheckString $info(treeopen)]>Open
|
||||
<td><INPUT TYPE=radio NAME=treeopen VALUE=1 $isopen>Open
|
||||
</td></tr><tr><td></td>
|
||||
<td><INPUT TYPE=radio NAME=treeopen VALUE=0 [CheckString [expr !$info(treeopen)]]>Closed
|
||||
<td><INPUT TYPE=radio NAME=treeopen VALUE=0 $isclosed>Closed
|
||||
</td></tr><tr>
|
||||
<td align=right valign=top><B>Log message:</B></td>
|
||||
<td><TEXTAREA NAME=log ROWS=10 COLS=80>$info(log)</TEXTAREA></td></tr>
|
||||
<td><TEXTAREA NAME=log ROWS=10 COLS=80>$info->{'log'}</TEXTAREA></td></tr>
|
||||
</table>
|
||||
<INPUT TYPE=CHECKBOX NAME=nukeit>Check this box to blow away this checkin entirely.<br>
|
||||
|
||||
<INPUT TYPE=SUBMIT VALUE=Submit>"
|
||||
<INPUT TYPE=SUBMIT VALUE=Submit>
|
||||
};
|
||||
|
||||
foreach i [lsort [array names info]] {
|
||||
puts "<INPUT TYPE=HIDDEN NAME=orig$i VALUE=\"[value_quote $info($i)]\">"
|
||||
foreach my $i (sort(keys(%$info))) {
|
||||
my $q = value_quote($info->{$i});
|
||||
print qq{<INPUT TYPE=HIDDEN NAME=orig$i VALUE="$q">\n};
|
||||
}
|
||||
puts "<INPUT TYPE=HIDDEN NAME=id VALUE=\"[value_quote $FORM(id)]\">"
|
||||
|
||||
puts "<INPUT TYPE=HIDDEN NAME=treeid VALUE=\"[value_quote $treeid]\">"
|
||||
print "<INPUT TYPE=HIDDEN NAME=id VALUE=\"$::FORM{'id'}\">";
|
||||
|
||||
print "<INPUT TYPE=HIDDEN NAME=treeid VALUE=\"" . value_quote($treeid) . "\">";
|
||||
|
||||
|
||||
|
||||
puts "</TABLE></FORM>"
|
||||
print "</TABLE></FORM>";
|
||||
|
||||
PutsTrailer
|
||||
PutsTrailer();
|
||||
|
||||
exit
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,83 +17,68 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
puts "Content-type: text/html
|
||||
my $Filename = FormData('msgname');
|
||||
my $RealFilename = DataDir() . "/$Filename";
|
||||
|
||||
my $Text = '';
|
||||
$Text = `cat $RealFilename` if -f $RealFilename;
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>We don't need no stinkin' HTML compose window</title>
|
||||
</head>
|
||||
LoadTreeConfig();
|
||||
PutsHeader("Message Editor", "Message Editor",
|
||||
"$Filename - $::TreeInfo{$::TreeID}{shortdesc}");
|
||||
|
||||
<body>
|
||||
<h1>Message editor</h1>"
|
||||
|
||||
set filename $FORM(msgname)
|
||||
|
||||
set fullfilename [DataDir]/$filename
|
||||
|
||||
if {[file exists $fullfilename]} {
|
||||
set text [read_file $fullfilename]
|
||||
} else {
|
||||
set text {}
|
||||
}
|
||||
|
||||
puts "
|
||||
Below is the template for the <b>$filename</b> message. Type the
|
||||
print "
|
||||
Below is the template for the <b>$Filename</b> message. Type the
|
||||
magic word and edit at will, but be careful to not break anything,
|
||||
especially around the headers.
|
||||
|
||||
The following magic symbols exist:
|
||||
|
||||
<table>"
|
||||
<table>
|
||||
";
|
||||
|
||||
proc PutDoc {name desc} {
|
||||
puts "<tr>"
|
||||
puts "<td align=right><tt><b>%$name%</b></tt></td>"
|
||||
puts "<td>Replaced by the $desc</td>"
|
||||
puts "</tr>"
|
||||
|
||||
sub PutDoc {
|
||||
my ($name, $desc) = @_;
|
||||
|
||||
print "\n<tr>\n<td align=right><tt><b>%$name%</b></tt></td>
|
||||
<td>Replaced by the $desc</td>\n</tr>\n";
|
||||
}
|
||||
|
||||
|
||||
switch -exact -- $filename {
|
||||
openmessage -
|
||||
closemessage {
|
||||
PutDoc name "username of the person getting mail"
|
||||
PutDoc dir "directory for this checkin"
|
||||
PutDoc files "list of files for this checkin"
|
||||
PutDoc log "log message for this checkin"
|
||||
PutDoc profile "profile for this user"
|
||||
}
|
||||
treeopened -
|
||||
treeopenedsamehook -
|
||||
treeclosed {
|
||||
PutDoc "hooklist" "comma-separated list of e-mail address of people on the hook"
|
||||
}
|
||||
default {
|
||||
puts "</table><P><font color=red>Uh, hey, this isn't a legal file for"
|
||||
puts "you to be editing here!</font>"
|
||||
PutsTrailer
|
||||
exit
|
||||
}
|
||||
if (($Filename eq 'openmessage') || ($Filename eq 'closemessage')) {
|
||||
PutDoc('name', "username of the person getting mail");
|
||||
PutDoc('dir', "directory for this checkin");
|
||||
PutDoc('files', "list of files for this checkin");
|
||||
PutDoc('log', "log message for this checkin");
|
||||
PutDoc('profile', "profile for this user");
|
||||
} elsif (($Filename eq 'treeopened') || ($Filename eq 'treeopenedsamehook') ||
|
||||
($Filename eq 'treeclosed')) {
|
||||
PutDoc('hooklist', "comma-separated list of e-mail address of people on the hook");
|
||||
} else {
|
||||
print "</table><P><font color=red>
|
||||
Uh, hey, this isn't a legal file for you to be editing here!</font>\n";
|
||||
PutsTrailer();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
puts "
|
||||
print "
|
||||
</TABLE>
|
||||
<FORM method=get action=\"doeditmessage.cgi\">
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
|
||||
<INPUT TYPE=HIDDEN NAME=msgname VALUE=$filename>
|
||||
<INPUT TYPE=HIDDEN NAME=origtext VALUE=\"[value_quote $text]\">
|
||||
<TEXTAREA NAME=text ROWS=40 COLS=80>$text</TEXTAREA><BR>
|
||||
<INPUT TYPE=HIDDEN NAME=msgname VALUE=$Filename>
|
||||
<INPUT TYPE=HIDDEN NAME=origtext VALUE=\"" . value_quote($Text) . "\">
|
||||
<TEXTAREA NAME=text ROWS=40 COLS=80>$Text</TEXTAREA><BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Change this message\">
|
||||
</FORM>
|
||||
|
||||
"
|
||||
";
|
||||
|
||||
|
||||
PutsTrailer
|
||||
PutsTrailer();
|
||||
exit 0;
|
||||
|
||||
exit
|
||||
|
|
|
|||
|
|
@ -0,0 +1,98 @@
|
|||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla 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/MPL/
|
||||
#
|
||||
# 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 Bugzilla Bug Tracking System.
|
||||
#
|
||||
# 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): Terry Weissman <terry@mozilla.org>
|
||||
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
require "CGI.pl";
|
||||
require "defparams.pl";
|
||||
|
||||
# Shut up misguided -w warnings about "used only once":
|
||||
use vars @::param_desc,
|
||||
@::param_list;
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
PutsHeader("Edit parameters");
|
||||
|
||||
print "This lets you edit the basic operating parameters of bonsai.\n";
|
||||
print "Be careful!\n";
|
||||
print "<p>\n";
|
||||
print "Any item you check Reset on will get reset to its default value.\n";
|
||||
|
||||
print "<form method=post action=doeditparams.cgi><table>\n";
|
||||
|
||||
my $rowbreak = "<tr><td colspan=2><hr></td></tr>";
|
||||
print $rowbreak;
|
||||
|
||||
foreach my $i (@::param_list) {
|
||||
print "<tr><th align=right valign=top>$i:</th><td>$::param_desc{$i}</td></tr>\n";
|
||||
print "<tr><td valign=top><input type=checkbox name=reset-$i>Reset</td><td>\n";
|
||||
my $value = Param($i);
|
||||
SWITCH: for ($::param_type{$i}) {
|
||||
/^t$/ && do {
|
||||
print "<input size=80 name=$i value=\"" .
|
||||
value_quote($value) . "\">\n";
|
||||
last SWITCH;
|
||||
};
|
||||
/^l$/ && do {
|
||||
print "<textarea wrap=hard name=$i rows=10 cols=80>" .
|
||||
value_quote($value) . "</textarea>\n";
|
||||
last SWITCH;
|
||||
};
|
||||
/^b$/ && do {
|
||||
my $on;
|
||||
my $off;
|
||||
if ($value) {
|
||||
$on = "checked";
|
||||
$off = "";
|
||||
} else {
|
||||
$on = "";
|
||||
$off = "checked";
|
||||
}
|
||||
print "<input type=radio name=$i value=1 $on>On\n";
|
||||
print "<input type=radio name=$i value=0 $off>Off\n";
|
||||
last SWITCH;
|
||||
};
|
||||
# DEFAULT
|
||||
print "<font color=red><blink>Unknown param type $::param_type{$i}!!!</blink></font>\n";
|
||||
}
|
||||
print "</td></tr>\n";
|
||||
print $rowbreak;
|
||||
}
|
||||
|
||||
print "<tr><th align=right valign=top>version:</th><td>
|
||||
What version of Bonsai this is. This can't be modified here, but
|
||||
<tt>%version%</tt> can be used as a parameter in places that understand
|
||||
such parameters</td></tr>
|
||||
<tr><td></td><td>" . Param('version') . "</td></tr>";
|
||||
|
||||
print "</table>\n";
|
||||
|
||||
print "<hr><B>Enter password to change parameters:</B>
|
||||
<INPUT NAME=password TYPE=password> <BR>";
|
||||
print "<input type=reset value=\"Reset form\"><br>\n";
|
||||
print "<input type=submit value=\"Submit changes\">\n";
|
||||
|
||||
print "</form>\n";
|
||||
|
||||
print "<p><a href=toplevel.cgi>Skip all this, and go back to the main bonsai page</a>\n";
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,16 +17,17 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
LoadWhiteboard
|
||||
print "Content-type: text/html\n\n";
|
||||
LoadWhiteboard();
|
||||
|
||||
puts "Content-type: text/html
|
||||
PutsHeader("Scritch, scritch.", "Edit Whiteboard");
|
||||
|
||||
<TITLE>Scritch, scritch.</TITLE>
|
||||
print "
|
||||
<FORM method=post action=\"doeditwhiteboard.cgi\">
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
|
||||
<INPUT TYPE=HIDDEN NAME=origwhite VALUE=\"[value_quote $whiteboard]\">
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
<INPUT TYPE=HIDDEN NAME=origwhite VALUE=\"" . value_quote($::WhiteBoard) . "\">
|
||||
|
||||
The free-for-all whiteboard is a fine place to put notes of general
|
||||
and temporary interest about the tree. (Like, \"I'm checking in a bunch
|
||||
|
|
@ -35,11 +36,10 @@ of nasty stuff; stay out of the tree until 3:30pm\".)
|
|||
<P>
|
||||
|
||||
Change the free-for-all whiteboard:<br>
|
||||
<TEXTAREA NAME=whiteboard ROWS=10 COLS=70>$whiteboard</TEXTAREA><BR>
|
||||
<TEXTAREA NAME=whiteboard ROWS=10 COLS=70>$::WhiteBoard</TEXTAREA><BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Change the Whiteboard\">
|
||||
</FORM>
|
||||
"
|
||||
";
|
||||
|
||||
PutsTrailer
|
||||
|
||||
exit
|
||||
PutsTrailer();
|
||||
exit;
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -0,0 +1,49 @@
|
|||
#!/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.
|
||||
|
||||
|
||||
use strict;
|
||||
|
||||
if (($#ARGV >= 0) && (-d $ARGV[0])) {
|
||||
chdir($ARGV[0]);
|
||||
} else {
|
||||
my $bonsaidir = $0;
|
||||
$bonsaidir =~ s:/[^/]*$::; # Remove last word, and slash before it.
|
||||
if ($bonsaidir eq "") {
|
||||
$bonsaidir = ".";
|
||||
}
|
||||
chdir($bonsaidir);
|
||||
}
|
||||
|
||||
my $filename = "data/admin.$$";
|
||||
unlink($filename);
|
||||
|
||||
die "Cannot Open data file: $!\n"
|
||||
unless (open(FILE, "> $filename"));
|
||||
|
||||
while (<STDIN>) {
|
||||
print FILE $_;
|
||||
}
|
||||
close(FILE);
|
||||
chmod(0666, $filename);
|
||||
system("./adminmail.pl $filename");
|
||||
|
||||
# unlink($filename);
|
||||
|
||||
exit;
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
#!/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.
|
||||
|
||||
|
||||
use strict;
|
||||
|
||||
if (($#ARGV >= 0) && (-d $ARGV[0])) {
|
||||
chdir($ARGV[0]);
|
||||
} else {
|
||||
my $bonsaidir = $0;
|
||||
$bonsaidir =~ s:/[^/]*$::; # Remove last word, and slash before it.
|
||||
if ($bonsaidir eq "") {
|
||||
$bonsaidir = ".";
|
||||
}
|
||||
chdir($bonsaidir);
|
||||
}
|
||||
|
||||
my $filename = "data/temp.$$";
|
||||
unlink($filename);
|
||||
|
||||
die "Cannot Open data file: $!\n"
|
||||
unless (open(FILE, "> $filename"));
|
||||
|
||||
while (<STDIN>) {
|
||||
print FILE $_;
|
||||
}
|
||||
close(FILE);
|
||||
chmod(0666, $filename);
|
||||
system("./addcheckin.pl $filename");
|
||||
|
||||
# unlink($filename);
|
||||
|
||||
exit;
|
||||
|
|
@ -1,12 +1,12 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Refresh"
|
||||
content="0; URL=toplevel.cgi">
|
||||
content="0; URL=cvsqueryform.cgi">
|
||||
</head>
|
||||
<body>
|
||||
Going to<br>
|
||||
<br>
|
||||
<a href="toplevel.cgi">toplevel.cgi</a>
|
||||
<a href="cvsqueryform.cgi">cvsqueryform.cgi</a>
|
||||
<br>
|
||||
</body>
|
||||
</html>
|
||||
|
|
|
|||
|
|
@ -54,7 +54,10 @@ $MYSQL << OK_ALL_DONE
|
|||
use bonsai;
|
||||
create table descs (
|
||||
id mediumint not null auto_increment primary key,
|
||||
description text
|
||||
description text,
|
||||
hash bigint not null,
|
||||
|
||||
index(hash)
|
||||
);
|
||||
|
||||
show columns from descs;
|
||||
|
|
|
|||
|
|
@ -21,28 +21,20 @@
|
|||
#
|
||||
# Unroll a module
|
||||
#
|
||||
require 'lloydcgi.pl';
|
||||
require 'cvsmenu.pl';
|
||||
require 'CGI.pl';
|
||||
|
||||
$|=1;
|
||||
|
||||
$CVS_ROOT = $form{"cvsroot"};
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
print "Content-type: text/html
|
||||
$CVS_ROOT = $::FORM{'cvsroot'};
|
||||
$CVS_ROOT = pickDefaultRepository() unless $CVS_ROOT;
|
||||
|
||||
<HTML>";
|
||||
|
||||
require 'modules.pl';
|
||||
|
||||
print "
|
||||
<HEAD>
|
||||
<TITLE>CVS Module Analyzer</TITLE>
|
||||
</HEAD>";
|
||||
PutsHeader("CVS Module Analyzer", $CVS_ROOT);
|
||||
|
||||
cvsmenu("align=right width=20%");
|
||||
|
||||
print "
|
||||
<H1>CVS Module Analyzer</H1>
|
||||
<p><b>This tool will show you the directories and files that make up a given
|
||||
cvs module.</b>
|
||||
";
|
||||
|
|
@ -63,19 +55,23 @@ print "
|
|||
<SELECT name='module' size=5>
|
||||
";
|
||||
|
||||
if( $form{module} eq 'all' || $form{module} eq '' ){
|
||||
$Module = 'default';
|
||||
if( $::FORM{module} eq 'all' || $::FORM{module} eq '' ){
|
||||
print "<OPTION SELECTED VALUE='all'>All Files in the Repository\n";
|
||||
}
|
||||
else {
|
||||
print "<OPTION VALUE='all'>All Files in the Repository\n";
|
||||
print "<OPTION SELECTED VALUE='$form{module}'>$form{module}\n";
|
||||
print "<OPTION SELECTED VALUE='$::FORM{module}'>$::FORM{module}\n";
|
||||
$Module = $::FORM{module};
|
||||
}
|
||||
|
||||
#
|
||||
# Print out all the Different Modules
|
||||
#
|
||||
for $k (sort( keys( %$modules ) ) ){
|
||||
print "<OPTION value='$k'>$k\n";
|
||||
$::TreeID = $Module if (exists($::TreeInfo{$Module}{'repository'}));
|
||||
LoadDirList();
|
||||
for $k (sort( grep(!/\*$/, @::LegalDirs) ) ){
|
||||
print "<OPTION value='$k'>$k\n" if ($k ne $Module);
|
||||
}
|
||||
|
||||
print "</SELECT></NOBR>\n";
|
||||
|
|
@ -89,11 +85,11 @@ print "
|
|||
</FORM>";
|
||||
|
||||
|
||||
if( $form{module} ne '' ){
|
||||
$mod = $form{module};
|
||||
if( $::FORM{module} ne '' ){
|
||||
$mod = $::FORM{module};
|
||||
print "<h1>Examining Module '$mod'</h1>\n\n";
|
||||
$mod_map = &get_module_map( $mod );
|
||||
for $i (sort keys %$mod_map) {
|
||||
|
||||
for $i (sort( grep(!/\*$/, @::LegalDirs) ) ){
|
||||
if( -d "$CVS_ROOT/$i"){
|
||||
print "<dt><tt>Dir: </tt>";
|
||||
print "<a href=rview.cgi?dir=$i&cvsroot=$CVS_ROOT>$i</a>";
|
||||
|
|
@ -116,7 +112,7 @@ if( $form{module} ne '' ){
|
|||
|
||||
|
||||
sub sortTest {
|
||||
if( $_[0] eq $form{sortby} ){
|
||||
if( $_[0] eq $::FORM{sortby} ){
|
||||
return " SELECTED";
|
||||
}
|
||||
else {
|
||||
|
|
@ -125,7 +121,7 @@ sub sortTest {
|
|||
}
|
||||
|
||||
sub dateTest {
|
||||
if( $_[0] eq $form{date} ){
|
||||
if( $_[0] eq $::FORM{date} ){
|
||||
return " CHECKED value=$_[0]";
|
||||
}
|
||||
else {
|
||||
|
|
|
|||
|
|
@ -1,79 +0,0 @@
|
|||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
|
||||
# The below was taken from the tclX distribution (version 7.4a), and modified
|
||||
# to quietly continue if it runs into a directory it doesn't have permission
|
||||
# to enter, and also to skip . directories.
|
||||
|
||||
|
||||
|
||||
#
|
||||
# globrecur.tcl --
|
||||
#
|
||||
# Build or process a directory list recursively.
|
||||
#------------------------------------------------------------------------------
|
||||
# Copyright 1992-1994 Karl Lehenbauer and Mark Diekhans.
|
||||
#
|
||||
# Permission to use, copy, modify, and distribute this software and its
|
||||
# documentation for any purpose and without fee is hereby granted, provided
|
||||
# that the above copyright notice appear in all copies. Karl Lehenbauer and
|
||||
# Mark Diekhans make no representations about the suitability of this
|
||||
# software for any purpose. It is provided "as is" without express or
|
||||
# implied warranty.
|
||||
#------------------------------------------------------------------------------
|
||||
# $Id: myglobrecur.tcl,v 1.1 1998-06-16 21:43:04 terry Exp $
|
||||
#------------------------------------------------------------------------------
|
||||
#
|
||||
|
||||
|
||||
|
||||
proc my_for_recursive_glob {var dirlist globlist cmd {depth 1}} {
|
||||
upvar $depth $var myVar
|
||||
set recurse {}
|
||||
foreach dir $dirlist {
|
||||
if ![file isdirectory $dir] {
|
||||
error "\"$dir\" is not a directory"
|
||||
}
|
||||
set code 0
|
||||
set result {}
|
||||
foreach pattern $globlist {
|
||||
if {[catch {set list [glob -nocomplain -- $dir/$pattern]}]} {
|
||||
continue
|
||||
}
|
||||
foreach file $list {
|
||||
set myVar $file
|
||||
set code [catch {uplevel $depth $cmd} result]
|
||||
if {$code != 0 && $code != 4} break
|
||||
}
|
||||
if {$code != 0 && $code != 4} break
|
||||
}
|
||||
if {$code != 0 && $code != 4} {
|
||||
if {$code == 3} {
|
||||
return $result
|
||||
}
|
||||
if {$code == 1} {
|
||||
global errorCode errorInfo
|
||||
return -code $code -errorcode $errorCode \
|
||||
-errorinfo $errorInfo $result
|
||||
}
|
||||
return -code $code $result
|
||||
}
|
||||
|
||||
if {[catch {set list [readdir $dir]}]} {
|
||||
continue
|
||||
}
|
||||
foreach file $list {
|
||||
set file $dir/$file
|
||||
if [file isdirectory $file] {
|
||||
set fileTail [file tail $file]
|
||||
if {![cequal "." [crange $fileTail 0 0]]} {
|
||||
lappend recurse $file
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if ![lempty $recurse] {
|
||||
return [my_for_recursive_glob $var $recurse $globlist $cmd \
|
||||
[expr {$depth + 1}]]
|
||||
}
|
||||
return {}
|
||||
}
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
$::param{'cocommand'} = '_CO_';
|
||||
$::param{'cvscommand'} = '_CVS_';
|
||||
$::param{'rcsdiffcommand'} = '_RCSDIFF_';
|
||||
$::param{'rlogcommand'} = '_RLOG_';
|
||||
1;
|
||||
|
|
@ -1,5 +1,4 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/usr/bonsaitools/bin/perl
|
||||
#
|
||||
# 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
|
||||
|
|
@ -17,370 +16,242 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
source myglobrecur.tcl
|
||||
use File::Basename;
|
||||
|
||||
if {[llength $argv] == 5} {
|
||||
lassign $argv treeid FORM(startfrom) FORM(firstfile) FORM(subdir) FORM(modules)
|
||||
} else {
|
||||
puts "Content-type: text/plain
|
||||
require "CGI.pl";
|
||||
|
||||
<HTML>"
|
||||
sub ProcessOneFile {
|
||||
my ($filename) = @_;
|
||||
my $rlog = Param('rlogcommand') . " $filename |";
|
||||
my $doingtags = 0;
|
||||
my $filehead = dirname($filename);
|
||||
my (%branchname, $filerealname, $filetail, $line, $trimmed);
|
||||
my ($tag, $version, $branchid, $dirid, $fileid, $indesc, $desc);
|
||||
my ($author, $revision, $datestr, $date, $pluscount, $minuscount);
|
||||
my ($branch);
|
||||
|
||||
CheckPassword $FORM(password)
|
||||
}
|
||||
print "$filename\n";
|
||||
|
||||
set startfrom [ParseTimeAndCheck [FormData startfrom]]
|
||||
die "Unable to run rlog command '$rlog': $!\n"
|
||||
unless (open(RLOG_PROC, "$rlog"));
|
||||
undef (%branchname);
|
||||
|
||||
set firstfile [string trim [FormData firstfile]]
|
||||
($filerealname = $filename) =~ s/,v$//g;
|
||||
$filehead =~ s!^$::Repository/*!!;
|
||||
$filehead = '.'
|
||||
unless ($filehead);
|
||||
$filetail = basename($filerealname);
|
||||
|
||||
set subdir [string trim [FormData subdir]]
|
||||
while (<RLOG_PROC>) {
|
||||
chop;
|
||||
$line = $_;
|
||||
$trimmed = trim($line);
|
||||
|
||||
Lock
|
||||
LoadTreeConfig
|
||||
Unlock
|
||||
if ($doingtags) {
|
||||
if ($line !~ /^\t/) {
|
||||
$doingtags = 0;
|
||||
} else {
|
||||
$trimmed =~ /^([^:]*):([^:]*)/;
|
||||
$tag = trim($1);
|
||||
$version = trim($2);
|
||||
|
||||
ConnectToDatabase
|
||||
next
|
||||
unless (length($tag) && length($version));
|
||||
|
||||
set repository $treeinfo($treeid,repository)
|
||||
regsub -all -- / $repository _ mungedname
|
||||
|
||||
puts "Rebuilding entire checkin history in $treeinfo($treeid,description) ..."
|
||||
flush stdout
|
||||
|
||||
|
||||
|
||||
# cmdtrace on
|
||||
|
||||
set repositoryid [GetId repositories repository $repository]
|
||||
|
||||
proc ProcessOneFile {filename} {
|
||||
global repository startfrom rlogcommand
|
||||
|
||||
puts "$filename"
|
||||
flush stdout
|
||||
set fid [open "|$rlogcommand $filename" r]
|
||||
set doingtags 0
|
||||
catch {unset branchname}
|
||||
regsub -- {,v$} $filename {} filerealname
|
||||
set filehead [file dirname $filerealname]
|
||||
regsub -- "^$repository" $filehead {} filehead
|
||||
regsub -- {^/} $filehead {} filehead
|
||||
if {[clength $filehead] == 0} {
|
||||
set filehead "."
|
||||
}
|
||||
set filetail [file tail $filerealname]
|
||||
while {1} {
|
||||
if {[gets $fid line] < 0} {
|
||||
break
|
||||
}
|
||||
set trimmed [string trim $line]
|
||||
if {$doingtags} {
|
||||
if {![cequal "\t" [crange $line 0 0]]} {
|
||||
set doingtags 0
|
||||
} else {
|
||||
lassign [split $trimmed ":"] tag version
|
||||
if {[clength $tag] == 0 || [clength $version] == 0} {
|
||||
continue
|
||||
}
|
||||
set version [string trim $version]
|
||||
|
||||
set branchid [GetId branches branch $tag]
|
||||
set dirid [GetId dirs dir $filehead]
|
||||
set fileid [GetId files file $filetail]
|
||||
$branchid = GetId('branches', 'branch', $tag);
|
||||
$dirid = GetId('dirs', 'dir', $filehead);
|
||||
$fileid = GetId('files', 'file', $filetail);
|
||||
#
|
||||
# Don't touch the tags database for now. Nothing uses it, and it just takes
|
||||
# up too much damn space.
|
||||
# SendSQL "replace into tags (branchid, repositoryid, dirid, fileid, revision) values ($branchid, $repositoryid, $dirid, $fileid, '$version')"
|
||||
#
|
||||
# SendSQL "replace into tags (branchid, repositoryid,
|
||||
# dirid, fileid, revision) values ($branchid,
|
||||
# $repositoryid, $dirid, $fileid, '$version')"
|
||||
#
|
||||
|
||||
set vlist [split $version '.']
|
||||
set sub [expr [llength $vlist] - 2]
|
||||
if {[cequal "0" [lindex $vlist $sub]]} {
|
||||
# Aha! Second-to-last being a zero is CVS's special way
|
||||
# of remembering a branch tag.
|
||||
set bnum [join [lreplace $vlist $sub $sub] "."]
|
||||
set branchname($bnum) $tag
|
||||
}
|
||||
continue
|
||||
}
|
||||
}
|
||||
switch -regexp -- $line {
|
||||
{^symbolic names} {
|
||||
set doingtags 1
|
||||
}
|
||||
{^revision ([0-9.]*)$} {
|
||||
set indesc 0
|
||||
while {1} {
|
||||
if {$indesc} {
|
||||
if {[cequal $line "----------------------------"] ||
|
||||
[cequal $line "============================================================================="]} {
|
||||
# OK, we're done. Write it out.
|
||||
if {[info exists revision] &&
|
||||
[info exists datestr] &&
|
||||
[info exists author]} {
|
||||
if {[regexp -- {^([0-9]*)/([0-9]*)/([0-9]*) ([0-9]*):([0-9]*):([0-9]*)$} $datestr foo year month day hours mins secs]} {
|
||||
set date [convertclock "$month/$day/$year $hours:$mins:$secs" GMT]
|
||||
|
||||
if {$date >= $startfrom} {
|
||||
set tbranch "T$branch"
|
||||
if {[cequal $tbranch "T"]} {
|
||||
set tbranch ""
|
||||
}
|
||||
set entrystr "C|$date|$author|$repository|$filehead|$filetail|$revision||$branch|+$pluscount|-$minuscount"
|
||||
AddToDatabase $entrystr $desc
|
||||
}
|
||||
}
|
||||
}
|
||||
set indesc 0
|
||||
} else {
|
||||
append desc $line
|
||||
append desc "\n"
|
||||
}
|
||||
} else {
|
||||
switch -regexp -- $line {
|
||||
{^revision ([0-9.]*)$} {
|
||||
if {[regexp -- {^revision ([0-9.]*)$} $line foo new]} {
|
||||
set revision $new
|
||||
catch {unset datestr}
|
||||
catch {unset author}
|
||||
set pluscount 0
|
||||
set minuscount 0
|
||||
set desc {}
|
||||
$version =~ /(.*)\.(\d+)(\.\d+)$/;
|
||||
$branchname{"$1$3"} = $tag
|
||||
if ($2 eq '0');
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
regsub -- {.[0-9]*$} $revision {} bnum
|
||||
if {[info exists branchname($bnum)]} {
|
||||
set branch "$branchname($bnum)"
|
||||
} else {
|
||||
set branch ""
|
||||
}
|
||||
}
|
||||
}
|
||||
{^date:} {
|
||||
regexp -- {^date: ([0-9 /:]*); author: ([^;]*);} $line foo datestr author
|
||||
regexp -- {lines: \+([0-9]*) -([0-9]*)} $line foo pluscount minuscount
|
||||
}
|
||||
{^branches: [0-9 .;]*$} {
|
||||
# Ignore these lines; make sure they don't
|
||||
# become part of the desciption.
|
||||
}
|
||||
default {
|
||||
set indesc 1
|
||||
set desc "$line\n"
|
||||
|
||||
}
|
||||
}
|
||||
if ($line =~ /^symbolic names/) {
|
||||
$doingtags = 1;
|
||||
next;
|
||||
} elsif ($line =~ /^revision ([0-9.]*)$/) {
|
||||
$pluscount = ($minuscount = ($date = ($indesc = 0)));
|
||||
$desc = ($branch = ($author = ($datestr = ($revision = ''))));
|
||||
|
||||
while (1) {
|
||||
# Dealing with descriptions in rlog output for a
|
||||
# revision...
|
||||
if ($indesc) {
|
||||
if (($line =~ /^-{27,30}$/) ||
|
||||
($line =~ /^={75,80}$/)) {
|
||||
# OK, we're done. Write it out.
|
||||
if ($author && $datestr && $revision) {
|
||||
$datestr =~ s!^(\d+)/(\d+/\d+)!$2/$1!;
|
||||
$date = str2time($datestr);
|
||||
if ($date >= $::StartFrom) {
|
||||
AddToDatabase("C|$date|$author|$Repository|$filehead|$filetail|$revision||$branch|+$pluscount|-$minuscount", $desc);
|
||||
}
|
||||
}
|
||||
$indesc = 0;
|
||||
} else {
|
||||
$desc .= $line . "\n";
|
||||
}
|
||||
}
|
||||
if {[gets $fid line] < 0} {
|
||||
break
|
||||
|
||||
# Dealing with revision information for a specific
|
||||
# revision...
|
||||
else {
|
||||
if ($line =~ /^revision ([0-9.]*)$/) {
|
||||
$pluscount = ($minuscount = 0);
|
||||
$date = ($indesc = 0);
|
||||
$datestr = ($desc = ($branch = ($author = "")));
|
||||
$revision = $1;
|
||||
|
||||
$revision =~ /(.*)\.\d*$/;
|
||||
$branch = $branchname{$1}
|
||||
if (exists($branchname{$1}));
|
||||
}
|
||||
|
||||
elsif ($line =~ /^date:/) {
|
||||
$line =~ s!^date: ([0-9 /:]*);\s+!!;
|
||||
$datestr = $1;
|
||||
|
||||
$line =~ s!^author: ([^;]*);\s+!!;
|
||||
$author = $1;
|
||||
|
||||
if ($line =~ /lines: \+(\d+) -(\d+)/) {
|
||||
$pluscount = $1;
|
||||
$minuscount = $2;
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ /^branches: [0-9 .;]*$/) {
|
||||
# Ignore these lines; make sure they don't
|
||||
# become part of the desciption.
|
||||
}
|
||||
|
||||
else {
|
||||
$indesc = 1;
|
||||
$desc = "$line\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
catch {close $fid}
|
||||
|
||||
last
|
||||
unless ($line = <RLOG_PROC>);
|
||||
chop($line);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
close(RLOG_PROC);
|
||||
}
|
||||
|
||||
|
||||
proc ProcessDirectory {dir} {
|
||||
global firstfile
|
||||
my_for_recursive_glob filename $dir "*,v" {
|
||||
if {![cequal $firstfile ""]} {
|
||||
if {![cequal $filename $firstfile]} {
|
||||
puts "Skipping $filename"
|
||||
flush stdout
|
||||
continue
|
||||
}
|
||||
set firstfile ""
|
||||
}
|
||||
ProcessOneFile $filename
|
||||
}
|
||||
sub ProcessDirectory {
|
||||
my ($dir) = @_;
|
||||
my ($file, @files);
|
||||
|
||||
die "$dir: not a directory" unless (-d $dir);
|
||||
die "$dir: Couldn't open for reading: $!"
|
||||
unless (opendir(DIR, $dir));
|
||||
@files = readdir(DIR);
|
||||
closedir (DIR);
|
||||
|
||||
foreach $file (@files) {
|
||||
next if $file eq '.';
|
||||
next if $file eq '..';
|
||||
|
||||
$file = "$dir/$file";
|
||||
if (-d $file) {
|
||||
&ProcessDirectory($file);
|
||||
} else {
|
||||
next unless ($file =~ /,v$/);
|
||||
|
||||
if ($FirstFile && ($FirstFile ne $file)) {
|
||||
print "Skipping $file...\n";
|
||||
next;
|
||||
}
|
||||
$FirstFile = 0;
|
||||
ProcessOneFile($file);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
$| = 1;
|
||||
|
||||
proc digest {str} {
|
||||
global array
|
||||
set key [lvarpop str]
|
||||
if {[cequal [cindex [lindex $str 0] 0] "-"]} {
|
||||
lvarpop str
|
||||
}
|
||||
set array($key) $str
|
||||
if ($#ARGV == 4) {
|
||||
$::TreeID = $ARGV[0];
|
||||
$::FORM{'startfrom'} = $ARGV[1];
|
||||
$::FORM{'firstfile'} = $ARGV[2];
|
||||
$::FORM{'subdir'} = $ARGV[3];
|
||||
$::FORM{'modules'} = $ARGV[4];
|
||||
} else {
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>";
|
||||
CheckPassword(FormData('password'));
|
||||
print "
|
||||
<title>Rebuilding CVS history database... please be patient...</title>
|
||||
<body>
|
||||
<pre>\n";
|
||||
}
|
||||
|
||||
$::StartFrom = ParseTimeAndCheck(FormData('startfrom'));
|
||||
$::FirstFile = trim(FormData('firstfile'));
|
||||
$::SubDir = trim(FormData('subdir'));
|
||||
$::Modules = '';
|
||||
|
||||
|
||||
set env(CVSROOT) $treeinfo($treeid,repository)
|
||||
set origdir [pwd]
|
||||
cd /
|
||||
set fid [open "|$cvscommand checkout -c" r]
|
||||
cd $origdir
|
||||
|
||||
set curline ""
|
||||
while {[gets $fid line] >= 0} {
|
||||
if {[ctype space [cindex $line 0]]} {
|
||||
append curline $line
|
||||
} else {
|
||||
digest $curline
|
||||
set curline $line
|
||||
}
|
||||
}
|
||||
digest $curline
|
||||
close $fid
|
||||
|
||||
|
||||
set startingdir $repository/$subdir
|
||||
|
||||
regsub -- {/\.$} $startingdir {} startingdir
|
||||
regsub -- {/$} $startingdir {} startingdir
|
||||
|
||||
|
||||
set oldlist {}
|
||||
|
||||
set list {}
|
||||
|
||||
if {[info exists FORM(modules)]} {
|
||||
set list [split $FORM(modules) ","]
|
||||
if (defined($::FORM{'modules'})) {
|
||||
$::Modules = trim(FormData('modules'));
|
||||
}
|
||||
|
||||
if {[lempty $list]} {
|
||||
set list $treeinfo($treeid,module)
|
||||
Lock();
|
||||
LoadTreeConfig();
|
||||
Unlock();
|
||||
|
||||
ConnectToDatabase();
|
||||
|
||||
$::Repository = $::TreeInfo{$::TreeID}{'repository'};
|
||||
$::Description = $::TreeInfo{$::TreeID}{'description'};
|
||||
$::RepositoryID = GetId('repositories', 'repository', $::Repository);
|
||||
$::StartingDir = 0;
|
||||
|
||||
print "
|
||||
Rebuilding entire checkin history in $::Description, (`$::TreeID' tree) ...
|
||||
";
|
||||
|
||||
Log("Rebuilding cvs history in $::Description, (`$::TreeID' tree)...");
|
||||
|
||||
LoadDirList();
|
||||
@Dirs = grep(!/\*$/, @::LegalDirs);
|
||||
@Dirs = split(/,\s*/, $::Modules) if $::Modules;
|
||||
($StartingDir = "$::Repository/$::SubDir") =~ s!/.?$!! if $::SubDir;
|
||||
|
||||
|
||||
print "Doing directories: @Dirs ...\n";
|
||||
foreach $Dir (@Dirs) {
|
||||
my $dir = "$::Repository/$Dir";
|
||||
|
||||
unless (grep $Dir, @::LegalDirs) {
|
||||
print "$Dir: is invalid, skipping...\n";
|
||||
}
|
||||
|
||||
if (-f $dir) {
|
||||
ProcessOneFile($dir);
|
||||
} elsif (-d $dir) {
|
||||
ProcessDirectory($dir);
|
||||
} else {
|
||||
print "$Dir: not a file or directory, skipping...\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
while {![cequal $list $oldlist]} {
|
||||
set oldlist $list
|
||||
set list {}
|
||||
foreach i $oldlist {
|
||||
if {[info exists array($i)]} {
|
||||
set list [concat $list $array($i)]
|
||||
# Do an unset to prevent infinite recursion.
|
||||
unset array($i)
|
||||
} else {
|
||||
lappend list $i
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
set tlist {}
|
||||
catch {unset present}
|
||||
foreach i $list {
|
||||
if {![info exists present($i)]} {
|
||||
lappend tlist $i
|
||||
set present($i) 1
|
||||
}
|
||||
}
|
||||
catch {unset present}
|
||||
|
||||
|
||||
set list {}
|
||||
|
||||
foreach i $tlist {
|
||||
set d $repository/$i
|
||||
regsub -- {/\.$} $d {} d
|
||||
regsub -- {/$} $d {} d
|
||||
lappend list $d
|
||||
}
|
||||
|
||||
if {[lempty $list]} {
|
||||
set $list $startingdir
|
||||
}
|
||||
|
||||
set slen [expr [clength $startingdir] - 1]
|
||||
|
||||
puts "Doing directories: $list"
|
||||
|
||||
foreach dir $list {
|
||||
if {![cequal [crange $dir 0 $slen] $startingdir]} {
|
||||
puts "*** Skipping $dir ***"
|
||||
continue
|
||||
}
|
||||
if {![file isdirectory $dir]} {
|
||||
if {[file isfile $dir]} {
|
||||
ProcessOneFile $dir
|
||||
}
|
||||
} else {
|
||||
ProcessDirectory $dir
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
# puts "<HR>Putting entries ($count unique descriptions) into database...<P>"
|
||||
# flush stdout
|
||||
|
||||
# set infid [open data/checkinlog$mungedname "r"]
|
||||
|
||||
# ConnectToDatabase
|
||||
|
||||
# set buffer {}
|
||||
# set desc {}
|
||||
# set indesc 0
|
||||
# set done 0
|
||||
# while {[gets $infid line] >= 0} {
|
||||
# if {$indesc} {
|
||||
# if {[cequal $line ":ENDLOGCOMMENT"]} {
|
||||
# AddToDatabase $buffer $desc
|
||||
# set buffer {}
|
||||
# set desc {}
|
||||
# set indesc 0
|
||||
# incr done
|
||||
# if {$done % 5 == 0} {
|
||||
# puts "$done done.<BR>"
|
||||
# flush stdout
|
||||
# }
|
||||
# } else {
|
||||
# append desc $line
|
||||
# append desc "\n"
|
||||
# }
|
||||
# } else {
|
||||
# if {[cequal $line "LOGCOMMENT"]} {
|
||||
# set indesc 1
|
||||
# } else {
|
||||
# append buffer $line
|
||||
# append buffer "\n"
|
||||
# }
|
||||
# }
|
||||
# }
|
||||
# close $infid
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# puts "<HR>"
|
||||
# flush stdout
|
||||
|
||||
# set dir data/taginfo
|
||||
# catch {mkdir $dir}
|
||||
# catch {chmod 0777 $dir}
|
||||
# append dir /tmp_[set mungedname]_[id process]
|
||||
# catch {mkdir $dir}
|
||||
# catch {chmod 0777 $dir}
|
||||
|
||||
# set numtags 0
|
||||
|
||||
# foreach n [lsort [info var tag_*]] {
|
||||
# upvar #0 $n t
|
||||
# set tagname [crange $n 4 end]
|
||||
# puts "Dumping tag $tagname<br>"
|
||||
# flush stdout
|
||||
# set filename $dir/[MungeTagName $tagname]
|
||||
# set fid [open "$filename" "w"]
|
||||
# foreach f [lsort [array names t]] {
|
||||
# puts $fid "0|add|$f|$t($f)"
|
||||
# }
|
||||
# close $fid
|
||||
# incr numtags
|
||||
# }
|
||||
|
||||
|
||||
# Lock
|
||||
# set newdir data/taginfo/$mungedname
|
||||
# catch {exec rm -rf $newdir}
|
||||
# frename $dir $newdir
|
||||
# Unlock
|
||||
|
||||
# puts "<HR><P>Done. $numfiles files checked; $numtags tags created.<P>"
|
||||
|
||||
exit 0;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,118 +17,118 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
puts "Content-type: text/html
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
<HTML>"
|
||||
print "Content-type: text/html
|
||||
|
||||
CheckPassword $FORM(password)
|
||||
<HTML>";
|
||||
|
||||
set startfrom [ParseTimeAndCheck [FormData startfrom]]
|
||||
CheckPassword($::FORM{'password'});
|
||||
|
||||
Lock
|
||||
LoadTreeConfig
|
||||
LoadCheckins
|
||||
set checkinlist {}
|
||||
WriteCheckins
|
||||
Unlock
|
||||
my $startfrom = ParseTimeAndCheck(FormData('startfrom'));
|
||||
|
||||
Lock();
|
||||
LoadTreeConfig();
|
||||
LoadCheckins();
|
||||
@::CheckInList = ();
|
||||
WriteCheckins();
|
||||
Unlock();
|
||||
|
||||
|
||||
puts "<TITLE> Rebooting, please wait...</TITLE>
|
||||
$| = 1;
|
||||
|
||||
print "<TITLE> Rebooting, please wait...</TITLE>
|
||||
|
||||
<H1>Recreating the hook</H1>
|
||||
|
||||
<h3>$treeinfo($treeid,description)</h3>
|
||||
<h3>$::TreeInfo{$::TreeID}->{'description'}</h3>
|
||||
|
||||
<p>
|
||||
Searching for first checkin after [MyFmtClock $startfrom]...<p>"
|
||||
|
||||
flush stdout
|
||||
|
||||
regsub -all -- / $treeinfo($treeid,repository) _ mungedname
|
||||
set filename "data/checkinlog$mungedname"
|
||||
|
||||
set fid [open $filename "r"]
|
||||
Searching for first checkin after " . MyFmtClock($startfrom) . "...<p>\n";
|
||||
|
||||
|
||||
set foundfirst 0
|
||||
my $mungedname = $::TreeInfo{$::TreeID}->{'repository'};
|
||||
$mungedname =~ s@/@_@g;
|
||||
$mungedname =~ s/^_//;
|
||||
|
||||
set buffer {}
|
||||
my $filename = "data/checkinlog/$mungedname";
|
||||
|
||||
open(FID, "<$filename") || die "Can't open $filename";
|
||||
|
||||
my $foundfirst = 0;
|
||||
|
||||
my $buffer = "";
|
||||
|
||||
|
||||
set tempfile data/repophook.[id process]
|
||||
my $tempfile = "data/repophook.$$";
|
||||
|
||||
proc FlushBuffer {} {
|
||||
global buffer tempfile treeid foundfirst count
|
||||
if {!$foundfirst || [cequal $buffer ""]} {
|
||||
return
|
||||
my $count = 0;
|
||||
my $lastdate = 0;
|
||||
|
||||
sub FlushBuffer {
|
||||
if (!$foundfirst || $buffer eq "") {
|
||||
return;
|
||||
}
|
||||
write_file $tempfile "junkline\n\n$buffer"
|
||||
exec ./addcheckin.tcl -treeid $treeid $tempfile
|
||||
unlink $tempfile
|
||||
set buffer {}
|
||||
incr count
|
||||
if {$count % 100 == 0} {
|
||||
puts "$count scrutinized...<br>"
|
||||
flush stdout
|
||||
open(TMP, ">$tempfile") || die "Can't open $tempfile";
|
||||
print TMP "junkline\n\n$buffer\n";
|
||||
close(TMP);
|
||||
system("./addcheckin.pl -treeid $::TreeID $tempfile");
|
||||
# unlink($tempfile);
|
||||
$buffer = "";
|
||||
$count++;
|
||||
if ($count % 100 == 0) {
|
||||
print "$count scrutinized...<br>\n";
|
||||
}
|
||||
}
|
||||
|
||||
set now [getclock]
|
||||
set count 0
|
||||
set lastdate 0
|
||||
my $now = time();
|
||||
|
||||
while {[gets $fid line] >= 0} {
|
||||
switch -glob -- $line {
|
||||
{?|*} {
|
||||
lassign [split $line "|"] chtype date
|
||||
if {$date < $lastdate} {
|
||||
puts "Ick; dates out of order!<br>"
|
||||
puts "<pre>[value_quote $line]</pre><p>"
|
||||
}
|
||||
set $lastdate $date
|
||||
if {$foundfirst} {
|
||||
append buffer "$line\n"
|
||||
} else {
|
||||
if {$date >= $startfrom} {
|
||||
if {$date >= $now} {
|
||||
puts "Found a future date! (ignoring):<br>"
|
||||
puts "<pre>[value_quote $line]</pre><p>"
|
||||
flush stdout
|
||||
} else {
|
||||
set foundfirst 1
|
||||
puts "Found first line: <br><pre>[value_quote $line]</pre><p>"
|
||||
puts "OK, now processing checkins...<p>"
|
||||
flush stdout
|
||||
set buffer "$line\n"
|
||||
set count 0
|
||||
}
|
||||
while (<FID>) {
|
||||
chomp();
|
||||
my $line = $_;
|
||||
if ($line =~ /^.\|/) {
|
||||
my ($chtype, $date) = (split(/\|/, $line));
|
||||
if ($date < $lastdate) {
|
||||
print "Ick; dates out of order!<br>\n";
|
||||
print "<pre>" . value_quote($line) . "</pre><p>\n";
|
||||
}
|
||||
$lastdate = $date;
|
||||
if ($foundfirst) {
|
||||
$buffer .= "$line\n";
|
||||
} else {
|
||||
if ($date >= $startfrom) {
|
||||
if ($date >= $now) {
|
||||
print "Found a future date! (ignoring):<br>\n";
|
||||
print "<pre>" . value_quote($line) . "</pre><p>\n";
|
||||
} else {
|
||||
incr count
|
||||
if {$count % 2000 == 0} {
|
||||
puts "Skipped $count lines...<p>"
|
||||
flush stdout
|
||||
}
|
||||
$foundfirst = 1;
|
||||
print "Found first line: <br>\n";
|
||||
print "<pre>" . value_quote($line) . "</pre><p>\n";
|
||||
print "OK, now processing checkins...<p>";
|
||||
$buffer = "$line\n";
|
||||
$count = 0;
|
||||
}
|
||||
} else {
|
||||
$count++;
|
||||
if ($count % 2000 == 0) {
|
||||
print "Skipped $count lines...<p>\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
{:ENDLOGCOMMENT} {
|
||||
append buffer "$line\n"
|
||||
FlushBuffer
|
||||
}
|
||||
default {
|
||||
append buffer "$line\n"
|
||||
}
|
||||
} elsif ($line =~ /^:ENDLOGCOMMENT$/) {
|
||||
$buffer .= "$line\n";
|
||||
FlushBuffer();
|
||||
} else {
|
||||
$buffer .= "$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
FlushBuffer
|
||||
FlushBuffer();
|
||||
|
||||
|
||||
catch {unset checkinlist}
|
||||
LoadCheckins
|
||||
print "OK, done. \n";
|
||||
|
||||
puts "Done. [llength $checkinlist] relevant checkins were found."
|
||||
|
||||
PutsTrailer
|
||||
PutsTrailer();
|
||||
|
|
|
|||
|
|
@ -21,28 +21,36 @@
|
|||
#
|
||||
# Query the CVS database.
|
||||
#
|
||||
require 'lloydcgi.pl';
|
||||
require 'cvsmenu.pl';
|
||||
require 'CGI.pl';
|
||||
|
||||
$|=1;
|
||||
|
||||
$CVS_ROOT = $form{"cvsroot"};
|
||||
$CVS_ROOT = $::FORM{"cvsroot"};
|
||||
$CVS_ROOT = pickDefaultRepository() unless $CVS_ROOT;
|
||||
|
||||
LoadTreeConfig();
|
||||
$::TreeID = $::FORM{'module'}
|
||||
if (!exists($::FORM{'treeid'}) &&
|
||||
exists($::FORM{'module'}) &&
|
||||
exists($::TreeInfo{$::FORM{'module'}}{'repository'}));
|
||||
$::TreeID = 'default'
|
||||
if (!exists($::TreeInfo{$::TreeID}{'repository'}) ||
|
||||
exists($::TreeInfo{$::TreeID}{'nobonsai'}));
|
||||
|
||||
|
||||
# get dir, remove leading and trailing slashes
|
||||
|
||||
$dir = $form{"dir"};
|
||||
$dir = $::FORM{"dir"};
|
||||
$dir =~ s/^\/([^:]*)/$1/;
|
||||
$dir =~ s/([^:]*)\/$/$1/;
|
||||
|
||||
$rev = $form{"rev"};
|
||||
$rev = $::FORM{"rev"};
|
||||
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>";
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
|
||||
&setup_script;
|
||||
print $script_str;
|
||||
$Setup_String = $script_str;
|
||||
|
||||
|
||||
if( $CVS_ROOT eq "" ){
|
||||
|
|
@ -55,31 +63,48 @@ if( $rev ne "" ){
|
|||
$s = "for branch <i>$rev</i>";
|
||||
}
|
||||
|
||||
print "
|
||||
<head><title>Repository Directory $CVS_ROOT/$dir $s</title></head>";
|
||||
|
||||
CheckHidden("$CVS_ROOT/$dir");
|
||||
|
||||
$revstr = '';
|
||||
$revstr = "&rev=$rev" unless $rev eq '';
|
||||
$rootstr = '';
|
||||
$rootstr .= "&cvsroot=$::FORM{'cvsroot'}" if defined $::FORM{'cvsroot'};
|
||||
$rootstr .= "&module=$::TreeID";
|
||||
$module = $::TreeInfo{$::TreeID}{'module'};
|
||||
|
||||
$toplevel = Param('toplevel');
|
||||
|
||||
$output = "<DIV ALIGN=LEFT>";
|
||||
$output .= "<A HREF='toplevel.cgi" . BatchIdPart('?') . "'>$toplevel</a>/ ";
|
||||
|
||||
$dir = $module unless ($dir);
|
||||
|
||||
($dir_head, $dir_tail) = $dir =~ m@(.*/)?(.+)@;
|
||||
foreach $path (split('/',$dir_head)) {
|
||||
$link_path .= $path;
|
||||
$output .= "<A HREF='rview.cgi?dir=$link_path";
|
||||
$output .= "&cvsroot=$form{'cvsroot'}" if defined $form{'cvsroot'};
|
||||
$output .= "&rev=$rev" unless $rev eq '';
|
||||
$output .= "'>$path</A>/ ";
|
||||
$output .= "<A HREF='rview.cgi?dir=$link_path$rootstr$revstr'>$path</A>/ ";
|
||||
$link_path .= '/';
|
||||
}
|
||||
chop ($output);
|
||||
$output .= " $s";
|
||||
$output .= "</DIV>";
|
||||
|
||||
EmitHtmlHeader("Repository Directory", $output);
|
||||
PutsHeader("Repository Directory $toplevel/$dir $s", $output);
|
||||
|
||||
cvsmenu("align=right width=20%");
|
||||
cvsmenu("align=right width=30%");
|
||||
|
||||
chdir "$CVS_ROOT/$dir";
|
||||
($other_dir = $dir) =~ s!^$module/?!!;
|
||||
$other_dir_used = 1;
|
||||
|
||||
LoadDirList();
|
||||
if (-d "$CVS_ROOT/$dir") {
|
||||
chdir "$CVS_ROOT/$dir";
|
||||
$other_dir_used = 0;
|
||||
} elsif (-d "$CVS_ROOT/$other_dir") {
|
||||
chdir "$CVS_ROOT/$other_dir";
|
||||
} else {
|
||||
chdir "$CVS_ROOT";
|
||||
}
|
||||
|
||||
print "
|
||||
<TABLE CELLPADDING=0 CELLSPACING=0>
|
||||
|
|
@ -87,6 +112,7 @@ print "
|
|||
Goto Directory:
|
||||
</TD><TD><INPUT name=dir value='$dir' size=30>
|
||||
<INPUT name=rev value='$rev' type=hidden>
|
||||
<INPUT name=module value='$::TreeID' type=hidden>
|
||||
<INPUT name=cvsroot value='$CVS_ROOT' type=hidden>
|
||||
<INPUT type=submit value='chdir'>
|
||||
</TD></TR></FORM>
|
||||
|
|
@ -94,21 +120,44 @@ Goto Directory:
|
|||
Branch:
|
||||
</TD><TD><INPUT name=rev value='$rev' size=30>
|
||||
<INPUT name=dir value='$dir' type=hidden>
|
||||
<INPUT name=module value='$::TreeID' type=hidden>
|
||||
<INPUT name=cvsroot value='$CVS_ROOT' type=hidden>
|
||||
<INPUT type=submit value='Set Branch'>
|
||||
</TR>
|
||||
</TR></FORM>
|
||||
</TABLE>
|
||||
|
||||
";
|
||||
|
||||
@dirs = ();
|
||||
|
||||
sub clean_dirpath {
|
||||
my ($dirpath) = @_;
|
||||
|
||||
$dirpath =~ s!^/+!!;
|
||||
$dirpath =~ s!/+!/!g;
|
||||
return $dirpath;
|
||||
}
|
||||
|
||||
|
||||
DIR:
|
||||
while( <*> ){
|
||||
if( -d $_ ){
|
||||
push @dirs, $_;
|
||||
LEGALDIR:
|
||||
for my $testdir (sort( grep(!/\*$/, @::LegalDirs) ) ) {
|
||||
my $trial = clean_dirpath("$other_dir/$_");
|
||||
my $trial2 = clean_dirpath("$dir/$_");
|
||||
|
||||
if (($other_dir_used && $trial =~ m!^$testdir(/|$)!) ||
|
||||
(!$other_dir_used && $trial2 =~ m!^$testdir(/|$)!)) {
|
||||
push @dirs, $_;
|
||||
next DIR;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
if( @dirs != 0 ){
|
||||
$j = 1;
|
||||
$split = int(@dirs/4)+1;
|
||||
|
|
@ -116,7 +165,7 @@ if( @dirs != 0 ){
|
|||
|
||||
|
||||
for $i (@dirs){
|
||||
$form{"dir"} = ($dir ne "" ? "$dir/$i" : $i);
|
||||
$::FORM{"dir"} = ($dir ne "" ? "$dir/$i" : $i);
|
||||
$anchor = &make_cgi_args;
|
||||
print "<dt><a href=rview.cgi${anchor}>$i</a>\n";
|
||||
if( $j % $split == 0 ){
|
||||
|
|
@ -124,7 +173,7 @@ if( @dirs != 0 ){
|
|||
}
|
||||
$j++;
|
||||
}
|
||||
$form{"dir"} = $dir;
|
||||
$::FORM{"dir"} = $dir;
|
||||
print "\n</tr></table>\n";
|
||||
}
|
||||
|
||||
|
|
@ -147,6 +196,8 @@ for $_ (@files){
|
|||
}
|
||||
print "\n</tr></table>\n";
|
||||
|
||||
PutsTrailer();
|
||||
|
||||
|
||||
sub setup_script {
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,334 +17,280 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
use vars qw(@TreeList);
|
||||
|
||||
Lock
|
||||
LoadCheckins
|
||||
LoadTreeConfig
|
||||
Unlock
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
LoadTreeConfig();
|
||||
Unlock();
|
||||
|
||||
# Stupid hack to make an empty array:
|
||||
set peoplearray(zzz) 1
|
||||
unset peoplearray(zzz)
|
||||
set versioninfo ""
|
||||
my %peoplearray = ();
|
||||
my @list = ();
|
||||
my $versioninfo = '';
|
||||
my $tweak = $::FORM{'tweak'};
|
||||
my $delta_size = 1;
|
||||
my ($title, $head, $subhead) = ('', '', '');
|
||||
my ($checkin, $info);
|
||||
|
||||
proc BreakBig {str} {
|
||||
set result {}
|
||||
while {[clength $str] > 20} {
|
||||
set head [crange $str 0 19]
|
||||
set w [string last "/" $head]
|
||||
if {$w < 0} {
|
||||
set w 19
|
||||
}
|
||||
append result "[crange $str 0 $w]<br>"
|
||||
incr w
|
||||
set str [crange $str $w end]
|
||||
}
|
||||
append result $str
|
||||
sub BreakBig {
|
||||
my ($str) = @_;
|
||||
my $result = '';
|
||||
|
||||
while (length($str) > 20) {
|
||||
my $head = substr($str, 0, 19);
|
||||
my $w = rindex($head, "/");
|
||||
|
||||
$w = 19 if ($w < 0);
|
||||
$result .= substr($str, 0, $w++) . "<br>";
|
||||
$str = substr($str, $w);
|
||||
}
|
||||
return $result . $str;
|
||||
}
|
||||
|
||||
|
||||
|
||||
set tweak [info exists FORM(tweak)]
|
||||
|
||||
set delta_size 1 ;#[info exists FORM(delta_size)]
|
||||
if (exists($::FORM{'person'})) {
|
||||
$title = $head = "Checkins for $::FORM{'person'}";
|
||||
|
||||
puts "Content-type: text/html"
|
||||
foreach $checkin (@::CheckInList) {
|
||||
$info = eval("\\\%$checkin");
|
||||
push @list, $checkin
|
||||
if ($$info{'person'} eq $::FORM{'person'});
|
||||
}
|
||||
} elsif (exists($::FORM{'mindate'}) || exists($::FORM{'maxdate'})) {
|
||||
my ($min, $max) = (0, 1<<30);
|
||||
|
||||
if {[info exists FORM(sort)]} {
|
||||
puts "Set-Cookie: SORT=$FORM(sort)"
|
||||
} elseif {[info exists COOKIE(SORT)]} {
|
||||
set FORM(sort) $COOKIE(SORT)
|
||||
$title = "Checkins";
|
||||
if (exists($::FORM{'mindate'})) {
|
||||
$title .= " since " . MyFmtClock($min = $::FORM{'mindate'});
|
||||
$title .= " and" if (exists($::FORM{'maxdate'}));
|
||||
}
|
||||
$title .= " before" . MyFmtClock($max = $::FORM{'maxdate'})
|
||||
if (exists($::FORM{'maxdate'}));
|
||||
$head = $title;
|
||||
|
||||
foreach $checkin (@::CheckInList) {
|
||||
$info = eval("\\\%$checkin");
|
||||
push @list, $checkin
|
||||
if (($$info{'date'} >= $min) && ($$info{'date'} <= $max));
|
||||
}
|
||||
} else {
|
||||
set FORM(sort) date
|
||||
}
|
||||
|
||||
puts "
|
||||
<HTML>"
|
||||
|
||||
if {[info exists FORM(person)]} {
|
||||
puts "<TITLE>Checkins for $FORM(person)</TITLE>"
|
||||
puts "<H1>Checkins for $FORM(person)</H1>"
|
||||
set list {}
|
||||
foreach i $checkinlist {
|
||||
upvar #0 $i info
|
||||
if {[cequal $info(person) $FORM(person)]} {
|
||||
lappend list $i
|
||||
}
|
||||
}
|
||||
} elseif {[info exists FORM(mindate)] || [info exists FORM(maxdate)]} {
|
||||
set str "Checkins"
|
||||
set min 0
|
||||
set max [expr 1<<30]
|
||||
if {[info exists FORM(mindate)]} {
|
||||
set min $FORM(mindate)
|
||||
append str " since [fmtclock $min "%m/%d %H:%M"]"
|
||||
if {[info exists FORM(maxdate)]} {
|
||||
append str " and"
|
||||
}
|
||||
}
|
||||
if {[info exists FORM(maxdate)]} {
|
||||
set max $FORM(maxdate)
|
||||
append str " before [fmtclock $max "%m/%d %H:%M"]"
|
||||
}
|
||||
puts "<TITLE>$str</TITLE>"
|
||||
puts "<H1>$str</H1>"
|
||||
set list {}
|
||||
foreach i $checkinlist {
|
||||
upvar #0 $i info
|
||||
if {$info(date) >= $min && $info(date) <= $max} {
|
||||
lappend list $i
|
||||
}
|
||||
}
|
||||
} else {
|
||||
puts "<TITLE>All checkins</TITLE>"
|
||||
puts "<H1>All Checkins</H1>"
|
||||
set list $checkinlist
|
||||
}
|
||||
|
||||
if {$readonly} {
|
||||
puts "<h2><font color=red>Be aware that you are looking at an old hook!</font></h2>"
|
||||
$title = $head = "All Checkins";
|
||||
@list = @::CheckInList;
|
||||
}
|
||||
|
||||
|
||||
puts "(Current sort is by <tt>$FORM(sort)</tt>; click on a column header
|
||||
to sort by that column.)"
|
||||
$subhead .= "<br><font color=red>
|
||||
Be aware that you are looking at an old hook!</font>"
|
||||
if (Param('readonly'));
|
||||
|
||||
# Oh, boy, is this ever gross. Dynamically write some code to be the sort
|
||||
# comparison routine, so that we know that the sort code will run fast.
|
||||
PutsHeader($title, $head, $subhead);
|
||||
|
||||
set fields [split $FORM(sort) ","]
|
||||
set w [lsearch $fields "date"]
|
||||
if {$w >= 0} {
|
||||
set fields [lrange $fields 0 [expr $w - 1]]
|
||||
$::FORM{'sort'} = 'date' unless $::FORM{'sort'};
|
||||
|
||||
print "
|
||||
(Current sort is by <tt>$::FORM{'sort'}</tt>; click on a column header
|
||||
to sort by that column.)";
|
||||
|
||||
my @fields = split(/,/, $::FORM{'sort'});
|
||||
|
||||
sub Compare {
|
||||
my $info_a = eval("\\\%$a");
|
||||
my $info_b = eval("\\\%$b");
|
||||
my $rval = 0;
|
||||
my $key;
|
||||
|
||||
foreach $key (@fields) {
|
||||
$rval = $$info_a{$key} cmp $$info_b{$key};
|
||||
return $rval unless ($rval == 0);
|
||||
}
|
||||
return $rval;
|
||||
}
|
||||
|
||||
set body {
|
||||
upvar #0 $n1 a $n2 b
|
||||
}
|
||||
foreach i $fields {
|
||||
append body "set delta \[string compare \$a($i) \$b($i)\]"
|
||||
append body "\n"
|
||||
append body {if {$delta != 0} {return $delta}}
|
||||
append body "\n"
|
||||
}
|
||||
append body {return [expr $b(date) - $a(date)]}
|
||||
|
||||
eval [list proc Compare {n1 n2} $body]
|
||||
|
||||
set total_added 0
|
||||
set total_removed 0
|
||||
my $total_added = 0;
|
||||
my $total_removed = 0;
|
||||
|
||||
#
|
||||
# Calculate delta information
|
||||
#
|
||||
if {$delta_size} {
|
||||
foreach i $list {
|
||||
upvar #0 $i info
|
||||
set info(added) 0
|
||||
set info(removed) 0
|
||||
CHECKIN:
|
||||
foreach $checkin (@list) {
|
||||
$info = eval("\\\%$checkin");
|
||||
|
||||
#
|
||||
# Loop through the checkins, grab the filename and stickyflags
|
||||
#
|
||||
if {[info exists info(fullinfo)]} {
|
||||
foreach fu $info(fullinfo) {
|
||||
set fn [lindex $fu 0]
|
||||
set sticky [lindex $fu 4]
|
||||
$$info{added} = 0;
|
||||
$$info{removed} = 0;
|
||||
|
||||
#
|
||||
# if the file is binary, don't show the delta information
|
||||
#
|
||||
if { ![string match {*.gif} $fn]
|
||||
&& ![string match {*.bmp} $fn]
|
||||
&& ![string match {-kb} $sticky]} {
|
||||
scan [lindex $fu 2] {%d} file_added
|
||||
scan [lindex $fu 3] {%d} file_removed
|
||||
if {[info exists file_added] && [info exists file_removed]} {
|
||||
incr info(added) $file_added
|
||||
incr info(removed) $file_removed
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (exists($$info{'fullinfo'})) {
|
||||
my @fullinfos = split(/!NeXt!/, $$info{'fullinfo'});
|
||||
INFO:
|
||||
foreach my $fullinfo (@fullinfos) {
|
||||
my ($file, $version, $addlines, $removelines, $sticky)
|
||||
= split(/\|/, $fullinfo);
|
||||
|
||||
set info(lines_changed) [format "%7d" [expr 1000000 - ($info(added) - $info(removed))]]
|
||||
incr total_added $info(added)
|
||||
incr total_removed $info(removed)
|
||||
}
|
||||
}
|
||||
# Skip binary files
|
||||
next INFO if (($file =~ /\.gif$/) ||
|
||||
($file =~ /\.bmp$/) ||
|
||||
($sticky =~ /-kb/));
|
||||
|
||||
set list [lsort -command Compare $list]
|
||||
$$info{added} += $addlines;
|
||||
$$info{removed} += $removelines;
|
||||
}
|
||||
}
|
||||
|
||||
regsub -all {[&?]sort=[^&]*} $buffer {} otherparams
|
||||
$$info{'lines_changed'} =
|
||||
sprintf("%7d", 1000000 - ($$info{added} - $$info{removed}));
|
||||
|
||||
proc NewSort {key} {
|
||||
global otherparams FORM
|
||||
set list [split $FORM(sort) ","]
|
||||
set w [lsearch $list $key]
|
||||
if {$w >= 0} {
|
||||
set list [lreplace $list $w $w]
|
||||
}
|
||||
set list [linsert $list 0 $key]
|
||||
return "[set otherparams]&sort=[join $list ,]"
|
||||
$total_added += $$info{added};
|
||||
$total_removed += $$info{removed};
|
||||
}
|
||||
|
||||
|
||||
if {$tweak} {
|
||||
puts "<FORM method=get action=\"dotweak.cgi\">"
|
||||
# Sort that puppy...
|
||||
@list = sort Compare @list;
|
||||
|
||||
# $::buffer contains the arguments that we were called with, it is
|
||||
# initialized by CGI.pl
|
||||
my $otherparams;
|
||||
($otherparams = $::buffer) =~ s/[&?]sort=[^&]*//g;
|
||||
|
||||
sub NewSort {
|
||||
my ($key) = @_;
|
||||
my @sort_keys = grep(!/^$key$/, split(/,/, $::FORM{'sort'}));
|
||||
unshift(@sort_keys, $key);
|
||||
|
||||
return $otherparams . "&sort=" . join(',', @sort_keys);
|
||||
}
|
||||
|
||||
|
||||
puts "
|
||||
<TABLE border cellspacing=2>
|
||||
<TR ALIGN=LEFT>
|
||||
"
|
||||
|
||||
if {$tweak} {
|
||||
puts "<TH></TH>"
|
||||
}
|
||||
#
|
||||
# Print the table...
|
||||
#
|
||||
|
||||
puts "
|
||||
<TH><A HREF=\"showcheckins.cgi?[set otherparams]&sort=date\">When</A>
|
||||
<TH><A HREF=\"showcheckins.cgi?[NewSort treeopen]\">Tree state</A>
|
||||
<TH><A HREF=\"showcheckins.cgi?[NewSort person]\">Who</A>
|
||||
<TH><A HREF=\"showcheckins.cgi?[NewSort dir]\">Directory</A>
|
||||
<TH><A HREF=\"showcheckins.cgi?[NewSort files]\">Files</A>"
|
||||
print "<FORM method=get action=\"dotweak.cgi\">\n" if $tweak;
|
||||
print "<TABLE border cellspacing=2>\n<TR ALIGN=LEFT>\n\n";
|
||||
print "<TH></TH>\n" if $tweak;
|
||||
|
||||
if {$delta_size} {
|
||||
puts "<TH><A HREF=\"showcheckins.cgi?[NewSort lines_changed]\"><tt>+/-</tt></A>"
|
||||
}
|
||||
|
||||
puts "
|
||||
print "
|
||||
<TH><A HREF=\"showcheckins.cgi?${otherparams}&sort=date\">When</A>
|
||||
<TH><A HREF=\"showcheckins.cgi?" . NewSort('treeopen') . "\">Tree state</A>
|
||||
<TH><A HREF=\"showcheckins.cgi?" . NewSort('person') . "\">Who</A>
|
||||
<TH><A HREF=\"showcheckins.cgi?" . NewSort('dir') . "\">Directory</A>
|
||||
<TH><A HREF=\"showcheckins.cgi?" . NewSort('files') . "\">Files</A>
|
||||
<TH><A HREF=\"showcheckins.cgi?" . NewSort('lines_changed') .
|
||||
"\"><tt>+/-</tt></A>
|
||||
<TH WIDTH=100%>Description
|
||||
</TR>"
|
||||
</TR>\n\n";
|
||||
|
||||
set count 0
|
||||
set maxcount 100
|
||||
|
||||
set branchpart {}
|
||||
my $count = 0;
|
||||
my $maxcount = 100;
|
||||
my $branchpart = '';
|
||||
|
||||
if {![cequal $treeinfo($treeid,branch) {}]} {
|
||||
set branchpart "&branch=$treeinfo($treeid,branch)"
|
||||
$branchpart = "&branch=$::TreeInfo{$::TreeID}{branch}"
|
||||
if ($::TreeInfo{$::TreeID}{branch});
|
||||
|
||||
foreach $checkin (@list) {
|
||||
$info = eval("\\\%$checkin");
|
||||
|
||||
# Don't make tables too big, or toy computers will break.
|
||||
if ($count++ > $maxcount) {
|
||||
$count = 0;
|
||||
print "</TABLE>\n\n<TABLE border cellspacing=2>\n";
|
||||
}
|
||||
|
||||
print "<TR>\n";
|
||||
print "<TD><INPUT TYPE=CHECKBOX NAME=\"$checkin\"></TD>\n" if $tweak;
|
||||
print "<TD><a href=editcheckin.cgi?id=$checkin" . BatchIdPart(). ">\n";
|
||||
print time2str("<font size=-1>%D %H:%M</font>" , $$info{date}) .
|
||||
"</a></TD>\n";
|
||||
print "<TD>" . (($$info{treeopen})? "open": "CLOSED") . "\n";
|
||||
print "<br>$$info{notes}\n" if $$info{notes};
|
||||
|
||||
$peoplearray{$$info{person}} = 1;
|
||||
print "<TD>". GenerateUserLookUp($$info{person}) . "</TD>\n";
|
||||
print "<TD><a href=\"cvsview2.cgi?" .
|
||||
"root=$::TreeInfo{$::TreeID}{repository}&" .
|
||||
"subdir=$$info{dir}&" .
|
||||
"files=" . join('+', split(/!NeXt!/, $$info{files})) . "&" .
|
||||
"command=DIRECTORY$branchpart\">" .
|
||||
BreakBig($$info{dir}) .
|
||||
"</a></TD>\n";
|
||||
print "<TD>\n";
|
||||
foreach my $file (split(/!NeXt!/, $$info{files})) {
|
||||
print " <a href=\"cvsview2.cgi?" .
|
||||
"root=$::TreeInfo{$::TreeID}{repository}&" .
|
||||
"subdir=$$info{dir}&" .
|
||||
"files=$file&" .
|
||||
"command=DIRECTORY$branchpart\">" .
|
||||
"$file</a>\n";
|
||||
}
|
||||
print "</td>\n";
|
||||
|
||||
print "<TD><tt>+$$info{added}/-". abs($$info{removed}). "</tt></td>\n";
|
||||
foreach my $fullinfo (split(/!NeXt!/, $$info{'fullinfo'})) {
|
||||
my ($file, $version) = split(/\|/, $fullinfo);
|
||||
$versioninfo = "$$info{person}|$$info{dir}|$file|$version,";
|
||||
}
|
||||
print "<TD WIDTH=100%>$$info{'log'}</td>\n";
|
||||
print "</tr>\n\n";
|
||||
}
|
||||
print "</table>\n";
|
||||
|
||||
print scalar @list . " checkins listed.
|
||||
Lines changed <tt>($total_added/$total_removed)</tt>.\n";
|
||||
|
||||
sub IsSelected {
|
||||
my ($value) = @_;
|
||||
|
||||
return "SELECTED" if ($value eq $::TreeID);
|
||||
return "";
|
||||
}
|
||||
|
||||
foreach i $list {
|
||||
upvar #0 $i info
|
||||
incr count
|
||||
if {$count >= $maxcount} {
|
||||
set count 0
|
||||
# Don't make tables too big, or toy computers will break.
|
||||
puts "</TABLE><TABLE border cellspacing=2>"
|
||||
}
|
||||
puts "<TR>"
|
||||
if {$tweak} {
|
||||
puts "<TD><INPUT TYPE=CHECKBOX NAME=$i></TD>"
|
||||
}
|
||||
puts "<TD><a href=editcheckin.cgi?id=$i[BatchIdPart]>"
|
||||
puts "[fmtclock $info(date) "<font size=-2>%m/%d %H:%M</font>"]</a></TD>"
|
||||
puts "<TD>"
|
||||
if {$info(treeopen)} {
|
||||
puts "open"
|
||||
} else {
|
||||
puts "CLOSED"
|
||||
}
|
||||
if {[info exists info(notes)]} {
|
||||
if {![cequal $info(notes) ""]} {
|
||||
puts "<br>$info(notes)"
|
||||
}
|
||||
}
|
||||
puts "</TD>"
|
||||
set peoplearray($info(person)) 1
|
||||
puts "<TD><a href=\"http://phonebook/ds/dosearch/phonebook/uid=[url_quote "$info(person),ou=People,o= Netscape Communications Corp.,c=US"]\">$info(person)</a></TD>"
|
||||
puts "<TD><a href=\"cvsview2.cgi?root=$treeinfo($treeid,repository)&subdir=$info(dir)&files=[join $info(files) +]&command=DIRECTORY$branchpart\">[BreakBig $info(dir)]</a></TD>"
|
||||
puts "<TD>"
|
||||
foreach f $info(files) {
|
||||
puts "<a href=\"cvsview2.cgi?root=$treeinfo($treeid,repository)&subdir=$info(dir)&files=$f&command=DIRECTORY$branchpart\">$f</a>"
|
||||
}
|
||||
|
||||
puts "</TD>"
|
||||
if {$delta_size} {
|
||||
puts "<TD>"
|
||||
if {$info(removed) < 0} {
|
||||
set str_removed $info(removed)
|
||||
} else {
|
||||
set str_removed "-$info(removed)"
|
||||
}
|
||||
puts "<tt>+$info(added)<br>$str_removed"
|
||||
puts "</TD>"
|
||||
}
|
||||
if {[info exists info(fullinfo)]} {
|
||||
foreach f $info(fullinfo) {
|
||||
lassign $f file version
|
||||
append versioninfo "$info(person)|$info(dir)|$file|$version,"
|
||||
}
|
||||
}
|
||||
puts "<TD WIDTH=100%>$info(log)</TD>"
|
||||
puts "</TR>"
|
||||
}
|
||||
puts "</TABLE>"
|
||||
|
||||
|
||||
if {$delta_size} {
|
||||
set deltastr " Lines changed <tt>($total_added/$total_removed)</tt>."
|
||||
} else {
|
||||
set deltastr ""
|
||||
}
|
||||
|
||||
|
||||
puts "[llength $list] checkins listed. $deltastr"
|
||||
|
||||
|
||||
if {$tweak} {
|
||||
puts "
|
||||
if ($tweak) {
|
||||
print "
|
||||
<hr>
|
||||
Check the checkins you wish to affect. Then select one of the below options.
|
||||
And type the magic word. Then click on submit.
|
||||
<P>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
|
||||
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
|
||||
<INPUT TYPE=radio NAME=command VALUE=nuke>Delete these checkins.<BR>
|
||||
<INPUT TYPE=radio NAME=command VALUE=setopen>Set the tree state on these checkins to be <B>Open</B>.<BR>
|
||||
<INPUT TYPE=radio NAME=command VALUE=setclose>Set the tree state on these checkins to be <B>Closed</B>.<BR>
|
||||
<INPUT TYPE=radio NAME=command VALUE=movetree>Move these checkins over to this tree:
|
||||
<SELECT NAME=desttree SIZE=1>"
|
||||
<SELECT NAME=desttree SIZE=1>\n";
|
||||
|
||||
proc IsSelected {value} {
|
||||
global treeid
|
||||
if {[cequal $value $treeid]} {
|
||||
return "SELECTED"
|
||||
} else {
|
||||
return ""
|
||||
}
|
||||
}
|
||||
|
||||
foreach my $tree (@::TreeList) {
|
||||
print "<OPTION ". IsSelected($tree).
|
||||
" VALUE=$tree>$::TreeInfo{$tree}{description}\n"
|
||||
unless $::TreeInfo{$tree}{nobonsai};
|
||||
}
|
||||
|
||||
foreach i $treelist {
|
||||
if {![info exists treeinfo($i,nobonsai)]} {
|
||||
puts "<OPTION [IsSelected $i] VALUE=$i>$treeinfo($i,description)"
|
||||
}
|
||||
}
|
||||
|
||||
puts "</SELECT><P>
|
||||
print "
|
||||
</SELECT><P>
|
||||
<B>Password:</B><INPUT NAME=password TYPE=password></td>
|
||||
<BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=Submit>
|
||||
</FORM>"
|
||||
</FORM>\n";
|
||||
} else {
|
||||
puts " "
|
||||
puts "<a href=showcheckins.cgi?$buffer&tweak=1>Tweak some of these checkins.</a>"
|
||||
puts "<br><br>"
|
||||
puts "<FORM action='multidiff.cgi' method=post>"
|
||||
puts "<INPUT TYPE='HIDDEN' name='allchanges' value = '$versioninfo'>"
|
||||
puts "<INPUT TYPE=SUBMIT VALUE='Show me ALL the Diffs'>"
|
||||
puts "</FORM>"
|
||||
print "
|
||||
|
||||
<a href=showcheckins.cgi?$::buffer&tweak=1>Tweak some of these checkins.</a>
|
||||
<br><br>
|
||||
<FORM action='multidiff.cgi' method=post>
|
||||
<INPUT TYPE='HIDDEN' name='allchanges' value = '$versioninfo'>
|
||||
<INPUT TYPE=SUBMIT VALUE='Show me ALL the Diffs'>
|
||||
</FORM>\n";
|
||||
}
|
||||
|
||||
if {[info exists FORM(ltabbhack)]} {
|
||||
puts "<!-- StupidLloydHack [join [lsort [array names peoplearray]] {,}] -->"
|
||||
puts "<!-- LloydHack2 $versioninfo -->"
|
||||
if (exists $::FORM{ltabbhack}) {
|
||||
print "<!-- StupidLloydHack " . join(',', sort(keys(%peoplearray))) .
|
||||
" -->\n";
|
||||
print "<!-- LloydHack2 $versioninfo -->\n";
|
||||
}
|
||||
|
||||
PutsTrailer();
|
||||
|
||||
|
||||
PutsTrailer
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,38 +17,32 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
print "Content-type: text/html\n\n";
|
||||
LoadTreeConfig();
|
||||
|
||||
LoadTreeConfig
|
||||
sub IsChecked {
|
||||
my ($value) = @_;
|
||||
my $rval = '';
|
||||
|
||||
proc IsChecked {value} {
|
||||
global treeid
|
||||
if {[cequal $value $treeid]} {
|
||||
return "CHECKED"
|
||||
} else {
|
||||
return ""
|
||||
}
|
||||
$rval = "CHECKED" if ($value eq $::TreeID);
|
||||
return $rval;
|
||||
}
|
||||
|
||||
puts "Content-type: text/html
|
||||
my $title = "George, George, George of the jungle...";
|
||||
PutsHeader($title, "Switch-o-Matic");
|
||||
|
||||
<HTML>
|
||||
<TITLE>George, George, George of the jungle...</TITLE>
|
||||
print "
|
||||
<b>Which tree would you like to see?</b>
|
||||
<FORM method=get action=\"toplevel.cgi\">\n";
|
||||
|
||||
Which tree would you like to see?
|
||||
"
|
||||
foreach my $i (@::TreeList) {
|
||||
next if (exists($::TreeInfo{$i}{nobosai}));
|
||||
|
||||
puts "<FORM method=get action=\"toplevel.cgi\">"
|
||||
|
||||
foreach i $treelist {
|
||||
if {![info exists treeinfo($i,nobonsai)]} {
|
||||
puts "<INPUT TYPE=radio NAME=treeid VALUE=$i [IsChecked $i]>"
|
||||
puts "$treeinfo($i,description)<BR>"
|
||||
}
|
||||
print "<INPUT TYPE=radio NAME=treeid VALUE=$i " . IsChecked($i) . ">\n";
|
||||
print "$::TreeInfo{$i}{description}<BR>\n";
|
||||
}
|
||||
|
||||
puts "<INPUT TYPE=SUBMIT Value=\"Submit\"></FORM>"
|
||||
|
||||
PutsTrailer
|
||||
|
||||
exit
|
||||
print "<INPUT TYPE=SUBMIT Value=\"Submit\"></FORM>\n";
|
||||
PutsTrailer();
|
||||
exit;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,235 +17,170 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
Lock
|
||||
LoadCheckins
|
||||
LoadMOTD
|
||||
LoadWhiteboard
|
||||
LoadTreeConfig
|
||||
Unlock
|
||||
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>";
|
||||
|
||||
|
||||
if {$treeopen} {
|
||||
set openword Open
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
LoadMOTD();
|
||||
LoadWhiteboard();
|
||||
LoadTreeConfig();
|
||||
Unlock();
|
||||
|
||||
|
||||
if ($::TreeOpen) {
|
||||
$openword = '<b><FONT SIZE=+2>OPEN</FONT></B>';
|
||||
} else {
|
||||
set openword Closed
|
||||
$openword = '<b><FONT SIZE=+3 COLOR=RED>CLOSED</FONT></B>';
|
||||
}
|
||||
|
||||
puts "Content-type: text/html
|
||||
Refresh: 300
|
||||
|
||||
<HTML>
|
||||
<TITLE>($openword) Bonsai -- the art of effectively controlling trees</TITLE>
|
||||
|
||||
<IMG ALIGN=right SRC=bonsai.gif>
|
||||
<H1>Bonsai -- Tree Control</H1>
|
||||
print "
|
||||
|
||||
<FORM name=treeform>
|
||||
<H3>
|
||||
<SELECT name=treeid size=1 onchange='submit();'>
|
||||
"
|
||||
";
|
||||
|
||||
# <SELECT name=treeid size=1 onchange='window.location =\"toplevel.cgi?treeid=\" + treeform.treeid.value;'>
|
||||
|
||||
foreach t $treelist {
|
||||
if {![info exists treeinfo($t,nobonsai)]} {
|
||||
if {[cequal $t $treeid]} {
|
||||
set c "SELECTED"
|
||||
} else {
|
||||
set c ""
|
||||
}
|
||||
puts "<OPTION VALUE=$t $c>$treeinfo($t,description)"
|
||||
foreach $tree (@::TreeList) {
|
||||
unless (exists $::TreeInfo{$tree}{nobonsai}) {
|
||||
$c = '';
|
||||
$c = "SELECTED" if ($tree eq $::TreeID);
|
||||
print "<OPTION VALUE=\"$tree\" $c>$::TreeInfo{$tree}{description}\n";
|
||||
}
|
||||
}
|
||||
|
||||
puts "</SELECT></H3></FORM>"
|
||||
print "</SELECT></H3></FORM>\n";
|
||||
|
||||
|
||||
|
||||
if {$readonly} {
|
||||
puts "<h2><font color=red>Be aware that you are looking at an old hook!</font></h2>"
|
||||
if (Param('readonly')) {
|
||||
print "<h2><font color=red>
|
||||
Be aware that you are looking at an old hook!</font></h2>\n";
|
||||
}
|
||||
|
||||
puts "<tt>[fmtclock [getclock] "%R"]</tt>: The tree is currently <B>"
|
||||
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";
|
||||
|
||||
if {$treeopen} {
|
||||
puts "<FONT SIZE=+2>OPEN</FONT></B><BR>"
|
||||
} else {
|
||||
puts "<FONT SIZE=+3 COLOR=RED>CLOSED</FONT></B><BR>"
|
||||
}
|
||||
|
||||
if {!$treeopen} {
|
||||
puts "The tree has been closed since <tt>[MyFmtClock $closetimestamp]</tt>."
|
||||
}
|
||||
puts "<BR>"
|
||||
puts "The last known good tree had a timestamp "
|
||||
puts "of <tt>[fmtclock $lastgoodtimestamp "%D %T %Z"]</tt>.<br>"
|
||||
|
||||
puts "<hr><pre variable>$motd</pre><hr>"
|
||||
|
||||
|
||||
puts "<br clear=all>"
|
||||
|
||||
# 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 "<b><a href=editwhiteboard.cgi[BatchIdPart ?]>Free-for-all whiteboard:</a></b> (Changebars indicate changes within last [PrettyDelta $delta])<pre>[html_quote [read_file $filename]]</pre><hr>"
|
||||
|
||||
puts "<b><a href=editwhiteboard.cgi[BatchIdPart ?]>Free-for-all whiteboard:</a></b><pre>[html_quote $whiteboard]</pre><hr>"
|
||||
|
||||
|
||||
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
|
||||
}
|
||||
print "Nobody seems to have made any changes since the tree opened.";
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
}
|
||||
}
|
||||
}
|
||||
$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');
|
||||
|
||||
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 "<p>"
|
||||
|
||||
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 "<font color=red>Can't contact the directory server at $ldapserver:$ldapport -- $errvar</font>"
|
||||
}
|
||||
|
||||
puts "<table border cellspacing=2>"
|
||||
puts "<th colspan=2>Who</th><th>What</th>"
|
||||
if {![cequal $ldapserver ""]} {
|
||||
puts "<th>How to contact</th>"
|
||||
}
|
||||
|
||||
foreach p $peoplelist {
|
||||
if {[info exists closedcheckin($p)]} {
|
||||
set extra " <font color=red>([llength $closedcheckin($p)] while tree closed!)</font>"
|
||||
} else {
|
||||
set extra ""
|
||||
}
|
||||
|
||||
set uname $username($p)
|
||||
set namepart $p
|
||||
regsub {@.*$} $namepart {} namepart
|
||||
puts "
|
||||
<tr>
|
||||
<td>$fullname($p)</a></td>
|
||||
<td><a href=\"http://phonebook/ds/dosearch/phonebook/uid=[url_quote "$namepart,ou=People,o= Netscape Communications Corp.,c=US"]\">
|
||||
$uname</td>
|
||||
<td><a href=\"showcheckins.cgi?person=[url_quote $uname][BatchIdPart]\">[llength $people($p)]
|
||||
[Pluralize change [llength $people($p)]]</a>$extra</td>"
|
||||
puts "
|
||||
<td>$curcontact($p)
|
||||
</tr>"
|
||||
}
|
||||
|
||||
puts "</table>"
|
||||
puts "[llength $checkinlist] checkins."
|
||||
|
||||
set mailaddr [join $peoplelist ","]
|
||||
append mailaddr "?subject=Hook%3a%20Build%20Problem"
|
||||
if {[info exists treeinfo($treeid,cchookmail)]} {
|
||||
append mailaddr "&cc=$treeinfo($treeid,cchookmail)"
|
||||
}
|
||||
puts "<p>"
|
||||
puts "<a href=showcheckins.cgi[BatchIdPart ?]>Show all checkins.</a><br>"
|
||||
puts "<a href=\"mailto:[set mailaddr]\">"
|
||||
puts "Send mail to \"the hook\".</a><br>"
|
||||
} 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 "
|
||||
print "
|
||||
<hr>
|
||||
<table>
|
||||
<tr>
|
||||
|
|
@ -253,19 +188,69 @@ puts "
|
|||
</tr>
|
||||
<tr>
|
||||
<td valign=top>
|
||||
<a href=$cvsqueryurl><b>CVS Query Tool</b></a><br>
|
||||
<a href=$tinderbox_base/showbuilds.cgi>Tinderbox continuous builds</a><br>
|
||||
<a href=\"switchtree.cgi[BatchIdPart ?]\">Switch to look at a different tree or branch</a><br>
|
||||
<a href=viewold.cgi[BatchIdPart ?]>Time warp -- view a different day's hook.</a><br>
|
||||
<a href=countcheckins.cgi[BatchIdPart ?]>See some stupid statistics about recent checkins.</a><br>
|
||||
<a href=admin.cgi[BatchIdPart ?]>Administration menu.</a><br>
|
||||
<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>
|
||||
<a href=http://www.mozilla.org/hacking/bonsai.html>Introduction to Bonsai.</a><br>
|
||||
<a href=http://www.mozilla.org/docs/>Mozilla Documentation and Build Instructions</a>
|
||||
$otherrefs
|
||||
</td>
|
||||
</tr></table>
|
||||
"
|
||||
" ;
|
||||
|
||||
exit 0;
|
||||
|
||||
|
||||
exit
|
||||
|
||||
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);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,23 @@
|
|||
# Example configuration file for Bonsai
|
||||
|
||||
# The Bonsai modules and their relation to cvs
|
||||
|
||||
# @::TreeList is a list of all configured Bonsai modules
|
||||
# to add a module, add its name to @::TreeList
|
||||
# then duplicate the "default" entry in @::TreeInfo and
|
||||
# change the values appropriately
|
||||
|
||||
@::TreeList = ('default');
|
||||
|
||||
%::TreeInfo = (
|
||||
default => {
|
||||
branch => '',
|
||||
description => 'My CVS repository',
|
||||
module => 'All',
|
||||
repository => '/cvsroot',
|
||||
shortdesc => 'Mine',
|
||||
},
|
||||
,
|
||||
);
|
||||
|
||||
1;
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
#!/usr/bonsaitools/bin/mysqltcl
|
||||
# -*- Mode: tcl; indent-tabs-mode: nil -*-
|
||||
#!/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
|
||||
|
|
@ -17,57 +17,62 @@
|
|||
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
||||
# Netscape Communications Corporation. All Rights Reserved.
|
||||
|
||||
source CGI.tcl
|
||||
require 'CGI.pl';
|
||||
|
||||
LoadCheckins
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
proc IsChecked {value} {
|
||||
global batchid
|
||||
if {[cequal $value $batchid]} {
|
||||
LoadCheckins();
|
||||
|
||||
sub IsChecked {
|
||||
my ($value) = (@_);
|
||||
if ($value == $::BatchID) {
|
||||
return "CHECKED"
|
||||
} else {
|
||||
return ""
|
||||
}
|
||||
}
|
||||
|
||||
puts "Content-type: text/html
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>
|
||||
<TITLE>Let's do the time warp again...</TITLE>
|
||||
|
||||
Which hook would you like to see?
|
||||
"
|
||||
";
|
||||
|
||||
set list {}
|
||||
my @list;
|
||||
|
||||
|
||||
foreach i [glob "[DataDir]/batch-*\[0-9\]"] {
|
||||
regexp -- {[0-9]*$} $i num
|
||||
lappend list $num
|
||||
foreach my $i (glob(DataDir() . "/batch-*\[0-9\].pl")) {
|
||||
if ($i =~ /batch-([0-9]*)\.pl/) {
|
||||
print "Pushing in $1 <br>\n";
|
||||
push(@list, $1);
|
||||
}
|
||||
}
|
||||
|
||||
set list [lsort -integer -decreasing $list]
|
||||
@list = sort {$b <=> $a} @list;
|
||||
|
||||
puts "<FORM method=get action=\"toplevel.cgi\">"
|
||||
puts "<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>"
|
||||
puts "<INPUT TYPE=SUBMIT Value=\"Submit\"><BR>"
|
||||
print "<FORM method=get action=\"toplevel.cgi\">\n";
|
||||
print "<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>\n";
|
||||
print "<INPUT TYPE=SUBMIT Value=\"Submit\"><BR>\n";
|
||||
|
||||
set value [lvarpop list]
|
||||
my $value = shift(@list);
|
||||
|
||||
puts "<INPUT TYPE=radio NAME=batchid VALUE=$value [IsChecked $value]>"
|
||||
puts "The current hook.<BR>"
|
||||
print "<INPUT TYPE=radio NAME=batchid VALUE=$value " . IsChecked($value). ">";
|
||||
print "The current hook.<BR>\n";
|
||||
|
||||
set count 1
|
||||
foreach i $list {
|
||||
set value [lvarpop list]
|
||||
puts "<INPUT TYPE=radio NAME=batchid VALUE=$value [IsChecked $value]>"
|
||||
source [DataDir]/batch-$i
|
||||
puts "Hook for tree that closed on [MyFmtClock $closetimestamp] <BR>"
|
||||
my $count = 1;
|
||||
foreach my $i (@list) {
|
||||
print "<INPUT TYPE=radio NAME=batchid VALUE=$i " . IsChecked($i) .
|
||||
">\n";
|
||||
my $name = DataDir() . "/batch-$i.pl";
|
||||
require "$name";
|
||||
print "Hook for tree that closed on " . MyFmtClock($::CloseTimeStamp) .
|
||||
"<BR>\n";
|
||||
}
|
||||
|
||||
puts "<INPUT TYPE=SUBMIT Value=\"Submit\">"
|
||||
puts "</FORM>"
|
||||
print "<INPUT TYPE=SUBMIT Value=\"Submit\">\n";
|
||||
print "</FORM>\n";
|
||||
|
||||
PutsTrailer
|
||||
|
||||
exit
|
||||
PutsTrailer();
|
||||
|
|
|
|||
Загрузка…
Ссылка в новой задаче