Compare commits
1 Commits
tags/preed
...
src
| Author | SHA1 | Date | |
|---|---|---|---|
|
258dc9fead |
@@ -1,512 +0,0 @@
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/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);
|
||||
my $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();
|
||||
|
||||
if (!defined $extra) {
|
||||
$extra = "";
|
||||
}
|
||||
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 = '';
|
||||
# HACK ALERT
|
||||
# quick fix by adam:
|
||||
# when browsing with rview, branch needs to be in 'rev' param
|
||||
# not 'branch' param. don't ask me why ...
|
||||
my $hack = ($page eq 'rview.cgi') ? 'rev' : 'branch';
|
||||
$branch = "&$hack=$::TreeInfo{$i}{'branch'}"
|
||||
if $::TreeInfo{$i}{'branch'};
|
||||
|
||||
$desc = $::TreeInfo{$i}{'shortdesc'};
|
||||
$desc = $::TreeInfo{$i}{'description'} unless $desc;
|
||||
|
||||
$root = "cvsroot=$::TreeInfo{$i}{'repository'}";
|
||||
$module = "module=$::TreeInfo{$i}{'module'}";
|
||||
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=\"mailto:$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 (%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;
|
||||
}
|
||||
}
|
||||
|
||||
# Layers are supported only by Netscape 4.
|
||||
# The DOM standards are supported by Mozilla and IE 5 or above. It should
|
||||
# also be supported by any browser claiming "Mozilla/5" or above.
|
||||
$::use_layers = 0;
|
||||
$::use_dom = 0;
|
||||
# MSIE chokes on |type="application/x-javascript"| so if we detect MSIE, we
|
||||
# we should send |type="text/javascript"|. While we're at it, we should send
|
||||
# |language="JavaScript"| for any browser that is "Mozilla/4" or older.
|
||||
$::script_type = '"language="JavaScript""';
|
||||
if (defined $ENV{HTTP_USER_AGENT}) {
|
||||
my $user_agent = $ENV{HTTP_USER_AGENT};
|
||||
if ($user_agent =~ m@^Mozilla/4.@ && $user_agent !~ /MSIE/) {
|
||||
$::use_layers = 1;
|
||||
} elsif ($user_agent =~ m@MSIE (\d+)@) {
|
||||
$::use_dom = 1 if $1 >= 5;
|
||||
$::script_type = 'type="text/javascript"';
|
||||
} elsif ($user_agent =~ m@^Mozilla/(\d+)@) {
|
||||
$::use_dom = 1 if $1 >= 5;
|
||||
$::script_type = 'type="application/x-javascript"';
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -1,62 +0,0 @@
|
||||
This file contains only important changes made to Bonsai. If you
|
||||
are updating from an older version, make sure that you check this file!
|
||||
|
||||
For a more complete list of what has changed, use Bonsai itself, at
|
||||
(http://cvs-mirror.mozilla.org/webtools/bonsai/cvsqueryform.cgi) to
|
||||
query the CVS tree. For example,
|
||||
|
||||
http://cvs-mirror.mozilla.org/webtools/bonsai/cvsquery.cgi?module=all&branch=HEAD&branchtype=match&dir=mozilla%2Fwebtools%2Fbonsai&file=&filetype=match&who=&whotype=match&sortby=Date&hours=2&date=week&mindate=&maxdate=&cvsroot=%2Fcvsroot
|
||||
|
||||
will tell you what has been changed in the last week.
|
||||
|
||||
|
||||
11/9/99 I have discovered that Bonsai gets all screwed up if you have multiple
|
||||
files with the same name but different capitalization in your directory. This
|
||||
is because the tables were all defined to have case-independent strings, but
|
||||
you want them to be case-dependent. To fix, feed the following to mysql:
|
||||
|
||||
alter table dirs change column dir dir varchar(128) binary not null;
|
||||
alter table files change column file file varchar(128) binary not null;
|
||||
alter table people change column who who varchar(32) binary not null;
|
||||
alter table repositories change column repository repository varchar(64) binary not null;
|
||||
alter table branches change column branch branch varchar(64) binary not null;
|
||||
alter table checkins change column revision revision varchar(32) binary not null, change column stickytag stickytag varchar(255) binary not null;
|
||||
alter table tags change column revision revision varchar(32) binary not null;
|
||||
|
||||
|
||||
|
||||
10/12/99 Apparently, newer alphas of MySQL won't allow you to have
|
||||
"when" as a column name. So, I have had to rename a column in the
|
||||
checkins table. You must feed the below to mysql or you won't
|
||||
work at all.
|
||||
|
||||
alter table checkins change column when ci_when datetime not null;
|
||||
|
||||
|
||||
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.
|
||||
@@ -1,303 +0,0 @@
|
||||
# -*- mode: indented-text -*-
|
||||
#
|
||||
# Author: Artem Belevich <abelevic@ctron.com>
|
||||
#
|
||||
# (Changes have been made to Artem's original doc, as things evolve.)
|
||||
#
|
||||
#
|
||||
|
||||
**********************************************************************
|
||||
|
||||
As it's said in README "This is not very well packaged code. It's
|
||||
not packaged at all. Don't come here expecting something you plop in
|
||||
a directory, twiddle a few things, and you're off and using it. Much
|
||||
work has to be done to get there."
|
||||
|
||||
This file is intended to make some things *easier* but not easy. You
|
||||
are still required to make some changes on your own. There is no
|
||||
guaranteed solution yet and it's unlikely that there will be one in
|
||||
the nearest future.
|
||||
|
||||
**********************************************************************
|
||||
|
||||
|
||||
0. OVERVIEW
|
||||
|
||||
Some time ago I've seen Linux Source Navigator (LSN) at
|
||||
http://sunsite.unc.edu/linux-source. I was impressed.
|
||||
It was and is a wonderful tool to explore Linux kernel source code.
|
||||
|
||||
Then Mozilla.org came up with a more elaborate tool that includes
|
||||
source browser with crossreferencing (LXR http://lxr.linux.no) and CVS
|
||||
tree control (Bonsai - http://www.mozilla.org/bonsai.html).
|
||||
While LXR formatting is not as pretty as LSN's one, it has a huge
|
||||
advantage - it lets you see where the identifier is defined and used.
|
||||
And Bonsai brings nice and easy (though sometimes incompatible with
|
||||
browsers other but Netscape's own) interface to the CVS history. This
|
||||
includes getting list of changes, diffs between revisions, etc.
|
||||
|
||||
All in all LXR+Bonsai+other stuff beneath is a useful tool capable
|
||||
of handling huge projects.
|
||||
|
||||
It's not that easy to make it work with other source tree but
|
||||
Mozilla's own but it's possible. And there are a lot of things to
|
||||
improve. Now I'm going to concentrate on the first goal - to make it
|
||||
work.
|
||||
|
||||
|
||||
1. GETTING IT UP
|
||||
|
||||
First of all you have to get all the tools in mozilla's
|
||||
mozilla/webtools CVS repository. This includes lxr,bonsai,registry
|
||||
and tinderbox. You're likely will not need neither tinderbox but get
|
||||
it just in case.
|
||||
|
||||
To get the sources you have to follow instructions on
|
||||
http://www.mozilla.org/bonsai.html.
|
||||
|
||||
OK, now you've got the sources but don't rush to try it right
|
||||
away. It's likely that you will not be able to even start most of
|
||||
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) Perl 5.004+ plus modules:
|
||||
2a) Date::Parse
|
||||
2b) Mail::Mailer
|
||||
2c) DBI
|
||||
2d) DBD::mysql
|
||||
3) 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
|
||||
database.
|
||||
|
||||
1.1 Getting and setting up MySQL database
|
||||
|
||||
Visit MySQL homepage at http://www.tcx.se and grab the latest
|
||||
stable binary release of the server. Sure, you can get sources and
|
||||
compile them yourself, but binaries are the easiest and the fastest
|
||||
way to get it up and running. Follow instructions found in
|
||||
manual. There is a section about installing binary-only
|
||||
distributions.
|
||||
|
||||
You should create database bonsai. It may be a good idea to make it
|
||||
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 Perl + Mysql
|
||||
|
||||
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.
|
||||
|
||||
If you have Perl already installed, try to run genxref program from
|
||||
LXR suite. If it complains that it misses DB terribly then you're
|
||||
probably will have to get and install DB 1.86 distribution from one of the
|
||||
CPAN (www.cpan.org) mirrors in src/misc directory. I personally got it
|
||||
from http://www.cpan.org/src/misc/db.1.86.tar.gz. Having DB compiled
|
||||
and installed you will also have to rebuild and reinstall Perl
|
||||
itself so It would recognize and compile DB module in. This can be
|
||||
tricky if you have DB installed in some strange place as I did.
|
||||
I've got an error during linking phase - there was a function missing
|
||||
in hash/ndbm.c file, so I just commented it out. It may potentially
|
||||
cause troubles, but I think it does not matter in our case as this
|
||||
was intended only for DBM compatibility - the feature we don't really
|
||||
use.
|
||||
|
||||
Now you hopefully have Perl + DB compiled installed and working.
|
||||
Time to set up Mysql module. This one is easy. Just follow
|
||||
instructions in MySQL manual. You have to read manuals sometimes..
|
||||
I think I'm getting older.. 8-)
|
||||
|
||||
Next step is to get TimeDate module from one of the CPAN mirrors.
|
||||
Go to CPAN search page
|
||||
(http://theory.uwinnipeg.ca/search/cpan-search.html) and search for
|
||||
the "TimeDate" module. Then get it and install.
|
||||
|
||||
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
|
||||
you'd better run HTTP daemon on the same machine that you run MySQL
|
||||
server on. Make sure that you can access 'bonsai' database with user
|
||||
id you're running the daemon with.
|
||||
|
||||
|
||||
2. TWEAKING THE TOOLS
|
||||
|
||||
Now you should have all necessary tools to be able to run LXR and
|
||||
Bonsai scripts and see why the wouldn't work for you right now.
|
||||
|
||||
2.1 LXR
|
||||
|
||||
The first thing to set up is LXR tool. All it needs is the source
|
||||
tree (not CVS tree). It's relatively easy and works almost right of
|
||||
the box. Follow instructions in LXR README file.
|
||||
|
||||
Having set LXR you will see that regardless what your source tree
|
||||
contains you will see that everything refers to it as Mozilla. Mozilla
|
||||
is a great thing and this tool was primarily tailored to mozilla tree
|
||||
but you'd like to control your own tree. First step is to edit your
|
||||
|
||||
Here is the short list of changes I had to make
|
||||
|
||||
file: ident
|
||||
1) change "&root=/cvsroot" to your CVSROOT path
|
||||
2) change "file=/mozilla/" to the directory under CVSROOT where
|
||||
your sources are. In my case it is just "/"
|
||||
|
||||
file: index.html
|
||||
Nothing vital here but probably worth changing to reflect your own
|
||||
environment
|
||||
|
||||
file: lxr.conf
|
||||
Changes to this file are described in LXR README file and are
|
||||
quite simple.
|
||||
|
||||
file: source
|
||||
You may find it useful to uncomment "$img = "/icons/..." lines if
|
||||
you use Explorer as it does not have internal-gopher-* images
|
||||
built in. Actually Bonsai contains a lot of netscapism that will
|
||||
make your IE4 unhappy anyway. You'd better stick with Netscape if
|
||||
you are going to use LXR/Bonsai
|
||||
|
||||
file: template-*
|
||||
Here you will probably want to watch closely at the places where
|
||||
you see the word 'mozilla' near '.cgi'. There are a lot of
|
||||
mozilla-specific paths hardcoded
|
||||
|
||||
change/get rid of banner that loads straight from mozilla.org that
|
||||
may be very dangerous if you're working for micro$oft and your
|
||||
boss comes by.. 8-)
|
||||
|
||||
2.2 Bonsai
|
||||
|
||||
This stuff sometimes gets very specific about your CVS repository
|
||||
setup. You have to make a lot of changes until more portable
|
||||
configuration mechanism is introduced.
|
||||
|
||||
These steps should create a basic Bonsai install:
|
||||
|
||||
./configure
|
||||
make install
|
||||
|
||||
You might want to give the option --prefix=<path> to configure to
|
||||
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.
|
||||
|
||||
Ensure that the bonsai cgi programs can write and create files in the
|
||||
data directory. Typically this means making the data directory owned by
|
||||
the web cgi id. Bonsai does not need to change the executable files in the
|
||||
main bonsai directory so these can be owned as root.
|
||||
|
||||
Edit data/treeconfig.pl file as described in README file. Create
|
||||
appropriate data/XXX directory for each tree XXX you've configured in
|
||||
'treeconfig.pl'. This file maps the names of trees to branch/module
|
||||
combinations. You will need to have at least one module in your CVS
|
||||
repository to run Bonsai. Typically users create a module called All
|
||||
which contains all the directories in the CVS repository. All
|
||||
repositories must be written as if they were local repositories (eg
|
||||
'/cvsroot') without hostnames or ':pserver:'. The cgi-bin scripts
|
||||
will access these directories on the web machine and they must contain
|
||||
the ',v' files which match cvsroot as listed in the checkin mail from
|
||||
the real CVS machine.
|
||||
|
||||
Go to the data directory and run
|
||||
|
||||
trapdoor <admin password here> >data/passwd
|
||||
|
||||
it will set up admin's password.
|
||||
|
||||
Bonsai should now be accessible via a web browser but not all
|
||||
functionality is installed yet. Visit admin.cgi and set all the parameters.
|
||||
|
||||
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.
|
||||
|
||||
3. Setting up database
|
||||
|
||||
This is quite simple but time consuming operation.
|
||||
First create database structure using maketable.sh script. You might
|
||||
want to edit it to use the user and password you want for the bonsai
|
||||
database.
|
||||
|
||||
You must ensure that your web machine can access the CVS repositories
|
||||
raw data files (',v' files). If the CVS repository is on another
|
||||
machine then the web machine must be configured to be able to read the
|
||||
files as if they were stored with the same pathes on the Web
|
||||
machine. Uually this is accomplished via an NFS read only mount of the
|
||||
cvsroot. You can check this configuration by looking at the file
|
||||
$CVSROOT/modules,v (perhaps this needs the prefix trimmed from this
|
||||
string to make a vaild path name). This file should be readable on
|
||||
both the CVS machine and on the web machine.
|
||||
|
||||
Then go to Bonsai administration page and press "Rebuild CVS history"
|
||||
button. Then you may go to the theater and watch a movie or two. It
|
||||
will take a lot of time. It takes several seconds to process one
|
||||
file. The more revisions in file the more time it will take. My SUN
|
||||
workstation with 2x200Mhz UltraSPARC processors run about an hour to
|
||||
process about 4K files with 20K+ revisions. Your mileage may vary.
|
||||
|
||||
If you need to do this more then once you may wish to purge ethe
|
||||
legaldirs file in the data directory. This is a cache file which
|
||||
holds the names of the directories in CVS, if a directory is not
|
||||
listed here it will not be loaded into the database. Changes to the
|
||||
modules file shoud probably be followed by a deletion of the legaldirs
|
||||
file.
|
||||
|
||||
I have also found it useful to rerun maketables.sh before reloading the
|
||||
CVS information. If I forget to do this step occasionally the load
|
||||
will fail in the middle because of duplicate data in the table.
|
||||
|
||||
Copy "dolog.pl" to your CVSROOT directory, and check it in. Add
|
||||
"dolog.pl" to CVSROOT/checkoutlist, and check it in. Then, add a line
|
||||
to your CVSROOT/loginfo file that says something like:
|
||||
|
||||
ALL $CVSROOT/CVSROOT/dolog.pl -r /cvsroot bonsai-checkin-daemon@my.bonsai.machine
|
||||
|
||||
Replace "/cvsroot" with the name of the CVS root directory, and
|
||||
"my.bonsai.machine" with the name of the machine Bonsai runs on. Now,
|
||||
on my.bonsai.machine, add a mail alias so that mail sent to
|
||||
"bonsai-checkin-daemon" will get piped to handleCheckinMail.tcl. The
|
||||
first argument to handleCheckinMail.tcl is the directory that bonsai
|
||||
is installed in. E.g. in /etc/aliases, add
|
||||
|
||||
bonsai-checkin-daemon: "|/usr/local/bonsai/handleCheckinMail.pl /usr/local/bonsai"
|
||||
|
||||
or whatever is appropriate for your mail transport agent.
|
||||
|
||||
4. Things to do
|
||||
|
||||
a) There should be better way to track CVS tree changes. Now it's done
|
||||
by making CVS send e-mail about each checkin. (See the comments at
|
||||
the top of dolog.pl for some clues.) One alternative theory would be
|
||||
to take advantage of the CVS history command, which provides
|
||||
all necessary information to get the list of recently committed files, so
|
||||
there is no need to send/process email. Just set up a cron job that
|
||||
will periodically look for CVS tree changes and update database. On
|
||||
the other hand, it's not at all clear how efficient the cvs history
|
||||
command is for large, active repositories.
|
||||
|
||||
b) Better configuration. One should not hardcode CVS tree <-> Source
|
||||
tree translations. Another thing to configure - banners.
|
||||
|
||||
c) LXR could be improved in a number of ways. Using MySQL database
|
||||
instead of DB would probably be a good idea. It's unclear what impact
|
||||
it will have on performance though. Incremental database updates would
|
||||
be nice. It might also be nice to borrow syntax highlighting from LSN.
|
||||
|
||||
|
||||
5. Conclusion.
|
||||
|
||||
OK. This may or may not work for you. But I hope you had a great
|
||||
time trying. Or just reading.
|
||||
|
||||
Any suggestions/additions are welcome.
|
||||
@@ -1,164 +0,0 @@
|
||||
#!gmake
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
|
||||
# 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.
|
||||
|
||||
CC = @CC@
|
||||
CFLAGS = @CFLAGS@
|
||||
# -lcrypt
|
||||
LDFLAGS = @LIBS@
|
||||
# /usr/bin/perl
|
||||
PERL = @PERL@
|
||||
# /var/www/bonsai
|
||||
PREFIX = @prefix@/bonsai
|
||||
|
||||
CVS=@CVS@
|
||||
RLOG=@RLOG@
|
||||
CO=@CO@
|
||||
RCSDIFF=@RCSDIFF@
|
||||
CVSGRAPH=@CVSGRAPH@
|
||||
|
||||
FILES = CGI.pl \
|
||||
SourceChecker.cgi \
|
||||
SourceChecker.pm \
|
||||
addcheckin.pl \
|
||||
admin.cgi \
|
||||
adminfuncs.pl \
|
||||
adminmail.pl \
|
||||
closemessage \
|
||||
contacthelp.html \
|
||||
countcheckins.cgi \
|
||||
createlegaldirs.pl \
|
||||
cvsblame.cgi \
|
||||
cvsblame.pl \
|
||||
cvsguess.cgi \
|
||||
cvsgraph.cgi \
|
||||
cvsindex.pl \
|
||||
cvslog.cgi \
|
||||
cvsmenu.pl \
|
||||
cvsquery.cgi \
|
||||
cvsquery.pl \
|
||||
cvsqueryform.cgi \
|
||||
cvsregexp.html \
|
||||
cvsview2.cgi \
|
||||
defparams.pl \
|
||||
doadmin.cgi \
|
||||
doeditcheckin.cgi \
|
||||
doeditmessage.cgi \
|
||||
doeditparams.cgi \
|
||||
doeditwhiteboard.cgi \
|
||||
dolog.pl \
|
||||
dotweak.cgi \
|
||||
editcheckin.cgi \
|
||||
editmessage.cgi \
|
||||
editparams.cgi \
|
||||
editwhiteboard.cgi \
|
||||
get_line.pl \
|
||||
globals.pl \
|
||||
handleAdminMail.pl \
|
||||
handleCheckinMail.pl \
|
||||
header.pl \
|
||||
index.html \
|
||||
indextest.pl \
|
||||
lloydcgi.pl \
|
||||
maketables.sh \
|
||||
moduleanalyse.cgi \
|
||||
modules.pl \
|
||||
multidiff.cgi \
|
||||
openmessage \
|
||||
processqueue.pl \
|
||||
rebuildcvshistory.cgi \
|
||||
repophook.cgi \
|
||||
reposfiles.pl \
|
||||
rview.cgi \
|
||||
showcheckins.cgi \
|
||||
switchtree.cgi \
|
||||
testlock.pl \
|
||||
toplevel.cgi \
|
||||
utils.pl \
|
||||
viewold.cgi
|
||||
|
||||
all: trapdoor treeconfig.pl params
|
||||
|
||||
trapdoor: trapdoor.o
|
||||
$(CC) -o trapdoor trapdoor.o $(LDFLAGS)
|
||||
|
||||
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#_CVSGRAPH_#$(CVSGRAPH)#g \
|
||||
$< >$@
|
||||
|
||||
install: all
|
||||
-mkdir -p $(PREFIX)
|
||||
@for I in $(FILES); do \
|
||||
echo Installing $$I && \
|
||||
sed -e s#/usr/bonsaitools/bin/perl#$(PERL)#g \
|
||||
-e s#/tools/ns/bin/perl5#$(PERL)#g \
|
||||
$$I > $(PREFIX)/$$I && \
|
||||
chmod 755 $(PREFIX)/$$I; done
|
||||
-mkdir -p $(PREFIX)/data && chmod 755 $(PREFIX)/data
|
||||
cp trapdoor $(PREFIX)/data
|
||||
cp bonsai.gif $(PREFIX)
|
||||
chmod 755 $(PREFIX)/bonsai.gif
|
||||
@if test ! -r $(PREFIX)/data/treeconfig.pl ; then \
|
||||
echo "Installing treeconfig.pl" && \
|
||||
cp treeconfig.pl $(PREFIX)/data ; \
|
||||
else \
|
||||
echo ; \
|
||||
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
|
||||
@if test ! -r $(PREFIX)/data/cvsgraph.conf ; then \
|
||||
echo "Installing cvsgraph.conf" && \
|
||||
cp cvsgraph.conf $(PREFIX)/data ; \
|
||||
else \
|
||||
echo ; \
|
||||
echo "Not replacing existing cvsgraph.conf" ; \
|
||||
fi
|
||||
@echo
|
||||
@echo "If you are updating an existing install, be sure to check"
|
||||
@echo "editparams.cgi to see if there are any new things you should"
|
||||
@echo "configure as this script will not overwrite your existing"
|
||||
@echo "params file"
|
||||
@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/treeconfig.pl"
|
||||
|
||||
clean:
|
||||
rm -f trapdoor trapdoor.o treeconfig.pl params
|
||||
@@ -1,573 +0,0 @@
|
||||
This is Bonsai. See <http://www.mozilla.org/bonsai.html>.
|
||||
|
||||
|
||||
==========
|
||||
DISCLAIMER
|
||||
==========
|
||||
|
||||
This is not very well packaged code. It's not packaged at all. Don't
|
||||
come here expecting something you plop in a directory, twiddle a few
|
||||
things, and you're off and using it. Much work has to be done to get
|
||||
there. We'd like to get there, but it wasn't clear when that would be,
|
||||
and so we decided to let people see it first.
|
||||
|
||||
Don't believe for a minute that you can use this stuff without first
|
||||
understanding most of the code.
|
||||
|
||||
Check out the INSTALL file for some guidance on getting started.
|
||||
Many, many thanks to Artem Belevich <abelevic@ctron.com> for
|
||||
trailblazing his way through this and writing down all the problems he
|
||||
had.
|
||||
|
||||
|
||||
============================
|
||||
Configuration files you need
|
||||
============================
|
||||
|
||||
Lots of configuration files need to be placed in the data subdir.
|
||||
This is also where bonsai keeps its running state. These two things
|
||||
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:
|
||||
|
||||
@::TreeList = ('default', 'other');
|
||||
|
||||
%::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',
|
||||
},
|
||||
|
||||
|
||||
);
|
||||
|
||||
1;
|
||||
|
||||
|
||||
|
||||
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 at the parameters
|
||||
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:
|
||||
|
||||
setenv PERL /usr/local/lib/perl5
|
||||
./configure
|
||||
|
||||
or for the Bourne shell:
|
||||
|
||||
PERL=/usr/local/lib/perl5 ./configure
|
||||
|
||||
|
||||
hidelist: A list of regexps that define filenames that we don't want
|
||||
to let people see via the bonsai pages. A common use is to
|
||||
just have one line that says "CVSROOT".
|
||||
|
||||
legaldirs: A list of directories to traverse when rebuilding the
|
||||
history of the repository. This file is required to exist
|
||||
for each module before you can start populating that module
|
||||
with existing cvs data.
|
||||
|
||||
|
||||
=================================
|
||||
What's What in the Bonsai sources:
|
||||
=================================
|
||||
|
||||
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.
|
||||
|
||||
Makefile.in: "make install" lets you specify where you store
|
||||
perl and bonsai on your system.
|
||||
|
||||
SourceChecker.cgi scc wrote to help sanitize code. DELETE
|
||||
Called by: nobody
|
||||
|
||||
SourceChecker.pm Callled by: SourceChecker.cgi
|
||||
|
||||
addcheckin.pl Perl. Add a checkin to a Bonsai hook. Determines
|
||||
if the tree was open or closed at the time, shunts
|
||||
checkin to proper tree.
|
||||
|
||||
admin.cgi Perl. Select from various administrative tasks
|
||||
(which require a password.)
|
||||
|
||||
Called by: toplevel.cgi
|
||||
|
||||
Calls:
|
||||
doadmin.cgi password=<text> treeid=<text>
|
||||
command=[open|close]
|
||||
closetimestamp=<time-text>
|
||||
lastgood=<time-text>
|
||||
doclear=<checkbox>
|
||||
|
||||
doadmin.cgi password=<text> treeid=<text>
|
||||
command=tweaktimes
|
||||
lastgood=<time-text>
|
||||
lastclose=<time-text>
|
||||
|
||||
doadmin.cgi password=<text> treeid=<text>
|
||||
command=editmotd
|
||||
origmotd=<text>
|
||||
motd=<text>
|
||||
|
||||
editmessage.cgi treeid=<text>
|
||||
msgname=[openmessage|closemessage|
|
||||
treeopened|treeopenedsamehook|
|
||||
treeclosed]
|
||||
#### note: no password?
|
||||
|
||||
repophook.cgi password=<text> treeid=<text>
|
||||
command=repophook
|
||||
startfrom=<time-text>
|
||||
|
||||
rebuildcvshistory.cgi password=<text>
|
||||
treeid=<text>
|
||||
command=rebuildcvs
|
||||
startfrom=<time-text>
|
||||
firstfile=<time-text>
|
||||
subdir=<time-text>
|
||||
|
||||
doadmin.cgi password=<text> treeid=<text>
|
||||
command=changepassword
|
||||
password=<text>
|
||||
newpassword=<text>
|
||||
newpassword2=<text>
|
||||
doglobal=<radio>
|
||||
|
||||
adminfuncs.pl Perl. Collection of functions to administrate a Bonsai
|
||||
hook.
|
||||
|
||||
adminmail.pl Perl. Set of routines for opening and closing the
|
||||
Bonsai hook based on receipt of e-mail.
|
||||
|
||||
bonsai.gif a bonsai tree.
|
||||
|
||||
closemessage HTML, text that gets sent to all people on the hook
|
||||
when the tree is closed.
|
||||
|
||||
configure Configure script (generated from configure.in?)
|
||||
|
||||
configure.in Configure.in script
|
||||
|
||||
contacthelp.html HTML, explanation of how to change someone's contact info
|
||||
|
||||
countcheckins.cgi Perl. Draws a graph of checkins for the various
|
||||
Bonsai 'hooks'.
|
||||
Called by: toplevel.cgi
|
||||
Calls: nobody
|
||||
|
||||
createlegaldirs.pl Use this to create the 'legaldirs' file for a module.
|
||||
|
||||
cvsblame.cgi Runs through a CVS file and tells you who changed what.
|
||||
Calls:
|
||||
rview.cgi dir= cvsroot= rev=
|
||||
cvsblame.cgi file= rev= root= mark=
|
||||
cvsblame.cgi set_line= (cookie magic?)
|
||||
cvsblame.cgi root= file= rev= use_html=
|
||||
cvsgraph.cgi file=
|
||||
cvsview2.cgi subdir= files= rev=
|
||||
cvsview2.cgi root= subdir= files= rev1= rev2=
|
||||
cvsqueryform.cgi
|
||||
Called by:
|
||||
cvsgraph.cgi
|
||||
cvsguess.cgi
|
||||
cvslog.cgi
|
||||
cvsview2.cgi
|
||||
moduleanalyse.cgi
|
||||
|
||||
cvsblame.pl Runs through a CVS file and tells you who changed what.
|
||||
Called by:
|
||||
cvsblame.cgi
|
||||
cvslog.cgi
|
||||
Calls: nobody
|
||||
|
||||
cvsguess.cgi Given a file name, try to figure out what directory
|
||||
it's in. then link to cvsblame.cgi. parameters are
|
||||
the same.
|
||||
|
||||
Seems to take an exact file name (sans directory),
|
||||
then do a redirect to cvsblame.cgi. If there are
|
||||
more than one file of that name, it presents a list.
|
||||
This is (I think) redundant with LXR's file name
|
||||
search.
|
||||
|
||||
Calls:
|
||||
cvsblame.cgi file= rev= mark= #
|
||||
Called by: *tinderbox
|
||||
|
||||
cvsindex.pl ???
|
||||
|
||||
cvslog.cgi Web interface to "cvs log".
|
||||
Calls:
|
||||
rview.cgi dir= cvsroot= rev=
|
||||
cvslog.cgi file= root= rev=
|
||||
sort=[revision|date|author]
|
||||
author=
|
||||
cvsview2.cgi
|
||||
command=DIFF_FRAMESET
|
||||
diff_mode=context
|
||||
whitespace_mode=show
|
||||
root= subdir= file=
|
||||
rev1= rev2=
|
||||
cvsview2.cgi
|
||||
command=DIRECTORY
|
||||
subdir= files= root= branch=
|
||||
|
||||
Used to call:
|
||||
cvsblame.cgi file= rev= root=
|
||||
Called by:
|
||||
cvsgraph.cgi
|
||||
cvsblame.cgi
|
||||
cvslog.cgi
|
||||
|
||||
cvsmenu.pl ???
|
||||
|
||||
cvsquery.cgi Displays the results of a query entered in cvsqueryform
|
||||
Called by:
|
||||
cvsqueryform.cgi
|
||||
Calls:
|
||||
cvsqueryform.cgi
|
||||
cvsview2 command=DIRECTORY
|
||||
subdir= files= branch= root=
|
||||
cvsview2.cgi command=DIFF_FRAMESET
|
||||
diff_mode=context
|
||||
whitespace_mode=show
|
||||
subdir= file= rev1= rev2= root=
|
||||
multidiff.cgi name=allchanges cvsroot=
|
||||
cvsquery.cgi sortby=
|
||||
../registry/who.cgi email=
|
||||
http://scopus.mcom.com/bugsplat/show_bug.cgi
|
||||
|
||||
cvsquery.gi ???
|
||||
Calls:
|
||||
cvsquery.pl
|
||||
|
||||
cvsquery.pl ???
|
||||
Called by:
|
||||
cvsquery.cgi
|
||||
|
||||
cvsqueryform.cgi Main screen to let you query the CVS database.
|
||||
Called by:
|
||||
cvsblame.cgi
|
||||
cvslog.cgi
|
||||
cvsquery.cgi
|
||||
toplevel.cgi
|
||||
Calls:
|
||||
cvsregexp.html
|
||||
cvsquery.cgi
|
||||
module=[all|allrepositories|?]
|
||||
branch=
|
||||
branchtype=[match|regexp]
|
||||
directory=<text>
|
||||
file=<text>
|
||||
who=<text>
|
||||
whotype=[match|regexp]
|
||||
sortby=[Date|Who|File|Change Size]
|
||||
date=[hours|day|week|month|all|
|
||||
explicit]
|
||||
hours=
|
||||
mindate=
|
||||
maxdate=
|
||||
cvsroot=
|
||||
|
||||
cvsregexp.html ???
|
||||
|
||||
cvsview2.cgi Lets you view CVS diffs.
|
||||
Called by:
|
||||
cvsblame.cgi
|
||||
cvslog.cgi
|
||||
cvsquery.cgi
|
||||
show2.cgi
|
||||
showcheckins.cgi
|
||||
Calls:
|
||||
rview.cgi dir= cvsroot= rev=
|
||||
cvsview2.cgi subdir= command=DIFF
|
||||
root= file= rev1= rev2=
|
||||
cvsview2.cgi subdir= command=DIFF_LINKS
|
||||
root= file= rev1= rev2=
|
||||
cvsview2.cgi subdir= command=DIFF
|
||||
root= file= rev1= rev2= #
|
||||
cvsview2.cgi subdir= command=DIFF_FRAMESET
|
||||
root= file= rev1= rev2=
|
||||
cvsview2.cgi subdir= command=DIRECTORY
|
||||
root= files= branch= skip=
|
||||
cvsview2.cgi subdir= command=LOG
|
||||
root= file= rev=
|
||||
|
||||
doadmin.cgi Perl. Executes admin things asked for in admin.cgi
|
||||
Called by:
|
||||
admin.cgi
|
||||
Calls:
|
||||
mailto:clienteng
|
||||
|
||||
doeditcheckin.cgi Perl. Edits a checkin on the hook.
|
||||
Called by:
|
||||
editcheckin.cgi
|
||||
Calls:
|
||||
nobody
|
||||
|
||||
doeditmessage.cgi Perl. Edits one of the email messages that bonsai sends
|
||||
people.
|
||||
Called by:
|
||||
editmessage.cgi
|
||||
Calls:
|
||||
nobody
|
||||
|
||||
doeditprofile.cgi Perl. Edit peoples contact info. Left-over code from
|
||||
before we started getting this info from LDAP.
|
||||
Called by:
|
||||
editprofile.cgi
|
||||
Calls:
|
||||
nobody
|
||||
|
||||
doeditwhiteboard.cgi Perl. Edits the free-for-all whiteboard.
|
||||
Called by:
|
||||
editwhiteboard.cgi
|
||||
Calls:
|
||||
nobody
|
||||
|
||||
dolog.pl Perl. Magic file that causes CVS to send mail to
|
||||
Bonsai whenever someone makes a change. Please read
|
||||
the comments towards the beginning for more clues.
|
||||
|
||||
dotweak.cgi Perl. Tweaks a bunch of checkins in ahook at once.
|
||||
Called by:
|
||||
show2.cgi
|
||||
showcheckins.cgi
|
||||
Calls:
|
||||
nobody
|
||||
|
||||
editcheckin.cgi Perl. Edits a checkin on the hook.
|
||||
Called by:
|
||||
show2.cgi
|
||||
showcheckins.cgi
|
||||
Calls:
|
||||
doeditcheckin.cgi
|
||||
|
||||
editmessage.cgi Perl. Edits one of the email messages that bonsai sends
|
||||
people.
|
||||
Called by:
|
||||
admin.cgi
|
||||
Calls:
|
||||
doeditmessage.cgi
|
||||
|
||||
editprofile.cgi Perl. Edit peoples contact info. Left-over code from
|
||||
before we started getting this info from LDAP.
|
||||
Called by:
|
||||
localprofile.cgi
|
||||
Calls:
|
||||
doeditprofile.cgi
|
||||
|
||||
editwhiteboard.cgi Perl. Edits the free-for-all whiteboard.
|
||||
Called by:
|
||||
toplevel.cgi
|
||||
Calls:
|
||||
doeditwhiteboard.cgi
|
||||
|
||||
globals.pl ???
|
||||
|
||||
handleAdminMail.pl Perl. Mail is piped to this script and parsed.
|
||||
Calls:
|
||||
adminfuncs.pl
|
||||
|
||||
handleCheckinMail.pl Perl. Mail is piped to this script and parsed. It
|
||||
then adds a checkin to a Bonsai hook.
|
||||
|
||||
header.pl ???
|
||||
|
||||
index.html loads cvsqueryform.cgi
|
||||
|
||||
indextest.pl ???
|
||||
|
||||
lloydcgi.pl parses CGI args from $QUERY_STRING and leaves them
|
||||
in $form{$key}; and puts cookies in %cookie_jar.
|
||||
Calls: nobody
|
||||
Called by: everybody
|
||||
|
||||
localprofile.cgi Perl. Display peoples contact info. Left-over code
|
||||
from before we started getting this info from LDAP.
|
||||
Called by:
|
||||
nobody
|
||||
Calls:
|
||||
editprofile.cgi
|
||||
profile.cgi
|
||||
|
||||
maketables.sh ???
|
||||
Unused?
|
||||
|
||||
moduleanalyse.cgi Shows the directories in a module.
|
||||
Called by:
|
||||
nobody
|
||||
Calls:
|
||||
moduleanalyse.cgi module=[all|?] cvsroot=
|
||||
rview.cgi dir= cvsroot=
|
||||
cvsblame.cgi file= root=
|
||||
|
||||
modules.pl ???
|
||||
Called by:
|
||||
branchspam.cgi
|
||||
cvsqueryform.cgi
|
||||
moduleanalyse.cgi
|
||||
|
||||
multidiff.cgi Implements the "Show me ALL the Diffs" button
|
||||
Called by:
|
||||
cvsquery.cgi
|
||||
show2.cgi
|
||||
showcheckins.cgi
|
||||
Calls:
|
||||
nobody
|
||||
|
||||
myglobrecur.pl ???
|
||||
|
||||
openmessage ???
|
||||
|
||||
perlifyconfig.pl ???
|
||||
|
||||
processqueue.pl ???
|
||||
|
||||
profile.cgi Perl. Stupid interface to LDAP to show all the info
|
||||
about a person.
|
||||
Called by:
|
||||
localprofile.cgi
|
||||
show2.cgi
|
||||
Calls:
|
||||
profile.cgi person=
|
||||
|
||||
rebuildcvshistory.cgi Perl. Admin script to go rebuild the bonsai database
|
||||
from CVS.
|
||||
Called by:
|
||||
admin.cgi
|
||||
Calls:
|
||||
nobody
|
||||
|
||||
rebuilddatabase.pl ???
|
||||
|
||||
repophook.cgi Perl. Rebuilds a bonsai hook from the bonsai database.
|
||||
Called by:
|
||||
admin.cgi
|
||||
Calls:
|
||||
nobody
|
||||
|
||||
reposfiles.pl ???
|
||||
|
||||
rview.cgi Lets you browse a directory in a CVS repository.
|
||||
Called by:
|
||||
cvsblame.cgi
|
||||
cvslog.cgi
|
||||
cvsview2.cgi
|
||||
moduleanalyse.cgi
|
||||
Calls:
|
||||
rview.cgi dir= cvsroot= rev=
|
||||
rview.cgi dir= cvsroot= rev= ?=chdir
|
||||
rview.cgi dir= cvsroot= rev= ?=Set Branch
|
||||
&make_cgi_args ???
|
||||
../registry/file.cgi cvsroot= file= dir=
|
||||
|
||||
showcheckins.cgi Perl. Shows some set of checkins in a bonsai hook.
|
||||
Called by:
|
||||
admin.cgi
|
||||
show2.cgi
|
||||
toplevel.cgi
|
||||
Calls:
|
||||
dotweak.cgi
|
||||
showcheckins.cgi [various funky args]
|
||||
editcheckin.cgi id= [various funky args]w
|
||||
http://phonebook/ds/dosearch/phonebook/...
|
||||
cvsview2.cgi root= subdir= files=
|
||||
command=DIRECTORY branch=
|
||||
http://w3/cgi/cvsview2.cgi subdir= files=
|
||||
command=DIRECTORY
|
||||
multidiff.cgi allchanges=
|
||||
|
||||
status/ ???
|
||||
|
||||
switchtree.cgi Perl. Lets you choose a different bonsai branch.
|
||||
Called by:
|
||||
toplevel.cgi
|
||||
Calls:
|
||||
nobody
|
||||
|
||||
testlock.pl ???
|
||||
|
||||
toplevel.cgi Perl. Main interface to the bonsai hook.
|
||||
Called by:
|
||||
CGI.pl
|
||||
contacthelp.html
|
||||
index.html
|
||||
sheriff2.html
|
||||
switchtree.cgi
|
||||
toplevel.cgi
|
||||
viewold.cgi
|
||||
Calls:
|
||||
editwhiteboard.cgi [...]
|
||||
http://phonebook/ds/dosearch/phonebook/...
|
||||
showcheckins.cgi
|
||||
http://warp/tinderbox/showbuilds.cgi
|
||||
switchtree.cgi [...]
|
||||
news:mcom.dev.client.build.busted
|
||||
http://phonebook/
|
||||
viewold.cgi [...]
|
||||
countcheckins.cgi [...]
|
||||
admin.cgi [...]
|
||||
index.html
|
||||
http://warp/client/dogbert/tree.html
|
||||
contacthelp.html
|
||||
http://warp/client/dogbert/buildlore/index.html
|
||||
|
||||
trapdoor.c ???
|
||||
|
||||
utils.pl ???
|
||||
|
||||
viewold.cgi Perl. Lets you choose an old bonsai hook to view.
|
||||
Called by:
|
||||
toplevel.cgi
|
||||
Calls:
|
||||
toplevel.cgi treeid=
|
||||
|
||||
|
||||
=================
|
||||
Glossary of terms
|
||||
=================
|
||||
|
||||
Here are some funky terms you may find here and there:
|
||||
|
||||
Hook The 'hook' is actually the oldest part of the Bonsai
|
||||
code. The idea is, every so often (at Netscape, it was
|
||||
every day), some build engineers will close the tree
|
||||
and make sure that everything still builds properly.
|
||||
If it doesn't, then the build engineers want to have a
|
||||
list of people they can go beat up, this being the list
|
||||
of people who changed the tree since the last time they
|
||||
successfully built the tree. Those people are "on the
|
||||
hook"; they are held responsible for any probs that
|
||||
arise.
|
||||
|
||||
So, it works out to: the list of people who have
|
||||
checked in since the tree was last closed.
|
||||
|
||||
|
||||
==========
|
||||
Maintainer
|
||||
==========
|
||||
|
||||
The current primary maintainer of Bonsai is Tara Hernandez <tara@tequilarista.org
|
||||
@@ -1,245 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
# SourceChecker.cgi -- tools for creating or modifying the dictionary
|
||||
# used by cvsblame.cgi.
|
||||
#
|
||||
# Created: Scott Collins <scc@netscape.com>, 4 Feb 1998.
|
||||
#
|
||||
# Arguments (passes via GET or POST):
|
||||
# ...
|
||||
#
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
use CGI;
|
||||
use SourceChecker;
|
||||
|
||||
|
||||
|
||||
#
|
||||
# Global
|
||||
#
|
||||
|
||||
my $query = new CGI;
|
||||
|
||||
|
||||
|
||||
#
|
||||
# Subroutines
|
||||
#
|
||||
|
||||
|
||||
sub print_page_header()
|
||||
{
|
||||
print <<'END_OF_HEADER';
|
||||
<H1>SourceChecker Dictionary Maintainance</H1>
|
||||
END_OF_HEADER
|
||||
}
|
||||
|
||||
|
||||
sub print_page_trailer()
|
||||
{
|
||||
print <<'END_OF_TRAILER';
|
||||
<HR>
|
||||
<FONT SIZE=-1>
|
||||
Last updated 5 Feb 1998.
|
||||
<A HREF="SourceChecker.cgi">Dictionary maintainance and help</A>.</FONT>
|
||||
Mail feedback to <A HREF="mailto:scc?subject=[SourceChecker.cgi]"><scc@netscape.com></A>.
|
||||
END_OF_TRAILER
|
||||
}
|
||||
|
||||
|
||||
|
||||
my $error_header = '<HR><H2>I couldn\'t process your request...</H2>';
|
||||
|
||||
sub print_error($)
|
||||
{
|
||||
my $message = shift;
|
||||
print "$error_header<P><EM>Error</EM>: $message</P>";
|
||||
$error_header = '';
|
||||
}
|
||||
|
||||
|
||||
sub print_query_building_form()
|
||||
{
|
||||
print $query->start_multipart_form;
|
||||
|
||||
print '<HR><H2>Build a new request</H2>';
|
||||
print '<P>...to modify or create a remote dictionary with words from one or more local files.</P>';
|
||||
|
||||
print '<H3>Files on the server</H3>';
|
||||
print '<P>...i.e., the dictionary to be created or modified.</P>';
|
||||
|
||||
print $query->textfield( -name=>'dictionary',
|
||||
-default=>'',
|
||||
-override=>1,
|
||||
-size=>30 );
|
||||
print '-- the path to dictionary.';
|
||||
|
||||
print '<H3>Files on your local machine</H3>';
|
||||
print '<P>...that will be uploaded to the server, so their contents can be added to the dictionary.</P>';
|
||||
|
||||
print '<BR>';
|
||||
print $query->filefield( -name=>'ignore_english', -size=>30 );
|
||||
print '-- contains english (i.e., transformable) words to ignore.';
|
||||
|
||||
print '<BR>';
|
||||
print $query->filefield( -name=>'ignore_strings', -size=>30 );
|
||||
print '-- contains identifiers (i.e., non-transformable) words to ignore.';
|
||||
|
||||
print '<BR>';
|
||||
print $query->filefield( -name=>'flag_strings', -size=>30 );
|
||||
print '-- contains identifiers words to be flagged.';
|
||||
|
||||
print '<BR>';
|
||||
print $query->filefield( -name=>'ignore_names', -size=>30 );
|
||||
print '-- contains user names to be ignored.';
|
||||
|
||||
print '<BR>';
|
||||
print $query->submit;
|
||||
|
||||
print $query->endform;
|
||||
}
|
||||
|
||||
|
||||
sub do_add_good_words($)
|
||||
{
|
||||
my $file = shift;
|
||||
|
||||
while ( <$file> )
|
||||
{
|
||||
next if /\#/;
|
||||
add_good_words($_);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub do_add_bad_words($)
|
||||
{
|
||||
my $file = shift;
|
||||
|
||||
while ( <$file> )
|
||||
{
|
||||
next if /\#/;
|
||||
add_bad_words($_);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub do_add_good_english($)
|
||||
{
|
||||
my $file = shift;
|
||||
|
||||
while ( <$file> )
|
||||
{
|
||||
next if /\#/;
|
||||
add_good_english($_);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub do_add_names($)
|
||||
{
|
||||
my $file = shift;
|
||||
|
||||
while ( <$file> )
|
||||
{
|
||||
next if /\#/;
|
||||
add_names($_);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub handle_query()
|
||||
{
|
||||
my $dictionary_path = $query->param('dictionary');
|
||||
if ( ! $dictionary_path )
|
||||
{
|
||||
print_error('You didn\'t supply a path to the dictionary file.');
|
||||
return;
|
||||
}
|
||||
|
||||
dbmopen %SourceChecker::token_dictionary, "$dictionary_path", 0666
|
||||
|| print_error("The dictionary you named could not be opened.");
|
||||
|
||||
my $added_some_words = 0;
|
||||
|
||||
my ($file_of_good_english, $file_of_good_words,
|
||||
$file_of_bad_words, $file_of_names);
|
||||
if ( $file_of_good_english = $query->param('ignore_english') )
|
||||
{
|
||||
do_add_good_english($file_of_good_english);
|
||||
$added_some_words = 1;
|
||||
}
|
||||
|
||||
if ( $file_of_good_words = $query->param('ignore_strings') )
|
||||
{
|
||||
do_add_good_words($file_of_good_words);
|
||||
$added_some_words = 1;
|
||||
}
|
||||
|
||||
if ( $file_of_bad_words = $query->param('flag_strings') )
|
||||
{
|
||||
do_add_bad_words($file_of_bad_words);
|
||||
$added_some_words = 1;
|
||||
}
|
||||
|
||||
if ( $file_of_names = $query->param('ignore_names') )
|
||||
{
|
||||
do_add_names($file_of_names);
|
||||
$added_some_words = 1;
|
||||
}
|
||||
|
||||
if ( ! $added_some_words )
|
||||
{
|
||||
print_error("You did not supply any words to add to the dictionary.");
|
||||
}
|
||||
|
||||
dbmclose %SourceChecker::token_dictionary;
|
||||
}
|
||||
|
||||
|
||||
|
||||
#
|
||||
# The main script
|
||||
#
|
||||
|
||||
print $query->header;
|
||||
print $query->start_html(-title=>'SourceChecker Dictionary Maintainance',
|
||||
-author=>'scc@netscape.com');
|
||||
|
||||
print_page_header();
|
||||
|
||||
if ( $query->param )
|
||||
{
|
||||
handle_query();
|
||||
}
|
||||
|
||||
print_query_building_form();
|
||||
print_page_trailer();
|
||||
|
||||
print $query->end_html;
|
||||
|
||||
__DATA__
|
||||
|
||||
@@ -1,195 +0,0 @@
|
||||
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
package SourceChecker;
|
||||
require Exporter;
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw(%token_dictionary add_good_english add_good_words add_bad_words add_names tokenize_line markup_line);
|
||||
@EXPORT_OK = qw($GOOD_TOKEN $UNKNOWN_TOKEN $BAD_TOKEN $NAME_TOKEN add_token canonical_token @markup_prefix @markup_suffix);
|
||||
|
||||
$GOOD_TOKEN = \-1;
|
||||
$UNKNOWN_TOKEN = \0;
|
||||
$NAME_TOKEN = \1;
|
||||
$BAD_TOKEN = \2;
|
||||
|
||||
|
||||
@markup_prefix = ('<FONT COLOR="green">', '<FONT COLOR="red">', '<FONT COLOR="blue">');
|
||||
@markup_suffix = ('</FONT>', '</FONT>', '</FONT>');
|
||||
|
||||
|
||||
|
||||
sub canonical_token($)
|
||||
{
|
||||
my $token = shift;
|
||||
|
||||
if ( defined $token )
|
||||
{
|
||||
$token =~ s/[\'Õ\&]+//g;
|
||||
$token = length($token)>2 ? lc $token : undef;
|
||||
}
|
||||
|
||||
$token;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub _push_tokens($$)
|
||||
{
|
||||
# Note: inherits |@exploded_phrases| and |@exploded_tokens| from caller(s)
|
||||
push @exploded_phrases, shift;
|
||||
push @exploded_tokens, canonical_token(shift);
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub _explode_line($)
|
||||
{
|
||||
# Note: inherits (and returns results into) |@exploded_phrases| and |@exploded_tokens| from caller(s)
|
||||
|
||||
my $line = shift;
|
||||
|
||||
my $between_tokens = 0;
|
||||
foreach $phrase ( split /([A-Za-z\'Õ\&]+)/, $line )
|
||||
{
|
||||
if ( $between_tokens = !$between_tokens )
|
||||
{
|
||||
_push_tokens($phrase, undef);
|
||||
next;
|
||||
}
|
||||
|
||||
for ( $_ = $phrase; $_; )
|
||||
{
|
||||
m/^[A-Z\'Õ\&]*[a-z\'Õ\&]*/;
|
||||
$token = $&;
|
||||
$_ = $';
|
||||
|
||||
if ( ($token =~ m/[A-Z][a-z\'Õ]+/) && $` )
|
||||
{
|
||||
$token = $&;
|
||||
_push_tokens($`, $`);
|
||||
}
|
||||
_push_tokens($token, $token);
|
||||
}
|
||||
}
|
||||
|
||||
$#exploded_phrases;
|
||||
}
|
||||
|
||||
|
||||
sub tokenize_line($)
|
||||
{
|
||||
my $line = shift;
|
||||
local @exploded_tokens;
|
||||
_explode_line($line);
|
||||
|
||||
my $i = -1;
|
||||
foreach $token ( @exploded_tokens )
|
||||
{
|
||||
$exploded_tokens[++$i] = $token if defined $token;
|
||||
}
|
||||
$#exploded_tokens = $i;
|
||||
@exploded_tokens;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub markup_line($)
|
||||
{
|
||||
my $line = shift;
|
||||
|
||||
local @exploded_phrases;
|
||||
local @exploded_tokens;
|
||||
|
||||
_explode_line($line);
|
||||
|
||||
$i = 0;
|
||||
foreach $phrase ( @exploded_phrases )
|
||||
{
|
||||
$phrase =~ s/&/&/g;
|
||||
$phrase =~ s/</</g;
|
||||
$phrase =~ s/>/>/g;
|
||||
|
||||
my $token = $exploded_tokens[$i];
|
||||
if ( defined $token && ($token_kind = $token_dictionary{$token}) >= 0 )
|
||||
{
|
||||
$phrase = $markup_prefix[$token_kind] . $phrase . $markup_suffix[$token_kind];
|
||||
}
|
||||
++$i;
|
||||
}
|
||||
|
||||
join '', @exploded_phrases;
|
||||
}
|
||||
|
||||
|
||||
sub add_token($$)
|
||||
{
|
||||
(my $token, my $token_kind) = @_;
|
||||
if ( !defined $token_dictionary{$token} || ($token_kind > $token_dictionary{$token}) )
|
||||
{
|
||||
$token_dictionary{$token} = $token_kind;
|
||||
}
|
||||
}
|
||||
|
||||
sub add_good_english($)
|
||||
{
|
||||
my $line = shift;
|
||||
|
||||
foreach $token ( tokenize_line($line) )
|
||||
{
|
||||
add_token($token, $$GOOD_TOKEN);
|
||||
|
||||
my $initial_char = substr($token, 0, 1);
|
||||
(my $remainder = substr($token, 1)) =~ s/[aeiouy]+//g;
|
||||
|
||||
$abbreviated_length = length($remainder) + 1;
|
||||
if ( $abbreviated_length != length($token) && $abbreviated_length > 2 )
|
||||
{
|
||||
add_token("$initial_char$remainder", $$GOOD_TOKEN);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub _add_tokens($$)
|
||||
{
|
||||
(my $line, my $token_kind) = @_;
|
||||
|
||||
foreach $token ( tokenize_line($line) )
|
||||
{
|
||||
add_token($token, $token_kind);
|
||||
}
|
||||
}
|
||||
|
||||
sub add_good_words($)
|
||||
{
|
||||
_add_tokens(shift, $$GOOD_TOKEN);
|
||||
}
|
||||
|
||||
sub add_bad_words($)
|
||||
{
|
||||
_add_tokens(shift, $$BAD_TOKEN);
|
||||
}
|
||||
|
||||
sub add_names($)
|
||||
{
|
||||
_add_tokens(shift, $$NAME_TOKEN);
|
||||
}
|
||||
|
||||
1;
|
||||
34
mozilla/webtools/bonsai/aclocal.m4
vendored
34
mozilla/webtools/bonsai/aclocal.m4
vendored
@@ -1,34 +0,0 @@
|
||||
dnl autoconf tests for bonsai
|
||||
dnl Pontus Lidman 99-05-04
|
||||
dnl
|
||||
dnl check if Perl::DB is installed
|
||||
dnl
|
||||
AC_DEFUN(AC_PERL_DB,
|
||||
[
|
||||
AC_MSG_CHECKING(for perl DBD::mysql module)
|
||||
$PERL -w -c -e 'use DBD::mysql' 2>/dev/null; has_dbd=$?
|
||||
if test "x$has_dbd" = "x0" ; then
|
||||
AC_MSG_RESULT(yes)
|
||||
ifelse([$1], , :, [$1])
|
||||
else
|
||||
AC_MSG_RESULT(no)
|
||||
echo "*** the perl MySQL module (DBD::mysql) could not be found"
|
||||
ifelse([$2], , :, [$2])
|
||||
fi
|
||||
])
|
||||
dnl
|
||||
dnl check if Date::Parse is installed
|
||||
dnl
|
||||
AC_DEFUN(AC_PERL_DATEPARSE,
|
||||
[
|
||||
AC_MSG_CHECKING(for perl Date::Parse module)
|
||||
$PERL -w -c -e 'use Date::Parse' 2>/dev/null; has_dateparse=$?
|
||||
if test "x$has_dateparse" = "x0" ; then
|
||||
AC_MSG_RESULT(yes)
|
||||
ifelse([$1], , :, [$1])
|
||||
else
|
||||
AC_MSG_RESULT(no)
|
||||
echo "*** the perl Date::Parse module could not be found"
|
||||
ifelse([$2], , :, [$2])
|
||||
fi
|
||||
])
|
||||
@@ -1,244 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
require '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);
|
||||
DisconnectFromDatabase(); # Minimize time connected to the DB, and
|
||||
# only do it while Lock()'d. That way,
|
||||
# zillions of addcheckin processes can't
|
||||
# lock up mysqld.
|
||||
@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,266 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
sub StupidFuncToShutUpWarningsByUsingVarsAgain {
|
||||
my $z;
|
||||
$z = $::TreeOpen;
|
||||
$z = $::CloseTimeStamp;
|
||||
}
|
||||
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
LoadMOTD();
|
||||
LoadTreeConfig();
|
||||
Unlock();
|
||||
|
||||
my $BIP = BatchIdPart('?');
|
||||
my $BIP_nohook = BatchIdPart();
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
PutsHeader("Bonsai Administration [`$::TreeID' Tree]",
|
||||
"Bonsai Administration",
|
||||
"Administrating `$::TreeID' Tree");
|
||||
|
||||
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>
|
||||
EOF
|
||||
|
||||
|
||||
TweakCheckins();
|
||||
CloseTree();
|
||||
TweakTimestamps();
|
||||
ChangeMOTD();
|
||||
EditEmailMessage();
|
||||
RebuildHook();
|
||||
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>
|
||||
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
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>
|
||||
);
|
||||
|
||||
if ($::TreeOpen) {
|
||||
print qq(
|
||||
<INPUT TYPE=HIDDEN NAME=command VALUE=close>
|
||||
<B>Closing time stamp is:</B>
|
||||
<INPUT NAME=closetimestamp VALUE=\"$timestamp\"><BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Close the tree\">
|
||||
);
|
||||
} else {
|
||||
print qq(
|
||||
<INPUT TYPE=HIDDEN NAME=command VALUE=open>
|
||||
<B>The new \"good\" timestamp is:</B>
|
||||
<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\">
|
||||
);
|
||||
}
|
||||
|
||||
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=command VALUE=tweaktimes>
|
||||
<TABLE>
|
||||
<TR>
|
||||
<TD><B>Last good timestamp:</B></TD>
|
||||
<TD><INPUT NAME=lastgood VALUE=\"$lg_timestamp\"></TD>
|
||||
</TR><TR>
|
||||
|
||||
<TD><B>Last close timestamp:</B></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>
|
||||
<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=\"$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>
|
||||
|
||||
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=treeclosed>to the hook when the tree closes
|
||||
</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>
|
||||
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
|
||||
<INPUT TYPE=HIDDEN NAME=command VALUE=repophook>
|
||||
Repopulate the hook from scratch.<p>
|
||||
<font color=red size=+2>This can be very dangerous.</font> You should
|
||||
usually only need to do this to populate a new Bonsai branch.
|
||||
<p>
|
||||
<b>Use any checkin since:</b>
|
||||
<INPUT NAME=startfrom VALUE=\"$lg_timestamp\">
|
||||
<br>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Rebuild the hook\">
|
||||
</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>
|
||||
<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.
|
||||
<p>
|
||||
<font color=red size=+2>This can take an incredibly long time.</font> You
|
||||
should
|
||||
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=\"$timestamp\">
|
||||
<br>
|
||||
<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>
|
||||
<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=command VALUE=changepassword>
|
||||
Change password.<BR>
|
||||
<B>Old password:</B> <INPUT NAME=password TYPE=password> <BR>
|
||||
<B>New password:</B> <INPUT NAME=newpassword TYPE=password> <BR>
|
||||
<B>Retype new password:</B> <INPUT NAME=newpassword2 TYPE=password> <BR>
|
||||
<INPUT TYPE=RADIO NAME=doglobal VALUE=0 CHECKED>Change password for this tree<BR>
|
||||
<INPUT TYPE=RADIO NAME=doglobal VALUE=1>Change master Bonsai password<BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Change the password\">
|
||||
</FORM>
|
||||
);
|
||||
}
|
||||
@@ -1,120 +0,0 @@
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use strict;
|
||||
use diagnostics;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub adminfuncs_pl_sillyness {
|
||||
my $zz;
|
||||
$zz = $::TreeID;
|
||||
}
|
||||
|
||||
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;
|
||||
|
||||
my $pathname = DataDir() . "/$filename";
|
||||
|
||||
return unless $hooklist;
|
||||
return unless -f $pathname;
|
||||
return unless open(MAIL, "< $pathname");
|
||||
$mail = join("", <MAIL>);
|
||||
close (MAIL);
|
||||
|
||||
%substs = ();
|
||||
$substs{'hooklist'} = $hooklist;
|
||||
$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();
|
||||
}
|
||||
|
||||
|
||||
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));
|
||||
}
|
||||
@@ -1,72 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
require '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,45 +0,0 @@
|
||||
%define _prefix /var/www/cgi-bin/bonsai
|
||||
|
||||
# auto generate the version number based on the output of the date
|
||||
# command.
|
||||
|
||||
%define _version %(eval "date '+%Y%m%d'")
|
||||
|
||||
Summary: Development monitoring tool
|
||||
Name: bonsai-local-conf
|
||||
Version: %{_version}
|
||||
Release: 1
|
||||
Copyright: MPL
|
||||
Group: Development/Tools
|
||||
Source: tar://bonsai_local_conf.tar.gz
|
||||
Prefix: %{_prefix}
|
||||
Buildroot: /var/tmp/%{name}-root
|
||||
|
||||
%description
|
||||
|
||||
The local configuration files for bonsai. This package customizes
|
||||
bonsai for the local use. The bonsai package is genaric, this
|
||||
package contains all the discriptions of the local system by providing
|
||||
the data subdirectory files.
|
||||
|
||||
|
||||
%prep
|
||||
# empty prep
|
||||
|
||||
%build
|
||||
#empty build
|
||||
|
||||
%install
|
||||
rm -rf $RPM_BUILD_ROOT
|
||||
mkdir -p $RPM_BUILD_ROOT/%{_prefix}
|
||||
|
||||
cd $RPM_BUILD_ROOT/%{_prefix}
|
||||
tar zxf %{_sourcedir}/bonsai_local_conf.tar.gz
|
||||
|
||||
%clean
|
||||
rm -rf $RPM_BUILD_ROOT
|
||||
|
||||
|
||||
%files
|
||||
%defattr(-,apache,apache)
|
||||
%{_prefix}/data/*
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 20 KiB |
@@ -1,58 +0,0 @@
|
||||
%define _prefix /var/www/cgi-bin/bonsai
|
||||
|
||||
# auto generate the version number based on the output of the date
|
||||
# command.
|
||||
|
||||
%define _version %(eval "date '+%Y%m%d'")
|
||||
|
||||
Summary: Web and SQL interface to CVS
|
||||
Name: bonsai
|
||||
Version: %{_version}
|
||||
Release: 1
|
||||
Copyright: MPL
|
||||
Group: Development/Tools
|
||||
Source: cvs://:pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot:mozilla/webtools/bonsai/bonsai.tar.gz
|
||||
Prereq: apache
|
||||
Prefix: %{_prefix}
|
||||
Buildroot: /var/tmp/%{name}-root
|
||||
|
||||
%description
|
||||
|
||||
|
||||
%prep
|
||||
%setup -q -n bonsai
|
||||
|
||||
|
||||
%build
|
||||
|
||||
prefix='%{_prefix}' \
|
||||
./configure
|
||||
|
||||
make
|
||||
|
||||
%install
|
||||
rm -rf $RPM_BUILD_ROOT
|
||||
mkdir -p $RPM_BUILD_ROOT/%{_prefix}
|
||||
|
||||
make PREFIX=$RPM_BUILD_ROOT/%{_prefix} \
|
||||
install
|
||||
|
||||
# the data directory needs to be group writable so that the cgi's can update
|
||||
# files in it. No other program needs to use this directory.
|
||||
|
||||
chmod 770 $RPM_BUILD_ROOT/%{_prefix}/data
|
||||
|
||||
# config files do not belong as part of this package,
|
||||
# they have their own package
|
||||
|
||||
rm -rf $RPM_BUILD_ROOT/%{_prefix}/data/*
|
||||
|
||||
%clean
|
||||
#rm -rf $RPM_BUILD_ROOT
|
||||
|
||||
# the data dir must be writable by the cgi process.
|
||||
%files
|
||||
%defattr(-,root,root)
|
||||
%{_prefix}
|
||||
%defattr(-,apache,apache)
|
||||
%{_prefix}/data
|
||||
@@ -1,201 +0,0 @@
|
||||
So you want to run Bonsai? It's better that you know how Bonsai works
|
||||
since your obviously going to be hacking around in the code to change
|
||||
it to your individual site configuration.
|
||||
|
||||
o What Bonsai can do for you:
|
||||
|
||||
Bonsai allows you to query the contents of your CVS tree, figuring out
|
||||
the differences between arbitrary versions and/or branches of a file
|
||||
and allows you to watch those changes over time.
|
||||
|
||||
One of the problems with CVS is that although it allows you to define
|
||||
logical groups of directories into a module, it has no way to define a
|
||||
module that represents a specific branch within one or more of those
|
||||
directories. Bonsai allows you to define a module that represents
|
||||
both a directory and a branch within that directory in your CVS
|
||||
repository.
|
||||
|
||||
Bonsai is tree control.
|
||||
|
||||
---------------------
|
||||
|
||||
o How does it work?
|
||||
|
||||
To do all this, Bonsai requires access to the source of your CVS
|
||||
repository. This means that it will actually read the source files in
|
||||
their ,v format. It is not enough that you have access to a checked
|
||||
out copy of an arbitrary CVS tree. Bonsai also reads the modules that
|
||||
you have defined in the modules file in the CVSROOT directory of your
|
||||
CVS repository. The logical mappings that you set up in that file
|
||||
define the base Bonsai modules that Bonsai will use to set up your
|
||||
queries.
|
||||
|
||||
In order to keep track of these changes in a format that is easily
|
||||
queried Bonsai also requires access to a relational database, in this
|
||||
case MySQL. Once your CVS tree is in place and Bonsai has been
|
||||
installed, you will import the important data from your CVS repository
|
||||
into the Bonsai database. This doesn't import the entire repository
|
||||
verbatim, it only reads and stores the information that it needs
|
||||
including information about users, dates, file names, versions and
|
||||
branch information.
|
||||
|
||||
To keep track of changes over time, Bonsai also requires notification
|
||||
through some kind of asynchronous method to know that you have updated
|
||||
a file. It keeps track of these changes through email. In CVS
|
||||
every time that you make a check-in, any scripts that are defined in the
|
||||
loginfo file in the CVSROOT directory of your CVS repository will be
|
||||
run and the information about that check-in will be passed to that
|
||||
script. Bonsai requires that you add a script to that file that will
|
||||
automatically generate a specially formatted email. That email will
|
||||
then be sent to a special account and, in turn, a script. That script
|
||||
will then parse the email and update the Bonsai database with the
|
||||
check-in information.
|
||||
|
||||
This method, while seemingly roundabout, provides a few advantages.
|
||||
It keeps you from constantly polling your CVS tree to check for
|
||||
changes. This can be a very intensive operation on large
|
||||
repositories. This method is pretty reliable. Mail messages are
|
||||
rarely lost on systems.
|
||||
|
||||
Bonsai requires that it always have read access to the CVS repository.
|
||||
It does not ever need to write to the repository so this means you can
|
||||
use a read-only nfs setup or some other mirroring strategy.
|
||||
|
||||
The last part of Bonsai is the web based interface. This interface is
|
||||
where you do most of the day-to-day administration and querying. The
|
||||
interface uses the backend database and the configuration files that
|
||||
you set up.
|
||||
|
||||
---------------
|
||||
|
||||
o How do I set up my administration password?
|
||||
|
||||
When you build bonsai, the program "trapdoor" is built and installed
|
||||
into the data directory in your Bonsai installation tree. Change to
|
||||
the data directory in your installation and run the command:
|
||||
|
||||
trapdoor <your admin password> > passwd
|
||||
|
||||
If you look at the file you will see your admin password in standard
|
||||
unix crypt() format.
|
||||
|
||||
---------------
|
||||
|
||||
o Ok, I've installed the files. What do I do now?
|
||||
|
||||
First, you need to define logical Bonsai modules on top of the modules
|
||||
that you have already defined in CVS. Any CVS modules that you do not
|
||||
define here will still show up in the Bonsai query interface.
|
||||
However, defining Bonsai modules allows you access to the most
|
||||
commonly used modules and allows you fast access to the branches of a
|
||||
particular module. Also, to import a directory from CVS into Bonsai
|
||||
it must be included as part of one of the Bonsai modules.
|
||||
|
||||
To set up the Bonsai modules you need to edit the configdata script in
|
||||
the data/ directory of your Bonsai installation. The first part of
|
||||
this file contains a list of the Bonsai modules that you want to
|
||||
define and looks something like this:
|
||||
|
||||
set treelist {default module_a module_b module_c}
|
||||
|
||||
Please note the "default" module. You can define this module to be
|
||||
any of the modules in your CVS tree. It is probably best that you
|
||||
define it as your most used. It _must_ be defined.
|
||||
|
||||
For each of the Bonsai modules you need to define the information that
|
||||
describes that module. For example, for you default module you can
|
||||
define the following information:
|
||||
|
||||
set treeinfo(default,module) XYZSource
|
||||
set treeinfo(default,branch) {}
|
||||
set treeinfo(default,repository) {/cvsroot}
|
||||
set treeinfo(default,description) {XYZ Sourcecode}
|
||||
set treeinfo(default,shortdesc) {XYZ}
|
||||
|
||||
Each of the treeinfo settings describes the following things:
|
||||
|
||||
module: This is the logical module as defined in your modules file on
|
||||
the CVS repository.
|
||||
|
||||
branch: This is the branch within that module. As above, you don't
|
||||
have to have one of these defined. If you don't it's the same as the
|
||||
HEAD branch.
|
||||
|
||||
repository: This is the directory that contains the repository.
|
||||
|
||||
description: This is the long description for the module, used
|
||||
throughout the web interface.
|
||||
|
||||
shortdesc: This is a shorter version of the description.
|
||||
|
||||
Here is another example using a branch:
|
||||
|
||||
set treeinfo(module_a,module) ABCSource
|
||||
set treeinfo(module_a,branch) {ACB_MERGE_1_0_BRANCH}
|
||||
set treeinfo(module_a,repository) {/cvsroot}
|
||||
set treeinfo(module_a,description) {ABC Sourcecode}
|
||||
set treeinfo(module_a,shortdesc) {ABC}
|
||||
|
||||
Also in the configdata file you need to define the absolute paths to
|
||||
some more commonly used commands and configuration information. These
|
||||
are pretty self explanatory:
|
||||
|
||||
set cvscommand /usr/local/bin/cvs
|
||||
set rlogcommand /usr/bin/rlog
|
||||
set rcsdiffcommand /usr/bin/rcsdiff
|
||||
set cocommand /usr/bin/co
|
||||
set lxr_base http://www.abc.com/webtools/lxr/source
|
||||
set mozilla_lxr_kludge TRUE
|
||||
|
||||
Once you have set up these configuration items you also need to make a
|
||||
directory in your data directory that has the same name as each of the
|
||||
modules above. For example, for the default module defined above you
|
||||
would need to create a directory called "ABCSource".
|
||||
|
||||
-----------------
|
||||
|
||||
o How do I import data?
|
||||
|
||||
You can do this from the administration menu in Bonsai. Go to the
|
||||
toplevel of Bonsai and choose the module that you want to import by
|
||||
using the pull down menu. Then click on the link near the bottom of
|
||||
the page for administration. This will take you to the administration
|
||||
page for that module. If this is the first time importing data, find
|
||||
the section that has a button labeled "Rebuild CVS history". When you
|
||||
fill in your administration password and click on the button, all of
|
||||
the history information for that Bonsai module will be rebuilt.
|
||||
|
||||
You need to do this once for all of the modules that you have defined.
|
||||
Unfortunately, there is no way to import an entire CVS tree from the
|
||||
root.
|
||||
|
||||
------------------
|
||||
|
||||
o How do I set up mail for bonsai?
|
||||
|
||||
There are three things that you need to do to to set up email for
|
||||
bonsai.
|
||||
|
||||
o You need to set up an account that will accept the email from Bonsai
|
||||
and process it. When you have set up that user's .forward file to run
|
||||
the script that handles the email. This is what a sample .forward
|
||||
file looks like, please note that the script takes one argument which
|
||||
is the directory where all of your bonsai data resides:
|
||||
|
||||
"|/home/httpd/html/webtools/bonsai/handleCheckinMail.tcl /home/httpd/html/webtools/bonsai"
|
||||
|
||||
o You need to set up an alias for "bonsai-checkin-daemon" to the
|
||||
account that will process the email. This is where the mail will be
|
||||
sent to when checking into CVS. Also create an alias called
|
||||
"bonsai-daemon" for error mail.
|
||||
|
||||
o You need to add the script that creates the email to the loginfo
|
||||
file in CVS. To do this you can add a line to the loginfo file that
|
||||
looks like this:
|
||||
|
||||
# For bonsai
|
||||
ALL /home/httpd/html/webtools/bonsai/dolog.pl -r /usr/local/cvsroot bonsai-checkin-daemon@your-bonsai-host.your-company.com
|
||||
#
|
||||
|
||||
This will generate a piece of email every time someone checks in code
|
||||
and should be handled with the setup above.
|
||||
@@ -1,23 +0,0 @@
|
||||
From: bonsai-daemon
|
||||
To: %name%
|
||||
Subject: [Bonsai] Hey! You checked in while the tree was closed!
|
||||
Mime-Version: 1.0
|
||||
Content-Type: text/html
|
||||
|
||||
<HTML>
|
||||
|
||||
<H1>Boy, you better have had permission!</H1>
|
||||
|
||||
You just checked into <tt>%dir%</tt> the files <tt>%files%</tt>. The
|
||||
tree is currently frozen. You better have had permission from the build group
|
||||
to make a checkin; otherwise, you're in deep doo-doo.
|
||||
|
||||
<P>
|
||||
|
||||
Your contact info and other vital data is listed below. Please
|
||||
<a href=http://warp/bonsai/profile.cgi?person=%name%>update</a>
|
||||
this info <b>immediately</b> if it is at all inaccurate or incorrect.
|
||||
|
||||
<hr>
|
||||
|
||||
%profile%
|
||||
1216
mozilla/webtools/bonsai/configure
vendored
1216
mozilla/webtools/bonsai/configure
vendored
File diff suppressed because it is too large
Load Diff
@@ -1,28 +0,0 @@
|
||||
dnl Process this file with autoconf to produce a configure script.
|
||||
AC_INIT(trapdoor.c)
|
||||
|
||||
dnl Checks for programs.
|
||||
AC_PROG_CC
|
||||
AC_PATH_PROG(PERL,perl)
|
||||
AC_PERL_DB
|
||||
AC_PERL_DATEPARSE
|
||||
|
||||
AC_PATH_PROG(CO,co)
|
||||
AC_PATH_PROG(CVS,cvs)
|
||||
AC_PATH_PROG(RLOG,rlog)
|
||||
AC_PATH_PROG(RCSDIFF,rcsdiff)
|
||||
|
||||
|
||||
dnl Checks for libraries.
|
||||
dnl Replace `main' with a function in -lcrypt:
|
||||
AC_CHECK_LIB(crypt, crypt)
|
||||
|
||||
dnl Checks for header files.
|
||||
|
||||
dnl Checks for typedefs, structures, and compiler characteristics.
|
||||
|
||||
dnl Checks for library functions.
|
||||
|
||||
AC_OUTPUT(Makefile)
|
||||
AC_OUTPUT_COMMANDS([echo type 'make install' to install bonsai])
|
||||
|
||||
@@ -1,27 +0,0 @@
|
||||
<html> <head>
|
||||
<title>Changing other people's contact info.</title>
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<h1>Changing other people's contact info.</h1>
|
||||
|
||||
Occasionally, you need to change the "contact info" listed for some
|
||||
other person. (Like, they just called you on their cellphone from the
|
||||
horrible traffic accident they just got in, and need you to go on the
|
||||
hook for them.) Well, it's easy. Go ahead onto their contact page,
|
||||
change the contact info field, and type your own username and UNIX
|
||||
password to the form. It'll work.
|
||||
<P>
|
||||
Note that you're only allowed to change the "Current Contact Info"
|
||||
field this way. It won't let you change anything else.
|
||||
|
||||
<hr>
|
||||
|
||||
<a href="toplevel.cgi" target=_top>Back to the top of Bonsai</a>
|
||||
|
||||
<hr>
|
||||
<address><a href="http://home.netscape.com/people/terry/">Terry Weissman <terry@netscape.com></a></address>
|
||||
<!-- hhmts start -->
|
||||
Last modified: Wed Oct 30 13:03:35 1996
|
||||
<!-- hhmts end -->
|
||||
</body> </html>
|
||||
@@ -1,165 +0,0 @@
|
||||
#!/usr/bin/perl -w
|
||||
#
|
||||
# Version: MPL 1.1
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public License Version
|
||||
# 1.1 (the "License"); you may not use this file except in compliance with
|
||||
# the License. You may obtain a copy of the License at
|
||||
# http://www.mozilla.org/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 parsecheckins.pl, a Bonsai-output -> HTML parser.
|
||||
#
|
||||
# The Initial Developer of the Original Code is
|
||||
# J. Paul Reed (preed@sigkill.com).
|
||||
#
|
||||
# Portions created by the Initial Developer are Copyright (C) 2003
|
||||
# the Initial Developer. All Rights Reserved.
|
||||
#
|
||||
# Contributor(s): Dave Miller <justdave@netscape.com>
|
||||
#
|
||||
|
||||
use strict;
|
||||
|
||||
## Suggested usage:
|
||||
##
|
||||
## cat saved_bonsai_query_output | perl parsecheckins.pl > output 2> logfile &
|
||||
## tail -f logfile
|
||||
##
|
||||
## Script progress gets dumped on stderr
|
||||
|
||||
## hostname of your Bugzilla installation
|
||||
my $bzHost = 'your.bugzilla.host';
|
||||
|
||||
## Set to 0 if you don't want to query your bugzilla host for the titles of
|
||||
## the bugs associated with these checkins
|
||||
my $getTitles = 1;
|
||||
|
||||
## Set to the lowest valid bug number in your bz install; for non-bmo
|
||||
## instals, should probably be 0
|
||||
my $lowBugnum = 1000;
|
||||
|
||||
## SCRIPT STARTS HERE ##
|
||||
my $input;
|
||||
|
||||
while (<>) {
|
||||
$input .= $_;
|
||||
}
|
||||
|
||||
## remove the header
|
||||
$input =~ s/.*?<TH WIDTH=\d+\%>Description\n.*?\n//is;
|
||||
|
||||
## remove the footer
|
||||
$input =~ s/<\/TABLE><br>.*//is;
|
||||
|
||||
## remove lines that contain nothing but starting a new table
|
||||
$input =~ s/<\/TABLE><TABLE.*?\n//igs;
|
||||
|
||||
## remap the linefeeds so they only occur between <tr> blocks
|
||||
$input =~ s/\n/ /gs;
|
||||
$input =~ s/<\/tr>\s*<tr>/<\/tr>\n<tr>/igs;
|
||||
|
||||
## ok, at this point, each <tr> is on a line by itself.
|
||||
## let's load this into an array of lines.
|
||||
my @lines = split(/\n/,$input);
|
||||
|
||||
## strip all lines that don't contain a description
|
||||
@lines = grep { $_ =~ /<TD WIDTH=4\d% VALIGN=TOP/ } @lines;
|
||||
|
||||
## strip all lines that are checkins that don't reference a bugzilla bug
|
||||
## comment this line out if you want bugs that don't reference a bz bug
|
||||
@lines = grep { $_ =~ /show_bug.cgi/ } @lines;
|
||||
|
||||
## now we do a bunch of transformations on each line:
|
||||
@lines = map {
|
||||
## remove all rowspan markers (simplifies some of the parsing below)
|
||||
s/rowspan=[^ >]+//ig;
|
||||
|
||||
## Strip off the leading and ending <tr>'s
|
||||
s/^<tr>//i;
|
||||
s/<\/tr>$//i;
|
||||
|
||||
## Strip out extra <br>s
|
||||
s/<br>/ /ig;
|
||||
|
||||
## remove the date column because we don't need it
|
||||
s/<TD width=2\%.*?<td/<td/i;
|
||||
|
||||
## remove the email address link; if you want to keep the email address,
|
||||
## comment out the 2nd regex and use the first (commented out) one
|
||||
# s/<a[^>]+>(.*?)<\/a>/$1/i;
|
||||
s/<td width=\d+\%><a[^>]+>(.*?)<\/a>\s*<td/<td/i;
|
||||
|
||||
## remove the filename column because we don't need it
|
||||
s/<td width=45\%.*?<td/<td/i;
|
||||
|
||||
## remove the version number, branch tag, and linecount columns
|
||||
s/<td width=2\%>(?:<font|\ ).*?<td/<td/i;
|
||||
s/<td width=2\%><tt>.*?<td/<td/i;
|
||||
s/<td width=2\%>(?:<font|\ ).*?<td/<td/i;
|
||||
|
||||
## Strip the last <td> preceding the commit message
|
||||
s/<td width=\d+%\s+VALIGN=TOP\s*>//i;
|
||||
|
||||
## Strip off parts of the comment we don't care about
|
||||
s/Patch by.+//;
|
||||
s/Fix by.+//;
|
||||
s/r=.+//;
|
||||
s/a=.+//;
|
||||
s/r,a=.+//;
|
||||
s/r\/a.+//;
|
||||
|
||||
## Get the titles for bugs
|
||||
|
||||
if (/show_bug\.cgi\?id=(\d+)/) {
|
||||
my $bugnum = $1;
|
||||
|
||||
if ($getTitles && $bugnum > $lowBugnum) {
|
||||
## We use lynx so libwww doesn't have to get installed;
|
||||
## yay for quick and dirty!
|
||||
my $bugreport = `lynx -source http://$bzHost/show_bug.cgi?id=$bugnum`;
|
||||
|
||||
if ($bugreport =~ /<TITLE>Bug \d+ - ([^<]+)<\/TITLE>/i) {
|
||||
my $title = $1;
|
||||
print STDERR "$bugnum: $title\n";
|
||||
|
||||
s/(HREF="[^"]+")/$1 title="$title"/;
|
||||
}
|
||||
else {
|
||||
print STDERR "BUG REPORT LACKS TITLE (not authorized to view?): "
|
||||
. "$bugnum\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
print STDERR "NO BUG LINK FOUND: $_\n";
|
||||
}
|
||||
|
||||
## Clean up extra spaces
|
||||
s/^\s+//;
|
||||
s/\s+$//;
|
||||
|
||||
## Standardize the separator format:
|
||||
s/(\d+<\/A>)\s*.\s+/$1 \- /;
|
||||
|
||||
## return the final result; should be the comment message, titles and all.
|
||||
$_;
|
||||
|
||||
} @lines;
|
||||
|
||||
## Uncomment this if you want the bugs listed oldest first
|
||||
#@lines = reverse @lines;
|
||||
|
||||
## Play with the output format here; now, it gives an unenumerated html list
|
||||
|
||||
print "<ul>\n";
|
||||
|
||||
foreach my $line (@lines) {
|
||||
print "<li>$line</li>\n";
|
||||
}
|
||||
|
||||
print "</ul>\n";
|
||||
@@ -1,93 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
use vars qw($CloseTimeStamp);
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
LoadCheckins();
|
||||
|
||||
my $maxsize = 400;
|
||||
|
||||
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>\n";
|
||||
|
||||
my @list = ();
|
||||
my $globstr = DataDir() . '/batch-*[0-9].pl';
|
||||
|
||||
foreach my $i (glob($globstr )) {
|
||||
if ($i =~ /(\d+)/) {
|
||||
push @list, $1;
|
||||
}
|
||||
}
|
||||
|
||||
@list = sort { $b <=> $a } @list;
|
||||
my $first = 1;
|
||||
my $biggest = 1;
|
||||
my %minfo; # meaninglesss info
|
||||
|
||||
foreach my $i (@list) {
|
||||
my $batch = DataDir() . "/batch-$i.pl";
|
||||
require $batch;
|
||||
|
||||
$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);
|
||||
}
|
||||
|
||||
my %people = ();
|
||||
foreach my $checkin (@::CheckInList) {
|
||||
my $info = eval("\\\%$checkin");
|
||||
$people{$$info{'person'}} = 1;
|
||||
}
|
||||
$minfo{$i}{numpeople} = scalar keys(%people);
|
||||
}
|
||||
|
||||
|
||||
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";
|
||||
}
|
||||
|
||||
print "</table>\n";
|
||||
PutsTrailer();
|
||||
exit;
|
||||
@@ -1,127 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
require '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);
|
||||
@@ -1,130 +0,0 @@
|
||||
#!/usr/local/bin/perl -w
|
||||
#use diagnostics;
|
||||
use strict;
|
||||
$::accessconfig = [
|
||||
#{
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'branch' => '#-all-#',
|
||||
# 'location' => {
|
||||
# 'file' => [ 'test/foo.sh' ],
|
||||
# },
|
||||
# 'close' => 'Hey! You Suck!',
|
||||
# 'bless' => {
|
||||
# 'user' => [ 'thj' ],
|
||||
# },
|
||||
# 'permit' => {
|
||||
# 'unix_group' => [ 'ebuildrel' ],
|
||||
# },
|
||||
# 'deny_msg' => 'buildrel group has been naughty',
|
||||
#},
|
||||
#{
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'branch' => 'TRUNK',
|
||||
# 'location' => {
|
||||
# 'file' => [ 'test/foo.sh' ],
|
||||
# },
|
||||
# 'close' => 'BRANCH closed, so go away.',
|
||||
# 'bless' => {
|
||||
# 'bonsai_group' => [ 'test-2' ],
|
||||
# },
|
||||
# 'permit' => {
|
||||
# 'bonsai_group' => [ 'test-2' ],
|
||||
# },
|
||||
# 'deny_msg' => 'i don\'t like people',
|
||||
#},
|
||||
#{
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'branch' => '#-all-#',
|
||||
# 'location' => {
|
||||
# 'module' => [ ],
|
||||
# 'directory' => [ 'test/foo/', 'blah/blah/blah' ],
|
||||
### 'file' => [ 'test/foo.sh' ],
|
||||
# },
|
||||
# 'close' => 0,
|
||||
## 'permit' => {
|
||||
### 'unix_group' => [ ],
|
||||
### 'bonsai_group' => [ ],
|
||||
### 'user' => [ ],
|
||||
## },
|
||||
## 'deny' => {
|
||||
## 'unix_group' => [ ],
|
||||
## 'bonsai_group' => [ ],
|
||||
## 'user' => [ ],
|
||||
## },
|
||||
## 'bless' => {
|
||||
## 'unix_group' => [ ],
|
||||
## 'bonsai_group' => [ 'blessed' ],
|
||||
## 'user' => [ ],
|
||||
## },
|
||||
#},
|
||||
#{
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'branch' => 'TRUNK',
|
||||
# 'location' => {
|
||||
# 'file' => [ 'test/foo.sh' ],
|
||||
# },
|
||||
# 'close' => 'Blah, blah, blah.',
|
||||
# 'bless' => {
|
||||
# 'user' => [ 'thj' ],
|
||||
# },
|
||||
# 'permit' => {
|
||||
# 'user' => [ 'thj' ],
|
||||
# },
|
||||
#},
|
||||
##{
|
||||
## 'cvsroot' => '#-all-#',
|
||||
## 'branch' => '#-all-#',
|
||||
## 'location' => {
|
||||
## 'directory' => [ 'CVSROOT' ],
|
||||
## },
|
||||
### 'close' => "TESTING TESTING TESTING",
|
||||
## 'permit' => {
|
||||
## 'unix_group' => [ 'buildrel' ],
|
||||
## },
|
||||
##},
|
||||
##{
|
||||
## 'cvsroot' => 'neutron:/var/cvs',
|
||||
## 'branch' => 'XML_Dev_BRANCH',
|
||||
## 'location' => {
|
||||
## 'module' => [ ],
|
||||
## 'directory' => [ ],
|
||||
## 'file' => [ 'test/foo.sh' ],
|
||||
## },
|
||||
## 'close' => 0,
|
||||
## 'permit' => {
|
||||
## 'unix_group' => [ ],
|
||||
## 'bonsai_group' => [ ],
|
||||
## 'user' => [ ],
|
||||
## },
|
||||
## 'deny' => {
|
||||
## 'unix_group' => [ ],
|
||||
## 'bonsai_group' => [ ],
|
||||
## 'user' => [ ],
|
||||
## },
|
||||
## 'bless' => {
|
||||
## 'unix_group' => [ ],
|
||||
## 'bonsai_group' => [ ],
|
||||
## 'user' => [ ],
|
||||
## },
|
||||
##},
|
||||
##{
|
||||
## 'cvsroot' => 'neutron:/var/cvs2',
|
||||
## 'branch' => 'FOO',
|
||||
## 'location' => {
|
||||
## 'module' => [ 'Vermouth' ],
|
||||
## },
|
||||
## 'close' => 0,
|
||||
##},
|
||||
{
|
||||
'cvsroot' => 'neutron:/var/cvs',
|
||||
'branch' => 'T2',
|
||||
'location' => {
|
||||
# 'module' => [ 'Vermouth' ],
|
||||
# 'file' => [ 'bmsrc/apps/ams/foo.pl' ],
|
||||
'directory' => [ 'mirror-test' ]
|
||||
},
|
||||
# 'permit' => { },
|
||||
# 'close' => "closed",
|
||||
},
|
||||
];
|
||||
return 1;
|
||||
@@ -1,214 +0,0 @@
|
||||
#!/usr/local/bin/perl -w
|
||||
use strict;
|
||||
use Sys::Hostname;
|
||||
use Cwd;
|
||||
|
||||
#use diagnostics ;
|
||||
#use Data::Dumper;
|
||||
#use Time::HiRes;
|
||||
|
||||
#
|
||||
# It's tempting to use environment variables for things like USER
|
||||
# and CVSROOT; however, don't. Using the builtin CVS variables is
|
||||
# a better idea, especially if you are using a three entry
|
||||
# $CVSROOT/CVSROOT/passwd (i.e., cvs runs as a local user instead of
|
||||
# the actual user)
|
||||
#
|
||||
$::cvsrootdir = shift @ARGV;
|
||||
#
|
||||
# I'd really rather have all my "use" and "require" statements before
|
||||
# anything else, but since I want to keep the bonsai-global.pm module
|
||||
# checked into $CVSROOT/CVSROOT, I need to do the ugly "parse" the
|
||||
# root first, then require the module foo you see here.
|
||||
#
|
||||
require "$::cvsrootdir/CVSROOT/bonsai-global.pm";
|
||||
require "$::cvsrootdir/CVSROOT/bonsai-config.pm";
|
||||
|
||||
#$::start = Time::HiRes::time;
|
||||
|
||||
$::cwd = cwd;
|
||||
$::user = shift @ARGV;
|
||||
$::time = time;
|
||||
$::directory = shift @ARGV ;
|
||||
$::directory =~ s/^$::cvsrootdir\/?(.*)$/$1/;
|
||||
$::cvsroot = hostname() . ":" . $::cvsrootdir;
|
||||
|
||||
#print "#" x 80, "\n", Dumper(\@ARGV), "#" x 80, "\n";
|
||||
|
||||
###
|
||||
### directory/file specific actions/checks
|
||||
###
|
||||
if ($::directory eq "CVSROOT") {
|
||||
$::modulesfile = "./modules";
|
||||
|
||||
if (-e $::modulesfile ) {
|
||||
$::modules = `cat $::modulesfile`;
|
||||
$::modules_hash = &BuildModuleHash($::modules) ;
|
||||
&CheckCircularity($::modules_hash);
|
||||
print "\nno circular references found in CVSROOT/modules\n";
|
||||
} else {
|
||||
print "\nno changes to CVSROOT/modules\n";
|
||||
}
|
||||
|
||||
if (-e "./bonsai-mirrorconfig.pm") {
|
||||
require "./bonsai-mirrorconfig.pm";
|
||||
print "CVSROOT/bonsai-mirrorconfig.pm has changed and appears to be OK\n";
|
||||
} else {
|
||||
print "no changes to CVSROOT/bonsai-mirrorconfig.pm\n";
|
||||
}
|
||||
|
||||
if (-e "./bonsai-accessconfig.pm") {
|
||||
require "./bonsai-accessconfig.pm";
|
||||
print "CVSROOT/bonsai-accessconfig.pm has changed and appears to be OK\n";
|
||||
} else {
|
||||
print "no changes to CVSROOT/bonsai-accessconfig.pm\n";
|
||||
}
|
||||
|
||||
print "\n";
|
||||
}
|
||||
###
|
||||
### Log checkin to database
|
||||
###
|
||||
open (ENTRIES, "<CVS/Entries") || die "Can't open CVS/Entries" ;
|
||||
while (<ENTRIES>) {
|
||||
chomp;
|
||||
my @line = split /\//;
|
||||
next if &get('code', @line);
|
||||
my $branch = &get('tag', @line);
|
||||
my $oldrev = &get('rev', @line);
|
||||
my $file = &get('file', @line);
|
||||
if (&intersect([$file], \@ARGV)) {
|
||||
# for my $f (@ARGV) { # Sometimes I really hate CVS
|
||||
# if ($file eq $f) {
|
||||
$::files .= $branch.":".$oldrev.":".$file." | ";
|
||||
push @{$::change_ref->{$branch}}, $file;
|
||||
# }
|
||||
}
|
||||
}
|
||||
close ENTRIES;
|
||||
$::files =~ s/^(.*) \| $/$1/;
|
||||
#print "\$files -- $::files\n";
|
||||
|
||||
&connect();
|
||||
|
||||
#print Time::HiRes::time - $::start, "\n";
|
||||
|
||||
my $ac = eval &retrieve("expanded_accessconfig");
|
||||
&log_commit($::cwd, $::user, $::time, $::directory, $::cvsroot, 'checking permissions', $::files);
|
||||
|
||||
#print Dumper($::change_ref);
|
||||
|
||||
for my $i (0..$#{$ac}) {
|
||||
if (&rule_applies($ac->[$i], $::change_ref)) {
|
||||
if ( $ac->[$i]->{'close'} && !&included($::user, $ac->[$i]->{'bless'}) ) { push @::closed, $i }
|
||||
if ( &included($::user, $ac->[$i]->{'deny'}) ) { push @::deny, $i }
|
||||
if ( $ac->[$i]->{'permit'} && !&included($::user, $ac->[$i]->{'permit'}) ) { push @::deny, $i }
|
||||
}
|
||||
}
|
||||
|
||||
@::eol = @{&branch_eol($::cvsroot, keys(%$::change_ref))};
|
||||
if (scalar @::eol) {
|
||||
my $branch = join ", ", @::eol;
|
||||
$::msg->{'denied'}->{'eol'} =~ s/#-branch-#/$branch/;
|
||||
|
||||
&print_deny_header('eol');
|
||||
map { print "branch: $_\nfiles:\n"; map { print " $::directory/$_\n" } @{$::change_ref->{$_}} } @::eol;
|
||||
print ¢er("", "#"), "\n";
|
||||
|
||||
&update_commit($::cwd, $::user, $::time, $::directory, $::cvsroot, 'branch eol');
|
||||
exit 1;
|
||||
}
|
||||
|
||||
if (scalar @::closed) {
|
||||
my $branch = join ", ", &uniq(map{ $ac->[$_]->{'branch'} } @::closed);
|
||||
$::msg->{'denied'}->{'closed'} =~ s/#-branch-#/$branch/;
|
||||
|
||||
&print_deny_header('closed');
|
||||
&print_blocking_rules('close', @::closed);
|
||||
|
||||
&update_commit($::cwd, $::user, $::time, $::directory, $::cvsroot, 'branch closed');
|
||||
exit 1;
|
||||
}
|
||||
|
||||
if (scalar @::deny) {
|
||||
&print_deny_header('access');
|
||||
&print_blocking_rules('deny_msg', @::deny);
|
||||
|
||||
&update_commit($::cwd, $::user, $::time, $::directory, $::cvsroot, 'permission denied');
|
||||
exit 1;
|
||||
}
|
||||
|
||||
&update_commit($::cwd, $::user, $::time, $::directory, $::cvsroot, 'checkin permitted');
|
||||
|
||||
&disconnect();
|
||||
|
||||
#print Time::HiRes::time - $::start, "\n\n";
|
||||
|
||||
###############
|
||||
# subroutines #
|
||||
###############
|
||||
sub print_blocking_rules {
|
||||
my ($key, @array) = @_;
|
||||
my $rules = join ", ", @array;
|
||||
$rules =~ s/^([0-9, ]*[0-9]+), ([0-9]+)$/$1 and $2/;
|
||||
print "access denied by rule", $#array?"s":"" , " $rules.\n\n";
|
||||
map { print "$_. ", $ac->[$_]->{$key}?$ac->[$_]->{$key}:'<no reason given>', "\n" } @array;
|
||||
print ¢er("", "#"), "\n";
|
||||
}
|
||||
|
||||
sub print_deny_header {
|
||||
my ($x) = @_;
|
||||
print ¢er("", "#"), "\n";
|
||||
print ¢er($::msg->{'denied'}->{'generic'}), "\n";
|
||||
print ¢er("", "="), "\n";
|
||||
print ¢er($::msg->{'denied'}->{$x}), "\n";
|
||||
print ¢er("", "-"), "\n";
|
||||
}
|
||||
|
||||
sub center {
|
||||
my ($string, $chr, $width) = @_;
|
||||
$chr = " " unless $chr;
|
||||
$width = 50 unless $width;
|
||||
my $half = ($width -length($string))/2;
|
||||
$string = $chr x $half . $string . $chr x $half;
|
||||
return $string;
|
||||
}
|
||||
|
||||
sub line {
|
||||
my ($chr, $width) = @_;
|
||||
$chr = "-" unless $chr;
|
||||
$width = 50 unless $width;
|
||||
return $chr x $width;
|
||||
}
|
||||
|
||||
sub included {
|
||||
my ($user, $ph) = @_;
|
||||
my $bga = &bonsai_groups($user);
|
||||
my $uga = &unix_groups($user);
|
||||
if (&intersect($bga, $ph->{'bonsai_group'}) ||
|
||||
&intersect($uga, $ph->{'unix_group'}) ||
|
||||
&intersect([$user, "#-all-#"], $ph->{'user'})) {
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub intersect { # find the intersection of N LIST references and return as a LIST
|
||||
my %h;
|
||||
map { map { $h{$_}++ } @$_ } @_;
|
||||
return grep { $h{$_} > $#_ } keys %h;
|
||||
}
|
||||
|
||||
sub rule_applies {
|
||||
my ($ah, $ch_ref) = @_;
|
||||
my $return = 0;
|
||||
while (my ($b, $fa) = each (%$ch_ref)) {
|
||||
if (($::cvsroot eq $ah->{'cvsroot'} || $ah->{'cvsroot'} eq "#-all-#") &&
|
||||
($b eq $ah->{'branch'} || $ah->{'branch'} eq "#-all-#")) {
|
||||
for my $f (@$fa) { # I would have like to have returned out of this
|
||||
$return += &allowed($f, $ah->{'location'}); # loop at the first &allowed file, but when i did
|
||||
} # the next call to the sub had ch_ref messed up and the each failed.
|
||||
}
|
||||
}
|
||||
return $return;
|
||||
}
|
||||
@@ -1,37 +0,0 @@
|
||||
#!/usr/local/bin/perl -w
|
||||
#use diagnostics;
|
||||
use strict;
|
||||
$::debug = 0;
|
||||
$::debug_level = 5;
|
||||
$::default_db = "development";
|
||||
$::default_column = "value";
|
||||
$::default_key = "id";
|
||||
%::db = (
|
||||
"production" => {
|
||||
"dsn" => "dbi:mysql:database=bonsai;host=bonsai2",
|
||||
"user" => "rw_bonsai",
|
||||
"pass" => "password",
|
||||
},
|
||||
"development" => {
|
||||
"dsn" => "dbi:mysql:database=bonsai_dev;host=bonsai2",
|
||||
"user" => "rw_bonsai_dev",
|
||||
"pass" => "password",
|
||||
},
|
||||
);
|
||||
$::msg = {
|
||||
"denied" => {
|
||||
"generic" => "CHECKIN ACCESS DENIED",
|
||||
"eol" => "BRANCH (#-branch-#) IS NO LONGER ACTIVE",
|
||||
"closed" => "BRANCH (#-branch-#) IS TEMPORARILY CLOSED",
|
||||
"access" => "INSUFFICIENT PERMISSION TO COMMIT",
|
||||
},
|
||||
};
|
||||
@::mirrored_checkin_reqex = (
|
||||
"^mirrored checkin from \\S+: ",
|
||||
"^mirrored add from \\S+: ",
|
||||
"^mirrored remove from \\S+: ",
|
||||
" \\(mirrored checkin from \\S+\\)\$",
|
||||
" \\(mirrored add from \\S+\\)\$",
|
||||
" \\(mirrored remove from \\S+\\)\$",
|
||||
);
|
||||
return 1;
|
||||
@@ -1,761 +0,0 @@
|
||||
#!/usr/local/bin/perl -w
|
||||
#use diagnostics;
|
||||
use DBI;
|
||||
use strict;
|
||||
use Time::HiRes qw(time);
|
||||
use Text::Soundex;
|
||||
#use Data::Dumper;
|
||||
|
||||
sub checkin {
|
||||
my ($cwd, $user, $time, $dir, $cvsroot, $log, $change, $hashref) = @_;
|
||||
my ($db, $ci_id, %ch_id, $branch, $file, $f_ref, $c_ref);
|
||||
unless ($db = ${$hashref}{"db"}) { $db = $::default_db }
|
||||
unless ($::last_insert_id{$db}) { $::last_insert_id{$db} = $::dbh{$db}->prepare("select LAST_INSERT_ID()") }
|
||||
$::dbh{$db}->do("insert into checkin set user_id=" . &id('user', $user)
|
||||
. ", directory_id=" . &id('directory', $dir)
|
||||
. ", log_id=" . &id('log', $log)
|
||||
. ", cvsroot_id=" . &id('cvsroot', $cvsroot)
|
||||
. ", time=$time");
|
||||
$ci_id = $::dbh{$db}->selectrow_array($::last_insert_id{$db});
|
||||
###
|
||||
### The Following should be put into a subroutine
|
||||
###
|
||||
my $insert_change = $::dbh{$db}->prepare("insert into `change` (checkin_id, file_id, oldrev, newrev, branch_id) values (?, ?, ?, ?, ?)");
|
||||
# my $insert_change_map = $::dbh{$db}->prepare("insert into checkin_change_map (checkin_id, change_id) values (?, ?)");
|
||||
while (($branch, $f_ref) = each %$change) {
|
||||
while (($file, $c_ref) = each %$f_ref) {
|
||||
$insert_change->execute($ci_id, &id('file', $file), ${$c_ref}{'old'}, ${$c_ref}{'new'}, &id('branch', $branch));
|
||||
$ch_id{$file} = $::dbh{$db}->selectrow_array($::last_insert_id{$db});
|
||||
# $insert_change_map->execute($ci_id, $::dbh{$db}->selectrow_array($::last_insert_id{$db}));
|
||||
}
|
||||
}
|
||||
###
|
||||
### End "needs to be in a subroutine"
|
||||
###
|
||||
return ($ci_id, \%ch_id);
|
||||
}
|
||||
|
||||
sub insert_mirror_object {
|
||||
# print "inserting mirror_object...\n";
|
||||
my ($db, $mirror_id, $bro, $hashref);
|
||||
$db = $::default_db;
|
||||
unless ($::last_insert_id{$db}) { $::last_insert_id{$db} = $::dbh{$db}->prepare("select LAST_INSERT_ID()") }
|
||||
my $insert_mirror = $::dbh{$db}->prepare("insert into mirror (checkin_id, branch_id, cvsroot_id, offset_id, status_id) values (?, ?, ?, ?, ?)");
|
||||
my $insert_mirror_map = $::dbh{$db}->prepare("insert into mirror_change_map (mirror_id, change_id, type_id, status_id) values (?, ?, ?, ?)");
|
||||
while (($bro, $hashref) = each %::mirror_object) {
|
||||
my ($branch, $cvsroot, $offset) = split /@/, $bro;
|
||||
$offset = '' unless $offset;
|
||||
$insert_mirror->execute($::id, &id('branch', $branch), &id('cvsroot', $cvsroot), &id('offset', $offset), &id('status', 'building_mirror'));
|
||||
my $mirror_id = $::dbh{$db}->selectrow_array($::last_insert_id{$db});
|
||||
# print "mirror_id: $mirror_id\nbranch: $branch\ncvsroot: $cvsroot\noffset: $offset\n";
|
||||
while (my($ch_id, $type) = each %$hashref) {
|
||||
$insert_mirror_map->execute($mirror_id, $ch_id, &id('type', $type), &id('status', &nomirrored($::logtext)?'nomirror':'pending'));
|
||||
$::dbh{$db}->do("UPDATE `mirror` SET status_id = ? WHERE id = ?", undef, &id('status', 'pending'), $mirror_id);
|
||||
|
||||
# print "\t-- $ch_id --> $type\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub pop_rev {
|
||||
# used to migrate to a different schema
|
||||
my $db = $::default_db ;
|
||||
my $new_total = 0;
|
||||
my $old_total = 0;
|
||||
my $pop_newrev = $::dbh{$db}->prepare("update `change` set newrev = ? where newrev_id = ?");
|
||||
my $pop_oldrev = $::dbh{$db}->prepare("update `change` set oldrev = ? where oldrev_id = ?");
|
||||
my $revisions = $::dbh{$db}->selectall_arrayref("select id, value from revision");
|
||||
for my $row (@$revisions) {
|
||||
my ($id, $value) = @$row;
|
||||
print "$id->$value: ";
|
||||
my $new = $pop_newrev->execute($value, $id);
|
||||
my $old = $pop_oldrev->execute($value, $id);
|
||||
$new_total += $new;
|
||||
$old_total += $old;
|
||||
print "new($new) -- old($old)\n";
|
||||
}
|
||||
print "\nnew_total = $new_total\nold_total = $old_total\n";
|
||||
}
|
||||
|
||||
sub pop_chid {
|
||||
# used to migrate to a different schema
|
||||
my $db = $::default_db ;
|
||||
my $new_total = 0;
|
||||
my $old_total = 0;
|
||||
my $pop_chid = $::dbh{$db}->prepare("update `change` set checkin_id = ? where id = ?");
|
||||
my $map = $::dbh{$db}->selectall_arrayref("select checkin_id, change_id from checkin_change_map");
|
||||
for my $row (@$map) {
|
||||
my ($check, $change) = @$row;
|
||||
print "$check->$change: ";
|
||||
my $new = $pop_chid->execute($check, $change);
|
||||
$new_total += $new;
|
||||
print "changed($new)\n";
|
||||
}
|
||||
print "\nnew_total = $new_total\nold_total = $old_total\n";
|
||||
}
|
||||
|
||||
sub bonsai_groups {
|
||||
my ($user) = @_;
|
||||
unless ($::groups{'bonsai'}) {
|
||||
my $db = $::default_db ;
|
||||
my $groups = $::dbh{$db}->selectcol_arrayref(
|
||||
"SELECT g.value FROM `group_user_map` m, `group` g, `user` u " .
|
||||
"WHERE m.user_id = u.id AND m.group_id = g.id AND u.value = ?",
|
||||
undef, $user);
|
||||
$::groups{'bonsai'} = [ uniq(@$groups), "#-all-#" ];
|
||||
}
|
||||
return $::groups{'bonsai'};
|
||||
}
|
||||
|
||||
sub unix_groups {
|
||||
my ($user) = @_;
|
||||
unless ($::groups{'unix'}) {
|
||||
my @groups;
|
||||
my $gid = (getpwnam($user))[3];
|
||||
my $grp = scalar getgrgid($gid) if $gid;
|
||||
return @groups unless $grp;
|
||||
push @groups, $grp;
|
||||
while (my ($name, $passwd, $gid, $members) = getgrent) {
|
||||
for my $m (split /\s/, $members) {
|
||||
if ($m eq $user) {
|
||||
push @groups, $name;
|
||||
next;
|
||||
}
|
||||
}
|
||||
}
|
||||
endgrent;
|
||||
$::groups{'unix'} = [ &uniq(@groups), "#-all-#" ];
|
||||
}
|
||||
return $::groups{'unix'};
|
||||
}
|
||||
|
||||
sub branch_eol {
|
||||
my ($r, @ba) = @_;
|
||||
my $where =
|
||||
my $db = $::default_db ;
|
||||
return $::dbh{$db}->selectcol_arrayref(
|
||||
"SELECT b.value FROM `cvsroot_branch_map_eol` m, `cvsroot` r, `branch` b " .
|
||||
"WHERE m.cvsroot_id = r.id AND m.branch_id = b.id AND " .
|
||||
"(b.value = ?".(" OR b.value = ?" x $#ba).")",
|
||||
undef, @ba);
|
||||
}
|
||||
|
||||
sub db_map {
|
||||
my ($table, @value) = @_;
|
||||
my ($set, $where);
|
||||
my $db = $::default_db ;
|
||||
$set = &db_map_clause($table, \@value, " , ");
|
||||
$where = &db_map_clause($table, \@value, " AND ");
|
||||
$::dbh{$db}->do("insert into `$table` set $set") unless &db_mapped($table, $where);
|
||||
}
|
||||
|
||||
sub db_demap {
|
||||
my ($table, @value) = @_;
|
||||
my $where = &db_map_clause($table, \@value, " AND ");
|
||||
my $db = $::default_db ;
|
||||
$::dbh{$db}->do("delete from `$table` where $where");
|
||||
}
|
||||
|
||||
sub db_mapped {
|
||||
my ($table, $where) = @_;
|
||||
my $db = $::default_db;
|
||||
my $mapped = $::dbh{$db}->selectrow_array("select count(*) from `$table` where $where");
|
||||
return $mapped;
|
||||
}
|
||||
|
||||
sub db_map_clause {
|
||||
my ($table, $value, $joiner) = @_;
|
||||
my $string;
|
||||
$joiner = " " unless $joiner;
|
||||
my ($names, $rest) = split /_map/, $table;
|
||||
my (@name) = split /_/, $names;
|
||||
for my $i (0..$#name) {
|
||||
$string .= "`".$name[$i]."_id` = ".&id($name[$i], $$value[$i]).$joiner;
|
||||
}
|
||||
$string =~ s/$joiner$/ /;
|
||||
#print "--> $string\n";
|
||||
return $string;
|
||||
}
|
||||
|
||||
sub log_commit {
|
||||
my ($cwd, $user, $time, $dir, $cvsroot, $status, $files, $hashref) = @_;
|
||||
my $db;
|
||||
unless ($db = ${$hashref}{"db"}) { $db = $::default_db }
|
||||
#&debug_msg("\n###\n### ".$::dbh{$db}->quote($status)."\n###\n", 9);
|
||||
$::dbh{$db}->do("insert into temp_commitinfo set user_id=" . &id('user', $user)
|
||||
. ", directory_id=" . &id('directory', $dir)
|
||||
. ", cvsroot_id=" . &id('cvsroot', $cvsroot)
|
||||
. ", files=" . $::dbh{$db}->quote($files)
|
||||
. ", cwd=" . $::dbh{$db}->quote($cwd)
|
||||
. ", status=" . $::dbh{$db}->quote($status)
|
||||
. ", time=$time");
|
||||
}
|
||||
|
||||
sub collapse_HOH {
|
||||
my ($HOHref, $arrayref) = @_;
|
||||
#print "#" x 80, "\n", Dumper($HOHref);
|
||||
while (my ($key, $hashref) = each %$HOHref) {
|
||||
for my $subkey (@$arrayref) {
|
||||
# delete $HOHref->{$key} unless $hashref->{$subkey} ;
|
||||
delete $HOHref->{$key} unless defined $hashref->{$subkey} ;
|
||||
}
|
||||
}
|
||||
#print Dumper($HOHref), "#" x 80 , "\n";
|
||||
}
|
||||
|
||||
sub collapse_HOHOH {
|
||||
my ($HOHOHref, $arrayref) = @_;
|
||||
#print "#" x 80, "\n", Dumper($HOHOHref);
|
||||
while (my ($key, $hashref) = each %$HOHOHref) {
|
||||
&collapse_HOH($hashref, $arrayref);
|
||||
}
|
||||
#print Dumper($HOHOHref), "#" x 80 , "\n";
|
||||
}
|
||||
|
||||
sub update_commit {
|
||||
my ($cwd, $user, $time, $dir, $cvsroot, $status, $hashref) = @_;
|
||||
my $db;
|
||||
unless ($db = ${$hashref}{"db"}) { $db = $::default_db }
|
||||
unless ($::update_temp_commitinfo{$db}) {
|
||||
$::update_temp_commitinfo{$db} = $::dbh{$db}->prepare("update temp_commitinfo set status = ?"
|
||||
. " where cwd = ?"
|
||||
. " and user_id = ?"
|
||||
. " and from_unixtime(time) > date_sub(from_unixtime(?), interval 2 hour)"
|
||||
. " and directory_id = ?"
|
||||
. " and cvsroot_id = ?")
|
||||
}
|
||||
$::update_temp_commitinfo{$db}->execute($status, $cwd, &id('user', $user), $time, &id('directory', $dir), &id('cvsroot', $cvsroot));
|
||||
}
|
||||
|
||||
sub delete_commit {
|
||||
my ($cwd, $user, $time, $dir, $cvsroot, $hashref) = @_;
|
||||
my $db;
|
||||
unless ($db = ${$hashref}{"db"}) { $db = $::default_db }
|
||||
$::dbh{$db}->do("delete from temp_commitinfo where cwd=" . $::dbh{$db}->quote($cwd)
|
||||
. " and user_id=" . &id('user', $user)
|
||||
. " and from_unixtime(time) > date_sub(from_unixtime($time), interval 2 hour)"
|
||||
. " and directory_id=" . &id('directory', $dir)
|
||||
. " and cvsroot_id=" . &id('cvsroot', $cvsroot));
|
||||
}
|
||||
|
||||
sub log_performance {
|
||||
my ($table, $ci_id, $time, $hashref) =@_;
|
||||
my $db;
|
||||
unless ($db = ${$hashref}{"db"}) { $db = $::default_db }
|
||||
$::dbh{$db}->do("insert into `$table` set checkin_id=" . $::dbh{$db}->quote($ci_id)
|
||||
. ", time=$time");
|
||||
}
|
||||
|
||||
sub store {
|
||||
my ($table, $value, $other_ref, $hashref) = @_;
|
||||
my ($db, $column, $other, $stored_value, @bind);
|
||||
unless ($db = ${$hashref}{"db"}) { $db = $::default_db }
|
||||
unless ($column = ${$hashref}{"column"}) { $column = $::default_column }
|
||||
while (my ($col, $val) = each %$other_ref) {
|
||||
$other .= ", ".$col ." = ? ";
|
||||
if ($col =~ /.*_id$/) {
|
||||
$col =~ s/_id$//;
|
||||
push @bind, &id($col, $val);
|
||||
} else {
|
||||
push @bind, $val;
|
||||
}
|
||||
}
|
||||
$other .= " ";
|
||||
$Data::Dumper::Indent = 0;
|
||||
$Data::Dumper::Terse = 1;
|
||||
$stored_value = Dumper($value);
|
||||
#print "insert into $table set value = ? $other\n";
|
||||
#for my $i (@bind) { print "$i\n" }
|
||||
$::dbh{$db}->do("insert into `$table` set value = ? $other", undef, $stored_value, @bind);
|
||||
}
|
||||
|
||||
sub retrieve {
|
||||
my ($table, $where_ref, $hashref) = @_;
|
||||
my ($db, $column, $value, $where, @bind);
|
||||
unless ($db = ${$hashref}{"db"}) { $db = $::default_db }
|
||||
unless ($column = ${$hashref}{"column"}) { $column = $::default_column }
|
||||
while (my ($col, $val) = each %$where_ref) {
|
||||
$where .= $col ." = ? AND ";
|
||||
if ($col =~ /.*_id$/) {
|
||||
$col =~ s/_id$//;
|
||||
push @bind, &id($col, $val);
|
||||
} else {
|
||||
push @bind, $val;
|
||||
}
|
||||
}
|
||||
$where .= "1";
|
||||
$value = $::dbh{$db}->selectrow_array("SELECT $column FROM `$table` WHERE $where ORDER BY id DESC LIMIT 1", undef, @bind);
|
||||
#print "SELECT $column FROM $table WHERE $where ORDER BY id DESC LIMIT 1", @bind;
|
||||
#for my $i (@bind) { print "$i\n" }
|
||||
return $value;
|
||||
}
|
||||
|
||||
sub id {
|
||||
my ($table, $value, $hashref) = @_;
|
||||
my ($db, $column, $key, $id);
|
||||
unless ($db = ${$hashref}{"db"}) { $db = $::default_db }
|
||||
unless ($column = ${$hashref}{"column"}) { $column = $::default_column }
|
||||
unless ($key = ${$hashref}{"key"}) { $key = $::default_key }
|
||||
unless ($::get_id{$db}{$table}) { $::get_id{$db}{$table} = $::dbh{$db}->prepare("select $key from `$table` where $column = ?")}
|
||||
unless ($id = $::dbh{$db}->selectrow_array($::get_id{$db}{$table}, "", ($value))) {
|
||||
unless ($::insert_value{$db}{$table}) { $::insert_value{$db}{$table} = $::dbh{$db}->prepare("insert into `$table` ($column) values (?)") }
|
||||
unless ($::last_insert_id{$db}) { $::last_insert_id{$db} = $::dbh{$db}->prepare("select LAST_INSERT_ID()") }
|
||||
$::insert_value{$db}{$table}->execute($value);
|
||||
$id = $::dbh{$db}->selectrow_array($::last_insert_id{$db});
|
||||
}
|
||||
}
|
||||
|
||||
sub connect {
|
||||
my $db;
|
||||
unless (($db) = @_) { $db = $::default_db }
|
||||
$::dbh{$db} = DBI->connect($::db{$db}{'dsn'}, $::db{$db}{'user'}, $::db{$db}{'pass'}, { PrintError => 1, RaiseError => 1 })
|
||||
}
|
||||
|
||||
sub disconnect {
|
||||
my $db;
|
||||
unless (($db) = @_) { $db = $::default_db }
|
||||
$::dbh{$db}->disconnect();
|
||||
}
|
||||
|
||||
sub debug_msg {
|
||||
my ($msg, $level, $hashref) = @_;
|
||||
my ($showtime, $timeformat, $prefix);
|
||||
my %time = (
|
||||
"epoch" => time,
|
||||
"local" => scalar localtime,
|
||||
);
|
||||
return $time{'epoch'} unless $::debug;
|
||||
unless ($showtime = ${$hashref}{"showtime"}) { $showtime = 'no' }
|
||||
unless ($timeformat = ${$hashref}{"timeformat"}) { $timeformat = 'local' }
|
||||
unless ($prefix = ${$hashref}{"prefix"}) { $prefix = '#' }
|
||||
if ($::debug_level >= $level) {
|
||||
print $prefix x $level . " " unless $prefix =~ /none/i;
|
||||
print $time{$timeformat}." " unless $showtime =~ /no/i;
|
||||
print "$msg\n";
|
||||
}
|
||||
return $time{'epoch'};
|
||||
}
|
||||
|
||||
sub get {
|
||||
my ($item, @line) = @_;
|
||||
my %i = (
|
||||
'code' => 0,
|
||||
'file' => 1,
|
||||
'rev' => 2,
|
||||
'time' => 3,
|
||||
'opt' => 4,
|
||||
'tag' => 5,
|
||||
);
|
||||
#print "=== $item : $i{$item} : $line[$i{$item}] -- " , Dumper(\@line);
|
||||
if ($item eq "tag") {
|
||||
$line[$i{$item}] = "TTRUNK" unless (defined $line[$i{$item}]);
|
||||
$line[$i{$item}] =~ s/^T//;
|
||||
}
|
||||
# if ($item eq "rev") {
|
||||
# $line[$i{$item}] = "NONE" if $line[$i{$item}] eq "0";
|
||||
## $line[$i{$item}] =~ s/^-//;
|
||||
# }
|
||||
return $line[$i{$item}];
|
||||
}
|
||||
|
||||
sub BuildModuleHash {
|
||||
my ($modules) = @_;
|
||||
my $modules_hash;
|
||||
#print "$modules";
|
||||
chomp $modules;
|
||||
$modules =~ s/\s*#.*\n?/\n/g ; # remove commented lines
|
||||
$modules =~ s/^\s*(.*)/$1/ ; # remove blank lines before module definitions
|
||||
$modules =~ s/\s*\\\s*\n\s*/ /g ; # join lines continued with \
|
||||
$modules =~ s/\n\s+/\n/g ; # remove leading whitespace
|
||||
$modules =~ s/\s+-[^la]\s+\S+//g ; # get rid of the arguments (and flags) to flags other than 'a' and 'l'
|
||||
$modules =~ s/\s+-[la]\s+/ /g ; # get rid of the 'a' and 'l' **** FIXME: l needs an ending or something ****
|
||||
#print "---\n$modules\n---\n";
|
||||
my @modules = split(/\n/, $modules);
|
||||
for my $line (@modules) {
|
||||
my @line = split(" ", $line);
|
||||
my $name = shift @line ;
|
||||
$modules_hash->{$name} = [ @line ];
|
||||
undef $name;
|
||||
undef $line;
|
||||
undef @line;
|
||||
}
|
||||
#print Dumper($modules_hash);
|
||||
return $modules_hash;
|
||||
}
|
||||
|
||||
sub uniq {
|
||||
my @list = @_;
|
||||
my %hash;
|
||||
for my $item (@list) { $hash{$item}++ }
|
||||
return keys(%hash);
|
||||
}
|
||||
|
||||
sub FlattenHash {
|
||||
# Remove duplicate entries in hash-arrays
|
||||
my $hashref = $_[0];
|
||||
my ($key, $value);
|
||||
while (my ($key, $value) = each %$hashref) {
|
||||
$$hashref{$key} = [ &uniq(@$value) ];
|
||||
}
|
||||
}
|
||||
|
||||
sub FormatModules {
|
||||
my ($hashref, $cvsroot) = @_ ;
|
||||
my %new_hash;
|
||||
while (my ($module, $list) = each %$hashref) {
|
||||
for my $item (@$list) {
|
||||
if ( $item =~ s/^!// ) {
|
||||
&make_module_regex(\%new_hash, $item, "exclude", $module, $cvsroot);
|
||||
} else {
|
||||
&make_module_regex(\%new_hash, $item, "include", $module, $cvsroot);
|
||||
}
|
||||
}
|
||||
}
|
||||
return \%new_hash;
|
||||
}
|
||||
|
||||
sub make_module_regex {
|
||||
my ($hash, $item, $type, $module, $cvsroot) = @_;
|
||||
if ( -d "$cvsroot/$item" ) {
|
||||
push @{$$hash{$module}{$type."_directory"}}, "^\Q$item\E/.+\$";
|
||||
} else {
|
||||
# $item =~ s/^(.*\/)?(.*)$/$1(Attic\/)?$2/;
|
||||
push @{$$hash{$module}{$type."_file"}}, "^\Q$item\E\$";
|
||||
}
|
||||
}
|
||||
|
||||
sub format_mirrorconfig {
|
||||
my ($mirrors) = @_;
|
||||
for my $m (@$mirrors) {
|
||||
for my $t ("mirror", "overwrite", "exclude") {
|
||||
next unless $m->{$t};
|
||||
while (my ($c, $a) = each %{$m->{$t}}) {
|
||||
next unless ($c eq "directory" || $c eq "file");
|
||||
my %n;
|
||||
for my $i (@$a) {
|
||||
if ($c eq "directory") {
|
||||
push @{$n{"include_".$c}}, "^\Q$i\E/.+\$";
|
||||
} else {
|
||||
push @{$n{"include_".$c}}, "^\Q$i\E\$";
|
||||
}
|
||||
}
|
||||
&FlattenHash(\%n);
|
||||
$m->{$t}->{$c} = \%n;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub format_accessconfig {
|
||||
my ($aa) = @_;
|
||||
for my $ah (@$aa) {
|
||||
next unless $ah->{'location'};
|
||||
while (my ($c, $a) = each %{$ah->{'location'}}) {
|
||||
next unless ($c eq "directory" || $c eq "file");
|
||||
my %n;
|
||||
for my $i (@$a) {
|
||||
if ($c eq "directory") {
|
||||
push @{$n{"include_".$c}}, "^\Q$i\E/.+\$";
|
||||
} else {
|
||||
push @{$n{"include_".$c}}, "^\Q$i\E\$";
|
||||
}
|
||||
}
|
||||
&FlattenHash(\%n);
|
||||
$ah->{'location'}->{$c} = \%n;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub expand_mirror_modules {
|
||||
my ($mirrors) = @_;
|
||||
my $modules_hashref;
|
||||
for my $m (@$mirrors) {
|
||||
my $r = $m->{'from'}->{'cvsroot'};
|
||||
$modules_hashref->{$r} = eval &retrieve("modules", {"cvsroot_id" => $r});
|
||||
for my $t ("mirror", "overwrite", "exclude") {
|
||||
next unless $m->{$t};
|
||||
my $a = $m->{$t}->{'module'};
|
||||
next unless defined $a;
|
||||
my %n;
|
||||
for my $i (@$a) {
|
||||
if (\%n) {
|
||||
while (my ($inc, $inc_array) = each %{$modules_hashref->{$r}->{$i}}) {
|
||||
push @{$n{$inc}}, @$inc_array;
|
||||
}
|
||||
} else {
|
||||
\%n = $modules_hashref->{$r}->{$i};
|
||||
}
|
||||
}
|
||||
&FlattenHash(\%n);
|
||||
$m->{$t}->{'module'} = \%n;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub expand_access_modules {
|
||||
my ($aa) = @_;
|
||||
my $modules_hashref;
|
||||
for my $ah (@$aa) {
|
||||
next unless $ah->{'location'};
|
||||
my $r = $ah->{'cvsroot'};
|
||||
$modules_hashref->{$r} = eval &retrieve("modules", {"cvsroot_id" => $r}) unless $r eq "#-all-#";
|
||||
my $a = $ah->{'location'}->{'module'};
|
||||
next unless defined $a;
|
||||
my %n;
|
||||
for my $i (@$a) {
|
||||
if (\%n) {
|
||||
while (my ($inc, $inc_array) = each %{$modules_hashref->{$r}->{$i}}) {
|
||||
push @{$n{$inc}}, @$inc_array;
|
||||
}
|
||||
} else {
|
||||
\%n = $modules_hashref->{$r}->{$i};
|
||||
}
|
||||
}
|
||||
&FlattenHash(\%n);
|
||||
$ah->{'location'}->{'module'} = \%n;
|
||||
}
|
||||
}
|
||||
|
||||
sub ExpandHash {
|
||||
my $hash = $_[0] ;
|
||||
my $hash2 = $_[1] ? $_[1] : $_[0] ;
|
||||
# &CheckCircularity($hash2);
|
||||
# print "not circular\n";
|
||||
my $done = 0 ;
|
||||
until ($done) {
|
||||
$done = 1 ;
|
||||
for my $key (keys %$hash) {
|
||||
for my $i (0..$#{$$hash{$key}}) {
|
||||
if (exists ($$hash2{$$hash{$key}[$i]})) {
|
||||
$done = 0 ;
|
||||
splice ( @{$$hash{$key}}, $i, 1, @{$$hash2{$$hash{$key}[$i]}} ) ;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub CheckCircularity {
|
||||
my $hash = $_[0] ;
|
||||
my @LHS ;
|
||||
my @RHS ;
|
||||
my $count = 0 ;
|
||||
for my $k (keys(%$hash)) {
|
||||
$LHS[$count]=$k ;
|
||||
$RHS[$count]=join(':', @{$hash->{$k}}) ;
|
||||
$count++ ;
|
||||
}
|
||||
#---------------------------------------------#
|
||||
# check for, and report, circular references #
|
||||
#---------------------------------------------#
|
||||
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
|
||||
#for (my $i=0; $i<=$#LHS; ++$i) {print "$LHS[$i] = $RHS[$i]\n";} #
|
||||
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
|
||||
my $sort_count = 0 ;
|
||||
my $unsorted_end = $#RHS ;
|
||||
SORT: for (my $i=$unsorted_end; $i>=0; --$i) {
|
||||
my $search_name = $LHS[$i] ;
|
||||
for (my $j=$i; $j>=0; --$j) {
|
||||
if ($RHS[$j] =~ /^$search_name:|:$search_name:|:$search_name$|^$search_name$/){
|
||||
unshift @LHS, $LHS[$i] ;
|
||||
unshift @RHS, $RHS[$i] ;
|
||||
splice @LHS, $i+1, 1 ;
|
||||
splice @RHS, $i+1, 1 ;
|
||||
++$sort_count ;
|
||||
if ($sort_count == $i+1) {
|
||||
print "\ncircular reference involving the following:\n\n" ;
|
||||
print "\t$LHS[0]" ;
|
||||
for my $x (1..$i) { print " : $LHS[$x]" }
|
||||
print "\n" ;
|
||||
for my $x (0..$i) {
|
||||
$RHS[$x] =~ s/:/ & /g ;
|
||||
print "\n\t$LHS[$x] --> $RHS[$x]" ;
|
||||
}
|
||||
print "\n\nyou suck, try again.\n\n" ;
|
||||
exit 1;
|
||||
}
|
||||
goto SORT ;
|
||||
}
|
||||
}
|
||||
--$unsorted_end ;
|
||||
$sort_count = 0 ;
|
||||
}
|
||||
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
|
||||
#print "\n"; #
|
||||
#for (my $i=0; $i<=$#LHS; ++$i) {print "$LHS[$i] = $RHS[$i]\n";} #
|
||||
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
|
||||
}
|
||||
|
||||
sub mirrored_checkin {
|
||||
my ($log) = @_;
|
||||
# print "$log\n========\n";
|
||||
for my $regex (@::mirrored_checkin_reqex) {
|
||||
# print "-- $regex\n";
|
||||
# print "\nNO MIRROR FOR YOU\n\n" if ($log =~ $regex);
|
||||
return 1 if ($log =~ $regex);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub nomirrored {
|
||||
my ($directive) = @_;
|
||||
if ($directive =~ /[#-]\s*[#-]([^-#]+)[#-]?\s*[#-]?/) {
|
||||
###if ($directive =~ /#\s*-(.*)-\s*#/) {
|
||||
$directive = $1
|
||||
} else {
|
||||
$directive = "none"
|
||||
}
|
||||
print "directive --> $directive (", soundex($directive), ")\n" if $directive;
|
||||
return 1 if (soundex($directive) eq soundex("nomirror"));
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub create_mirrors {
|
||||
my ($change_ref, $mirror_ref) = @_ ;
|
||||
my (@bro_array, %bro_hash);
|
||||
while (my ($from, $branch_change_ref) = each %$change_ref) {
|
||||
my $start_bro = $from."@".$::cvsroot."@";
|
||||
# $Data::Dumper::Indent = 0 ;
|
||||
# print "$start_bro -- $::directory -> " . Dumper([keys(%$branch_change_ref)]) , "\n";
|
||||
# $Data::Dumper::Indent = 2 ;
|
||||
$bro_hash{$start_bro} = {'start' => $start_bro, 'files' => [keys(%$branch_change_ref)], 'offset' => ''};
|
||||
}
|
||||
# print Dumper(\%bro_hash);
|
||||
&make_mirror(\%bro_hash);
|
||||
# print Dumper(\%::mirror_object);
|
||||
# print "\n\nlogging mirror_object to database\n\n";
|
||||
&insert_mirror_object;
|
||||
}
|
||||
|
||||
sub make_mirror {
|
||||
my ($hash) = @_;
|
||||
my (%sub);
|
||||
my %x = ("exclude" => 0, "overwrite" => 1, "mirror" => 2);
|
||||
while (my ($bro, $details) = each %$hash) {
|
||||
my ($bro_branch, $bro_root, $bro_offset, @old_bro) = split ("@", $bro);
|
||||
$bro_offset = "" unless $bro_offset;
|
||||
my $new_bro = $bro_branch."@".$bro_root."@".$bro_offset;
|
||||
for my $m (@$::mirror) {
|
||||
for my $to (@{$m->{to}}) {
|
||||
my @sub_files;
|
||||
if ($m->{from}->{branch} eq $bro_branch && $m->{from}->{cvsroot} eq $bro_root) {
|
||||
my $adjusted_offset = &adjust_offset($bro_offset, $to->{'offset'});
|
||||
my $sub_bro = "$to->{branch}\@$to->{cvsroot}\@$adjusted_offset";
|
||||
if ($sub_bro ne $details->{'start'}) {
|
||||
for my $f (@{$details->{'files'}}) {
|
||||
my $type = &check_mirror($f, $m, $details->{'offset'});
|
||||
if ($type && $x{$type} > 0) {
|
||||
unless (defined $::mirror_object{$sub_bro}->{$::ch_id_ref->{$f}}) {
|
||||
push @{$sub{$sub_bro."@".$new_bro}->{'files'}}, $f;
|
||||
}
|
||||
unless ( defined $::mirror_object{$sub_bro}->{$::ch_id_ref->{$f}} &&
|
||||
$x{$type} < $x{$::mirror_object{$sub_bro}->{$::ch_id_ref->{$f}}} ) {
|
||||
$::mirror_object{$sub_bro}->{$::ch_id_ref->{$f}} = $type;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (defined $sub{$sub_bro."@".$new_bro}) {
|
||||
$sub{$sub_bro."@".$new_bro}{'start'} = $details->{'start'};
|
||||
$sub{$sub_bro."@".$new_bro}{'offset'} = $adjusted_offset;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
# print "SUB-" x 19, "SUB\n", Dumper(\%sub), "SUB-" x 19, "SUB\n";
|
||||
# print "\n###\n### Making more mirrors\n###\n" if %sub;
|
||||
# if ($::COUNT++ < 100) {
|
||||
# print "$::COUNT-" x 39, "$::COUNT\n", Dumper(\%::mirror_object);
|
||||
&make_mirror(\%sub) if %sub;
|
||||
# }
|
||||
}
|
||||
|
||||
sub adjust_offset {
|
||||
my ($p, $o) = @_;
|
||||
my ($pL, $pR, $oL, $oR);
|
||||
($pL, $pR) = split /\|/, $p;
|
||||
($oL, $oR) = split /\|/, $o;
|
||||
($pL, $oR) = &shorten($pL, $oR, 1);
|
||||
($pR, $oL) = &shorten($pR, $oL, 0);
|
||||
my $n = $pL.$oL."|".$oR.$pR;
|
||||
return $n ne "|" ? $n : "" ;
|
||||
}
|
||||
|
||||
sub shorten {
|
||||
my ($a, $b, $e) = @_;
|
||||
my $x;
|
||||
$a = '' unless $a;
|
||||
$b = '' unless $b;
|
||||
if (length $a < length $b) {
|
||||
$x = $a;
|
||||
} else {
|
||||
$x = $b;
|
||||
}
|
||||
if ($e) {
|
||||
$x = "\Q$x\E\$" ;
|
||||
} else {
|
||||
$x = "^\Q$x\E" ;
|
||||
}
|
||||
if ($a =~ /$x/ && $b =~ /$x/) {
|
||||
$a =~ s/$x//;
|
||||
$b =~ s/$x//;
|
||||
}
|
||||
return ($a, $b);
|
||||
}
|
||||
|
||||
sub check_mirror {
|
||||
my ($file, $mirror_hashref, $offset) = @_;
|
||||
my $type = undef;
|
||||
for my $t ("mirror", "overwrite", "exclude") {
|
||||
# print "$file -- $t -- $mirror_hashref->{'from'}->{'branch'} --> ";
|
||||
# print Dumper($mirror_hashref->{'to'}), "\n";
|
||||
if (defined $mirror_hashref->{$t}) {
|
||||
$type = $t if &allowed($file, $mirror_hashref->{$t}, $offset);
|
||||
}
|
||||
}
|
||||
# print Dumper($mirror_hashref);
|
||||
return $type;
|
||||
}
|
||||
|
||||
sub allowed {
|
||||
my ($file, $type_hashref, $offset) = @_;
|
||||
my %x = ('exclude' => 0, 'include' => 1);
|
||||
# for my $st ("module", "directory", "file") {
|
||||
for my $st ("file", "directory", "module") {
|
||||
if (defined $type_hashref->{$st}) {
|
||||
# print "=== $st", Dumper($type_hashref->{$st});
|
||||
for my $type ("file", "directory") {
|
||||
for my $clude ("exclude", "include") {
|
||||
if (defined $type_hashref->{$st}->{$clude."_".$type}) {
|
||||
return $x{$clude} if &match_array($file, $type_hashref->{$st}->{$clude."_".$type}, $offset) ;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub match_array {
|
||||
my ($file, $regex_arrayref, $offset) = @_;
|
||||
$file = $::directory."/".$file if $::directory;
|
||||
$offset = "|" unless $offset;
|
||||
my ($from_offset, $to_offset) = split /\|/, $offset;
|
||||
$file =~ s/\Q$from_offset\E/$to_offset/;
|
||||
for my $r (@$regex_arrayref) {
|
||||
##
|
||||
# print "#####".$file."#####".$r."#####";
|
||||
# if ($file =~ /$r/) {
|
||||
# print " MATCH\n";
|
||||
# return 1;
|
||||
# } else {
|
||||
# print " NO-MATCH\n";
|
||||
# }
|
||||
##
|
||||
return 1 if $file =~ /$r/ ;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -1,181 +0,0 @@
|
||||
#!/usr/local/bin/perl -w
|
||||
use strict;
|
||||
use Sys::Hostname;
|
||||
use Cwd;
|
||||
use Data::Dumper;
|
||||
use Time::HiRes;
|
||||
#use Storable qw(lock_store lock_retrieve);
|
||||
use vars qw($ch_id_ref);
|
||||
#
|
||||
# It's tempting to use environment variables for things like USER
|
||||
# and CVSROOT; however, don't. Using the builtin CVS variables is
|
||||
# a better idea, especially if you are using a three entry
|
||||
# $CVSROOT/CVSROOT/passwd (i.e., cvs runs as a local user instead of
|
||||
# the actual user)
|
||||
#
|
||||
$::cvsrootdir = shift @ARGV;
|
||||
#
|
||||
# I'd really rather have all my "use" and "require" statements before
|
||||
# anything else, but since I want to keep the bonsai-global.pm module
|
||||
# checked into $CVSROOT/CVSROOT, I need to do the ugly "parse" the
|
||||
# root first, then require the module foo you see here.
|
||||
#
|
||||
require "$::cvsrootdir/CVSROOT/bonsai-global.pm";
|
||||
require "$::cvsrootdir/CVSROOT/bonsai-config.pm";
|
||||
|
||||
$::start = Time::HiRes::time;
|
||||
|
||||
$::cwd = cwd;
|
||||
$::user = shift @ARGV;
|
||||
$::time = time;
|
||||
$::directory = shift @ARGV ;
|
||||
#$::directory =~ s/^\"(.*)\"$/$1/;
|
||||
$::cvsroot = hostname() . ":" . $::cvsrootdir;
|
||||
|
||||
#print "CWD: $::cwd\n### USER: $::user\n### TIME: $::time\n### DIR: $::directory\n### CVSROOT: $::cvsroot\n";
|
||||
|
||||
$::log = 0;
|
||||
while (<>) {
|
||||
#print " -- $_";
|
||||
if (/^Log Message:$/) {
|
||||
$::log = 1;
|
||||
next;
|
||||
}
|
||||
next until $::log;
|
||||
$::logtext .= $_;
|
||||
#print " ---- $_";
|
||||
}
|
||||
$::logtext =~ s/[\s\n]*$//;
|
||||
#-debug-# &debug_msg("LOG: $::logtext", 3);
|
||||
|
||||
if (-e "CVS/Entries") { # if block for first intermodule mirrored add of a new directory
|
||||
open (ENTRIES, "<CVS/Entries") || die "Can't open CVS/Entries" ;
|
||||
while (<ENTRIES>) {
|
||||
chomp;
|
||||
#-debug-# print "CVS/Entries: $_\n";
|
||||
my @line = split /\//;
|
||||
next if &get('code', @line);
|
||||
my $file = &get('file', @line);
|
||||
my $branch = &get('tag', @line);
|
||||
$::change_ref->{$branch}->{$file}->{'old'} = &get('rev', @line);
|
||||
$::change_ref->{$branch}->{$file}->{'old'} =~ s/^-//;
|
||||
undef $file;
|
||||
undef $branch;
|
||||
undef @line;
|
||||
}
|
||||
close ENTRIES;
|
||||
}
|
||||
|
||||
if (-e "CVS/Entries.Log") { # if block for directory adds since CVS/Entries.log doesn't get created for directory adds
|
||||
open (ENTRIES, "<CVS/Entries.Log") || die "Can't open CVS/Entries.Log" ;
|
||||
while (<ENTRIES>) {
|
||||
chomp;
|
||||
#-debug-# print "CVS/Entries.log: $_\n";
|
||||
my @line = split /\//;
|
||||
next if (&get('code', @line) eq 'A D'); # the if block isn't enough, this covers cvs add foo foo/* foo/*/* ...
|
||||
my $file = &get('file', @line);
|
||||
my $branch = &get('tag', @line);
|
||||
$::change_ref->{$branch}->{$file}->{'new'} = &get('rev', @line);
|
||||
# $::change_ref->{$branch}->{$file}->{'new'} =~ s/^-[1-9][0-9\.]+$/NONE/;
|
||||
$::change_ref->{$branch}->{$file}->{'new'} =~ s/^-[1-9][0-9\.]+$/0/;
|
||||
undef $file;
|
||||
undef $branch;
|
||||
undef @line;
|
||||
}
|
||||
close ENTRIES;
|
||||
}
|
||||
|
||||
&collapse_HOHOH($::change_ref, ['new', 'old']);
|
||||
|
||||
&connect();
|
||||
|
||||
$::mirror = eval &retrieve("expanded_mirrorconfig");
|
||||
#print "\$expanded_mirrorconfig",Dumper($::mirror);
|
||||
|
||||
###
|
||||
### directory/file specific actions
|
||||
###
|
||||
if ($::directory eq "CVSROOT") {
|
||||
my $modulesfile = "./modules";
|
||||
if (-e $modulesfile ) { # create an expanded modules file and store it in the database
|
||||
my $modules = `cat $modulesfile`;
|
||||
my $modules_hash = &BuildModuleHash($modules) ;
|
||||
&ExpandHash($modules_hash); # Expand the modules file in terms of itself
|
||||
&FlattenHash($modules_hash); # Remove dulicate entries from expansion
|
||||
my $formatted_modules = &FormatModules($modules_hash, $::cvsrootdir); # Convert to regexs suitable for matching
|
||||
&store("modules", $formatted_modules, {"cvsroot_id" => $::cvsroot, "rev" => $::change_ref->{'TRUNK'}->{'modules'}->{'new'}});
|
||||
#
|
||||
# update expanded_mirrorconfig & expanded_accessconfig
|
||||
#
|
||||
unless ($::change_ref->{'TRUNK'}->{'bonsai-mirrorconfig.pm'} &&
|
||||
$::change_ref->{'TRUNK'}->{'bonsai-mirrorconfig.pm'}->{'new'}) {
|
||||
my $mc = eval &retrieve("mirrorconfig");
|
||||
&expand_mirror_modules($mc);
|
||||
&store("expanded_mirrorconfig", $mc);
|
||||
}
|
||||
unless ($::change_ref->{'TRUNK'}->{'bonsai-accessconfig.pm'} &&
|
||||
$::change_ref->{'TRUNK'}->{'bonsai-accessconfig.pm'}->{'new'}) {
|
||||
my $ac = eval &retrieve("accessconfig");
|
||||
&expand_access_modules($ac);
|
||||
&store("expanded_accessconfig", $ac);
|
||||
}
|
||||
}
|
||||
|
||||
if ($::change_ref->{'TRUNK'}->{'bonsai-mirrorconfig.pm'} &&
|
||||
$::change_ref->{'TRUNK'}->{'bonsai-mirrorconfig.pm'}->{'new'}) {
|
||||
require "./bonsai-mirrorconfig.pm";
|
||||
#print Dumper($::mirrorconfig), "#" x 80, "\n";
|
||||
&format_mirrorconfig($::mirrorconfig); # Convert to regexs suitable for matching
|
||||
#print Dumper($::mirrorconfig), "#" x 80, "\n";
|
||||
&store("mirrorconfig", $::mirrorconfig, {"cvsroot_id" => $::cvsroot, "rev" => $::change_ref->{'TRUNK'}->{'bonsai-mirrorconfig.pm'}->{'new'}});
|
||||
#
|
||||
# update expanded_mirrorconfig
|
||||
#
|
||||
#$Data::Dumper::Indent=2;
|
||||
#$Data::Dumper::Terse=0;
|
||||
#print Dumper($::mirrorconfig), "#" x 80, "\n";
|
||||
&expand_mirror_modules($::mirrorconfig);
|
||||
#print Dumper($::mirrorconfig);
|
||||
&store("expanded_mirrorconfig", $::mirrorconfig);
|
||||
}
|
||||
|
||||
if ($::change_ref->{'TRUNK'}->{'bonsai-accessconfig.pm'} &&
|
||||
$::change_ref->{'TRUNK'}->{'bonsai-accessconfig.pm'}->{'new'}) {
|
||||
require "./bonsai-accessconfig.pm";
|
||||
#print Dumper($::accessconfig), "#" x 80, "\n";
|
||||
&format_accessconfig($::accessconfig); # Convert to regexs suitable for matching
|
||||
&store("accessconfig", $::accessconfig, {"cvsroot_id" => $::cvsroot, "rev" => $::change_ref->{'TRUNK'}->{'bonsai-accessconfig.pm'}->{'new'}});
|
||||
#
|
||||
# update expanded_accessconfig
|
||||
#
|
||||
#$Data::Dumper::Indent=2;
|
||||
#$Data::Dumper::Terse=0;
|
||||
#print Dumper($::accessconfig), "#" x 80, "\n";
|
||||
&expand_access_modules($::accessconfig);
|
||||
#print Dumper($::accessconfig);
|
||||
&store("expanded_accessconfig", $::accessconfig);
|
||||
}
|
||||
}
|
||||
|
||||
###
|
||||
### Create checkin and mirror objects in database
|
||||
###
|
||||
#-debug-# &debug_msg("logging checkins in $::directory to database...", 1);
|
||||
&update_commit($::cwd, $::user, $::time, $::directory, $::cvsroot, 'creating checkin object');
|
||||
($::id, $::ch_id_ref) = &checkin($::cwd, $::user, $::time, $::directory, $::cvsroot, $::logtext, $::change_ref);
|
||||
#print Dumper($::change_ref);
|
||||
#-debug-# &debug_msg("\ncheckin id: $::id\n", 0, { prefix => 'none' });
|
||||
unless (&mirrored_checkin($::logtext)) {
|
||||
#print "\n--> creating mirror objects <--\n\n";
|
||||
#unless (&mirrored_checkin($::logtext) || &nomirrored($::logtext)) {
|
||||
&update_commit($::cwd, $::user, $::time, $::directory, $::cvsroot, 'creating mirror object(s)');
|
||||
&create_mirrors($::change_ref, $::mirror);
|
||||
}
|
||||
|
||||
#print "FINAL-" x 12, "FINAL\n", Dumper(\%::mirror_object) if %::mirror_object;
|
||||
|
||||
&update_commit($::cwd, $::user, $::time, $::directory, $::cvsroot, 'checkin complete');
|
||||
&delete_commit($::cwd, $::user, $::time, $::directory, $::cvsroot);
|
||||
&log_performance("loginfo_performance", $::id, Time::HiRes::time - $::start);
|
||||
&disconnect();
|
||||
#while (my ($file, $change_id) = each %$::ch_id_ref) { print "--> $change_id -- $file\n" }
|
||||
@@ -1,398 +0,0 @@
|
||||
#!/usr/local/bin/perl -w
|
||||
#use diagnostics;
|
||||
use strict;
|
||||
$::mirrorconfig = [
|
||||
{
|
||||
'from' => {
|
||||
'branch' => 'B1',
|
||||
'cvsroot' => 'neutron:/var/cvs',
|
||||
},
|
||||
'to' => [
|
||||
{
|
||||
'branch' => 'T1',
|
||||
'cvsroot' => 'neutron:/var/cvs',
|
||||
'offset' => '',
|
||||
},
|
||||
],
|
||||
'mirror' => {
|
||||
'directory' => [ 'mirror-test' ],
|
||||
},
|
||||
},
|
||||
{
|
||||
'from' => {
|
||||
'branch' => 'T1',
|
||||
'cvsroot' => 'neutron:/var/cvs',
|
||||
},
|
||||
'to' => [
|
||||
{
|
||||
'branch' => 'TRUNK',
|
||||
'cvsroot' => 'neutron:/var/cvs',
|
||||
'offset' => 'mirror-test/|modules/mirror-test/foo/',
|
||||
},
|
||||
],
|
||||
'mirror' => {
|
||||
'directory' => [ 'mirror-test' ],
|
||||
},
|
||||
},
|
||||
{
|
||||
'from' => {
|
||||
'branch' => 'TRUNK',
|
||||
'cvsroot' => 'neutron:/var/cvs',
|
||||
},
|
||||
'to' => [
|
||||
{
|
||||
'branch' => 'T2',
|
||||
'cvsroot' => 'neutron:/var/cvs',
|
||||
'offset' => '',
|
||||
},
|
||||
],
|
||||
'mirror' => {
|
||||
'directory' => [ 'modules2' ],
|
||||
},
|
||||
},
|
||||
{
|
||||
'from' => {
|
||||
'branch' => 'TRUNK',
|
||||
'cvsroot' => 'neutron:/var/cvs',
|
||||
},
|
||||
'to' => [
|
||||
{
|
||||
'branch' => 'TRUNK',
|
||||
'cvsroot' => 'neutron:/var/cvs',
|
||||
'offset' => 'modules/|modules2/',
|
||||
},
|
||||
],
|
||||
'mirror' => {
|
||||
'directory' => [ 'modules/mirror-test' ],
|
||||
},
|
||||
},
|
||||
#{
|
||||
# 'from' => {
|
||||
# 'branch' => 'BMS_REL_3_0_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# },
|
||||
# 'to' => [
|
||||
# {
|
||||
# 'branch' => 'BMS_REL_3_1_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# },
|
||||
# {
|
||||
# 'branch' => 'BMS_REL_3_2_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# },
|
||||
# {
|
||||
# 'branch' => 'BMS_REL_4_0_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# },
|
||||
# {
|
||||
# 'branch' => 'TRUNK',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# }
|
||||
# ],
|
||||
# 'mirror' => {
|
||||
# 'directory' => [
|
||||
# 'tools/config'
|
||||
# ]
|
||||
# },
|
||||
# 'exclude' => {
|
||||
# 'file' => [
|
||||
# 'tools/config/classpath_solaris',
|
||||
# 'tools/config/classpath_nt'
|
||||
# ]
|
||||
# },
|
||||
#},
|
||||
#{
|
||||
# 'from' => {
|
||||
# 'branch' => 'BMS_REL_3_1_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# },
|
||||
# 'to' => [
|
||||
# {
|
||||
# 'branch' => 'BMS_REL_3_2_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# }
|
||||
# ],
|
||||
# 'mirror' => {
|
||||
# 'module' => [
|
||||
# 'Vermouth',
|
||||
# 'BMTools'
|
||||
# ]
|
||||
# },
|
||||
#},
|
||||
#{
|
||||
# 'from' => {
|
||||
# 'branch' => 'BMS_REL_4_0_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# },
|
||||
# 'to' => [
|
||||
# {
|
||||
# 'branch' => 'BMS_REL_4_0_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# }
|
||||
# ],
|
||||
# 'mirror' => {
|
||||
# 'module' => [
|
||||
# 'Vermouth',
|
||||
# 'BMTools'
|
||||
# ]
|
||||
# },
|
||||
# 'exclude' => {
|
||||
# 'directory' => [
|
||||
# 'demo',
|
||||
# 'projects/config',
|
||||
# 'bmsrc/packages/com/bluemartini/automation',
|
||||
# 'projects/automation',
|
||||
# ],
|
||||
# },
|
||||
#},
|
||||
#{
|
||||
# 'from' => {
|
||||
# 'branch' => 'BMS_REL_4_1_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# },
|
||||
# 'to' => [
|
||||
# {
|
||||
# 'branch' => 'TRUNK',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# }
|
||||
# ],
|
||||
# 'mirror' => {
|
||||
# 'directory' => [
|
||||
# 'translation'
|
||||
# ]
|
||||
# },
|
||||
# 'exclude' => {
|
||||
# 'directory' => [ 'bmsrc/apps/ams' ],
|
||||
# },
|
||||
#},
|
||||
#{
|
||||
# 'from' => {
|
||||
# 'branch' => 'BMS_REL_4_1_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# },
|
||||
# 'to' => [
|
||||
# {
|
||||
# 'branch' => 'Marvin_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# }
|
||||
# ],
|
||||
# 'mirror' => {
|
||||
# 'module' => [
|
||||
# 'Vermouth',
|
||||
# 'BMTools'
|
||||
# ]
|
||||
# },
|
||||
# 'exclude' => {
|
||||
# 'directory' => [ 'bmsrc/apps/ams' ],
|
||||
# },
|
||||
#},
|
||||
#{
|
||||
# 'from' => {
|
||||
# 'branch' => 'BMS_REL_4_1_M_1_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# },
|
||||
# 'to' => [
|
||||
# {
|
||||
# 'branch' => 'Marvin_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# }
|
||||
# ],
|
||||
# 'mirror' => {
|
||||
# 'module' => [
|
||||
# 'Vermouth',
|
||||
# 'BMTools',
|
||||
# 'BMInstall'
|
||||
# ]
|
||||
# },
|
||||
#},
|
||||
#{
|
||||
# 'from' => {
|
||||
# 'branch' => 'BMS_REL_4_1_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# },
|
||||
# 'to' => [
|
||||
# {
|
||||
# 'branch' => 'TRUNK',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# }
|
||||
# ],
|
||||
# 'mirror' => {
|
||||
# 'module' => [
|
||||
# 'Vermouth',
|
||||
# 'BMTools',
|
||||
# 'BMInstall'
|
||||
# ]
|
||||
# },
|
||||
# 'exclude' => {
|
||||
# 'directory' => [
|
||||
# 'demo',
|
||||
# 'bmsrc/packages/com/bluemartini/automation',
|
||||
# 'projects/automation',
|
||||
# 'bmsrc/apps/ams'
|
||||
# ]
|
||||
# },
|
||||
#},
|
||||
#{
|
||||
# 'from' => {
|
||||
# 'branch' => 'Stanford_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# },
|
||||
# 'to' => [
|
||||
# {
|
||||
# 'branch' => 'TRUNK',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# }
|
||||
# ],
|
||||
# 'mirror' => {
|
||||
# 'module' => [
|
||||
# 'Vermouth',
|
||||
# 'BMTools',
|
||||
# 'BMInstall'
|
||||
# ]
|
||||
# },
|
||||
# 'exclude' => {
|
||||
# 'directory' => [
|
||||
# 'demo',
|
||||
# 'bmsrc/packages/com/bluemartini/automation',
|
||||
# 'projects/automation'
|
||||
# ]
|
||||
# },
|
||||
#},
|
||||
#{
|
||||
# 'from' => {
|
||||
# 'branch' => 'TRUNK',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# },
|
||||
# 'to' => [
|
||||
# {
|
||||
# 'branch' => 'db2_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# }
|
||||
# ],
|
||||
# 'mirror' => {
|
||||
# 'module' => [
|
||||
# 'Vermouth',
|
||||
# 'BMTools',
|
||||
# 'BMInstall'
|
||||
# ],
|
||||
## 'file' => [
|
||||
## 'test/foo.sh'
|
||||
## ],
|
||||
## 'directory' => [
|
||||
## 'CVSROOT',
|
||||
## ]
|
||||
# },
|
||||
# 'exclude' => {
|
||||
# 'directory' => [
|
||||
# 'demo'
|
||||
# ],
|
||||
## 'file' => [
|
||||
## 'makefile'
|
||||
## ],
|
||||
# },
|
||||
#},
|
||||
##{
|
||||
## 'from' => {
|
||||
## 'branch' => 'TRUNK',
|
||||
## 'cvsroot' => 'neutron:/var/cvs',
|
||||
## },
|
||||
## 'to' => [
|
||||
## {
|
||||
## 'branch' => 'incognitus_Dev_BRANCH',
|
||||
## 'cvsroot' => 'neutron:/var/cvs',
|
||||
## 'offset' => '',
|
||||
## }
|
||||
## ],
|
||||
## 'mirror' => {
|
||||
## 'module' => [
|
||||
## 'Vermouth',
|
||||
## 'BMTools',
|
||||
## 'BMInstall'
|
||||
## ]
|
||||
## },
|
||||
## 'exclude' => {
|
||||
## 'directory' => [
|
||||
## 'demo'
|
||||
## ]
|
||||
## },
|
||||
##},
|
||||
#{
|
||||
# 'from' => {
|
||||
# 'branch' => 'db2_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# },
|
||||
# 'to' => [
|
||||
# {
|
||||
# 'branch' => 'incognitus_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# }
|
||||
# ],
|
||||
# 'mirror' => {
|
||||
# 'module' => [
|
||||
# 'Vermouth',
|
||||
# 'BMTools',
|
||||
# 'BMInstall'
|
||||
# ],
|
||||
## 'directory' => [
|
||||
## 'CVSROOT',
|
||||
## ]
|
||||
# },
|
||||
# 'exclude' => {
|
||||
# 'directory' => [
|
||||
# 'demo'
|
||||
# ],
|
||||
# 'file' => [
|
||||
# 'makefile'
|
||||
# ]
|
||||
# },
|
||||
#},
|
||||
##
|
||||
## testing foo below
|
||||
##
|
||||
#{
|
||||
# 'from' => {
|
||||
# 'branch' => 'TRUNK',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# },
|
||||
# 'to' => [
|
||||
# {
|
||||
# 'branch' => 'Test2_Dev_BRANCH',
|
||||
# 'cvsroot' => 'neutron:/var/cvs',
|
||||
# 'offset' => '',
|
||||
# }
|
||||
# ],
|
||||
# 'mirror' => {
|
||||
# 'module' => [
|
||||
# 'thj'
|
||||
# ],
|
||||
# 'directory' => [
|
||||
# 'test'
|
||||
# ],
|
||||
# 'file' => [
|
||||
# 'test/foo.sh',
|
||||
# ],
|
||||
# },
|
||||
# 'exclude' => {
|
||||
## 'directory' => [
|
||||
## 'demo'
|
||||
## ],
|
||||
# 'file' => [
|
||||
# 'test/foo.sh',
|
||||
# ],
|
||||
# },
|
||||
#}
|
||||
];
|
||||
return 1;
|
||||
@@ -1,4 +0,0 @@
|
||||
bonsai-config.pm
|
||||
bonsai-global.pm
|
||||
bonsai-loginfo.pl
|
||||
bonsai-commitinfo.pl
|
||||
@@ -1 +0,0 @@
|
||||
ALL $CVSROOT/CVSROOT/bonsai-commitinfo.pl ${CVSROOT} ${USER}
|
||||
@@ -1 +0,0 @@
|
||||
ALL $CVSROOT/CVSROOT/bonsai-loginfo.pl ${CVSROOT} ${USER} %{}
|
||||
@@ -1,8 +0,0 @@
|
||||
This directory contains a work in progress. There is currently no documentation, and it is
|
||||
almost guaranteed not to work on your system.
|
||||
|
||||
Therefore, I'd advise you to just pretend that it's not here for now.
|
||||
|
||||
Really.
|
||||
|
||||
11.1.02
|
||||
@@ -1,39 +0,0 @@
|
||||
package DB::Insert;
|
||||
|
||||
use DBI;
|
||||
use strict;
|
||||
|
||||
sub exec_log {
|
||||
#use Data::Dumper;
|
||||
#print Dumper(\@_);
|
||||
$::dbh->do("
|
||||
INSERT INTO
|
||||
`exec_log`
|
||||
SET
|
||||
time = UNIX_TIMESTAMP(),
|
||||
command = ?,
|
||||
stdout = ?,
|
||||
stderr = ?,
|
||||
exit_value = ?,
|
||||
signal_num = ?,
|
||||
dumped_core = ?
|
||||
", undef, @_);
|
||||
return $::dbh->selectrow_array("SELECT LAST_INSERT_ID()");
|
||||
}
|
||||
|
||||
sub mirror_change_exec_map {
|
||||
#use Data::Dumper;
|
||||
#print Dumper(\@_);
|
||||
$::dbh->do("
|
||||
INSERT INTO
|
||||
`mirror_change_exec_map`
|
||||
SET
|
||||
mirror_id = ?,
|
||||
change_id = ?,
|
||||
exec_log_id = ?
|
||||
", undef, @_);
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
__END__
|
||||
@@ -1,142 +0,0 @@
|
||||
package DB::Select;
|
||||
|
||||
use DBI;
|
||||
use strict;
|
||||
use Sys::Hostname;
|
||||
|
||||
sub mirrors {
|
||||
my $sth = $::dbh->prepare("
|
||||
SELECT
|
||||
m.id, m.checkin_id, b.value, r.value, o.value
|
||||
FROM
|
||||
checkin c, mirror m, branch b, cvsroot r, offset o, status s
|
||||
WHERE
|
||||
c.id = m.checkin_id
|
||||
AND b.id = m.branch_id
|
||||
AND r.id = m.cvsroot_id
|
||||
AND o.id = m.offset_id
|
||||
AND s.id = m.status_id
|
||||
AND c.time < ? - ?
|
||||
AND s.value = ?
|
||||
AND r.value RLIKE ?
|
||||
ORDER BY
|
||||
c.time, checkin_id, m.id
|
||||
");
|
||||
my $arrayref = $::dbh->selectall_arrayref(
|
||||
$sth,
|
||||
undef,
|
||||
time,
|
||||
$::mirror_delay,
|
||||
shift,
|
||||
'^' . Sys::Hostname::hostname() . ':.*$'
|
||||
);
|
||||
$sth->finish();
|
||||
return $arrayref;
|
||||
}
|
||||
|
||||
sub checkin {
|
||||
my $sth = $::dbh->prepare("
|
||||
SELECT
|
||||
u.value as user, d.value as directory, l.value as log, r.value as cvsroot
|
||||
FROM
|
||||
checkin c, user u, directory d, log l, cvsroot r
|
||||
WHERE
|
||||
u.id = c.user_id
|
||||
AND d.id = c.directory_id
|
||||
AND l.id = c.log_id
|
||||
AND r.id = c.cvsroot_id
|
||||
AND c.id = ?
|
||||
LIMIT 1
|
||||
");
|
||||
$sth->execute(shift);
|
||||
my $hashref = $sth->fetchrow_hashref();
|
||||
$sth->finish();
|
||||
return $hashref;
|
||||
}
|
||||
|
||||
sub change {
|
||||
my $sth = $::dbh->prepare("
|
||||
SELECT
|
||||
f.value as file, ch.oldrev, ch.newrev, b.value as branch
|
||||
FROM
|
||||
`change` ch, file f, branch b
|
||||
WHERE
|
||||
f.id = ch.file_id
|
||||
AND b.id = ch.branch_id
|
||||
AND ch.id = ?
|
||||
LIMIT 1
|
||||
");
|
||||
$sth->execute(shift);
|
||||
my $hashref = $sth->fetchrow_hashref();
|
||||
$sth->finish();
|
||||
return $hashref;
|
||||
}
|
||||
|
||||
sub mirror_changes {
|
||||
my $sth = $::dbh->prepare("
|
||||
SELECT
|
||||
mcm.change_id, t.value as type
|
||||
FROM
|
||||
mirror_change_map mcm, type t, status s
|
||||
WHERE
|
||||
t.id = mcm.type_id
|
||||
AND s.id = mcm.status_id
|
||||
AND s.value = ?
|
||||
AND mcm.mirror_id = ?
|
||||
");
|
||||
my $arrayref = $::dbh->selectall_arrayref(
|
||||
$sth,
|
||||
undef,
|
||||
@_
|
||||
);
|
||||
$sth->finish();
|
||||
return $arrayref;
|
||||
}
|
||||
|
||||
sub runtime {
|
||||
my $sth = $::dbh->prepare("
|
||||
SELECT
|
||||
c.value as command,
|
||||
ri.mirror_delay,
|
||||
ri.min_scan_time,
|
||||
ri.throttle_time,
|
||||
ri.max_addcheckins,
|
||||
ri.last_update,
|
||||
ri.mh_command_response as response,
|
||||
ri.id
|
||||
FROM
|
||||
mh_runtime_info ri, mh_command c
|
||||
WHERE
|
||||
ri.mh_hostname_id = ?
|
||||
AND ri.mh_command_id = c.id
|
||||
ORDER BY
|
||||
ri.id DESC,
|
||||
ri.time DESC
|
||||
LIMIT 1
|
||||
");
|
||||
$sth->execute(shift);
|
||||
my $hashref = $sth->fetchrow_hashref();
|
||||
$sth->finish();
|
||||
return $hashref;
|
||||
}
|
||||
|
||||
sub branch_eol {
|
||||
my ($r, @ba) = @_;
|
||||
return $::dbh->selectcol_arrayref("
|
||||
SELECT
|
||||
b.value
|
||||
FROM
|
||||
`cvsroot_branch_map_eol` m, `cvsroot` r, `branch` b
|
||||
WHERE
|
||||
r.id = m.cvsroot_id
|
||||
AND b.id = m.branch_id
|
||||
AND (b.value = ?" . (" OR b.value = ?" x $#ba) . ")
|
||||
",
|
||||
undef,
|
||||
@ba
|
||||
);
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
__END__
|
||||
@@ -1,70 +0,0 @@
|
||||
package DB::Update;
|
||||
|
||||
use DBI;
|
||||
use strict;
|
||||
|
||||
use DB::Util;
|
||||
|
||||
BEGIN {
|
||||
}
|
||||
|
||||
sub mirror {
|
||||
#use Data::Dumper;
|
||||
#print Dumper(\@_);
|
||||
my ($id, $status) = @_;
|
||||
$::dbh->do("
|
||||
UPDATE
|
||||
`mirror`
|
||||
SET
|
||||
status_id = ?
|
||||
WHERE
|
||||
id = ?
|
||||
",
|
||||
undef,
|
||||
&DB::Util::id('status', $status, {'read_only' => 1}),
|
||||
$id
|
||||
);
|
||||
}
|
||||
|
||||
sub mirror_change {
|
||||
#use Data::Dumper;
|
||||
#print Dumper(\@_);
|
||||
my ($mid, $chid, $status) = @_;
|
||||
$::dbh->do("
|
||||
UPDATE
|
||||
`mirror_change_map`
|
||||
SET
|
||||
status_id = ?
|
||||
WHERE
|
||||
mirror_id = ?
|
||||
AND change_id = ?
|
||||
",
|
||||
undef,
|
||||
&DB::Util::id('status', $status, {'read_only' => 1}),
|
||||
$mid,
|
||||
$chid
|
||||
);
|
||||
}
|
||||
|
||||
sub runtime {
|
||||
#use Data::Dumper;
|
||||
#print Dumper(\@_);
|
||||
my ($r, $id) = @_;
|
||||
$r++;
|
||||
$::dbh->do("
|
||||
UPDATE
|
||||
`mh_runtime_info`
|
||||
SET
|
||||
mh_command_response = ?
|
||||
WHERE
|
||||
id = ?
|
||||
",
|
||||
undef,
|
||||
$r,
|
||||
$id
|
||||
);
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
__END__
|
||||
@@ -1,66 +0,0 @@
|
||||
package DB::Util;
|
||||
|
||||
use DBI;
|
||||
use strict;
|
||||
|
||||
sub connect {
|
||||
unless ($::dbh->{'Active'}) {
|
||||
$::dbh = DBI->connect(
|
||||
$::db{$default::db}{'dsn'},
|
||||
$::db{$default::db}{'user'},
|
||||
$::db{$default::db}{'pass'},
|
||||
{
|
||||
PrintError => 1,
|
||||
RaiseError => 1
|
||||
}
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
sub disconnect {
|
||||
$::dbh->disconnect() if ($::dbh->{'Active'});
|
||||
}
|
||||
|
||||
sub id {
|
||||
#use Data::Dumper;
|
||||
#print Dumper(\@_);
|
||||
my ($table, $value, $hashref) = @_;
|
||||
my ($column, $key, $ro, $id);
|
||||
unless ($column = ${$hashref}{"column"}) { $column = $default::column }
|
||||
unless ($key = ${$hashref}{"key"}) { $key = $default::key }
|
||||
unless ($ro = ${$hashref}{"read_only"}) { $ro = 0 }
|
||||
unless ($id = $::dbh->selectrow_array("SELECT $key FROM `$table` WHERE $column = ?", undef, $value)) {
|
||||
unless ($ro) {
|
||||
$::dbh->do("INSERT INTO `$table` SET $column = ?", undef, $value);
|
||||
$id = $::dbh->selectrow_array("SELECT LAST_INSERT_ID()");
|
||||
} else {
|
||||
die "\nThe value \"$value\" was not found in column \"$column\" of table \"$table\" during a read-only ID lookup operation.\n\n";
|
||||
}
|
||||
}
|
||||
#-debug-# print "\n$id\n\n";
|
||||
return $id;
|
||||
}
|
||||
|
||||
sub retrieve {
|
||||
my ($table, $where_ref, $hashref) = @_;
|
||||
my ($column, $value, $where, @bind);
|
||||
unless ($column = ${$hashref}{"column"}) { $column = $default::column }
|
||||
while (my ($col, $val) = each %$where_ref) {
|
||||
$where .= $col ." = ? AND ";
|
||||
if ($col =~ /.*_id$/) {
|
||||
$col =~ s/_id$//;
|
||||
push @bind, &id($col, $val);
|
||||
} else {
|
||||
push @bind, $val;
|
||||
}
|
||||
}
|
||||
$where .= "1";
|
||||
$value = $::dbh->selectrow_array("SELECT $column FROM `$table` WHERE $where ORDER BY id DESC LIMIT 1", undef, @bind);
|
||||
#print "SELECT $column FROM $table WHERE $where ORDER BY id DESC LIMIT 1", @bind;
|
||||
#for my $i (@bind) { print "$i\n" }
|
||||
return $value;
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
__END__
|
||||
@@ -1,65 +0,0 @@
|
||||
package access;
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
|
||||
|
||||
sub allowed {
|
||||
my ($file, $type_hashref) = @_;
|
||||
my %x = ('exclude' => 0, 'include' => 1);
|
||||
# for my $st ("module", "directory", "file") {
|
||||
for my $st ("file", "directory", "module") {
|
||||
if (defined $type_hashref->{$st}) {
|
||||
# print "=== $st", Dumper($type_hashref->{$st});
|
||||
for my $type ("file", "directory") {
|
||||
for my $clude ("exclude", "include") {
|
||||
if (defined $type_hashref->{$st}->{$clude."_".$type}) {
|
||||
return $x{$clude} if &match_array($file, $type_hashref->{$st}->{$clude."_".$type}) ;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub match_array {
|
||||
my ($file, $regex_arrayref) = @_;
|
||||
# $file = $directory."/".$file if $directory;
|
||||
for my $r (@$regex_arrayref) {
|
||||
##
|
||||
# print "#####".$file."#####".$r."#####";
|
||||
# if ($file =~ /$r/) {
|
||||
# print " MATCH\n";
|
||||
# return 1;
|
||||
# } else {
|
||||
# print " NO-MATCH\n";
|
||||
# }
|
||||
##
|
||||
return 1 if $file =~ /$r/ ;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub rule_applies {
|
||||
my ($ah, $cvsroot, $branch, $file) = @_;
|
||||
my $return = 0;
|
||||
if (($cvsroot eq $ah->{'cvsroot'} || $ah->{'cvsroot'} eq "#-all-#") &&
|
||||
($branch eq $ah->{'branch'} || $ah->{'branch'} eq "#-all-#")) {
|
||||
return &allowed($file, $ah->{'location'});
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
#next if &access::closed{$accessconfig, $to_branch, $directory, $file);
|
||||
sub closed {
|
||||
my ($accessconfig, $cvsroot, $branch, $directory, $file) = @_;
|
||||
$file = $directory."/".$file if $directory;
|
||||
for my $access_rule (@$accessconfig) {
|
||||
if (&rule_applies($access_rule, $cvsroot, $branch, $file)) {
|
||||
return 1 if ( $access_rule->{'close'} ); # { print "\nclosed\n\n" }
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
@@ -1,45 +0,0 @@
|
||||
package default;
|
||||
use strict;
|
||||
#
|
||||
# addresses to which to complain
|
||||
#
|
||||
$default::admin_address = 'release-eng@bluemartini.com';
|
||||
$default::pager_address = 'vajonez@yahoo.com';
|
||||
#
|
||||
# default times (seconds)
|
||||
#
|
||||
# how long to wait after a checkin to start mirroring
|
||||
# this is mostly to give folks a time to nomirror
|
||||
$default::mirror_delay = 15 * 60;
|
||||
# let's be kind and not hammer the network/database.
|
||||
# minimum time between checks of the database
|
||||
$default::min_scan_time = 10;
|
||||
# the old bonsai code uses a really inefficient means
|
||||
# of getting checkin info into the database. each
|
||||
# addcheckin.pl process consumes ~8MB of memory and
|
||||
# take several seconds to run. The following number
|
||||
# is the number of addcheckins that we'd like to see
|
||||
# running at any one time. If the number of addcheckin.pl's
|
||||
# exceeds the number below, wait throttle_time seconds
|
||||
# and try again.
|
||||
$default::max_addcheckins = 20;
|
||||
$default::throttle_time = 5;
|
||||
#
|
||||
# Database stuff (pick the correct one!)
|
||||
#
|
||||
$default::db = "development";
|
||||
$default::column = "value";
|
||||
$default::key = "id";
|
||||
%::db = (
|
||||
"production" => {
|
||||
"dsn" => "dbi:mysql:database=bonsai;host=bonsai2",
|
||||
"user" => "bonsai_mh",
|
||||
"pass" => "password",
|
||||
},
|
||||
"development" => {
|
||||
"dsn" => "dbi:mysql:database=bonsai_dev;host=bonsai2",
|
||||
"user" => "bonsai_dev_mh",
|
||||
"pass" => "password",
|
||||
},
|
||||
);
|
||||
return 1;
|
||||
@@ -1,732 +0,0 @@
|
||||
#!/usr/local/bin/perl -w
|
||||
#use Time::HiRes;
|
||||
#$::start = Time::HiRes::time;
|
||||
#use Cwd;
|
||||
|
||||
use strict;
|
||||
use Sys::Hostname;
|
||||
use Getopt::Long;
|
||||
use File::Basename;
|
||||
use File::Path;
|
||||
use FindBin;
|
||||
use MIME::Lite;
|
||||
use Data::Dumper;
|
||||
|
||||
use lib $FindBin::Bin;
|
||||
|
||||
use config;
|
||||
use proc;
|
||||
use DB::Util;
|
||||
use DB::Insert;
|
||||
use DB::Update;
|
||||
|
||||
#
|
||||
# Trap some signals and send mail to the interested parties
|
||||
#
|
||||
$SIG{HUP} = \&signal_handler;
|
||||
$SIG{INT} = \&signal_handler;
|
||||
$SIG{TERM} = \&signal_handler;
|
||||
$SIG{QUIT} = \&signal_handler;
|
||||
$SIG{SEGV} = \&signal_handler;
|
||||
$SIG{__DIE__} = \&signal_handler;
|
||||
sub signal_handler {
|
||||
my $msg = join "\n--\n", (@_, "mirror.pl is quitting now.\n");
|
||||
unless ($_[0] =~ /^.* failed at .*proc.pm line \d{1,3}\.$/) {
|
||||
&proc::notify("[CVS-mirror] FATAL ERROR", $msg);
|
||||
}
|
||||
die @_;
|
||||
};
|
||||
#sub {
|
||||
# my $msg = join "\n--\n", (@_, "mirror.pl is quitting now.\n");
|
||||
# unless ($_[0] =~ /^.* failed at .*proc.pm line \d{1,3}\.$/) {
|
||||
# &proc::notify("[CVS-mirror] FATAL ERROR", $msg);
|
||||
# }
|
||||
# die @_;
|
||||
#};
|
||||
|
||||
my $CVS = "/usr/local/bin/cvs";
|
||||
my $DIFF = "/usr/local/bin/diff";
|
||||
my $DIFF3 = "/usr/local/bin/diff3";
|
||||
my $PATCH = "/usr/local/bin/patch";
|
||||
|
||||
my $h = {};
|
||||
|
||||
my $paramref = {
|
||||
'return' => 'hashref',
|
||||
# 'noop' => 0,
|
||||
# 'log_stdout' => 1,
|
||||
'log_always' => 1,
|
||||
'workdir' => 'tmp',
|
||||
'keep_dir' => 1,
|
||||
# 'nomail' => 1,
|
||||
};
|
||||
#
|
||||
# Get the command line options. do not modify the values in the hash
|
||||
# instead modify the local scalars
|
||||
#
|
||||
GetOptions ($h,
|
||||
'mirror_id=i',
|
||||
'change_id=i',
|
||||
'action=s',
|
||||
'user=s',
|
||||
'from_branch=s',
|
||||
'from_cvsroot=s',
|
||||
'to_branch=s',
|
||||
'to_cvsroot=s',
|
||||
'offset:s',
|
||||
'directory:s',
|
||||
'file=s',
|
||||
'oldrev=s',
|
||||
'newrev=s',
|
||||
'log:s',
|
||||
);
|
||||
#
|
||||
# I know this appears to be a gratuitious waste of memory, but I want to
|
||||
# keep the original unmodified values in the %h hash and the munged values
|
||||
# in local scalars. I don't care if you don't like it and think that it's
|
||||
# silly.
|
||||
#
|
||||
my $mirror_id = $h->{'mirror_id'};
|
||||
my $change_id = $h->{'change_id'};
|
||||
my $action = $h->{'action'};
|
||||
my $user = $h->{'user'};
|
||||
my $from_branch = $h->{'from_branch'};
|
||||
my $from_cvsroot = $h->{'from_cvsroot'};
|
||||
my $to_branch = $h->{'to_branch'};
|
||||
my $to_cvsroot = $h->{'to_cvsroot'};
|
||||
my $offset = $h->{'offset'};
|
||||
my $directory = $h->{'directory'};
|
||||
my $file = $h->{'file'};
|
||||
my $oldrev = $h->{'oldrev'};
|
||||
my $newrev = $h->{'newrev'};
|
||||
my $log = $h->{'log'};
|
||||
#
|
||||
# Create aggregate variables and quotemeta things that need quoting
|
||||
# I'm quoting stuff (like mirror_id, rev numbers, and branch) that
|
||||
# don't technically require it, just in case (however unlikely) CVS
|
||||
# or bonsai change the way they operate.
|
||||
#
|
||||
$mirror_id = quotemeta($mirror_id);
|
||||
$change_id = quotemeta($change_id);
|
||||
$action = quotemeta($action);
|
||||
$user = quotemeta($user);
|
||||
$from_branch = quotemeta($from_branch);
|
||||
$to_branch = quotemeta($to_branch);
|
||||
$oldrev = quotemeta($oldrev);
|
||||
$newrev = quotemeta($newrev);
|
||||
#
|
||||
# munge the directory/filename using the offset to tweak from/to.
|
||||
# this allows for inter-repository and inter-module mirroring
|
||||
# (becareful, inter-x mirroring is *NOT* well tested)
|
||||
#
|
||||
my $from_dir_file = $directory ? $directory . "/" . $file : $file;
|
||||
my $to_dir_file = $from_dir_file;
|
||||
$offset = "|" unless $offset;
|
||||
my ($from_offset, $to_offset) = split /\|/, $offset;
|
||||
# remove \Q & \E below to allow from side regex matching; although, that is
|
||||
# likely to open a panadora's box of problems for very little benefit.
|
||||
# thj sez "don't do it"
|
||||
$to_dir_file =~ s/\Q$from_offset\E/$to_offset/;
|
||||
my $to_directory = dirname($to_dir_file);
|
||||
my $to_file = basename($to_dir_file);
|
||||
my $uq_to_directory = $to_directory;
|
||||
$to_directory = quotemeta($to_directory);
|
||||
$to_file = quotemeta($to_file);
|
||||
my $uq_to_dir_file = $to_dir_file;
|
||||
$to_dir_file = quotemeta($to_dir_file);
|
||||
my $from_directory = quotemeta($directory);
|
||||
my $from_file = quotemeta($file);
|
||||
$from_dir_file = quotemeta($from_dir_file);
|
||||
#
|
||||
# determine the mirror checkin change type
|
||||
#
|
||||
my $change_type;
|
||||
if ($oldrev && $newrev) {
|
||||
$change_type = "checkin";
|
||||
} elsif (!$oldrev && $newrev) {
|
||||
$change_type = "add";
|
||||
} elsif ($oldrev && !$newrev) {
|
||||
$change_type = "remove";
|
||||
} else {
|
||||
die "Both and 'oldrev' and 'newrev' are undefined (mirror_id = $mirror_id, ".
|
||||
"change_id = $change_id). This is bad. REAL BAD (trust me).\n\n" .
|
||||
"If you are getting this error it means that the checkin/change got inserted into " .
|
||||
"the database in an extremely bad way. Please to be fixing.\n";
|
||||
}
|
||||
#
|
||||
# munge the log message to indicate this is a mirrored checkin of change_type $change_type
|
||||
#
|
||||
$log .= " (mirrored $change_type from $from_branch)";
|
||||
$log = quotemeta($log);
|
||||
#
|
||||
# get the host name and fix cvsroots for local and remote access
|
||||
# TODO: the remote access parts will require a read-only user on the
|
||||
# remote repository and also a modified from_cvsroot that includes
|
||||
# a conection method and user.
|
||||
#
|
||||
# TODO: exit if to_cvsroot != from_cvsroot. do so until I get adds working
|
||||
#
|
||||
my $hostname = Sys::Hostname::hostname();
|
||||
$to_cvsroot =~ s/^$hostname://; # this should always match
|
||||
$from_cvsroot =~ s/^$hostname://; # this should only sometimes match
|
||||
#
|
||||
# Oh what a lame ass hack. the old bonsai does stupid shit with
|
||||
# rlog, and uses $ENV{'CVSROOT'}. um, that's lame.
|
||||
#
|
||||
$ENV{'CVSROOT'} = $to_cvsroot;
|
||||
my $uq_to_cvsroot = $to_cvsroot;
|
||||
$to_cvsroot = quotemeta($to_cvsroot);
|
||||
$from_cvsroot = quotemeta($from_cvsroot);
|
||||
#
|
||||
# if we are mirroring to/from the TRUNK branch (TRUNK)
|
||||
# do not include a -r option on the command line
|
||||
# (from_branch_arg is probaly wasted since we have rev numbers
|
||||
# and should therefore never need it, but i like symmetry).
|
||||
#
|
||||
my $to_branch_arg = ($to_branch && $to_branch ne "TRUNK") ? "-r $to_branch" : "" ;
|
||||
my $from_branch_arg = ($from_branch && $from_branch ne "TRUNK") ? "-r $from_branch" : "" ;
|
||||
#
|
||||
# Determine the appropriate merge type (cvs or diff3)
|
||||
#
|
||||
my $merge_type;
|
||||
if ($offset ne "|" || $from_cvsroot ne $to_cvsroot) {
|
||||
$merge_type = 'diff3';
|
||||
} else {
|
||||
$merge_type = 'cvs';
|
||||
}
|
||||
|
||||
my $status;
|
||||
$status = &mirror($merge_type, $change_type);
|
||||
$status = &diff_patch if $status eq 'conflict';
|
||||
$status = &mirror($merge_type, $change_type, 1) if $status eq 'conflict';
|
||||
&error_detected if $status eq "error";
|
||||
$status = $status eq "merge" ? $merge_type."_".$status : $status;
|
||||
&update_status($status);
|
||||
|
||||
#
|
||||
# Subroutines
|
||||
#
|
||||
sub mirror {
|
||||
my ($merge_type, $change_type, $force_ci) = @_;
|
||||
my ($cmd, $r, $status) = undef;
|
||||
$force_ci = $force_ci ? '-f' : '' ;
|
||||
$status = 'merge';
|
||||
if ($merge_type eq 'cvs') {
|
||||
unlink "tmp/$uq_to_dir_file" if (-f "tmp/$uq_to_dir_file");
|
||||
$r = &run_and_log("$CVS -d $to_cvsroot co $to_branch_arg -j $oldrev -j $newrev $to_dir_file");
|
||||
&missing_file if (
|
||||
$change_type eq 'checkin' &&
|
||||
!-f "tmp/$uq_to_dir_file"
|
||||
);
|
||||
if ($change_type eq 'add' && defined $r->{'stderr'} &&
|
||||
$r->{'stderr'} eq "cvs checkout: file $uq_to_dir_file exists, but has been added in revision $h->{'newrev'}\n") {
|
||||
my $diff_to_branch = $to_branch eq "TRUNK" ? "HEAD" : $to_branch;
|
||||
$r = &run_and_log("$CVS rdiff -r $newrev -r $diff_to_branch $to_dir_file", {'nomail' => 1});
|
||||
&previously_added($r->{'stdout'} ? 'different' : 'same');
|
||||
}
|
||||
&previously_removed if (
|
||||
$change_type eq 'remove' &&
|
||||
defined $r->{'stderr'} &&
|
||||
$r->{'stderr'} ne "cvs checkout: scheduling $uq_to_dir_file for removal\n"
|
||||
);
|
||||
$status = 'conflict' if (
|
||||
$change_type eq 'checkin' &&
|
||||
defined $r->{'stderr'} &&
|
||||
$r->{'stderr'} eq "rcsmerge: warning: conflicts during merge\n"
|
||||
);
|
||||
if ( $change_type eq 'checkin' && defined $r->{'stderr'} &&
|
||||
$r->{'stderr'} =~ /\Qcvs checkout: nonmergeable file needs merge\E/) {
|
||||
my $diff_to_branch = $to_branch eq "TRUNK" ? "HEAD" : $to_branch;
|
||||
my $nmfd = &run_and_log("$CVS rdiff -r $oldrev -r $diff_to_branch $to_dir_file", {'nomail' => 1});
|
||||
$status = 'non_merge_overwrite' if $nmfd->{'stdout'};
|
||||
}
|
||||
if ($status eq 'merge' || $status eq 'non_merge_overwrite' || $force_ci) {
|
||||
$r = &run_and_log("$CVS ci $force_ci -m $log $to_dir_file");
|
||||
&conflicted if ($status eq 'conflict');
|
||||
&non_merge if ($status eq 'non_merge_overwrite');
|
||||
&previously_applied unless ($r->{'stdout'} || $r->{'stderr'} || $r->{'exit_value'});
|
||||
$status = 'error' if (
|
||||
$r->{'exit_value'} ||
|
||||
(defined $r->{'stderr'} &&
|
||||
$r->{'stderr'} !~ /^(\Qcvs commit: [\E([0-9]{2}:){2}[0-9]{2}\Q] waiting for \E.*?\Q's lock in $uq_to_cvsroot\/$uq_to_directory\E\n)+\Qcvs commit: [\E([0-9]{2}:){2}[0-9]{2}\Q] obtained lock in $uq_to_cvsroot\/$uq_to_directory\E\n$/
|
||||
)
|
||||
);
|
||||
}
|
||||
return $status;
|
||||
} elsif ($merge_type eq 'diff3') {
|
||||
#
|
||||
# use diff3 (like cvs does internally) to mirror between modules and repositories.
|
||||
# since cvs can't do the magic for us, we need to have separate actions for change, add, and remove.
|
||||
#
|
||||
|
||||
# cleanup any cruft that might be left over from the previous attempt (prior to the forced checkin of the conflict)
|
||||
unlink "tmp/$uq_to_dir_file" if (-f "tmp/$uq_to_dir_file");
|
||||
|
||||
# check keyword expansion mode of source file
|
||||
my ($keywordmode, $option) = undef;
|
||||
$r = &run_and_log("$CVS -d $from_cvsroot rlog -hN $from_dir_file | grep '^keyword substitution: '");
|
||||
chomp($keywordmode = $r->{'stdout'});
|
||||
$keywordmode =~ s/^^keyword substitution: //;
|
||||
|
||||
if ($change_type eq 'checkin') {
|
||||
# for changes to existing files use diff3 to merge
|
||||
|
||||
# get the old revision
|
||||
$r = &run_and_log("$CVS -q -d $from_cvsroot co -p -r $oldrev $from_dir_file > $from_file,$oldrev");
|
||||
$status = 'error' if (defined $r->{'stderr'} || $r->{'exit_value'});
|
||||
|
||||
# get the new revision
|
||||
$r = &run_and_log("$CVS -q -d $from_cvsroot co -p -r $newrev $from_dir_file > $from_file,$newrev");
|
||||
$status = 'error' if (defined $r->{'stderr'} || $r->{'exit_value'});
|
||||
|
||||
# get the version from the destination module/branch. If it is not there send a missing_file warning
|
||||
$r = &run_and_log(
|
||||
"$CVS -d $to_cvsroot co $to_branch_arg $to_dir_file",
|
||||
{'nomail' => 1}
|
||||
);
|
||||
&missing_file if (!-f "tmp/$uq_to_dir_file");
|
||||
|
||||
# if binary compare dest. with old and change status to "non_merge" and checkin the new source file
|
||||
# if not, don't change the status (and thus send the mail), just checkin the new file
|
||||
if ($keywordmode eq 'b') {
|
||||
$r = &run_and_log("$DIFF -q $from_file,$oldrev $to_dir_file");
|
||||
$status = "non_merge_overwrite" if $r->{'stdout'};
|
||||
$r = &run_and_log("cp $from_file,$oldrev $to_dir_file");
|
||||
# thereshould really be an error check here
|
||||
} else {
|
||||
# behold the magic that is diff3! (store result in foo,new)
|
||||
$r = &run_and_log(
|
||||
"$DIFF3 -E -am $to_dir_file $from_file,$oldrev $from_file,$newrev > $to_dir_file,new",
|
||||
{'nomail' => 1}
|
||||
);
|
||||
$status = 'error' if ($r->{'exit_value'} == 2);
|
||||
$status = 'conflict' if ($r->{'exit_value'} == 1);
|
||||
|
||||
# replace with the new file in prep for checkin
|
||||
$r = &run_and_log("mv $to_dir_file,new $to_dir_file");
|
||||
$status = 'error' if (defined $r->{'stderr'} || $r->{'exit_value'});
|
||||
}
|
||||
|
||||
# if we haven't conflicted yet, or we are conflicted and diff_patch couldn't handle it, it's time to checkin
|
||||
if ($status eq 'merge' || $status eq 'non_merge_overwrite' || $force_ci) {
|
||||
$r = &run_and_log("$CVS ci -m $log $to_dir_file");
|
||||
|
||||
# send bitch mail for conflicts
|
||||
&conflicted if ($status eq 'conflict');
|
||||
|
||||
# send mail about binary changes where the files are different
|
||||
&non_merge if ($status eq 'non_merge_overwrite');
|
||||
|
||||
# send more naggy mail if the checkin is a noop
|
||||
&previously_applied unless ($r->{'stdout'} || $r->{'stderr'} || $r->{'exit_value'});
|
||||
|
||||
# set the status to "error" if we get a non-zero exit value or something unexpected on stderr
|
||||
# (the ugly regex is to ignore lock bump messages)
|
||||
$status = 'error' if (
|
||||
$r->{'exit_value'} ||
|
||||
(defined $r->{'stderr'} &&
|
||||
$r->{'stderr'} !~ /^(\Qcvs commit: [\E([0-9]{2}:){2}[0-9]{2}\Q] waiting for \E.*?\Q's lock in $uq_to_cvsroot\/$uq_to_directory\E\n)+\Qcvs commit: [\E([0-9]{2}:){2}[0-9]{2}\Q] obtained lock in $uq_to_cvsroot\/$uq_to_directory\E\n$/
|
||||
)
|
||||
);
|
||||
}
|
||||
} elsif ($change_type eq 'add') {
|
||||
# TODO: Needs mucho error handling and binary foo
|
||||
# for added files, bootstrap/spoof some CVS admin directories and add the file
|
||||
|
||||
# check to see if the file is already here and send the appropriate bitch mail
|
||||
$r = &run_and_log(
|
||||
"$CVS -d $to_cvsroot co -d prev $to_branch_arg $to_dir_file",
|
||||
{'nomail' => 1}
|
||||
);
|
||||
if (-f "tmp/$uq_to_dir_file") {
|
||||
$r = &run_and_log("$CVS -q -d $from_cvsroot co -p -r $newrev $from_dir_file > $from_file,$newrev");
|
||||
$r = &run_and_log("$DIFF -wB $from_file,$newrev prev/$to_file", {'nomail' => 1});
|
||||
&previously_added($r->{'stdout'} ? 'different' : 'same');
|
||||
}
|
||||
|
||||
#$r = &run_and_log("$CVS -d $from_cvsroot rlog -hN $from_dir_file | grep '^keyword substitution: '");
|
||||
#my $option = $r->{'stdout'};
|
||||
#$option =~ s/^^keyword substitution: /-/;
|
||||
|
||||
# create the directory structure for the new file
|
||||
$r = &run_and_log("mkdir -p $to_directory");
|
||||
$status = 'error' if (defined $r->{'stderr'} || $r->{'exit_value'});
|
||||
|
||||
# get the new file and stash it in it's freshly created directory
|
||||
$r = &run_and_log("$CVS -q -d $from_cvsroot co -p -r $newrev $from_dir_file > $to_dir_file");
|
||||
$status = 'error' if (defined $r->{'stderr'} || $r->{'exit_value'});
|
||||
|
||||
# spoof an existing checkout by populating a CVS admin directory
|
||||
$r = &run_and_log("mkdir CVS");
|
||||
$status = 'error' if (defined $r->{'stderr'} || $r->{'exit_value'});
|
||||
$r = &run_and_log("echo $to_cvsroot > CVS/Root");
|
||||
$status = 'error' if (defined $r->{'stderr'} || $r->{'exit_value'});
|
||||
$r = &run_and_log("echo . > CVS/Repository");
|
||||
$status = 'error' if (defined $r->{'stderr'} || $r->{'exit_value'});
|
||||
$r = &run_and_log("echo D > CVS/Entries");
|
||||
$status = 'error' if (defined $r->{'stderr'} || $r->{'exit_value'});
|
||||
# you only need CVS/Tag if not on the trunk (also need to prefix with a "T")
|
||||
if ($to_branch ne 'TRUNK') {
|
||||
$r = &run_and_log("echo T$to_branch > CVS/Tag");
|
||||
$status = 'error' if (defined $r->{'stderr'} || $r->{'exit_value'});
|
||||
}
|
||||
|
||||
# recursively add the subdirs (as described in the `info cvs`) to create the appropriate admin dirs
|
||||
my $add = undef;
|
||||
for my $element (split("/", $uq_to_dir_file)) {
|
||||
$add .= quotemeta($element);
|
||||
|
||||
# don forget to set the keyword expansion the same as the source file
|
||||
$option = ($add eq $to_dir_file) ? "-k" . $keywordmode : "";
|
||||
|
||||
# add the dir/file
|
||||
$r = &run_and_log("$CVS add $option $add");
|
||||
|
||||
# ignore some expected stderr output
|
||||
$status = 'error' if (
|
||||
$r->{'exit_value'} ||
|
||||
(defined $r->{'stderr'} &&
|
||||
$r->{'stderr'} ne
|
||||
"cvs add: scheduling file `$uq_to_dir_file' for addition\n" .
|
||||
"cvs add: use 'cvs commit' to add this file permanently\n" &&
|
||||
$r->{'stderr'} !~
|
||||
/^\Qcvs add: re-adding file $uq_to_dir_file (in place of dead revision \E[0-9\.]+?\)\n\Qcvs add: use 'cvs commit' to add this file permanently\E\n$/
|
||||
)
|
||||
);
|
||||
$add .= quotemeta("/");
|
||||
}
|
||||
|
||||
# checkin the new file
|
||||
$r = &run_and_log("$CVS ci -m $log $to_dir_file");
|
||||
|
||||
# again ignore some expected error with big freaky regexs
|
||||
$status = 'error' if (
|
||||
$r->{'exit_value'} ||
|
||||
(defined $r->{'stderr'} &&
|
||||
$r->{'stderr'} ne
|
||||
"cvs commit: changing keyword expansion mode to $option\n" &&
|
||||
$r->{'stderr'} !~
|
||||
/^((\Qcvs commit: [\E([0-9]{2}:){2}[0-9]{2}\Q] waiting for \E.*?\Q's lock in $uq_to_cvsroot\/$uq_to_directory\E\n)+\Qcvs commit: [\E([0-9]{2}:){2}[0-9]{2}\Q] obtained lock in $uq_to_cvsroot\/$uq_to_directory\E\n)?(\Qcvs commit: changing keyword expansion mode to $option\E\n)?$/
|
||||
)
|
||||
);
|
||||
} elsif ($change_type eq 'remove') {
|
||||
# removes are easy, first check to see if the file is even there, and send a message if not
|
||||
$r = &run_and_log(
|
||||
"$CVS -d $to_cvsroot co $to_branch_arg $to_dir_file",
|
||||
{'nomail' => 1}
|
||||
);
|
||||
&previously_removed if (!-f "tmp/$uq_to_dir_file");
|
||||
|
||||
# remove the file (ignoring expected stderr output)
|
||||
$r = &run_and_log("$CVS rm -f $to_dir_file");
|
||||
$status = 'error' if (
|
||||
$r->{'exit_value'} ||
|
||||
(defined $r->{'stderr'} &&
|
||||
$r->{'stderr'} ne
|
||||
"cvs remove: scheduling `$uq_to_dir_file' for removal\n" .
|
||||
"cvs remove: use 'cvs commit' to remove this file permanently\n"
|
||||
)
|
||||
);
|
||||
|
||||
# and check it in (ignoring expected stderr output)
|
||||
$r = &run_and_log("$CVS ci -m $log $to_dir_file");
|
||||
$status = 'error' if (
|
||||
$r->{'exit_value'} ||
|
||||
(defined $r->{'stderr'} &&
|
||||
$r->{'stderr'} !~ /^(\Qcvs commit: [\E([0-9]{2}:){2}[0-9]{2}\Q] waiting for \E.*?\Q's lock in $uq_to_cvsroot\/$uq_to_directory\E\n)+\Qcvs commit: [\E([0-9]{2}:){2}[0-9]{2}\Q] obtained lock in $uq_to_cvsroot\/$uq_to_directory\E\n$/
|
||||
)
|
||||
);
|
||||
} else {
|
||||
die "Undefined change type ($change_type), Loser.\n\n";
|
||||
}
|
||||
} else {
|
||||
die "Undefined merge type ($merge_type) specified.\n\n" .
|
||||
"Your coding is weak and ineffectual.\n\n";
|
||||
}
|
||||
return $status;
|
||||
}
|
||||
|
||||
#
|
||||
# patch/diff command
|
||||
#
|
||||
sub diff_patch {
|
||||
my ($r) = undef;
|
||||
unlink "tmp/$uq_to_dir_file" if (-f "tmp/$uq_to_dir_file");
|
||||
$r = &run_and_log("$CVS -d $to_cvsroot co $to_branch_arg $to_dir_file");
|
||||
$r = &run_and_log(
|
||||
"$CVS -d $from_cvsroot rdiff -c -r $oldrev -r $newrev $from_dir_file | $PATCH -c -N -l $to_dir_file",
|
||||
{'nomail' => 1}
|
||||
);
|
||||
if ($r->{'exit_value'} && defined $r->{'stdout'}) {
|
||||
if ($r->{'stdout'} =~ /\d+ out of \d+ hunk[s]? FAILED -- saving rejects to( file)? $to_dir_file\.rej/) {
|
||||
return 'conflict';
|
||||
} elsif ($r->{'stdout'} =~ /\QReversed (or previously applied) patch detected! Skipping patch.\E/) {
|
||||
#
|
||||
# patch lies and says the patch is reversed or previously applied when it is not.
|
||||
# use mirror_id = 3247 & change_id = 31329 with GNU patch version 2.5.4 as a test case/example.
|
||||
# Since we can't trust patch, return 'conflict' and force the checkin.
|
||||
# &previously_applied;
|
||||
return 'conflict';
|
||||
}
|
||||
return 'error'
|
||||
}
|
||||
$r = &run_and_log("$CVS ci -m $log $to_dir_file");
|
||||
if (
|
||||
$r->{'exit_value'} ||
|
||||
(defined $r->{'stderr'} &&
|
||||
$r->{'stderr'} !~ /^(\Qcvs commit: [\E([0-9]{2}:){2}[0-9]{2}\Q] waiting for \E.*?\Q's lock in $uq_to_cvsroot\/$uq_to_directory\E\n)+\Qcvs commit: [\E([0-9]{2}:){2}[0-9]{2}\Q] obtained lock in $uq_to_cvsroot\/$uq_to_directory\E\n$/
|
||||
)
|
||||
) {
|
||||
return 'error';
|
||||
} else {
|
||||
return 'diff_patch';
|
||||
}
|
||||
#return (defined $r->{'stderr'} || $r->{'exit_value'}) ? 'error' : 'diff_patch';
|
||||
}
|
||||
#
|
||||
# Command executor and output logger
|
||||
#
|
||||
sub run_and_log {
|
||||
my ($cmd, $param) = @_;
|
||||
my $r = undef;
|
||||
my $new_paramref = {%$paramref};
|
||||
while (my($key, $value) = each (%$param)) {
|
||||
$new_paramref->{$key} = $value;
|
||||
}
|
||||
&DB::Util::connect();
|
||||
$r = &proc::run($cmd, $new_paramref);
|
||||
&DB::Insert::mirror_change_exec_map(
|
||||
$mirror_id,
|
||||
$change_id,
|
||||
$r->{'log_id'}
|
||||
) if defined $r->{'log_id'};
|
||||
&DB::Util::disconnect();
|
||||
return $r;
|
||||
}
|
||||
#
|
||||
# Send a message (and update the mirror_change status) if we try to mirror
|
||||
# and a nonfatal error is detected.
|
||||
#
|
||||
sub error_detected {
|
||||
my ($subject, $body, $from_root, $to_root) = undef;
|
||||
if ($h->{'to_cvsroot'} eq $h->{'from_cvsroot'}) {
|
||||
$to_root = "";
|
||||
$from_root = "";
|
||||
} else {
|
||||
$to_root = " ($h->{'to_cvsroot'})";
|
||||
$from_root = " ($h->{'from_cvsroot'})";
|
||||
}
|
||||
$subject = "error - $user - $to_branch - $uq_to_dir_file";
|
||||
$body = qq#
|
||||
Your checkin to $h->{'directory'}/$h->{'file'} on the $h->{'from_branch'}$from_root could not be mirrored to the $h->{'to_branch'}$to_root because $uq_to_dir_file an unexpected error was detected.
|
||||
|
||||
Whatever is broken (or not quite right) will likely need to be fixed by Release Engineering. This message is just to inform you that the mirror operation did not complete successfully. If you have any questions, please contact Release Engineering.
|
||||
|
||||
Release Engineering: Use the info below to look up the details of the error in the database.
|
||||
#;
|
||||
&mail($subject, $body);
|
||||
&update_status("error");
|
||||
}
|
||||
#
|
||||
# Send a message (and update the mirror_change status) if we try to mirror
|
||||
# and the destination file doen't exist
|
||||
#
|
||||
sub missing_file {
|
||||
my ($subject, $body, $from_root, $to_root) = undef;
|
||||
if ($h->{'to_cvsroot'} eq $h->{'from_cvsroot'}) {
|
||||
$to_root = "";
|
||||
$from_root = "";
|
||||
} else {
|
||||
$to_root = " ($h->{'to_cvsroot'})";
|
||||
$from_root = " ($h->{'from_cvsroot'})";
|
||||
}
|
||||
$subject = "missing file - $user - $to_branch - $uq_to_dir_file";
|
||||
$body = qq#
|
||||
Your checkin to $h->{'directory'}/$h->{'file'} on the $h->{'from_branch'}$from_root could not be mirrored to the $h->{'to_branch'}$to_root because $uq_to_dir_file was not found on the $h->{'to_branch'}$to_root.
|
||||
|
||||
This could be caused by any of a number of things, such as mirroring being misconfigured, the file might have originally been added to the $h->{'from_branch'} by a tagging operation instead of a \"cvs add\", or maybe it's been removed from the $h->{'to_branch'}$to_root.
|
||||
|
||||
If $uq_to_dir_file needs to be on the $h->{'to_branch'}$to_root either add it or contact Release Engineering.
|
||||
#;
|
||||
&mail($subject, $body);
|
||||
&update_status("missing");
|
||||
}
|
||||
#
|
||||
# Send mail if the mirror was to add a file and it already exists
|
||||
#
|
||||
sub previously_added {
|
||||
my $diff = shift;
|
||||
my ($subject, $body, $from_root, $to_root) = undef;
|
||||
if ($h->{'to_cvsroot'} eq $h->{'from_cvsroot'}) {
|
||||
$to_root = "";
|
||||
$from_root = "";
|
||||
} else {
|
||||
$to_root = " ($h->{'to_cvsroot'})";
|
||||
$from_root = " ($h->{'from_cvsroot'})";
|
||||
}
|
||||
my $foo = $diff eq "same" ? "the " : "";
|
||||
$subject = "previously added ($diff) - $user - $to_branch - $uq_to_dir_file";
|
||||
$body = qq#
|
||||
Your add of $h->{'directory'}/$h->{'file'} to the $h->{'from_branch'}$from_root could not be mirrored to the $h->{'to_branch'}$to_root because $uq_to_dir_file was already present. The file you added and $uq_to_dir_file on the $h->{'to_branch'}$to_root are $foo$diff.
|
||||
|
||||
This may (or may not) indicate a problem. Contact Release Engineering if you have any questions.
|
||||
#;
|
||||
&mail($subject, $body);
|
||||
&update_status("prev_add_$diff");
|
||||
}
|
||||
#
|
||||
# Send mail if the mirror was to remove a file and it was already removed
|
||||
#
|
||||
sub previously_removed {
|
||||
my ($subject, $body, $from_root, $to_root) = undef;
|
||||
if ($h->{'to_cvsroot'} eq $h->{'from_cvsroot'}) {
|
||||
$to_root = "";
|
||||
$from_root = "";
|
||||
} else {
|
||||
$to_root = " ($h->{'to_cvsroot'})";
|
||||
$from_root = " ($h->{'from_cvsroot'})";
|
||||
}
|
||||
$subject = "previously removed - $user - $to_branch - $uq_to_dir_file";
|
||||
$body = qq#
|
||||
Your remove of $h->{'directory'}/$h->{'file'} from the $h->{'from_branch'}$from_root could not be mirrored to the $h->{'to_branch'}$to_root because $uq_to_dir_file does not exist on the $h->{'to_branch'}$to_root. This file was either previously removed, or never existed on the $h->{'to_branch'}$to_root.
|
||||
|
||||
This may (or may not) indicate a problem. Contact Release Engineering if you have any questions.
|
||||
#;
|
||||
&mail($subject, $body);
|
||||
&update_status("prev_rm");
|
||||
}
|
||||
#
|
||||
# Send a message if the mirror results in a NOOP
|
||||
#
|
||||
sub previously_applied {
|
||||
my ($subject, $body, $from_root, $to_root) = undef;
|
||||
if ($h->{'to_cvsroot'} eq $h->{'from_cvsroot'}) {
|
||||
$to_root = "";
|
||||
$from_root = "";
|
||||
} else {
|
||||
$to_root = " ($h->{'to_cvsroot'})";
|
||||
$from_root = " ($h->{'from_cvsroot'})";
|
||||
}
|
||||
$subject = "previously applied - $user - $to_branch - $uq_to_dir_file";
|
||||
$body = qq#
|
||||
Your checkin to $h->{'directory'}/$h->{'file'} on the $h->{'from_branch'}$from_root was not mirrored to $uq_to_dir_file on the $h->{'to_branch'}$to_root because that change appears to have already been applied.
|
||||
|
||||
This may (or may not) indicate a problem. Contact Release Engineering if you have any questions.
|
||||
#;
|
||||
&mail($subject, $body);
|
||||
&update_status("noop");
|
||||
}
|
||||
#
|
||||
# Send mail if the mirror involves a nonmergable file and the source and destination
|
||||
# were different before the original checkin, since we are overwriting the destination
|
||||
# file.
|
||||
#
|
||||
sub non_merge {
|
||||
my ($subject, $body, $from_root, $to_root) = undef;
|
||||
if ($h->{'to_cvsroot'} eq $h->{'from_cvsroot'}) {
|
||||
$to_root = "";
|
||||
$from_root = "";
|
||||
} else {
|
||||
$to_root = " ($h->{'to_cvsroot'})";
|
||||
$from_root = " ($h->{'from_cvsroot'})";
|
||||
}
|
||||
$subject = "nonmergeable file - $user - $to_branch - $uq_to_dir_file";
|
||||
$body = qq#
|
||||
Your checkin to nonmergable file: $h->{'directory'}/$h->{'file'} on the $h->{'from_branch'}$from_root has mirrored to the $h->{'to_branch'}$to_root overwriting the file $uq_to_dir_file. Before your checkin these two files were DIFFERENT; however, now they are the same.
|
||||
|
||||
This may (or may not) desirable. Contact Release Engineering if you have any questions.
|
||||
#;
|
||||
&mail($subject, $body);
|
||||
&update_status("non_merge_overwrite");
|
||||
}
|
||||
#
|
||||
# Send email if conflicts were generated during the mirror
|
||||
#
|
||||
sub conflicted {
|
||||
my ($subject, $body, $count, $conflict, $conflict_text, $to_root, $from_root) = undef;
|
||||
if ($h->{'to_cvsroot'} eq $h->{'from_cvsroot'}) {
|
||||
$to_root = "";
|
||||
$from_root = "";
|
||||
} else {
|
||||
$to_root = " ($h->{'to_cvsroot'})";
|
||||
$from_root = " ($h->{'from_cvsroot'})";
|
||||
}
|
||||
$conflict_text = "=" x 70 . "\nConflict Detail:\n";
|
||||
open (CONFLICTFILE, "tmp/$uq_to_dir_file");
|
||||
while (<CONFLICTFILE>) {
|
||||
$count++;
|
||||
if (/^<<<<<<< /) {
|
||||
$conflict++;
|
||||
if ($conflict == 1) {
|
||||
$conflict_text .= "\nAt line $count:\n";
|
||||
}
|
||||
}
|
||||
if ($conflict) {
|
||||
$conflict_text .= $_;
|
||||
}
|
||||
if (/^>>>>>>> /) {
|
||||
if ($conflict == 1) {
|
||||
$conflict_text .= "\n";
|
||||
}
|
||||
$conflict--;
|
||||
}
|
||||
}
|
||||
close (CONFLICTFILE);
|
||||
$conflict_text .= "=" x 70 . "\n";
|
||||
$subject = "CONFLICT - $user - $to_branch - $uq_to_dir_file";
|
||||
$body = qq#
|
||||
Your checkin to $h->{'directory'}/$h->{'file'} on the $h->{'from_branch'}$from_root has mirrored with conflicts (shown below) and the $h->{'to_branch'}$to_root is now broken.
|
||||
|
||||
THIS REQUIRES YOUR IMMEDIATE ATTENTION.
|
||||
|
||||
You can checkout the conflicted file with the following command:
|
||||
|
||||
cvs co $to_branch_arg $uq_to_dir_file
|
||||
|
||||
If you have any questions please contact Release Engineering.
|
||||
#;
|
||||
&mail($subject, "$body\n$conflict_text");
|
||||
&update_status("conflict");
|
||||
}
|
||||
#
|
||||
# handy dandy little mirror_change status updater function
|
||||
#
|
||||
sub update_status {
|
||||
#-debug-#print Dumper(\@_);
|
||||
&DB::Util::connect();
|
||||
&DB::Update::mirror_change($mirror_id, $change_id, shift);
|
||||
&DB::Util::disconnect();
|
||||
exit 0;
|
||||
}
|
||||
#
|
||||
# convenient little wrapper for MIME::Lite
|
||||
# add a cute little message that contains a dump of all the options/values
|
||||
# passed to this program (might be useful for debugging).
|
||||
#
|
||||
sub mail {
|
||||
my ($subject, $text) = @_;
|
||||
$Data::Dumper::Indent = 1;
|
||||
$Data::Dumper::Terse = 1;
|
||||
$text .= "\n--\n<jedi_mind_trick>\n" .
|
||||
"This is not the information you're looking for.\n" .
|
||||
Dumper($h) .
|
||||
"</jedi_mind_trick>"
|
||||
;
|
||||
my $msg = MIME::Lite->new(
|
||||
From => "$default::admin_address",
|
||||
To => "$user\@bluemartini.com",
|
||||
# Cc => "$default::admin_address",
|
||||
Bcc => "$default::pager_address",
|
||||
Subject => "[CVS-mirror] $subject",
|
||||
Datestamp => 0,
|
||||
Data => "$text",
|
||||
);
|
||||
$msg->send();
|
||||
}
|
||||
#
|
||||
# Cleanup after ourselves since the calling script is running as the
|
||||
# unprivileged mirror user.
|
||||
#
|
||||
END { rmtree $paramref->{'workdir'} };
|
||||
|
||||
__END__
|
||||
@@ -1,29 +0,0 @@
|
||||
#!/usr/local/bin/perl -w
|
||||
use Time::HiRes qw(time);
|
||||
use Data::Dumper;
|
||||
|
||||
use strict;
|
||||
use Sys::Hostname;
|
||||
use FindBin;
|
||||
|
||||
use lib $FindBin::RealBin;
|
||||
|
||||
use config;
|
||||
use DB::Util;
|
||||
use DB::Select;
|
||||
use DB::Update;
|
||||
use DB::Insert;
|
||||
|
||||
my $runtime;
|
||||
|
||||
&DB::Util::connect();
|
||||
$main::host_id = &DB::Util::id("mh_hostname", Sys::Hostname::hostname());
|
||||
$runtime = &DB::Select::runtime($main::host_id);
|
||||
$runtime = &DB::Select::runtime($main::host_id);
|
||||
unless ($::mirror_delay = $runtime->{'mirror_delay'} ) { $::mirror_delay = $default::mirror_delay };
|
||||
unless ($::min_scan_time = $runtime->{'min_scan_time'} ) { $::min_scan_time = $default::min_scan_time };
|
||||
unless ($::throttle_time = $runtime->{'throttle_time'} ) { $::throttle_time = $default::throttle_time };
|
||||
unless ($::max_addcheckins = $runtime->{'max_addcheckins'}) { $::max_addcheckins = $default::max_addcheckins };
|
||||
&DB::Util::disconnect();
|
||||
|
||||
__END__
|
||||
@@ -1,291 +0,0 @@
|
||||
#!/usr/local/bin/perl -w
|
||||
use Time::HiRes qw(time);
|
||||
use Data::Dumper;
|
||||
|
||||
use strict;
|
||||
use Sys::Hostname;
|
||||
use FindBin;
|
||||
|
||||
use lib $FindBin::Bin;
|
||||
|
||||
use config;
|
||||
use proc;
|
||||
use access;
|
||||
use DB::Util;
|
||||
use DB::Select;
|
||||
use DB::Update;
|
||||
use DB::Insert;
|
||||
|
||||
umask 0;
|
||||
#
|
||||
# Need /usr/local/bin in the path since sometimes
|
||||
# diff3 needs to find the gnu version of diff
|
||||
#
|
||||
$ENV{'PATH'}='/usr/local/bin:/usr/bin';
|
||||
#
|
||||
# overload the die function to send me email when things go bad
|
||||
# don't send mail if died in proc.pm since it does it's own error
|
||||
# catching and email bitching.
|
||||
#
|
||||
# TODO: maybe put this in the main loop and get a list of people from
|
||||
# the database to send bitch mail to
|
||||
#
|
||||
#
|
||||
# Trap some signals and send mail to the interested parties
|
||||
#
|
||||
$SIG{HUP} = \&signal_handler;
|
||||
$SIG{INT} = \&signal_handler;
|
||||
$SIG{TERM} = \&signal_handler;
|
||||
$SIG{QUIT} = \&signal_handler;
|
||||
$SIG{SEGV} = \&signal_handler;
|
||||
$SIG{__DIE__} = \&signal_handler;
|
||||
sub signal_handler {
|
||||
my $msg = join "\n--\n", (@_, "mirrord.pl is quitting now.\n");
|
||||
unless ($_[0] =~ /^.* failed at .*proc.pm line \d{1,3}\.$/) {
|
||||
&proc::notify("[CVS-mirror] FATAL ERROR", $msg);
|
||||
}
|
||||
die @_;
|
||||
};
|
||||
#$SIG{__DIE__} = sub {
|
||||
# my $msg = join "\n--\n", (@_, "mirrord.pl is quitting now.\n");
|
||||
# unless ($_[0] =~ /^.* failed at .*proc.pm line \d{1,3}\.$/) {
|
||||
# &proc::notify("[CVS-mirror] FATAL ERROR", $msg);
|
||||
# }
|
||||
# die @_;
|
||||
#};
|
||||
|
||||
my $checkin = {};
|
||||
my $change = {};
|
||||
my $runtime;
|
||||
my $totalops;
|
||||
|
||||
my $mirror_cmd = $FindBin::Bin . "/mirror.pl";
|
||||
my $paramref = {
|
||||
'tmpdir' => '/tmp/mirror',
|
||||
'return' => 'hashref',
|
||||
# 'nomail' => 1,
|
||||
'noop' => 0,
|
||||
# 'log_stdout' => 1,
|
||||
};
|
||||
|
||||
&DB::Util::connect();
|
||||
$main::host_id = &DB::Util::id("mh_hostname", Sys::Hostname::hostname());
|
||||
&DB::Util::disconnect();
|
||||
#
|
||||
# Main loop
|
||||
#
|
||||
while (1) {
|
||||
my $loopstart = time;
|
||||
my $lastcommand = defined $runtime->{'command'} ? $runtime->{'command'} : "";
|
||||
&DB::Util::connect();
|
||||
#
|
||||
# fetch some operating parameters from the database
|
||||
#
|
||||
$runtime = &DB::Select::runtime($main::host_id);
|
||||
unless ($::mirror_delay = $runtime->{'mirror_delay'} ) { $::mirror_delay = $default::mirror_delay };
|
||||
unless ($::min_scan_time = $runtime->{'min_scan_time'} ) { $::min_scan_time = $default::min_scan_time };
|
||||
unless ($::throttle_time = $runtime->{'throttle_time'} ) { $::throttle_time = $default::throttle_time };
|
||||
unless ($::max_addcheckins = $runtime->{'max_addcheckins'}) { $::max_addcheckins = $default::max_addcheckins };
|
||||
#
|
||||
# Send some mail when the command changes
|
||||
#
|
||||
if (defined $runtime->{'command'} && $runtime->{'command'} ne $lastcommand ) {
|
||||
&proc::notify("[CVS-mirror] $runtime->{'command'}", "");
|
||||
};
|
||||
#
|
||||
# log an acknowledgement in the database and shutdown if the 'command' parameter = exit
|
||||
#
|
||||
if (defined $runtime->{'command'} && $runtime->{'command'} =~ m/exit/i ) {
|
||||
&DB::Update::runtime($runtime->{'response'}, $runtime->{'id'}) if defined $runtime->{'id'};
|
||||
last;
|
||||
};
|
||||
#
|
||||
# if 'command' != pause, acknowledge and start gathering mirror information
|
||||
#
|
||||
unless (defined $runtime->{'command'} && $runtime->{'command'} =~ m/pause/i) {
|
||||
&DB::Update::runtime($runtime->{'response'}, $runtime->{'id'}) if defined $runtime->{'id'};
|
||||
#print "running...\nlast_update = $runtime->{'last_update'}\n";
|
||||
#
|
||||
# Get a copy of the accessconfig from the database. (used later to prevent attempting
|
||||
# to mirror to a branch/module/directory/file that is closed)
|
||||
#
|
||||
my $accessconfig = eval &DB::Util::retrieve("expanded_accessconfig");
|
||||
#
|
||||
# get a list(ref) of mirrors currently labelled as 'pending'
|
||||
#
|
||||
my $mirrors = &DB::Select::mirrors('pending');
|
||||
#
|
||||
# loop over the mirror list
|
||||
#
|
||||
for my $m (@$mirrors) {
|
||||
#
|
||||
# extract data from mirror reference and store it in convenience variables
|
||||
#
|
||||
my $mid = $m->[0];
|
||||
my $cid = $m->[1];
|
||||
my $to_branch = $m->[2];
|
||||
my $to_cvsroot = $m->[3];
|
||||
my $offset = $m->[4];
|
||||
#
|
||||
# gather information about the checkin that produced this mirror object
|
||||
# and cache it since it will likely be used by another mirror object in the list
|
||||
#
|
||||
$checkin->{$cid} = &DB::Select::checkin($cid) unless defined $checkin->{$cid};
|
||||
#
|
||||
# store the checkin info in convenience variables
|
||||
#
|
||||
my $directory = $checkin->{$cid}->{'directory'};
|
||||
my $user = $checkin->{$cid}->{'user'};
|
||||
my $log = $checkin->{$cid}->{'log'};
|
||||
my $from_cvsroot = $checkin->{$cid}->{'cvsroot'};
|
||||
#
|
||||
# gather a list of changes from the source checkin that apply to this mirror
|
||||
#
|
||||
my $mirror_changes = &DB::Select::mirror_changes("pending", $mid);
|
||||
#
|
||||
# loop over the changes for this mirror object
|
||||
#
|
||||
for my $mc (@$mirror_changes) {
|
||||
#
|
||||
# extract information about the mirror-change, and store in blah blah blah...
|
||||
#
|
||||
my $chid = $mc->[0];
|
||||
my $action = $mc->[1];
|
||||
#
|
||||
# gather info about this particular change and cache it...
|
||||
#
|
||||
$change->{$chid} = &DB::Select::change($chid) unless defined $change->{$chid};
|
||||
#
|
||||
# extract into convenience variables
|
||||
#
|
||||
my $file = $change->{$chid}->{'file'};
|
||||
my $oldrev = $change->{$chid}->{'oldrev'};
|
||||
my $newrev = $change->{$chid}->{'newrev'};
|
||||
my $from_branch = $change->{$chid}->{'branch'};
|
||||
#
|
||||
# Check to see if to_branch has been EOL'd, if so, update the mirror_change status
|
||||
# send a friendly reminder to the cvs administrator that he/she sucks. (Oh, and don't
|
||||
# mirror this change).
|
||||
#
|
||||
if (@{&DB::Select::branch_eol($to_cvsroot, $to_branch)}) {
|
||||
print "EOL BRANCH = ", @{&DB::Select::branch_eol($to_cvsroot, $to_branch)}, "\n";
|
||||
&DB::Update::mirror_change($mid, $chid, 'to_branch_eol');
|
||||
&proc::notify("[CVS-mirror] warning - to_branch_eol",
|
||||
"An attempt was made to mirror $directory/$file from $from_cvsroot:$from_branch " .
|
||||
"to $to_cvsroot:$to_branch (oldrev = $oldrev, newrev = $newrev, offset = \"$offset\")." .
|
||||
"\n\nYou've likely EOL'd a branch and forgot to update your mirror rules. " .
|
||||
"\n\n\tcheckin_id = $cid\n\tchange_id = $chid\n\tmirror_id = $mid" .
|
||||
"\n\taction = $action\n\tuser = $user\n\tlog message = $log\n\n" .
|
||||
"\n-- Your loving and ever-present MirrorHandler"
|
||||
);
|
||||
next;
|
||||
print "--> branch eol\n";
|
||||
}
|
||||
#
|
||||
# Ckeck to see if the repository is open before proceeding (blessed users are NOT mirrored)
|
||||
#
|
||||
#my $pre = time;
|
||||
next if &access::closed($accessconfig, $to_cvsroot, $to_branch, $directory, $file);
|
||||
#my $post = time;
|
||||
#print "--> $to_cvsroot, $to_branch, $directory, $file -- ", $post - $pre, "\n";
|
||||
print "--> $to_cvsroot, $to_branch, $directory, $file\n";
|
||||
#
|
||||
# if we are using the old bonsai on this machine, lets limit the number of
|
||||
# addcheckin.pl process that are spawned, since each addcheckin.pl uses about
|
||||
# 8MB of RAM.
|
||||
#
|
||||
print "--> addcheckin.pl count: ", &proc::addcheckin_count(), "\n";
|
||||
sleep $::throttle_time while (&proc::addcheckin_count() > $::max_addcheckins);
|
||||
#
|
||||
# TODO: Check that mirror is still valid before proceeding. There is the possiblilty that the
|
||||
# mirror rules may have changed between the time of the source checkin and the execution of the
|
||||
# mirror, if so I should detect it and marke the mirror-change as 'mirror_rule_cancelled' or
|
||||
# some such.
|
||||
#
|
||||
#
|
||||
# build up the command that we will call to mirror this change.
|
||||
# We are using 'sudo' so that we can run mirrord.pl as an unprivileged user
|
||||
# and still execute cvs and patch/diff as the person who initially performed
|
||||
# the checkin.
|
||||
#
|
||||
# we pass checkin/mirror metadata (mirror_id and change_id) so that mirror_cmd
|
||||
# can update the database appropriately. logging is good.
|
||||
#
|
||||
my $cmd =
|
||||
"sudo -u " . quotemeta($user)
|
||||
. " " . quotemeta($mirror_cmd)
|
||||
. " --mirror_id=" . quotemeta($mid)
|
||||
. " --change_id=" . quotemeta($chid)
|
||||
. " --action=" . quotemeta($action)
|
||||
. " --user=" . quotemeta($user)
|
||||
. " --from_branch=" . quotemeta($from_branch)
|
||||
. " --from_cvsroot=" . quotemeta($from_cvsroot)
|
||||
. " --to_branch=" . quotemeta($to_branch)
|
||||
. " --to_cvsroot=" . quotemeta($to_cvsroot)
|
||||
. " --offset=" . quotemeta($offset)
|
||||
. " --directory=" . quotemeta($directory)
|
||||
. " --file=" . quotemeta($file)
|
||||
. " --oldrev=" . quotemeta($oldrev)
|
||||
. " --newrev=" . quotemeta($newrev)
|
||||
. " --log=" . quotemeta($log)
|
||||
;
|
||||
#
|
||||
# execute cmd using our googfy little system wrapper so that we can trap
|
||||
# runtime errors, capture stdout/stderr, send bitch mail, etc.
|
||||
#
|
||||
print "\n$cmd\n\n";
|
||||
my $result = &proc::run($cmd, $paramref);
|
||||
#print Dumper($result);
|
||||
#
|
||||
# associate the log entry (if produced) with this mirror-change
|
||||
#
|
||||
&DB::Insert::mirror_change_exec_map( $mid, $chid, $result->{'log_id'}) if defined $result->{'log_id'};
|
||||
#
|
||||
# mark the mirror-change status as 'error' if a non-zero exit status was rerurned, the process
|
||||
# terminated as the result of receiving a signal, or if it core dumped.
|
||||
#
|
||||
if ($result->{'stderr'} || $result->{'exit_value'} || $result->{'signal_num'} || $result->{'dumped_core'}) {
|
||||
&DB::Update::mirror_change($mid, $chid, 'error');
|
||||
}
|
||||
}
|
||||
#
|
||||
# get a count of changes that are still marked as pending (likely due to a branch closure) or that
|
||||
# experienced an error. If no pending or error changes, mark this mirror object as complete.
|
||||
#
|
||||
my $not_mirrored = scalar @{&DB::Select::mirror_changes("pending", $mid)};
|
||||
my $errors = scalar @{&DB::Select::mirror_changes("error", $mid)};
|
||||
&DB::Update::mirror($mid, 'complete') unless ($not_mirrored || $errors);
|
||||
#print "*** changes still pending = $not_mirrored\n";
|
||||
#print "*** changes with errors = $errors\n";
|
||||
#$totalops += scalar @$mirror_changes;
|
||||
#print "changes details -- ", Dumper($checkin);
|
||||
#print "checkins -- ", scalar keys %$checkin, "\n";
|
||||
#print "changes -- ", scalar keys %$change, "\n";
|
||||
#print "mirrors -- ", scalar @$mirrors, "\n" if $mirrors;
|
||||
#print "totalops -- ", $totalops, "\n" if $totalops;
|
||||
}
|
||||
} else {
|
||||
#
|
||||
# acknowledge the 'pause' command
|
||||
#
|
||||
&DB::Update::runtime($runtime->{'response'}, $runtime->{'id'}) if defined $runtime->{'id'};
|
||||
print "paused...\n";
|
||||
}
|
||||
&DB::Util::disconnect();
|
||||
my $looptime = time - $loopstart;
|
||||
print "--> mirror loop duration: $looptime seconds.\n";
|
||||
$checkin = {};
|
||||
$change = {};
|
||||
#
|
||||
# sleep a bit, if we finished before the min_scan_time so that we don;t needlessly trash the db and network
|
||||
#
|
||||
if ($looptime < $::min_scan_time) {
|
||||
print "--> Sleeping for ", $::min_scan_time - $looptime, " seconds.\n\n";
|
||||
sleep $::min_scan_time - $looptime;
|
||||
}
|
||||
}
|
||||
|
||||
print "exiting...\n";
|
||||
&DB::Util::disconnect();
|
||||
|
||||
__END__
|
||||
@@ -1,265 +0,0 @@
|
||||
package proc;
|
||||
|
||||
use strict;
|
||||
use Data::Dumper;
|
||||
use Time::HiRes qw(time);
|
||||
use File::Path;
|
||||
use FindBin;
|
||||
use File::Basename;
|
||||
use Cwd;
|
||||
use MIME::Lite;
|
||||
|
||||
#
|
||||
# Simulate try-catch-finally block (these subs need to be before the rest
|
||||
# or perl pitches a bitch. Example syntax:
|
||||
#
|
||||
# try {
|
||||
# <some perl that can fail or that has an "or die">
|
||||
# } and catch {
|
||||
# <some perl code to execute if the code in the above try block generated an error>
|
||||
# } or finally {
|
||||
# <some code to always execute regardless of errors (i'm not sure when to ever use this)>
|
||||
# };
|
||||
#
|
||||
# the trailing ";" *IS* required, unlike other blocks.
|
||||
#
|
||||
|
||||
sub try (&) {
|
||||
my $code = shift;
|
||||
eval { &{$code} };
|
||||
¬ify("[CVS-mirror]: non-fatal error", $@) if $@;
|
||||
}
|
||||
|
||||
sub catch (&) {
|
||||
my $code = shift;
|
||||
eval { &{$code} };
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub finally (&) {
|
||||
my $code = shift;
|
||||
eval { &{$code} };
|
||||
}
|
||||
|
||||
sub run {
|
||||
my ($cmd, $href) = @_;
|
||||
my ($return);
|
||||
my ($tmpdir, $workdir, $homedir, $debug, $noop, $nomail, $log_always, $log_stdout, $keep_dir, $exit_code);
|
||||
print "#-debug-# ",Dumper($href) if $href->{"debug"};
|
||||
#
|
||||
# define defaults for options
|
||||
#
|
||||
unless ($tmpdir = $href->{"tmpdir"} ) { $tmpdir = cwd }
|
||||
unless ($workdir = $href->{"workdir"} ) { $workdir = $tmpdir."/".$FindBin::Script."-".time."-".$$ }
|
||||
unless ($homedir = $href->{"homedir"} ) { $homedir = cwd }
|
||||
unless ($debug = $href->{"debug"} ) { $debug = 0 }
|
||||
unless ($noop = $href->{"noop"} ) { $noop = 0 }
|
||||
unless ($nomail = $href->{"nomail"} ) { $nomail = 0 }
|
||||
unless ($log_always = $href->{"log_always"}) { $log_always = 0 }
|
||||
unless ($log_stdout = $href->{"log_stdout"}) { $log_stdout = 0 }
|
||||
unless ($keep_dir = $href->{"keep_dir"} ) { $keep_dir = 0 }
|
||||
unless ($return->{'type'} = $href->{"return"}) { $return->{'type'} = 'array' }
|
||||
if ($debug) {
|
||||
print "#-debug-# tmpdir:\t$tmpdir\n";
|
||||
print "#-debug-# workdir:\t$workdir\n";
|
||||
print "#-debug-# homedir:\t$homedir\n";
|
||||
print "#-debug-# debug:\t$debug\n";
|
||||
print "#-debug-# noop: \t$noop\n";
|
||||
print "#-debug-# nomail:\t$nomail\n";
|
||||
print "#-debug-# log_always:\t$log_always\n";
|
||||
print "#-debug-# log_stdout:\t$log_stdout\n";
|
||||
print "#-debug-# keep_dir:\t$keep_dir\n";
|
||||
print "#-debug-# return type:\t$return->{'type'}\n";
|
||||
}
|
||||
#
|
||||
# reformat command
|
||||
#
|
||||
my $ocmd = $cmd;
|
||||
$cmd = "echo" if $noop;
|
||||
$cmd = "(".$cmd.") 1>stdout 2>stderr";
|
||||
#
|
||||
# make workdir and chdir into it
|
||||
#
|
||||
print "#-debug-# started from:\t".cwd."\n" if $debug;
|
||||
unless ($href->{'workdir'} && $keep_dir && -d $workdir) {
|
||||
try {
|
||||
mkpath $workdir, $debug or die "\nfailed to create \"$workdir\": $!\n";
|
||||
} and catch {
|
||||
$return->{'stderr'} .= "\nfailed to create \"$workdir\"\n";
|
||||
$return->{'exit_value'} += 666;
|
||||
goto RETURN;
|
||||
};
|
||||
}
|
||||
try {
|
||||
chdir $workdir or die "failed to chdir to \"$workdir\": $!\n";
|
||||
} and catch {
|
||||
$return->{'stderr'} .= "\nfailed to chdir to \"$workdir\": $!\n";
|
||||
$return->{'exit_value'} += 666;
|
||||
goto RETURN;
|
||||
};
|
||||
print "#-debug-# working in:\t".cwd."\n" if $debug;
|
||||
#
|
||||
# execute command and record exit status
|
||||
#
|
||||
print "#-debug-# executing:\t$cmd\n" if $debug;
|
||||
print ("#-debug-# send mail:\t", $nomail?"no":"yes","\n") if $debug;
|
||||
unless ($nomail) {
|
||||
try {
|
||||
$exit_code = system($cmd) and die "\"$cmd\" failed";
|
||||
}
|
||||
} else {
|
||||
$exit_code = system($cmd);
|
||||
}
|
||||
$return->{'exit_value'} = $exit_code >> 8;
|
||||
$return->{'signal_num'} = $exit_code & 127;
|
||||
$return->{'dumped_core'} = $exit_code & 128;
|
||||
#
|
||||
# record STDOUT
|
||||
#
|
||||
try {
|
||||
open(OUT, "<stdout") or die "failed to open \"$workdir/stdout\": $!\n";
|
||||
} and catch {
|
||||
$return->{'stderr'} .= "\nfailed to open \"$workdir/stdout\"\n";
|
||||
$return->{'exit_value'} += 666;
|
||||
goto RETURN;
|
||||
};
|
||||
while (<OUT>) { $return->{'stdout'} .= $_ }
|
||||
try {
|
||||
close(OUT) or die "failed to close \"$workdir/stdout\": $!\n";
|
||||
} and catch {
|
||||
$return->{'stderr'} .= "\nfailed to close \"$workdir/stdout\"\n";
|
||||
};
|
||||
try {
|
||||
unlink "stdout" or die "failed to delete \"$workdir/stdout\"\n";
|
||||
} and catch {
|
||||
$return->{'stderr'} .= "\nfailed to delete \"$workdir/stdout\"\n";
|
||||
};
|
||||
#
|
||||
# record STDERR
|
||||
#
|
||||
try {
|
||||
open(ERR, "<stderr") or die "failed to open \"$workdir/stderr\": $!\n";
|
||||
} and catch {
|
||||
$return->{'stderr'} .= "\nfailed to open \"$workdir/stderr\"\n";
|
||||
$return->{'exit_value'} += 666;
|
||||
goto RETURN;
|
||||
};
|
||||
while (<ERR>) { $return->{'stderr'} .= $_ }
|
||||
try {
|
||||
close(ERR) or die "failed to close \"$workdir/stderr\": $!\n";
|
||||
} and catch {
|
||||
$return->{'stderr'} .= "\nfailed to close \"$workdir/stderr\"\n";
|
||||
};
|
||||
try {
|
||||
unlink "stderr" or die "failed to delete \"$workdir/stderr\"\n";
|
||||
} and catch {
|
||||
$return->{'stderr'} .= "\nfailed to delete \"$workdir/stderr\"\n";
|
||||
};
|
||||
#
|
||||
# return to homedir
|
||||
#
|
||||
try {
|
||||
chdir $homedir or die "failed to chdir to \"$homedir\": $!\n";
|
||||
} and catch {
|
||||
$return->{'stderr'} .= "\nfailed to chdir to \"$homedir\"\n";
|
||||
};
|
||||
print "#-debug-# returned to:\t".cwd."\n" if $debug;
|
||||
#
|
||||
# cleanup workdir unless we're directed to keep it
|
||||
#
|
||||
unless ($keep_dir) {
|
||||
try { rmtree $workdir or die "failed to delete \"$workdir\": $!\n" };
|
||||
}
|
||||
#
|
||||
# Return stdout, stderr, and exit status in the form requested.
|
||||
# Bitch and die, if an invalid form was requested
|
||||
#
|
||||
RETURN:
|
||||
if ($log_always) {
|
||||
$return->{'log_id'} = &log($ocmd, $return);
|
||||
} elsif ($log_stdout &&
|
||||
$return->{'stdout'} ||
|
||||
$return->{'stderr'} ||
|
||||
$return->{'exit_value'} ||
|
||||
$return->{'signal_num'} ||
|
||||
$return->{'dumped_core'}) {
|
||||
$return->{'log_id'} = &log($ocmd, $return);
|
||||
} elsif ($return->{'stderr'} ||
|
||||
$return->{'exit_value'} ||
|
||||
$return->{'signal_num'} ||
|
||||
$return->{'dumped_core'}) {
|
||||
$return->{'log_id'} = &log($ocmd, $return);
|
||||
} else {
|
||||
# don't log anything
|
||||
}
|
||||
if ($return->{'type'} =~ /^array$|^list$/i) {
|
||||
return (
|
||||
$return->{'stdout'},
|
||||
$return->{'stderr'},
|
||||
$return->{'exit_value'},
|
||||
$return->{'signal_num'},
|
||||
$return->{'dumped_core'},
|
||||
$return->{'log_id'}
|
||||
);
|
||||
} elsif ($return->{'type'} =~ /^arrayref$|^listref$/i) {
|
||||
return [
|
||||
$return->{'stdout'},
|
||||
$return->{'stderr'},
|
||||
$return->{'exit_value'},
|
||||
$return->{'signal_num'},
|
||||
$return->{'dumped_core'},
|
||||
$return->{'log_id'}
|
||||
];
|
||||
} elsif ($return->{'type'} =~ /^hashref$/i) {
|
||||
delete $return->{'type'};
|
||||
return $return ;
|
||||
} elsif ($return->{'type'} =~ /^hash$/i) {
|
||||
delete $return->{'type'};
|
||||
return %$return ;
|
||||
} else {
|
||||
try { die (
|
||||
"Invalid return type requested ($return->{'type'}).\n",
|
||||
"Valid return types are:\n",
|
||||
"\tARRAY or LIST (default)\n",
|
||||
"\tHASH\n",
|
||||
"\tARRAYREF or LISTREF\n",
|
||||
"\tHASHREF\n\n",
|
||||
);
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
sub log {
|
||||
my ($cmd, $h) = @_;
|
||||
return &DB::Insert::exec_log(
|
||||
$cmd,
|
||||
$h->{'stdout'},
|
||||
$h->{'stderr'},
|
||||
$h->{'exit_value'},
|
||||
$h->{'signal_num'},
|
||||
$h->{'dumped_core'}
|
||||
);
|
||||
}
|
||||
|
||||
sub notify {
|
||||
#
|
||||
# TODO: make the from/to headers variables
|
||||
#
|
||||
my ($subject, $text) = @_;
|
||||
my $msg = MIME::Lite->new(
|
||||
From => $default::admin_address,
|
||||
To => $default::pager_address,
|
||||
Subject => $subject,
|
||||
Datestamp => 0,
|
||||
Data => $text
|
||||
);
|
||||
$msg->send();
|
||||
}
|
||||
|
||||
sub addcheckin_count {
|
||||
my $count = `ps -ef | grep -c "[a]ddcheckin\.pl"`;
|
||||
chomp $count;
|
||||
return $count;
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -1,19 +0,0 @@
|
||||
# phpMyAdmin MySQL-Dump
|
||||
# version 2.2.1
|
||||
# http://phpwizard.net/phpMyAdmin/
|
||||
# http://phpmyadmin.sourceforge.net/ (download page)
|
||||
#
|
||||
# Host: bonsai2
|
||||
# Generation Time: Feb 12, 2002 at 10:02 PM
|
||||
# Server version: 3.23.46
|
||||
# PHP Version: 4.0.3pl1
|
||||
# Database : `bonsai`
|
||||
|
||||
#
|
||||
# Dumping data for table `mh_command`
|
||||
#
|
||||
|
||||
INSERT INTO `mh_command` VALUES (1, 'run');
|
||||
INSERT INTO `mh_command` VALUES (2, 'pause');
|
||||
INSERT INTO `mh_command` VALUES (3, 'exit');
|
||||
|
||||
@@ -1,32 +0,0 @@
|
||||
# phpMyAdmin MySQL-Dump
|
||||
# version 2.2.1
|
||||
# http://phpwizard.net/phpMyAdmin/
|
||||
# http://phpmyadmin.sourceforge.net/ (download page)
|
||||
#
|
||||
# Host: bonsai2
|
||||
# Generation Time: Feb 12, 2002 at 10:00 PM
|
||||
# Server version: 3.23.46
|
||||
# PHP Version: 4.0.3pl1
|
||||
# Database : `bonsai`
|
||||
|
||||
#
|
||||
# Dumping data for table `status`
|
||||
#
|
||||
|
||||
INSERT INTO `status` VALUES (1, 'pending');
|
||||
INSERT INTO `status` VALUES (2, 'nomirror');
|
||||
INSERT INTO `status` VALUES (3, 'complete');
|
||||
INSERT INTO `status` VALUES (4, 'cvs_merge');
|
||||
INSERT INTO `status` VALUES (5, 'error');
|
||||
INSERT INTO `status` VALUES (6, 'to_branch_eol');
|
||||
INSERT INTO `status` VALUES (7, 'missing');
|
||||
INSERT INTO `status` VALUES (8, 'prev_add_same');
|
||||
INSERT INTO `status` VALUES (9, 'prev_rm');
|
||||
INSERT INTO `status` VALUES (10, 'prev_add_different');
|
||||
INSERT INTO `status` VALUES (11, 'conflict');
|
||||
INSERT INTO `status` VALUES (12, 'diff_patch');
|
||||
INSERT INTO `status` VALUES (13, 'noop');
|
||||
INSERT INTO `status` VALUES (14, 'diff3_merge');
|
||||
INSERT INTO `status` VALUES (15, 'non_merge_overwrite');
|
||||
INSERT INTO `status` VALUES (16, 'building_mirror');
|
||||
|
||||
@@ -1,377 +0,0 @@
|
||||
# phpMyAdmin MySQL-Dump
|
||||
# version 2.2.1
|
||||
# http://phpwizard.net/phpMyAdmin/
|
||||
# http://phpmyadmin.sourceforge.net/ (download page)
|
||||
#
|
||||
# Host: bonsai2
|
||||
# Generation Time: Feb 12, 2002 at 09:31 PM
|
||||
# Server version: 3.23.46
|
||||
# PHP Version: 4.0.3pl1
|
||||
# Database : `bonsai`
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `accessconfig`
|
||||
#
|
||||
|
||||
CREATE TABLE `accessconfig` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`time` timestamp(14) NOT NULL,
|
||||
`cvsroot_id` int(10) unsigned NOT NULL default '0',
|
||||
`rev` varchar(128) NOT NULL default '',
|
||||
`value` mediumtext NOT NULL,
|
||||
PRIMARY KEY (`id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `branch`
|
||||
#
|
||||
|
||||
CREATE TABLE `branch` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` varchar(64) binary NOT NULL default '',
|
||||
PRIMARY KEY (`id`),
|
||||
UNIQUE KEY `value` (`value`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `change`
|
||||
#
|
||||
|
||||
CREATE TABLE `change` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`checkin_id` int(10) unsigned NOT NULL default '0',
|
||||
`file_id` int(10) unsigned NOT NULL default '0',
|
||||
`oldrev` varchar(128) NOT NULL default '',
|
||||
`newrev` varchar(128) NOT NULL default '',
|
||||
`branch_id` int(10) unsigned NOT NULL default '0',
|
||||
PRIMARY KEY (`id`),
|
||||
KEY `checkin_id` (`checkin_id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `checkin`
|
||||
#
|
||||
|
||||
CREATE TABLE `checkin` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`user_id` int(10) unsigned NOT NULL default '0',
|
||||
`time` int(10) unsigned NOT NULL default '0',
|
||||
`directory_id` int(10) unsigned NOT NULL default '0',
|
||||
`log_id` int(10) unsigned NOT NULL default '0',
|
||||
`cvsroot_id` int(10) unsigned NOT NULL default '0',
|
||||
PRIMARY KEY (`id`),
|
||||
KEY `time` (`time`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `cvsroot`
|
||||
#
|
||||
|
||||
CREATE TABLE `cvsroot` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` varchar(128) binary NOT NULL default '',
|
||||
PRIMARY KEY (`id`),
|
||||
UNIQUE KEY `value` (`value`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `cvsroot_branch_map_eol`
|
||||
#
|
||||
|
||||
CREATE TABLE `cvsroot_branch_map_eol` (
|
||||
`cvsroot_id` int(10) unsigned NOT NULL default '0',
|
||||
`branch_id` int(10) unsigned NOT NULL default '0',
|
||||
`timestamp` timestamp(14) NOT NULL,
|
||||
PRIMARY KEY (`cvsroot_id`,`branch_id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `directory`
|
||||
#
|
||||
|
||||
CREATE TABLE `directory` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` varchar(128) binary NOT NULL default '',
|
||||
PRIMARY KEY (`id`),
|
||||
UNIQUE KEY `value` (`value`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `exec_log`
|
||||
#
|
||||
|
||||
CREATE TABLE `exec_log` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`time` int(10) unsigned NOT NULL default '0',
|
||||
`command` text NOT NULL,
|
||||
`stdout` mediumtext,
|
||||
`stderr` mediumtext,
|
||||
`exit_value` smallint(5) unsigned default '0',
|
||||
`signal_num` tinyint(3) unsigned default '0',
|
||||
`dumped_core` tinyint(3) unsigned default '0',
|
||||
PRIMARY KEY (`id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `expanded_accessconfig`
|
||||
#
|
||||
|
||||
CREATE TABLE `expanded_accessconfig` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`time` timestamp(14) NOT NULL,
|
||||
`value` mediumtext NOT NULL,
|
||||
PRIMARY KEY (`id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `expanded_mirrorconfig`
|
||||
#
|
||||
|
||||
CREATE TABLE `expanded_mirrorconfig` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`time` timestamp(14) NOT NULL,
|
||||
`value` mediumtext NOT NULL,
|
||||
PRIMARY KEY (`id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `file`
|
||||
#
|
||||
|
||||
CREATE TABLE `file` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` varchar(128) binary NOT NULL default '',
|
||||
PRIMARY KEY (`id`),
|
||||
UNIQUE KEY `value` (`value`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `group`
|
||||
#
|
||||
|
||||
CREATE TABLE `group` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` varchar(64) binary NOT NULL default '',
|
||||
PRIMARY KEY (`id`),
|
||||
UNIQUE KEY `value` (`value`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `group_user_map`
|
||||
#
|
||||
|
||||
CREATE TABLE `group_user_map` (
|
||||
`group_id` int(10) unsigned NOT NULL default '0',
|
||||
`user_id` int(10) unsigned NOT NULL default '0'
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `log`
|
||||
#
|
||||
|
||||
CREATE TABLE `log` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` text NOT NULL,
|
||||
PRIMARY KEY (`id`),
|
||||
KEY `value` (`value`(25))
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `loginfo_performance`
|
||||
#
|
||||
|
||||
CREATE TABLE `loginfo_performance` (
|
||||
`checkin_id` int(10) unsigned NOT NULL default '0',
|
||||
`time` float unsigned NOT NULL default '0',
|
||||
PRIMARY KEY (`checkin_id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `mh_command`
|
||||
#
|
||||
|
||||
CREATE TABLE `mh_command` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` varchar(32) NOT NULL default '',
|
||||
PRIMARY KEY (`id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `mh_hostname`
|
||||
#
|
||||
|
||||
CREATE TABLE `mh_hostname` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` varchar(64) NOT NULL default '',
|
||||
PRIMARY KEY (`id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `mh_runtime_info`
|
||||
#
|
||||
|
||||
CREATE TABLE `mh_runtime_info` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`time` int(10) unsigned NOT NULL default '0',
|
||||
`last_update` timestamp(14) NOT NULL,
|
||||
`mh_hostname_id` int(10) unsigned NOT NULL default '0',
|
||||
`mh_command_id` int(10) unsigned NOT NULL default '0',
|
||||
`mh_command_response` int(10) unsigned NOT NULL default '0',
|
||||
`mirror_delay` smallint(5) unsigned NOT NULL default '0',
|
||||
`min_scan_time` smallint(5) unsigned NOT NULL default '0',
|
||||
`throttle_time` smallint(5) unsigned NOT NULL default '0',
|
||||
`max_addcheckins` smallint(5) unsigned NOT NULL default '0',
|
||||
PRIMARY KEY (`id`),
|
||||
KEY `id` (`id`,`time`,`mh_hostname_id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `mirror`
|
||||
#
|
||||
|
||||
CREATE TABLE `mirror` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`checkin_id` int(10) unsigned NOT NULL default '0',
|
||||
`branch_id` int(10) unsigned NOT NULL default '0',
|
||||
`cvsroot_id` int(10) unsigned NOT NULL default '0',
|
||||
`offset_id` int(10) unsigned NOT NULL default '0',
|
||||
`status_id` int(10) unsigned NOT NULL default '0',
|
||||
PRIMARY KEY (`id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `mirror_change_exec_map`
|
||||
#
|
||||
|
||||
CREATE TABLE `mirror_change_exec_map` (
|
||||
`mirror_id` int(10) unsigned NOT NULL default '0',
|
||||
`change_id` int(10) unsigned NOT NULL default '0',
|
||||
`exec_log_id` int(10) unsigned NOT NULL default '0'
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `mirror_change_map`
|
||||
#
|
||||
|
||||
CREATE TABLE `mirror_change_map` (
|
||||
`mirror_id` int(10) unsigned NOT NULL default '0',
|
||||
`change_id` int(10) unsigned NOT NULL default '0',
|
||||
`type_id` int(10) unsigned NOT NULL default '0',
|
||||
`status_id` int(10) unsigned NOT NULL default '0',
|
||||
KEY `mirror_id` (`mirror_id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `mirrorconfig`
|
||||
#
|
||||
|
||||
CREATE TABLE `mirrorconfig` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`time` timestamp(14) NOT NULL,
|
||||
`cvsroot_id` int(10) unsigned NOT NULL default '0',
|
||||
`rev` varchar(128) NOT NULL default '',
|
||||
`value` mediumtext NOT NULL,
|
||||
PRIMARY KEY (`id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `modules`
|
||||
#
|
||||
|
||||
CREATE TABLE `modules` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`time` timestamp(14) NOT NULL,
|
||||
`cvsroot_id` int(10) unsigned NOT NULL default '0',
|
||||
`rev` varchar(128) NOT NULL default '',
|
||||
`value` mediumtext NOT NULL,
|
||||
PRIMARY KEY (`id`),
|
||||
KEY `cvsroot_id` (`cvsroot_id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `offset`
|
||||
#
|
||||
|
||||
CREATE TABLE `offset` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` varchar(128) binary NOT NULL default '',
|
||||
PRIMARY KEY (`id`),
|
||||
UNIQUE KEY `value` (`value`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `status`
|
||||
#
|
||||
|
||||
CREATE TABLE `status` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` varchar(32) binary NOT NULL default '',
|
||||
PRIMARY KEY (`id`),
|
||||
UNIQUE KEY `value` (`value`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `temp_commitinfo`
|
||||
#
|
||||
|
||||
CREATE TABLE `temp_commitinfo` (
|
||||
`cwd` varchar(255) NOT NULL default '',
|
||||
`user_id` int(10) unsigned NOT NULL default '0',
|
||||
`time` int(10) unsigned NOT NULL default '0',
|
||||
`directory_id` int(10) unsigned NOT NULL default '0',
|
||||
`cvsroot_id` int(10) unsigned NOT NULL default '0',
|
||||
`files` text NOT NULL,
|
||||
`status` varchar(32) NOT NULL default '',
|
||||
PRIMARY KEY (`cwd`,`user_id`,`time`,`directory_id`,`cvsroot_id`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `type`
|
||||
#
|
||||
|
||||
CREATE TABLE `type` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` varchar(16) binary NOT NULL default '',
|
||||
PRIMARY KEY (`id`),
|
||||
UNIQUE KEY `value` (`value`)
|
||||
) TYPE=MyISAM;
|
||||
# --------------------------------------------------------
|
||||
|
||||
#
|
||||
# Table structure for table `user`
|
||||
#
|
||||
|
||||
CREATE TABLE `user` (
|
||||
`id` int(10) unsigned NOT NULL auto_increment,
|
||||
`value` varchar(32) NOT NULL default '',
|
||||
PRIMARY KEY (`id`),
|
||||
UNIQUE KEY `value` (`value`)
|
||||
) TYPE=MyISAM;
|
||||
|
||||
@@ -1,805 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# cvsblame.cgi -- cvsblame with logs as popups and allowing html in comments.
|
||||
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
# Created: Steve Lamm <slamm@netscape.com>, 12-Sep-97.
|
||||
# Modified: Marc Byrd <byrd@netscape.com> , 19971030.
|
||||
#
|
||||
# Arguments (passed via GET or POST):
|
||||
# file - path to file name (e.g. ns/cmd/xfe/Makefile)
|
||||
# root - cvs root (e.g. /warp/webroot)
|
||||
# - default includes /m/src/ and /h/rodan/cvs/repository/1.0
|
||||
# rev - revision (default is the latest version)
|
||||
# line_nums - boolean for line numbers on/off (use 1,0).
|
||||
# (1,on by default)
|
||||
# use_html - boolean for html comments on/off (use 1,0).
|
||||
# (0,off by default)
|
||||
# sanitize - path to sanitization dictionary
|
||||
# (e.g. /warp2/webdoc/projects/bonsai/dictionary/sanitization.db)
|
||||
# mark - highlight a line
|
||||
#
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::progname;
|
||||
$zz = $::revision_ctime;
|
||||
$zz = $::revision_log;
|
||||
}
|
||||
|
||||
require 'CGI.pl';
|
||||
require 'cvsblame.pl';
|
||||
require 'lloydcgi.pl';
|
||||
use SourceChecker;
|
||||
|
||||
# Cope with the cookie and print the header, first thing. That way, if
|
||||
# any errors result, they will show up for the user.
|
||||
|
||||
print "Content-Type:text/html\n";
|
||||
if ($ENV{REQUEST_METHOD} eq 'POST' and defined $::FORM{set_line}) {
|
||||
# Expire the cookie 5 months from now
|
||||
print "Set-Cookie: line_nums=$::FORM{set_line}; expires="
|
||||
. toGMTString(time + 86400 * 152) . "; path=/\n";
|
||||
}
|
||||
|
||||
# Some Globals
|
||||
#
|
||||
my $Head = 'CVS Blame';
|
||||
my $SubHead = '';
|
||||
|
||||
my @src_roots = getRepositoryList();
|
||||
|
||||
# Init sanitiazation source checker
|
||||
#
|
||||
my $sanitization_dictionary = $::FORM{sanitize};
|
||||
my $opt_sanitize = defined $sanitization_dictionary;
|
||||
if ( $opt_sanitize )
|
||||
{
|
||||
dbmopen %SourceChecker::token_dictionary, "$sanitization_dictionary", 0664;
|
||||
}
|
||||
|
||||
# Init byrd's 'feature' to allow html in comments
|
||||
#
|
||||
my $opt_html_comments = &html_comments_init();
|
||||
|
||||
|
||||
# Handle the "file" argument
|
||||
#
|
||||
my $filename = '';
|
||||
$filename = $::FORM{file} if defined $::FORM{file};
|
||||
if ($filename eq '')
|
||||
{
|
||||
print "\n";
|
||||
&print_usage;
|
||||
exit;
|
||||
} elsif ($filename =~ /CVSROOT/) {
|
||||
print "\nFiles in the CVSROOT dir cannot be viewed.\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
my ($file_head, $file_tail) = $filename =~ m@(.*/)?(.+)@;
|
||||
|
||||
# Handle the "rev" argument
|
||||
#
|
||||
$::opt_rev = '';
|
||||
$::opt_rev = $::FORM{rev} if defined $::FORM{rev} and $::FORM{rev} ne 'HEAD';
|
||||
my $revstr = '';
|
||||
$revstr = "&rev=$::opt_rev" unless $::opt_rev eq '';
|
||||
my $browse_revtag = 'HEAD';
|
||||
$browse_revtag = $::opt_rev if ($::opt_rev =~ /[A-Za-z]/);
|
||||
my $revision = '';
|
||||
|
||||
# Handle the "root" argument
|
||||
#
|
||||
my $root = $::FORM{root};
|
||||
if (defined $root and $root ne '') {
|
||||
$root =~ s|/$||;
|
||||
validateRepository($root);
|
||||
if (-d $root) {
|
||||
unshift(@src_roots, $root);
|
||||
} else {
|
||||
print "\n";
|
||||
&print_top;
|
||||
print "Error: Root, $root, is not a directory.<BR><BR>\n";
|
||||
print "</BODY></HTML>\n";
|
||||
&print_bottom;
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# Find the rcs file
|
||||
#
|
||||
my $rcs_filename;
|
||||
my $found_rcs_file = 0;
|
||||
foreach (@src_roots) {
|
||||
$root = $_;
|
||||
$rcs_filename = "$root/$filename,v";
|
||||
$rcs_filename = Fix_BonsaiLink($rcs_filename);
|
||||
$found_rcs_file = 1, last if -r $rcs_filename;
|
||||
$rcs_filename = "$root/${file_head}Attic/$file_tail,v";
|
||||
$found_rcs_file = 1, last if -r $rcs_filename;
|
||||
}
|
||||
|
||||
unless ($found_rcs_file) {
|
||||
print "\n";
|
||||
&print_top;
|
||||
my $escaped_filename = html_quote($filename);
|
||||
print "Rcs file, $escaped_filename, does not exist.<pre>rcs_filename => '$rcs_filename'\nroot => '$root'</pre><BR><BR>\n";
|
||||
print "</BODY></HTML>\n";
|
||||
&print_bottom;
|
||||
exit;
|
||||
}
|
||||
|
||||
my $rcs_path;
|
||||
($rcs_path) = $rcs_filename =~ m@$root/(.*)/.+?,v@;
|
||||
|
||||
CheckHidden($rcs_filename);
|
||||
|
||||
# Parse the rcs file ($::opt_rev is passed as a global)
|
||||
#
|
||||
$revision = &parse_cvs_file($rcs_filename);
|
||||
my $file_rev = $revision;
|
||||
|
||||
my @text = &extract_revision($revision);
|
||||
if ($#text != $#::revision_map) {
|
||||
print "\n";
|
||||
die "$::progname: Internal consistency error"
|
||||
}
|
||||
|
||||
# Raw data opt (so other scripts can parse and play with the data)
|
||||
if (defined $::FORM{data}) {
|
||||
print "\n";
|
||||
&print_raw_data;
|
||||
exit;
|
||||
}
|
||||
|
||||
print "Last-Modified: ".time2str("%a, %d %b %Y %T %Z", str2time($::revision_ctime{$::opt_rev}), "GMT")."\n";
|
||||
print "\n";
|
||||
#ENDHEADERS!!
|
||||
|
||||
# Handle the "line_nums" argument
|
||||
#
|
||||
my $opt_line_nums = 1;
|
||||
if (defined $::COOKIE{line_nums}) {
|
||||
$opt_line_nums = 1 if $::COOKIE{line_nums} eq 'on';
|
||||
}
|
||||
if (defined $::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
|
||||
my $opt_includes = 0;
|
||||
$opt_includes = 1 if defined $::FORM{includes} and
|
||||
$::FORM{includes} =~ /on|yes|1/i;
|
||||
$opt_includes = 1 if $opt_includes and $file_tail =~ /(.c|.h|.cpp)$/;
|
||||
|
||||
my $use_html = 0;
|
||||
$use_html = 1 if defined $::FORM{use_html} and $::FORM{use_html} eq '1';
|
||||
|
||||
# Handle the "mark" argument
|
||||
#
|
||||
my %mark_line;
|
||||
my $mark_arg = '';
|
||||
$mark_arg = $::FORM{mark} if defined $::FORM{mark};
|
||||
foreach my $mark (split ',', $mark_arg) {
|
||||
my ($begin, $end);
|
||||
if (($begin, $end) = $mark =~ /(\d*)\-(\d*)/) {
|
||||
$begin = 1 if $begin eq '';
|
||||
$end = $#text + 1 if $end eq '' or $end > $#text + 1;
|
||||
next if $begin >= $end;
|
||||
$mark_line{$begin} = 'begin';
|
||||
$mark_line{$end} = 'end';
|
||||
} else {
|
||||
$mark_line{$mark} = 'single';
|
||||
}
|
||||
}
|
||||
|
||||
# Start printing out the page
|
||||
#
|
||||
&print_top;
|
||||
print Param('bannerhtml', 1);
|
||||
|
||||
# Print link at top for directory browsing
|
||||
#
|
||||
print q(
|
||||
<TABLE BORDER=0 CELLPADDING=5 CELLSPACING=0 WIDTH="100%">
|
||||
<TR>
|
||||
<TD ALIGN=LEFT VALIGN=CENTER>
|
||||
<NOBR><FONT SIZE="+2"><B>
|
||||
CVS Blame
|
||||
</B></FONT></NOBR>
|
||||
<BR><B>
|
||||
);
|
||||
|
||||
my $link_path = "";
|
||||
foreach my $path (split('/',$rcs_path)) {
|
||||
|
||||
# Customize this translation
|
||||
$link_path .= url_encode2($path).'/';
|
||||
my $lxr_path = Fix_LxrLink($link_path);
|
||||
print "<A HREF='$lxr_path'>$path</a>/ ";
|
||||
}
|
||||
my $lxr_path = Fix_LxrLink("$link_path$file_tail");
|
||||
print "<A HREF='$lxr_path'>$file_tail</a> ";
|
||||
|
||||
my $graph_cell = Param('cvsgraph') ? <<"--endquote--" : "";
|
||||
</TR><TR>
|
||||
<TD NOWRAP>
|
||||
<A HREF="cvsgraph.cgi?file=$filename">Revision Graph</A>
|
||||
</TD>
|
||||
--endquote--
|
||||
|
||||
print " (<A HREF='cvsblame.cgi?file=$filename&rev=$revision&root=$root'";
|
||||
print " onmouseover='return log(event,\"$::prev_revision{$revision}\",\"$revision\");'" if $::use_layers;
|
||||
print " onmouseover=\"showMessage('$revision','top')\" id=\"line_top\"" if $::use_dom;
|
||||
print ">";
|
||||
print "$browse_revtag:" unless $browse_revtag eq 'HEAD';
|
||||
print $revision if $revision;
|
||||
print "</A>)";
|
||||
|
||||
print qq(
|
||||
</B>
|
||||
</TD>
|
||||
<TD ALIGN=RIGHT VALIGN=TOP WIDTH="1%">
|
||||
<TABLE BORDER CELLPADDING=10 CELLSPACING=0>
|
||||
<TR>
|
||||
<TD NOWRAP BGCOLOR="#FAFAFA">
|
||||
<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
|
||||
<TR>
|
||||
<TD NOWRAP>
|
||||
<A HREF="$lxr_path">LXR: Cross Reference</A>
|
||||
</TD>
|
||||
</TR><TR>
|
||||
<TD NOWRAP>
|
||||
<A HREF="cvslog.cgi?file=$filename$revstr">Full Change Log</A>
|
||||
</TD>
|
||||
$graph_cell
|
||||
</TR>
|
||||
</TABLE>
|
||||
</TD>
|
||||
</TR>
|
||||
</TABLE>
|
||||
</TD>
|
||||
</TR>
|
||||
</TABLE>
|
||||
);
|
||||
|
||||
my $open_table_tag =
|
||||
'<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%">';
|
||||
print "$open_table_tag<TR><TD colspan=3><PRE>";
|
||||
|
||||
# Print each line of the revision, preceded by its annotation.
|
||||
#
|
||||
my $count = $#::revision_map;
|
||||
if ($count == 0) {
|
||||
$count = 1;
|
||||
}
|
||||
my $line_num_width = int(log($count)/log(10)) + 1;
|
||||
my $revision_width = 3;
|
||||
my $author_width = 5;
|
||||
my $line = 0;
|
||||
my %usedlog;
|
||||
$usedlog{$revision} = 1;
|
||||
my $old_revision = 0;
|
||||
my $row_color = '';
|
||||
my $lines_in_table = 0;
|
||||
my $inMark = 0;
|
||||
my $rev_count = 0;
|
||||
foreach $revision (@::revision_map)
|
||||
{
|
||||
my $text = $text[$line++];
|
||||
$usedlog{$revision} = 1;
|
||||
$lines_in_table++;
|
||||
|
||||
if ($opt_html_comments) {
|
||||
# Don't escape HTML in C/C++ comments
|
||||
$text = &leave_html_comments($text);
|
||||
} elsif ( $opt_sanitize ){
|
||||
# Mark filty words and Escape HTML meta-characters
|
||||
$text = markup_line($text);
|
||||
} else {
|
||||
$text =~ s/&/&/g;
|
||||
$text =~ s/</</g;
|
||||
$text =~ s/>/>/g;
|
||||
}
|
||||
# Add a link to traverse to included files
|
||||
$text = &link_includes($text) if $opt_includes;
|
||||
|
||||
my $output = '';
|
||||
|
||||
# Highlight lines
|
||||
my $mark_cmd;
|
||||
if (defined($mark_cmd = $mark_line{$line}) and $mark_cmd ne 'end') {
|
||||
$output .= '</TD></TR><TR><TD BGCOLOR=LIGHTGREEN WIDTH="100%"><PRE>';
|
||||
$inMark = 1;
|
||||
}
|
||||
|
||||
if ($old_revision ne $revision and $line != 1) {
|
||||
if ($row_color eq '') {
|
||||
$row_color=' BGCOLOR="#e7e7e7"';
|
||||
} else {
|
||||
$row_color='';
|
||||
}
|
||||
if (not $inMark) {
|
||||
if ($lines_in_table > 100) {
|
||||
$output .= "</TD></TR></TABLE>$open_table_tag<TR><TD colspan=3$row_color><PRE>";
|
||||
$lines_in_table=0;
|
||||
} else {
|
||||
$output .= "</TD></TR><TR><TD colspan=3$row_color><PRE>";
|
||||
}
|
||||
}
|
||||
} elsif ($lines_in_table > 200 and not $inMark) {
|
||||
$output .= "</TD></TR></TABLE>$open_table_tag<TR><TD colspan=3$row_color><PRE>";
|
||||
$lines_in_table=0;
|
||||
}
|
||||
|
||||
$output .= "<A NAME=$line></A>";
|
||||
|
||||
$output .= sprintf("%${line_num_width}s ", $line) if $opt_line_nums;
|
||||
|
||||
if ($old_revision ne $revision or $rev_count > 20) {
|
||||
|
||||
$revision_width = max($revision_width,length($revision));
|
||||
|
||||
if ($::prev_revision{$revision}) {
|
||||
$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=\"cvsblame.cgi?file=$filename&rev=$revision&root=$root\"";
|
||||
}
|
||||
$output .= " onmouseover='return log(event,\"$::prev_revision{$revision}\",\"$revision\");'" if $::use_layers;
|
||||
$output .= " onmouseover=\"showMessage('$revision','$line')\" id=\"line_$line\"" if $::use_dom;
|
||||
$output .= ">";
|
||||
my $author = $::revision_author{$revision};
|
||||
$author =~ s/%.*$//;
|
||||
$author_width = max($author_width,length($author));
|
||||
$output .= sprintf("%-${author_width}s ", $author);
|
||||
$output .= "$revision</A> ";
|
||||
$output .= ' ' x ($revision_width - length($revision));
|
||||
|
||||
$old_revision = $revision;
|
||||
$rev_count = 0;
|
||||
} else {
|
||||
$output .= ' ' . ' ' x ($author_width + $revision_width);
|
||||
}
|
||||
$rev_count++;
|
||||
|
||||
$output .= "$text";
|
||||
|
||||
# Close the highlighted section
|
||||
if (defined $mark_cmd and $mark_cmd ne 'begin') {
|
||||
chop($output);
|
||||
$output .= "</TD></TR><TR><TD colspan=3$row_color><PRE>";
|
||||
$inMark = 0;
|
||||
}
|
||||
|
||||
print $output;
|
||||
}
|
||||
print "</TD></TR></TABLE>\n";
|
||||
|
||||
if ($::use_layers || $::use_dom) {
|
||||
# Write out cvs log messages as a JS variables
|
||||
# or hidden <div>'s
|
||||
print qq|<SCRIPT $::script_type><!--\n| if $::use_layers;
|
||||
while (my ($revision, $junk) = each %usedlog) {
|
||||
|
||||
# Create a safe variable name for a revision log
|
||||
my $revisionName = $revision;
|
||||
$revisionName =~ tr/./_/;
|
||||
|
||||
my $log = $::revision_log{$revision};
|
||||
$log =~ s/([^\n\r]{80})([^\n\r]*)/$1\n$2/g if $::use_layers;
|
||||
$log = html_quote($log);
|
||||
$log = MarkUpText($log);
|
||||
$log =~ s/\n|\r|\r\n/<BR>/g;
|
||||
$log =~ s/"/\\"/g if $::use_layers;
|
||||
|
||||
# Write JavaScript variable for log entry (e.g. log1_1 = "New File")
|
||||
my $author = $::revision_author{$revision};
|
||||
$author =~ tr/%/@/;
|
||||
my $author_email = EmailFromUsername($author);
|
||||
print "<div id=\"rev_$revision\" class=\"log_msg\" style=\"display:none\">" if $::use_dom;
|
||||
print "log$revisionName = \"" if $::use_layers;
|
||||
print "<b>$revision</b> <<a href='mailto:$author_email'>$author</a>>"
|
||||
." <b>$::revision_ctime{$revision}</b><BR>"
|
||||
."<SPACER TYPE=VERTICAL SIZE=5>$log";
|
||||
print "\";\n" if $::use_layers;
|
||||
print "</div>\n" if $::use_dom;
|
||||
}
|
||||
print "//--></SCRIPT>" if $::use_layers;
|
||||
}
|
||||
|
||||
&print_bottom;
|
||||
|
||||
if ( $opt_sanitize )
|
||||
{
|
||||
dbmclose %SourceChecker::token_dictionary;
|
||||
}
|
||||
|
||||
## END of main script
|
||||
|
||||
sub max {
|
||||
my ($a, $b) = @_;
|
||||
return ($a > $b ? $a : $b);
|
||||
}
|
||||
|
||||
sub print_top {
|
||||
my ($title_text) = "for $file_tail (";
|
||||
$title_text .= "$browse_revtag:" unless $browse_revtag eq 'HEAD';
|
||||
$title_text .= $revision if $revision;
|
||||
$title_text .= ")";
|
||||
$title_text =~ s/\(\)//;
|
||||
|
||||
$| = 1;
|
||||
|
||||
print "<HTML><HEAD><TITLE>CVS Blame $title_text</TITLE>";
|
||||
|
||||
print <<__TOP__ if $::use_layers;
|
||||
<SCRIPT $::script_type><!--
|
||||
var event = 0; // Nav3.0 compatibility
|
||||
document.loaded = false;
|
||||
|
||||
function finishedLoad() {
|
||||
if (parseInt(navigator.appVersion) < 4 ||
|
||||
navigator.userAgent.toLowerCase().indexOf("msie") != -1) {
|
||||
return true;
|
||||
}
|
||||
document.loaded = true;
|
||||
document.layers['popup'].visibility='hide';
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
function revToName (rev) {
|
||||
revName = rev + "";
|
||||
revArray = revName.split(".");
|
||||
return revArray.join("_");
|
||||
}
|
||||
|
||||
function log(event, prev_rev, rev) {
|
||||
if (parseInt(navigator.appVersion) < 4 ||
|
||||
navigator.userAgent.toLowerCase().indexOf("msie") != -1) {
|
||||
return true;
|
||||
}
|
||||
|
||||
var l = document.layers['popup'];
|
||||
var guide = document.layers['popup_guide'];
|
||||
|
||||
if (event.target.text.length > max_link_length) {
|
||||
max_link_length = event.target.text.length;
|
||||
|
||||
guide.document.write("<PRE>" + event.target.text);
|
||||
guide.document.close();
|
||||
|
||||
popup_offset = guide.clip.width;
|
||||
}
|
||||
|
||||
if (document.loaded) {
|
||||
l.document.write("<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=3><TR><TD BGCOLOR=#F0A000>");
|
||||
l.document.write("<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=6><TR><TD BGCOLOR=#FFFFFF><tt>");
|
||||
l.document.write(eval("log" + revToName(rev)) + "</TD></TR></TABLE>");
|
||||
l.document.write("</td></tr></table>");
|
||||
l.document.close();
|
||||
}
|
||||
|
||||
if(event.target.y > window.innerHeight + window.pageYOffset - l.clip.height) {
|
||||
l.top = (window.innerHeight + window.pageYOffset - (l.clip.height + 15));
|
||||
} else {
|
||||
l.top = event.target.y - 9;
|
||||
}
|
||||
l.left = event.target.x + popup_offset;
|
||||
|
||||
l.visibility="show";
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
file_tail = "$file_tail";
|
||||
popup_offset = 5;
|
||||
max_link_length = 0;
|
||||
|
||||
initialLayer = "<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=3><TR><TD BGCOLOR=#F0A000><TABLE BORDER=0 CELLSPACING=0 CELLPADDING=6><TR><TD BGCOLOR=#FFFFFF><B>Page loading...please wait.</B></TD></TR></TABLE></td></tr></table>";
|
||||
|
||||
//--></SCRIPT>
|
||||
</HEAD>
|
||||
<BODY onLoad="finishedLoad();" BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0000EE" VLINK="#551A8B" ALINK="#F0A000">
|
||||
<LAYER SRC="javascript:initialLayer" NAME='popup' onMouseOut="this.visibility='hide';" LEFT=0 TOP=0 BGCOLOR='#FFFFFF' VISIBILITY='hide'></LAYER>
|
||||
<LAYER SRC="javascript:initialLayer" NAME='popup_guide' onMouseOut="this.visibility='hide';" LEFT=0 TOP=0 VISIBILITY='hide'></LAYER>
|
||||
__TOP__
|
||||
print <<__TOP__ if $::use_dom;
|
||||
<script $::script_type><!--
|
||||
var r
|
||||
function showMessage(rev,line) {
|
||||
if (r) {
|
||||
r.style.display='none'
|
||||
}
|
||||
r = document.getElementById('rev_'+rev)
|
||||
var l = document.getElementById('line_'+line)
|
||||
var t = l.offsetTop
|
||||
var p = l.offsetParent
|
||||
while (p.tagName != 'BODY') {
|
||||
t = t + p.offsetTop
|
||||
p = p.offsetParent
|
||||
}
|
||||
r.style.top = t
|
||||
r.style.left = l.offsetLeft + l.offsetWidth + 20
|
||||
r.style.display=''
|
||||
}
|
||||
|
||||
function hideMessage() {
|
||||
if (r) {
|
||||
r.style.display='none'
|
||||
}
|
||||
}
|
||||
//--></script>
|
||||
|
||||
<style type="text/css">
|
||||
body {
|
||||
background-color: white;
|
||||
color: black;
|
||||
}
|
||||
|
||||
a:link {
|
||||
color: blue;
|
||||
}
|
||||
|
||||
a:visited {
|
||||
color: purple;
|
||||
}
|
||||
|
||||
a:active {
|
||||
color: orange;
|
||||
}
|
||||
|
||||
.log_msg {
|
||||
border-style: solid;
|
||||
border-color: #F0A000;
|
||||
background-color: #FFFFFF;
|
||||
padding: 5;
|
||||
position: absolute;
|
||||
}
|
||||
</style>
|
||||
<body onclick="hideMessage()">
|
||||
__TOP__
|
||||
print '<BODY BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0000EE" VLINK="#551A8B" ALINK="#F0A000">' if not ($::use_layers || $::use_dom);
|
||||
} # print_top
|
||||
|
||||
sub print_usage {
|
||||
my ($linenum_message) = '';
|
||||
my ($new_linenum, $src_roots_list);
|
||||
my ($title_text) = "Usage";
|
||||
|
||||
if ($ENV{REQUEST_METHOD} eq 'POST' and defined $::FORM{set_line}) {
|
||||
|
||||
# Expire the cookie 5 months from now
|
||||
my $set_cookie = "Set-Cookie: line_nums=$::FORM{set_line}; expires="
|
||||
.&toGMTString(time + 86400 * 152)."; path=/";
|
||||
# XXX Hey, nothing is done with this handy cookie string! ### XXX
|
||||
}
|
||||
if ( not defined $::COOKIE{line_nums} and not defined $::FORM{set_line}) {
|
||||
$new_linenum = 'on';
|
||||
} elsif ($::COOKIE{line_nums} eq 'off' or $::FORM{set_line} eq 'off') {
|
||||
$linenum_message = 'Line numbers are currently <b>off</b>.';
|
||||
$new_linenum = 'on';
|
||||
} else {
|
||||
$linenum_message = 'Line numbers are currently <b>on</b>.';
|
||||
$new_linenum = 'off';
|
||||
}
|
||||
$src_roots_list = join('<BR>', @src_roots);
|
||||
|
||||
print <<__USAGE__;
|
||||
<HTML>
|
||||
<HEAD>
|
||||
<TITLE>CVS Blame $title_text</TITLE>
|
||||
</HEAD><BODY>
|
||||
<H2>CVS Blame Usage</H2>
|
||||
Add parameters to the query string to view a file.
|
||||
<P>
|
||||
<TABLE BORDER CELLPADDING=3>
|
||||
<TR ALIGN=LEFT>
|
||||
<TH>Param</TH>
|
||||
<TH>Default</TH>
|
||||
<TH>Example</TH>
|
||||
<TH>Description</TH>
|
||||
</TR><TR>
|
||||
<TD>file</TD>
|
||||
<TD>--</TD>
|
||||
<TD>ns/cmd/Makefile</TD>
|
||||
<TD>path to file name</TD>
|
||||
</TR><TR>
|
||||
<TD>root</TD>
|
||||
<TD>$src_roots_list</TD>
|
||||
<TD>/warp/webroot</TD>
|
||||
<TD>cvs root</TD>
|
||||
</TR><TR>
|
||||
<TD>rev</TD>
|
||||
<TD>HEAD</TD>
|
||||
<TD>1.3
|
||||
<BR>ACTRA_branch</TD>
|
||||
<TD>revision</TD>
|
||||
</TR><TR>
|
||||
<TD>line_nums</TD>
|
||||
<TD>on *</TD>
|
||||
<TD>on
|
||||
<BR>off</TD>
|
||||
<TD>line numbers</TD>
|
||||
</TR><TR>
|
||||
<TD>#<line_number></TD>
|
||||
<TD>--</TD>
|
||||
<TD>#111</TD>
|
||||
<TD>jump to a line</TD>
|
||||
</TR>
|
||||
</TABLE>
|
||||
|
||||
<P>Examples:
|
||||
<TABLE><TR><TD> </TD><TD>
|
||||
<A HREF="cvsblame.cgi?file=ns/cmd/Makefile">
|
||||
cvsblame.cgi?file=ns/cmd/Makefile</A>
|
||||
</TD></TR><TR><TD> </TD><TD>
|
||||
<A HREF="cvsblame.cgi?file=ns/cmd/xfe/mozilla.c&rev=Dogbert4xEscalation_BRANCH">
|
||||
cvsblame.cgi?file=ns/cmd/xfe/mozilla.c&rev=Dogbert4xEscalation_BRANCH</A>
|
||||
</TD></TR><TR><TD> </TD><TD>
|
||||
<A HREF="cvsblame.cgi?file=projects/bonsai/cvsblame.cgi&root=/warp/webroot">
|
||||
cvsblame.cgi?file=projects/bonsai/cvsblame.cgi&root=/warp/webroot</A>
|
||||
</TD></TR><TR><TD> </TD><TD>
|
||||
<A HREF="cvsblame.cgi?file=ns/config/config.mk&line_nums=on">
|
||||
cvsblame.cgi?file=ns/config/config.mk&line_nums=on</A>
|
||||
</TD></TR><TR><TD> </TD><TD>
|
||||
<A HREF="cvsblame.cgi?file=ns/cmd/xfe/dialogs.c#2384">
|
||||
cvsblame.cgi?file=ns/cmd/xfe/dialogs.c#2384</A>
|
||||
</TD></TR></TABLE>
|
||||
|
||||
<P>
|
||||
You may also begin a query with the <A HREF="cvsqueryform.cgi">CVS Query Form</A>.
|
||||
<FORM METHOD='POST' ACTION='cvsblame.cgi'>
|
||||
|
||||
<TABLE CELLPADDING=0 CELLSPACING=0>
|
||||
<TR>
|
||||
<TD>*<SPACER TYPE=HORIZONTAL SIZE=6></TD>
|
||||
<TD>Instead of the <i>line_nums</i> parameter, you can
|
||||
<INPUT TYPE=submit value='set a cookie to turn $new_linenum'>
|
||||
line numbers.</TD>
|
||||
</TR><TR>
|
||||
<TD></TD>
|
||||
<TD>$linenum_message</TD>
|
||||
</TR></TABLE>
|
||||
|
||||
<INPUT TYPE=hidden NAME='set_line' value='$new_linenum'>
|
||||
</FORM>
|
||||
__USAGE__
|
||||
&print_bottom;
|
||||
} # sub print_usage
|
||||
|
||||
sub 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:$maintainer?subject=About the cvsblame script"><$maintainer></A>.
|
||||
</FONT></BODY>
|
||||
</HTML>
|
||||
__BOTTOM__
|
||||
} # print_bottom
|
||||
|
||||
sub print_raw_data {
|
||||
my %revs_seen = ();
|
||||
my $prev_rev = $::revision_map[0];
|
||||
my $count = 0;
|
||||
for my $rev (@::revision_map) {
|
||||
if ($prev_rev eq $rev) {
|
||||
$count++;
|
||||
} else {
|
||||
print "$prev_rev:$count\n";
|
||||
$count = 1;
|
||||
$prev_rev = $rev;
|
||||
$revs_seen{$rev} = 1;
|
||||
}
|
||||
}
|
||||
print "$prev_rev:$count\n";
|
||||
print "REVISION DETAILS\n";
|
||||
for my $rev (sort keys %revs_seen) {
|
||||
print "$rev|$::revision_ctime{$rev}|$::revision_author{$rev}|$::revision_log{$rev}.\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub link_includes {
|
||||
my ($text) = $_[0];
|
||||
|
||||
if ($text =~ /\#(\s*)include(\s*)"(.*?)"/) {
|
||||
foreach my $trial_root (($rcs_path, 'ns/include',
|
||||
"$rcs_path/Attic", "$rcs_path/..")) {
|
||||
if (-r "$root/$trial_root/$3,v") {
|
||||
$text = "$`#$1include$2\"<A HREF='cvsblame.cgi"
|
||||
."?root=$root&file=$trial_root/$3&rev=".$browse_revtag
|
||||
."&use_html=$use_html'>$3</A>\";$'";
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
return $text;
|
||||
}
|
||||
|
||||
my $in_comments = 0;
|
||||
my $open_delim;
|
||||
my $close_delim;
|
||||
my $expected_delim;
|
||||
|
||||
sub html_comments_init {
|
||||
return 0 unless $use_html;
|
||||
|
||||
# Initialization for C comment context switching
|
||||
$in_comments = 0;
|
||||
$open_delim = '\/\*';
|
||||
$close_delim = '\*\/';
|
||||
|
||||
# Initialize the next expected delim
|
||||
$expected_delim = $open_delim;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub leave_html_comments {
|
||||
my ($text) = $_[0];
|
||||
# Allow HTML in the comments.
|
||||
#
|
||||
my $newtext = "";
|
||||
my $oldtext = $text;
|
||||
while ($oldtext =~ /(.*$expected_delim)(.*\n)/) {
|
||||
$a = $1;
|
||||
$b = $2;
|
||||
# pay no attention to C++ comments within C comment context
|
||||
if ($in_comments == 0) {
|
||||
$a =~ s/</</g;
|
||||
$a =~ s/>/>/g;
|
||||
$expected_delim = $close_delim;
|
||||
$in_comments = 1;
|
||||
}
|
||||
else {
|
||||
$expected_delim = $open_delim;
|
||||
$in_comments = 0;
|
||||
}
|
||||
$newtext = $newtext . $a;
|
||||
$oldtext = $b;
|
||||
}
|
||||
# Handle thre remainder
|
||||
if ($in_comments == 0){
|
||||
$oldtext =~ s/</</g;
|
||||
$oldtext =~ s/>/>/g;
|
||||
}
|
||||
$text = $newtext . $oldtext;
|
||||
|
||||
# Now fix the breakage of <username> stuff on xfe. -byrd
|
||||
if ($text =~ /(.*)<(.*@.*)>(.*\n)/) {
|
||||
$text = $1 . "<A HREF=mailto:$2?subject=$filename>$2</A>" . $3;
|
||||
}
|
||||
|
||||
return $text;
|
||||
}
|
||||
@@ -1,888 +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.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
##############################################################################
|
||||
#
|
||||
# cvsblame.pl - Shamelessly adapted from Scott Furman's cvsblame script
|
||||
# by Steve Lamm (slamm@netscape.com)
|
||||
# - Annotate each line of a CVS file with its author,
|
||||
# revision #, date, etc.
|
||||
#
|
||||
# Report problems to Steve Lamm (slamm@netscape.com)
|
||||
#
|
||||
##############################################################################
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub cvsblame_pl_sillyness {
|
||||
my $zz;
|
||||
$zz = $::file_description;
|
||||
$zz = $::opt_A;
|
||||
$zz = $::opt_d;
|
||||
$zz = $::principal_branch;
|
||||
$zz = %::lines_added;
|
||||
$zz = %::lines_removed;
|
||||
};
|
||||
|
||||
use Time::Local qw(timegm); # timestamps
|
||||
use Date::Format; # human-readable dates
|
||||
|
||||
my $debug = 0;
|
||||
$::opt_m = 0 unless (defined($::opt_m));
|
||||
|
||||
# Extract base part of this script's name
|
||||
($::progname = $0) =~ /([^\/]+)$/;
|
||||
|
||||
&cvsblame_init;
|
||||
|
||||
my $SECS_PER_DAY;
|
||||
my $time;
|
||||
|
||||
sub cvsblame_init {
|
||||
# Use default formatting options if none supplied
|
||||
if (!$::opt_A && !$::opt_a && !$::opt_d && !$::opt_v) {
|
||||
$::opt_a = 1;
|
||||
$::opt_v = 1;
|
||||
}
|
||||
|
||||
$time = time;
|
||||
$SECS_PER_DAY = 60 * 60 * 24;
|
||||
|
||||
# Timestamp threshold at which annotations begin to occur, if -m option present.
|
||||
$::opt_m_timestamp = $time;
|
||||
if (defined $::opt_m) {
|
||||
$::opt_m_timestamp -= $::opt_m * $SECS_PER_DAY;
|
||||
}
|
||||
}
|
||||
|
||||
# Generic traversal of a CVS tree. Invoke callback function for
|
||||
# individual directories that contain CVS files.
|
||||
sub traverse_cvs_tree {
|
||||
my ($dir, $nlink);
|
||||
local *callback;
|
||||
($dir, *callback, $nlink) = @_;
|
||||
my ($dev, $ino, $mode, $subcount);
|
||||
|
||||
# Get $nlink for top-level directory
|
||||
($dev, $ino, $mode, $nlink) = stat($dir) unless $nlink;
|
||||
|
||||
# Read directory
|
||||
opendir(DIR, $dir) || die "Can't open $dir\n";
|
||||
my (@filenames) = readdir(DIR);
|
||||
closedir(DIR);
|
||||
|
||||
return if ! -d "$dir/CVS";
|
||||
|
||||
&callback($dir);
|
||||
|
||||
# This dir has subdirs
|
||||
if ($nlink != 2) {
|
||||
$subcount = $nlink - 2; # Number of subdirectories
|
||||
for (@filenames) {
|
||||
last if $subcount == 0;
|
||||
next if $_ eq '.';
|
||||
next if $_ eq '..';
|
||||
next if $_ eq 'CVS';
|
||||
my $name = "$dir/$_";
|
||||
|
||||
($dev, $ino, $mode, $nlink) = lstat($name);
|
||||
next unless -d _;
|
||||
if (-x _ && -r _) {
|
||||
print STDERR "$::progname: Entering $name\n";
|
||||
&traverse_cvs_tree($name, *callback, $nlink);
|
||||
} else {
|
||||
warn("Couldn't chdir to $name");
|
||||
}
|
||||
--$subcount;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Consume one token from the already opened RCSFILE filehandle.
|
||||
# Unescape string tokens, if necessary.
|
||||
|
||||
my $line_buffer;
|
||||
|
||||
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>;
|
||||
$line_buffer =~ s/^\s+//; # Erase leading whitespace
|
||||
}
|
||||
|
||||
# A string of non-whitespace characters is a token ...
|
||||
return $1 if ($line_buffer =~ s/^([^;@][^;\s]*)\s*//o);
|
||||
|
||||
# ...and so is a single semicolon ...
|
||||
return ';' if ($line_buffer =~ s/^;\s*//o);
|
||||
|
||||
# ...or an RCS-encoded string that starts with an @ character.
|
||||
$line_buffer =~ s/^@([^@]*)//o;
|
||||
my $token = $1;
|
||||
|
||||
# Detect single @ character used to close RCS-encoded string.
|
||||
while ($line_buffer !~ /@/o || # Short-circuit optimization
|
||||
$line_buffer !~ /([^@]|^)@([^@]|$)/o) {
|
||||
$token .= $line_buffer;
|
||||
die ("Unexpected EOF") if eof(RCSFILE);
|
||||
$line_buffer = <RCSFILE>;
|
||||
}
|
||||
|
||||
# Retain the remainder of the line after the terminating @ character.
|
||||
my $i = rindex($line_buffer, '@');
|
||||
$token .= substr($line_buffer, 0, $i);
|
||||
$line_buffer = substr($line_buffer, $i + 1);
|
||||
|
||||
# Undo escape-coding of @ characters.
|
||||
$token =~ s/@@/@/og;
|
||||
|
||||
# Digest any extra blank lines.
|
||||
while (($line_buffer =~ /^$/) && !eof(RCSFILE)) {
|
||||
$line_buffer = <RCSFILE>;
|
||||
}
|
||||
return $token;
|
||||
}
|
||||
|
||||
my $rcs_pathname;
|
||||
|
||||
# Consume a token from RCS filehandle and ensure that it matches
|
||||
# the given string constant.
|
||||
sub match_token {
|
||||
my ($match) = @_;
|
||||
|
||||
my ($token) = &get_token;
|
||||
die "Unexpected parsing error in RCS file $rcs_pathname.\n",
|
||||
"Expected token: $match, but saw: $token\n"
|
||||
if ($token ne $match);
|
||||
}
|
||||
|
||||
# Push RCS token back into the input buffer.
|
||||
sub unget_token {
|
||||
my ($token) = @_;
|
||||
$line_buffer = $token . " " . $line_buffer;
|
||||
}
|
||||
|
||||
# Parses "administrative" header of RCS files, setting these globals:
|
||||
#
|
||||
# $::head_revision -- Revision for which cleartext is stored
|
||||
# $::principal_branch
|
||||
# $::file_description
|
||||
# %::revision_symbolic_name -- maps from numerical revision # to symbolic tag
|
||||
# %::tag_revision -- maps from symbolic tag to numerical revision #
|
||||
#
|
||||
sub parse_rcs_admin {
|
||||
my ($token, $tag, $tag_name, $tag_revision);
|
||||
|
||||
# Undefine variables, because we may have already read another RCS file
|
||||
undef %::tag_revision;
|
||||
undef %::revision_symbolic_name;
|
||||
|
||||
while (1) {
|
||||
# Read initial token at beginning of line
|
||||
$token = &get_token();
|
||||
|
||||
# We're done once we reach the description of the RCS tree
|
||||
if ($token =~ /^\d/o) {
|
||||
&unget_token($token);
|
||||
return;
|
||||
}
|
||||
|
||||
# print "token: $token\n";
|
||||
|
||||
if ($token eq "head") {
|
||||
$::head_revision = &get_token;
|
||||
&get_token; # Eat semicolon
|
||||
} elsif ($token eq "branch") {
|
||||
$::principal_branch = &get_token;
|
||||
&get_token; # Eat semicolon
|
||||
} elsif ($token eq "symbols") {
|
||||
|
||||
# Create an associate array that maps from tag name to
|
||||
# revision number and vice-versa.
|
||||
while (($tag = &get_token) ne ';') {
|
||||
($tag_name, $tag_revision) = split(':', $tag);
|
||||
|
||||
$::tag_revision{$tag_name} = $tag_revision;
|
||||
$::revision_symbolic_name{$tag_revision} = $tag_name;
|
||||
}
|
||||
} elsif ($token eq "comment") {
|
||||
$::file_description = &get_token;
|
||||
&get_token; # Eat semicolon
|
||||
|
||||
# Ignore all these other fields - We don't care about them.
|
||||
} elsif (($token eq "locks") ||
|
||||
($token eq "strict") ||
|
||||
($token eq "expand") ||
|
||||
($token eq "access")) {
|
||||
(1) while (&get_token ne ';');
|
||||
} else {
|
||||
warn ("Unexpected RCS token: $token\n");
|
||||
}
|
||||
}
|
||||
|
||||
die "Unexpected EOF";
|
||||
}
|
||||
|
||||
# Construct associative arrays that represent the topology of the RCS tree
|
||||
# and other arrays that contain info about individual revisions.
|
||||
#
|
||||
# The following associative arrays are created, keyed by revision number:
|
||||
# %::revision_date -- e.g. "96.02.23.00.21.52"
|
||||
# %::timestamp -- seconds since 12:00 AM, Jan 1, 1970 GMT
|
||||
# %::revision_author -- e.g. "tom"
|
||||
# %::revision_branches -- descendant branch revisions, separated by spaces,
|
||||
# e.g. "1.21.4.1 1.21.2.6.1"
|
||||
# %::prev_revision -- revision number of previous *ancestor* in RCS tree.
|
||||
# Traversal of this array occurs in the direction
|
||||
# of the primordial (1.1) revision.
|
||||
# %::prev_delta -- revision number of previous revision which forms
|
||||
# the basis for the edit commands in this revision.
|
||||
# This causes the tree to be traversed towards the
|
||||
# trunk when on a branch, and towards the latest trunk
|
||||
# revision when on the trunk.
|
||||
# %::next_delta -- revision number of next "delta". Inverts %::prev_delta.
|
||||
#
|
||||
# Also creates %::last_revision, keyed by a branch revision number, which
|
||||
# indicates the latest revision on a given branch,
|
||||
# e.g. $::last_revision{"1.2.8"} == 1.2.8.5
|
||||
#
|
||||
|
||||
|
||||
my %revision_age;
|
||||
|
||||
sub parse_rcs_tree {
|
||||
my ($revision, $date, $author, $branches, $next);
|
||||
my ($branch, $is_trunk_revision);
|
||||
|
||||
# Undefine variables, because we may have already read another RCS file
|
||||
undef %::timestamp;
|
||||
undef %revision_age;
|
||||
undef %::revision_author;
|
||||
undef %::revision_branches;
|
||||
undef %::revision_ctime;
|
||||
undef %::revision_date;
|
||||
undef %::prev_revision;
|
||||
undef %::prev_delta;
|
||||
undef %::next_delta;
|
||||
undef %::last_revision;
|
||||
|
||||
while (1) {
|
||||
$revision = &get_token;
|
||||
|
||||
# End of RCS tree description ?
|
||||
if ($revision eq 'desc') {
|
||||
&unget_token($revision);
|
||||
return;
|
||||
}
|
||||
|
||||
$is_trunk_revision = ($revision =~ /^[0-9]+\.[0-9]+$/);
|
||||
|
||||
$::tag_revision{$revision} = $revision;
|
||||
($branch) = $revision =~ /(.*)\.[0-9]+/o;
|
||||
$::last_revision{$branch} = $revision;
|
||||
|
||||
# Parse date
|
||||
&match_token('date');
|
||||
$date = &get_token;
|
||||
$::revision_date{$revision} = $date;
|
||||
&match_token(';');
|
||||
|
||||
# Convert date into timestamp
|
||||
my @date_fields = reverse(split(/\./, $date));
|
||||
$date_fields[4]--; # Month ranges from 0-11, not 1-12
|
||||
$::timestamp{$revision} = timegm(@date_fields);
|
||||
|
||||
# Pretty print the date string
|
||||
my @ltime = localtime($::timestamp{$revision});
|
||||
my $formated_date = strftime("%d %b %Y %H:%M", @ltime);
|
||||
$::revision_ctime{$revision} = $formated_date;
|
||||
|
||||
# Save age
|
||||
$revision_age{$revision} =
|
||||
($time - $::timestamp{$revision}) / $SECS_PER_DAY;
|
||||
|
||||
# Parse author
|
||||
&match_token('author');
|
||||
$author = &get_token;
|
||||
$::revision_author{$revision} = $author;
|
||||
&match_token(';');
|
||||
|
||||
# Parse state;
|
||||
&match_token('state');
|
||||
while (&get_token ne ';') { }
|
||||
|
||||
# Parse branches
|
||||
&match_token('branches');
|
||||
$branches = '';
|
||||
my $token;
|
||||
while (($token = &get_token) ne ';') {
|
||||
$::prev_revision{$token} = $revision;
|
||||
$::prev_delta{$token} = $revision;
|
||||
$branches .= "$token ";
|
||||
}
|
||||
$::revision_branches{$revision} = $branches;
|
||||
|
||||
# Parse revision of next delta in chain
|
||||
&match_token('next');
|
||||
$next = '';
|
||||
if (($token = &get_token) ne ';') {
|
||||
$next = $token;
|
||||
&get_token; # Eat semicolon
|
||||
$::next_delta{$revision} = $next;
|
||||
$::prev_delta{$next} = $revision;
|
||||
if ($is_trunk_revision) {
|
||||
$::prev_revision{$revision} = $next;
|
||||
} else {
|
||||
$::prev_revision{$next} = $revision;
|
||||
}
|
||||
}
|
||||
|
||||
if ($debug >= 3) {
|
||||
print "<pre>revision = $revision\n";
|
||||
print "date = $date\n";
|
||||
print "author = $author\n";
|
||||
print "branches = $branches\n";
|
||||
print "next = $next</pre>\n\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub parse_rcs_description {
|
||||
&match_token('desc');
|
||||
my $rcs_file_description = &get_token;
|
||||
}
|
||||
|
||||
# Construct associative arrays containing info about individual revisions.
|
||||
#
|
||||
# The following associative arrays are created, keyed by revision number:
|
||||
# %::revision_log -- log message
|
||||
# %::revision_deltatext -- Either the complete text of the revision,
|
||||
# in the case of the head revision, or the
|
||||
# encoded delta between this revision and another.
|
||||
# The delta is either with respect to the successor
|
||||
# revision if this revision is on the trunk or
|
||||
# relative to its immediate predecessor if this
|
||||
# revision is on a branch.
|
||||
sub parse_rcs_deltatext {
|
||||
undef %::revision_log;
|
||||
undef %::revision_deltatext;
|
||||
|
||||
while (!eof(RCSFILE)) {
|
||||
my $revision = &get_token;
|
||||
print "Reading delta for revision: $revision\n" if ($debug >= 3);
|
||||
&match_token('log');
|
||||
$::revision_log{$revision} = &get_token;
|
||||
&match_token('text');
|
||||
$::revision_deltatext{$revision} = &get_token;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# Reads and parses complete RCS file from already-opened RCSFILE descriptor.
|
||||
# Or if a parameter is given use the corresponding file
|
||||
sub parse_rcs_file {
|
||||
my $path = shift;
|
||||
if (defined $path) {
|
||||
open (RCSFILE, "< $path");
|
||||
}
|
||||
print "Reading RCS admin...\n" if ($debug >= 2);
|
||||
&parse_rcs_admin();
|
||||
print "Reading RCS revision tree topology...\n" if ($debug >= 2);
|
||||
&parse_rcs_tree();
|
||||
|
||||
if( $debug >= 3 ){
|
||||
print "<pre>Keys:\n\n";
|
||||
for my $i (keys %::tag_revision ){
|
||||
my $k = $::tag_revision{$i};
|
||||
print "yoyuo $i: $k\n";
|
||||
}
|
||||
print "</pre>\n";
|
||||
}
|
||||
|
||||
&parse_rcs_description();
|
||||
print "Reading RCS revision deltas...\n" if ($debug >= 2);
|
||||
&parse_rcs_deltatext();
|
||||
print "Done reading RCS file...\n" if ($debug >= 2);
|
||||
close RCSFILE if (defined $path);
|
||||
}
|
||||
|
||||
# Map a tag to a numerical revision number. The tag can be a symbolic
|
||||
# branch tag, a symbolic revision tag, or an ordinary numerical
|
||||
# revision number.
|
||||
sub map_tag_to_revision {
|
||||
my ($tag_or_revision) = @_;
|
||||
|
||||
my ($revision) = $::tag_revision{$tag_or_revision};
|
||||
|
||||
# Is this a branch tag, e.g. xxx.yyy.0.zzz
|
||||
if ($revision =~ /(.*)\.0\.([0-9]+)/o) {
|
||||
my $branch = $1 . '.' . $2;
|
||||
# Return latest revision on the branch, if any.
|
||||
return $::last_revision{$branch} if (defined($::last_revision{$branch}));
|
||||
return $1; # No revisions on branch - return branch point
|
||||
} else {
|
||||
return $revision;
|
||||
}
|
||||
}
|
||||
|
||||
# Construct an ordered list of ancestor revisions to the given
|
||||
# revision, starting with the immediate ancestor and going back
|
||||
# to the primordial revision (1.1).
|
||||
#
|
||||
# Note: The generated path does not traverse the tree the same way
|
||||
# that the individual revision deltas do. In particular,
|
||||
# the path traverses the tree "backwards" on branches.
|
||||
|
||||
sub ancestor_revisions {
|
||||
my ($revision) = @_;
|
||||
my (@ancestors);
|
||||
|
||||
$revision = $::prev_revision{$revision};
|
||||
while ($revision) {
|
||||
push(@ancestors, $revision);
|
||||
$revision = $::prev_revision{$revision};
|
||||
}
|
||||
|
||||
return @ancestors;
|
||||
}
|
||||
|
||||
# Extract the given revision from the digested RCS file.
|
||||
# (Essentially the equivalent of cvs up -rXXX)
|
||||
sub extract_revision {
|
||||
my ($revision) = @_;
|
||||
my (@path);
|
||||
my $add_lines_remaining = 0;
|
||||
my ($start_line, $count);
|
||||
# Compute path through tree of revision deltas to most recent trunk revision
|
||||
while ($revision) {
|
||||
push(@path, $revision);
|
||||
$revision = $::prev_delta{$revision};
|
||||
}
|
||||
@path = reverse(@path);
|
||||
shift @path; # Get rid of head revision
|
||||
|
||||
# Get complete contents of head revision
|
||||
my (@text) = split(/^/, $::revision_deltatext{$::head_revision});
|
||||
|
||||
# Iterate, applying deltas to previous revision
|
||||
foreach $revision (@path) {
|
||||
my $adjust = 0;
|
||||
my @diffs = split(/^/, $::revision_deltatext{$revision});
|
||||
|
||||
my ($lines_added) = 0;
|
||||
my ($lines_removed) = 0;
|
||||
|
||||
foreach my $command (@diffs) {
|
||||
if ($add_lines_remaining > 0) {
|
||||
# Insertion lines from a prior "a" command.
|
||||
splice(@text, $start_line + $adjust,
|
||||
0, $command);
|
||||
$add_lines_remaining--;
|
||||
$adjust++;
|
||||
} elsif ($command =~ /^d(\d+)\s(\d+)/) {
|
||||
# "d" - Delete command
|
||||
($start_line, $count) = ($1, $2);
|
||||
splice(@text, $start_line + $adjust - 1, $count);
|
||||
$adjust -= $count;
|
||||
$lines_removed += $count;
|
||||
} elsif ($command =~ /^a(\d+)\s(\d+)/) {
|
||||
# "a" - Add command
|
||||
($start_line, $count) = ($1, $2);
|
||||
$add_lines_remaining = $count;
|
||||
$lines_added += $lines_added;
|
||||
} else {
|
||||
die "Error parsing diff commands";
|
||||
}
|
||||
}
|
||||
$::lines_removed{$revision} += $lines_removed;
|
||||
$::lines_added{$revision} += $lines_added;
|
||||
}
|
||||
|
||||
return @text;
|
||||
}
|
||||
|
||||
sub parse_cvs_file {
|
||||
($rcs_pathname) = @_;
|
||||
|
||||
# Args in: $::opt_rev - requested revision
|
||||
# $::opt_m - time since modified
|
||||
# Args out: @::revision_map
|
||||
# %::timestamp
|
||||
# (%::revision_deltatext)
|
||||
|
||||
my @diffs;
|
||||
my $revision;
|
||||
my $skip;
|
||||
my ($start_line, $count);
|
||||
my @temp;
|
||||
|
||||
@::revision_map = ();
|
||||
CheckHidden($rcs_pathname);
|
||||
|
||||
die "$::progname: error: This file appeared to be under CVS control, " .
|
||||
"but the RCS file is inaccessible.\n(Couldn't open '$rcs_pathname')\n"
|
||||
if !open (RCSFILE, "< $rcs_pathname");
|
||||
&parse_rcs_file();
|
||||
close(RCSFILE);
|
||||
|
||||
if (!defined($::opt_rev) || $::opt_rev eq '' || $::opt_rev eq 'HEAD') {
|
||||
# Explicitly specified topmost revision in tree
|
||||
$revision = $::head_revision;
|
||||
} else {
|
||||
# Symbolic tag or specific revision number specified.
|
||||
$revision = &map_tag_to_revision($::opt_rev);
|
||||
die "$::progname: error: -r: No such revision: $::opt_rev\n"
|
||||
if ($revision eq '');
|
||||
}
|
||||
|
||||
# The primordial revision is not always 1.1! Go find it.
|
||||
my $primordial = $revision;
|
||||
while (exists($::prev_revision{$primordial}) &&
|
||||
$::prev_revision{$primordial} ne "") {
|
||||
$primordial = $::prev_revision{$primordial};
|
||||
}
|
||||
|
||||
# Don't display file at all, if -m option is specified and no
|
||||
# changes have been made in the specified file.
|
||||
if ($::opt_m && $::timestamp{$revision} < $::opt_m_timestamp) {
|
||||
return '';
|
||||
}
|
||||
|
||||
# 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.
|
||||
my $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));
|
||||
my $rev;
|
||||
for ($rev = $::prev_revision{$::head_revision}; $rev;
|
||||
$rev = $::prev_revision{$rev}) {
|
||||
@diffs = split(/^/, $::revision_deltatext{$rev});
|
||||
foreach my $command (@diffs) {
|
||||
if ($skip > 0) {
|
||||
# Skip insertion lines from a prior "a" command.
|
||||
$skip--;
|
||||
} elsif ($command =~ /^d(\d+)\s(\d+)/) {
|
||||
# "d" - Delete command
|
||||
($start_line, $count) = ($1, $2);
|
||||
$line_count -= $count;
|
||||
} elsif ($command =~ /^a(\d+)\s(\d+)/) {
|
||||
# "a" - Add command
|
||||
($start_line, $count) = ($1, $2);
|
||||
$skip = $count;
|
||||
$line_count += $count;
|
||||
} else {
|
||||
die "$::progname: error: illegal RCS file $rcs_pathname\n",
|
||||
" error appears in revision $rev\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Now, play the delta edit commands *backwards* from the primordial
|
||||
# revision forward, but rather than applying the deltas to the text of
|
||||
# each revision, apply the changes to an array of revision numbers.
|
||||
# This creates a "revision map" -- an array where each element
|
||||
# represents a line of text in the given revision but contains only
|
||||
# the revision number in which the line was introduced rather than
|
||||
# the line text itself.
|
||||
#
|
||||
# Note: These are backward deltas for revisions on the trunk and
|
||||
# forward deltas for branch revisions.
|
||||
|
||||
# Create initial revision map for primordial version.
|
||||
while ($line_count--) {
|
||||
push(@::revision_map, $primordial);
|
||||
}
|
||||
|
||||
my @ancestors = &ancestor_revisions($revision);
|
||||
unshift (@ancestors, $revision); #
|
||||
pop @ancestors; # Remove "1.1"
|
||||
$::last_revision = $primordial;
|
||||
foreach $revision (reverse @ancestors) {
|
||||
my $is_trunk_revision = ($revision =~ /^[0-9]+\.[0-9]+$/);
|
||||
|
||||
if ($is_trunk_revision) {
|
||||
@diffs = split(/^/, $::revision_deltatext{$::last_revision});
|
||||
|
||||
# Revisions on the trunk specify deltas that transform a
|
||||
# revision into an earlier revision, so invert the translation
|
||||
# of the 'diff' commands.
|
||||
foreach my $command (@diffs) {
|
||||
if ($skip > 0) {
|
||||
$skip--;
|
||||
} else {
|
||||
if ($command =~ /^d(\d+)\s(\d+)$/) { # Delete command
|
||||
($start_line, $count) = ($1, $2);
|
||||
|
||||
$#temp = -1;
|
||||
while ($count--) {
|
||||
push(@temp, $revision);
|
||||
}
|
||||
splice(@::revision_map, $start_line - 1, 0, @temp);
|
||||
} elsif ($command =~ /^a(\d+)\s(\d+)$/) { # Add command
|
||||
($start_line, $count) = ($1, $2);
|
||||
splice(@::revision_map, $start_line, $count);
|
||||
$skip = $count;
|
||||
} else {
|
||||
die "Error parsing diff commands";
|
||||
}
|
||||
}
|
||||
}
|
||||
} else {
|
||||
# Revisions on a branch are arranged backwards from those on
|
||||
# the trunk. They specify deltas that transform a revision
|
||||
# into a later revision.
|
||||
my $adjust = 0;
|
||||
@diffs = split(/^/, $::revision_deltatext{$revision});
|
||||
foreach my $command (@diffs) {
|
||||
if ($skip > 0) {
|
||||
$skip--;
|
||||
} else {
|
||||
if ($command =~ /^d(\d+)\s(\d+)$/) { # Delete command
|
||||
($start_line, $count) = ($1, $2);
|
||||
splice(@::revision_map, $start_line + $adjust - 1, $count);
|
||||
$adjust -= $count;
|
||||
} elsif ($command =~ /^a(\d+)\s(\d+)$/) { # Add command
|
||||
($start_line, $count) = ($1, $2);
|
||||
|
||||
$skip = $count;
|
||||
$#temp = -1;
|
||||
while ($count--) {
|
||||
push(@temp, $revision);
|
||||
}
|
||||
splice(@::revision_map, $start_line + $adjust, 0, @temp);
|
||||
$adjust += $skip;
|
||||
} else {
|
||||
die "Error parsing diff commands";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
$::last_revision = $revision;
|
||||
}
|
||||
return $revision;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
#
|
||||
# The following are parts of the original cvsblame script that are not
|
||||
# used for cvsblame.pl
|
||||
#
|
||||
|
||||
# Read CVS/Entries and CVS/Repository files.
|
||||
#
|
||||
# Creates these associative arrays, keyed by the CVS file pathname
|
||||
#
|
||||
# %cvs_revision -- Revision # present in working directory
|
||||
# %cvs_date
|
||||
# %cvs_sticky_revision -- Sticky tag, if any
|
||||
#
|
||||
# Also, creates %cvs_files, keyed by the directory path, which contains
|
||||
# a space-separated list of the files under CVS control in the directory
|
||||
sub read_cvs_entries
|
||||
{
|
||||
my ($directory) = @_;
|
||||
my ($filename, $rev, $date, $idunno, $sticky, $pathname);
|
||||
|
||||
$cvsdir = $directory . '/CVS';
|
||||
|
||||
CheckHidden($cvsdir);
|
||||
|
||||
return if (! -d $cvsdir);
|
||||
|
||||
return if !open(ENTRIES, "< $cvsdir/Entries");
|
||||
|
||||
while(<ENTRIES>) {
|
||||
chop;
|
||||
($filename, $rev, $date, $idunno, $sticky) = split("/", substr($_, 1));
|
||||
($pathname) = $directory . "/" . $filename;
|
||||
$cvs_revision{$pathname} = $rev;
|
||||
$cvs_date{$pathname} = $date;
|
||||
$cvs_sticky_revision{$pathname} = $sticky;
|
||||
$cvs_files{$directory} .= "$filename\\";
|
||||
}
|
||||
close(ENTRIES);
|
||||
|
||||
return if !open(REPOSITORY, "< $cvsdir/Repository");
|
||||
$repository = <REPOSITORY>;
|
||||
chop($repository);
|
||||
close(REPOSITORY);
|
||||
$repository{$directory} = $repository;
|
||||
}
|
||||
|
||||
# Given path to file in CVS working directory, compute path to RCS
|
||||
# repository file. Cache that info for future use.
|
||||
|
||||
|
||||
sub rcs_pathname {
|
||||
($pathname) = @_;
|
||||
|
||||
if ($pathname =~ m@/@) {
|
||||
($directory,$filename) = $pathname =~ m@(.*)/([^/]+)$@;
|
||||
} else {
|
||||
($directory,$filename) = ('.',$pathname);
|
||||
$pathname = "./" . $pathname;
|
||||
}
|
||||
if (!defined($repository{$directory})) {
|
||||
&read_cvs_entries($directory);
|
||||
}
|
||||
|
||||
if (!defined($cvs_revision{$pathname})) {
|
||||
die "$::progname: error: File '$pathname' does not appear to be under" .
|
||||
" CVS control.\n"
|
||||
}
|
||||
|
||||
print STDERR "file: $filename\n" if $debug;
|
||||
my ($rcs_path) = $repository{$directory} . '/' . $filename . ',v';
|
||||
return $rcs_path if (-r $rcs_path);
|
||||
|
||||
# A file that exists only on the branch, not on the trunk, is found
|
||||
# in the Attic subdir.
|
||||
return $repository{$directory} . '/Attic/' . $filename . ',v';
|
||||
}
|
||||
|
||||
sub show_annotated_cvs_file {
|
||||
my ($pathname) = @_;
|
||||
my (@output) = ();
|
||||
|
||||
my $revision = &parse_cvs_file($pathname);
|
||||
|
||||
@text = &extract_revision($revision);
|
||||
die "$::progname: Internal consistency error" if ($#text != $#::revision_map);
|
||||
|
||||
# Set total width of line annotation.
|
||||
# Warning: field widths here must match format strings below.
|
||||
$annotation_width = 0;
|
||||
$annotation_width += 8 if $::opt_a; # author
|
||||
$annotation_width += 7 if $::opt_v; # revision
|
||||
$annotation_width += 6 if $::opt_A; # age
|
||||
$annotation_width += 12 if $::opt_d; # date
|
||||
$blank_annotation = ' ' x $annotation_width;
|
||||
|
||||
if ($multiple_files_on_command_line) {
|
||||
print "\n", "=" x (83 + $annotation_width);
|
||||
print "\n$::progname: Listing file: $pathname\n"
|
||||
}
|
||||
|
||||
# Print each line of the revision, preceded by its annotation.
|
||||
$line = 0;
|
||||
foreach $revision (@::revision_map) {
|
||||
$text = $text[$line++];
|
||||
$annotation = '';
|
||||
|
||||
# Annotate with revision author
|
||||
$annotation .= sprintf("%-8s", $::revision_author{$revision}) if $::opt_a;
|
||||
|
||||
# Annotate with revision number
|
||||
$annotation .= sprintf(" %-6s", $revision) if $::opt_v;
|
||||
|
||||
# Date annotation
|
||||
$annotation .= " $::revision_ctime{$revision}" if $::opt_d;
|
||||
|
||||
# Age annotation ?
|
||||
$annotation .= sprintf(" (%3s)",
|
||||
int($revision_age{$revision})) if $::opt_A;
|
||||
|
||||
# -m (if-modified-since) annotion ?
|
||||
if ($::opt_m && ($::timestamp{$revision} < $::opt_m_timestamp)) {
|
||||
$annotation = $blank_annotation;
|
||||
}
|
||||
|
||||
# Suppress annotation of whitespace lines, if requested;
|
||||
$annotation = $blank_annotation if $::opt_w && ($text =~ /^\s*$/);
|
||||
|
||||
# printf "%4d ", $line if $::opt_l;
|
||||
# print "$annotation - $text";
|
||||
push(@output, sprintf("%4d ", $line)) if $::opt_l;
|
||||
push(@output, "$annotation - $text");
|
||||
}
|
||||
@output;
|
||||
}
|
||||
|
||||
sub usage {
|
||||
die
|
||||
"$::progname: usage: [options] [file|dir]...\n",
|
||||
" Options:\n",
|
||||
" -r <revision> Specify CVS revision of file to display\n",
|
||||
" <revision> can be any of:\n",
|
||||
" + numeric tag, e.g. 1.23,\n",
|
||||
" + symbolic branch or revision tag, e.g. CHEDDAR,\n",
|
||||
" + HEAD keyword (most recent revision on trunk)\n",
|
||||
" -a Annotate lines with author (username)\n",
|
||||
" -A Annotate lines with age, in days\n",
|
||||
" -v Annotate lines with revision number\n",
|
||||
" -d Annotate lines with date, in local time zone\n",
|
||||
" -l Annotate lines with line number\n",
|
||||
" -w Don't annotate all-whitespace lines\n",
|
||||
" -m <# days> Only annotate lines modified within last <# days>\n",
|
||||
" -h Print help (this message)\n\n",
|
||||
" (-a -v assumed, if none of -a, -v, -A, -d supplied)\n"
|
||||
;
|
||||
}
|
||||
|
||||
|
||||
&usage if (!&Getopts('r:m:Aadhlvw'));
|
||||
&usage if ($::opt_h); # help option
|
||||
|
||||
$multiple_files_on_command_line = 1 if ($#ARGV != 0);
|
||||
|
||||
&cvsblame_init;
|
||||
|
||||
sub annotate_cvs_directory
|
||||
{
|
||||
my ($dir) = @_;
|
||||
&read_cvs_entries($dir);
|
||||
foreach $file (split(/\\/, $cvs_files{$dir})) {
|
||||
&show_annotated_cvs_file("$dir/$file");
|
||||
}
|
||||
}
|
||||
|
||||
# No files on command-line ? Use current directory.
|
||||
push(@ARGV, '.') if ($#ARGV == -1);
|
||||
|
||||
# Iterate over files/directories on command-line
|
||||
while ($#ARGV >= 0) {
|
||||
$pathname = shift @ARGV;
|
||||
# Is it a directory ?
|
||||
if (-d $pathname) {
|
||||
&traverse_cvs_tree($pathname, *annotate_cvs_directory);
|
||||
|
||||
# No, it must be a file.
|
||||
} else {
|
||||
&show_annotated_cvs_file($pathname);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
@@ -1,196 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# cvsgraph.cgi -- a graph of all branchs, tags, etc.
|
||||
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/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 CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Jacob Steenhagen
|
||||
#
|
||||
# Contributor(s): Jacob Steenhagen <jake@acutex.net>
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
use vars qw{ $revision_ctime $revision_author };
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
# This cgi doesn't actually generate a graph. It relies on the cvsgraph
|
||||
# program found at http://www.akhphd.au.dk/~bertho/cvsgraph/
|
||||
# File locations can be set at in the editparams.cgi page.
|
||||
|
||||
sub print_top {
|
||||
my ($title) = @_;
|
||||
$title ||= "Error";
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
|
||||
print "<html>\n<head>\n";
|
||||
print " <title>$title</title>\n";
|
||||
print "</head>\n<body>\n";
|
||||
}
|
||||
|
||||
sub print_bottom {
|
||||
print "</body>\n</html>\n";
|
||||
}
|
||||
|
||||
sub print_usage {
|
||||
&print_top;
|
||||
print "This script requires a filename.\n";
|
||||
&print_bottom;
|
||||
}
|
||||
|
||||
### Live code below
|
||||
|
||||
unless (Param('cvsgraph')) {
|
||||
&print_top;
|
||||
print "CVS Graph is not currently configured for this installation\n";
|
||||
&print_bottom;
|
||||
exit;
|
||||
}
|
||||
|
||||
my @src_roots = getRepositoryList();
|
||||
|
||||
# Handle the "file" argument
|
||||
#
|
||||
my $filename = '';
|
||||
$filename = $::FORM{file} if defined $::FORM{file};
|
||||
if ($filename eq '') {
|
||||
&print_usage;
|
||||
exit;
|
||||
}
|
||||
|
||||
my ($file_head, $file_tail) = $filename =~ m@(.*/)?(.+)@;
|
||||
|
||||
# Handle the "root" argument
|
||||
#
|
||||
my $root = $::FORM{root};
|
||||
if (defined $root and $root ne '') {
|
||||
$root =~ s|/$||;
|
||||
validateRepository($root);
|
||||
if (-d $root) {
|
||||
unshift(@src_roots, $root);
|
||||
} else {
|
||||
&print_top;
|
||||
print "Error: Root, $root, is not a directory.<BR><BR>\n";
|
||||
&print_bottom;
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
# Find the rcs file
|
||||
#
|
||||
my $rcs_filename;
|
||||
my $found_rcs_file = 0;
|
||||
foreach (@src_roots) {
|
||||
$root = $_;
|
||||
$rcs_filename = "$root/$filename,v";
|
||||
$rcs_filename = Fix_BonsaiLink($rcs_filename);
|
||||
$found_rcs_file = 1, last if -r $rcs_filename;
|
||||
$rcs_filename = "$root/${file_head}Attic/$file_tail,v";
|
||||
$found_rcs_file = 1, last if -r $rcs_filename;
|
||||
}
|
||||
|
||||
unless ($found_rcs_file) {
|
||||
&print_top;
|
||||
print "Rcs file, $filename, does not exist.\n";
|
||||
print "<pre>rcs_filename => '$rcs_filename'\nroot => '$root'</pre>\n";
|
||||
&print_bottom;
|
||||
exit;
|
||||
}
|
||||
|
||||
# Hack these variables up the way that the cvsgraph executable wants them
|
||||
my $full_rcs_filename = $rcs_filename;
|
||||
$rcs_filename =~ s:^$root/::;
|
||||
my $conf = $0;
|
||||
$conf =~ s:[^/\\]+$::;
|
||||
$conf .= "data/cvsgraph.conf";
|
||||
|
||||
my @cvsgraph_cmd = (Param("cvsgraph"),
|
||||
"-c", $conf,
|
||||
"-r", $root);
|
||||
|
||||
if (defined $::FORM{'image'}) {
|
||||
print "Content-type: image/png\n\n";
|
||||
}
|
||||
else {
|
||||
push(@cvsgraph_cmd, "-i", "-M", "revmap"); # Include args to make map
|
||||
&print_top("CVS Graph for " . $file_tail);
|
||||
print <<"--endquote--" if $::use_dom;
|
||||
<script $::script_type><!--
|
||||
var r
|
||||
function showMessage(rev) {
|
||||
if (r) {
|
||||
r.style.display='none'
|
||||
}
|
||||
r = document.getElementById('rev_'+rev)
|
||||
var l = document.getElementById('link_'+rev)
|
||||
var t = l.offsetTop + 20
|
||||
r.style.top = t
|
||||
r.style.left = l.offsetLeft + l.offsetWidth + 20
|
||||
r.style.display=''
|
||||
return true
|
||||
}
|
||||
|
||||
function hideMessage() {
|
||||
if (r) {
|
||||
r.style.display='none'
|
||||
return true
|
||||
}
|
||||
return false
|
||||
}
|
||||
//--></script>
|
||||
|
||||
<style type="text/css">
|
||||
.log_msg {
|
||||
border-style: solid;
|
||||
border-color: #F0A000;
|
||||
background-color: #FFFFFF;
|
||||
padding: 5;
|
||||
position: absolute;
|
||||
}
|
||||
</style>
|
||||
--endquote--
|
||||
|
||||
print <<"--endquote--" unless $::use_dom;
|
||||
<script $::script_type><!--
|
||||
// Dummy Functions to prevent script errors (this browser does not support DOM)
|
||||
function showMessage() { return false }
|
||||
function hideMessage() { return false }
|
||||
//--></script>
|
||||
--endquote--
|
||||
}
|
||||
|
||||
system(@cvsgraph_cmd, $rcs_filename);
|
||||
|
||||
if (!defined $::FORM{'image'}) {
|
||||
print qq{<img src="cvsgraph.cgi?file=$::FORM{'file'}&image=1" };
|
||||
print qq{usemap="#revmap" alt="$filename" border="0" onclick="hideMessage()">\n};
|
||||
if ($::use_dom) {
|
||||
require 'cvsblame.pl';
|
||||
&parse_cvs_file($full_rcs_filename);
|
||||
foreach my $rev (keys %::revision_log) {
|
||||
my $author = EmailFromUsername($::revision_author{$rev});
|
||||
my $rev_log = html_quote($::revision_log{$rev});
|
||||
$rev_log =~ s/\n/<br>\n/g;
|
||||
print qq{<div id="rev_$rev" class="log_msg" style="display:none">\n};
|
||||
print qq{<b>$rev</b> };
|
||||
print qq{<<a href="mailto:$author">$author</a>> };
|
||||
print qq{<b>$::revision_ctime{$rev}</b><br>\n};
|
||||
print $rev_log;
|
||||
print qq{</div>\n};
|
||||
}
|
||||
}
|
||||
&print_bottom;
|
||||
}
|
||||
@@ -1,181 +0,0 @@
|
||||
# CvsGraph configuration
|
||||
#
|
||||
# - Empty lines and whitespace are ignored.
|
||||
#
|
||||
# - Comments start with '#' and everything until
|
||||
# end of line is ignored.
|
||||
#
|
||||
# - Strings are C-style strings in which characters
|
||||
# may be escaped with '\' and written in octal
|
||||
# and hex escapes. Note that '\' must be escaped
|
||||
# if it is to be entered as a character.
|
||||
#
|
||||
# - Some strings are expanded with printf like
|
||||
# conversions which start with '%'. Not all
|
||||
# are applicable at all times, in which case they
|
||||
# will expand to noting.
|
||||
# %c = cvsroot (with trailing '/')
|
||||
# %C = cvsroot (*without* trailing '/')
|
||||
# %m = module (with trailing '/')
|
||||
# %M = module (*without* trailing '/')
|
||||
# %f = filename without path
|
||||
# %F = filename without path and with ",v" stripped
|
||||
# %p = path part of filename (with trailing '/')
|
||||
# %r = number of revisions
|
||||
# %b = number of branches
|
||||
# %% = '%'
|
||||
# %R = the revision number (e.g. '1.2.4.4')
|
||||
# %P = previous revision number
|
||||
# %B = the branch number (e.g. '1.2.4')
|
||||
# %d = date of revision
|
||||
# %a = author of revision
|
||||
# %s = state of revision
|
||||
# %t = current tag of branch or revision
|
||||
# %0..%9 = command-line argument -0 .. -9
|
||||
#
|
||||
# - Numbers may be entered as octal, decimal or
|
||||
# hex as in 0117, 79 and 0x4f respectively.
|
||||
#
|
||||
# - Fonts are numbered 0..4 (defined as in libgd)
|
||||
# 0 = tiny
|
||||
# 1 = small
|
||||
# 2 = medium (bold)
|
||||
# 3 = large
|
||||
# 4 = giant
|
||||
#
|
||||
# - Colors are a string like html-type colors in
|
||||
# the form "#rrggbb" with parts written in hex
|
||||
# rr = red (00..ff)
|
||||
# gg = green (00-ff)
|
||||
# bb = blue (00-ff)
|
||||
#
|
||||
# - There are several reserved words besides of the
|
||||
# feature-keywords. These additional reserved words
|
||||
# expand to numerical values:
|
||||
# * false = 0
|
||||
# * true = 1
|
||||
# * left = 0
|
||||
# * center = 1
|
||||
# * right = 2
|
||||
# * gif = 0
|
||||
# * png = 1
|
||||
# * jpeg = 2
|
||||
# * tiny = 0
|
||||
# * small = 1
|
||||
# * medium = 2
|
||||
# * large = 3
|
||||
# * giant = 4
|
||||
|
||||
# cvsroot <string>
|
||||
# The *absolute* base directory where the
|
||||
# CSV/RCS repository can be found
|
||||
# cvsmodule <string>
|
||||
#
|
||||
#cvsroot = "/cvsroot";
|
||||
#cvsmodule = "";
|
||||
|
||||
# color_bg <color>
|
||||
# The background color of the image
|
||||
color_bg = "#ffffff";
|
||||
|
||||
# date_format <string>
|
||||
# The strftime(3) format string for date and time
|
||||
date_format = "%d-%b-%Y %H:%M:%S";
|
||||
|
||||
box_shadow = true;
|
||||
|
||||
tag_font = medium;
|
||||
tag_color = "#007000";
|
||||
|
||||
rev_font = giant;
|
||||
rev_color = "#000000";
|
||||
rev_bgcolor = "#f0f0f0";
|
||||
rev_separator = 1;
|
||||
rev_minline = 15;
|
||||
rev_maxline = 30;
|
||||
rev_lspace = 5;
|
||||
rev_rspace = 5;
|
||||
rev_tspace = 3;
|
||||
rev_bspace = 3;
|
||||
rev_text = "%d\n%a"; # or "%d\n%a, %s" for author and state too
|
||||
rev_text_font = tiny;
|
||||
rev_text_color = "#500020";
|
||||
|
||||
# branch_font <number>
|
||||
# The font of the number and tags
|
||||
# branch_color <color>
|
||||
# All branch element's color
|
||||
# branch_[lrtb]space <number>
|
||||
# Interior spacing (margin)
|
||||
# branch_margin <number>
|
||||
# Exterior spacing
|
||||
# branch_connect <number>
|
||||
# Length of the vertical connector
|
||||
branch_font = medium;
|
||||
branch_color = "#0000c0";
|
||||
branch_bgcolor = "#ffffc0";
|
||||
branch_lspace = 5;
|
||||
branch_rspace = 5;
|
||||
branch_tspace = 3;
|
||||
branch_bspace = 3;
|
||||
branch_margin = 15;
|
||||
branch_connect = 8;
|
||||
|
||||
# title <string>
|
||||
# The title string is expanded (see above for details)
|
||||
# title_[xy] <number>
|
||||
# Postion of title
|
||||
# title_font <number>
|
||||
# The font
|
||||
# title_align <number>
|
||||
# 0 = left
|
||||
# 1 = center
|
||||
# 2 = right
|
||||
# title_color <color>
|
||||
title = "%m%f\nRevisions: %r, Branches: %b";
|
||||
title_x = 10;
|
||||
title_y = 5;
|
||||
title_font = small;
|
||||
title_align = left;
|
||||
title_color = "#800000";
|
||||
|
||||
# Margins of the image
|
||||
# Note: the title is outside the margin
|
||||
margin_top = 35;
|
||||
margin_bottom = 10;
|
||||
margin_left = 10;
|
||||
margin_right = 10;
|
||||
|
||||
# Image format(s)
|
||||
# image_type <number|{gif,jpeg,png}>
|
||||
# gif (0) = Create gif image
|
||||
# png (1) = Create png image
|
||||
# jpeg (2) = Create jpeg image
|
||||
# Image types are available if they can be found in
|
||||
# the gd library. Newer versions of gd do not have
|
||||
# gif anymore. CvsGraph will automatically generate
|
||||
# png images instead.
|
||||
# image_quality <number>
|
||||
# The quality of a jpeg image (1..100)
|
||||
image_type = png;
|
||||
image_quality = 75;
|
||||
|
||||
# HTML ImageMap generation
|
||||
# map_name <string>
|
||||
# The name= attribute in <map name="mapname">...</map>
|
||||
# map_branch_href <string>
|
||||
# map_branch_alt <string>
|
||||
# map_rev_href <string>
|
||||
# map_rev_alt <string>
|
||||
# map_diff_href <string>
|
||||
# map_diff_alt <string>
|
||||
# These are the href= and alt= attributes in the <area>
|
||||
# tags of html. The strings are expanded (see above).
|
||||
map_name = "revmap";
|
||||
map_branch_href = "href=\"cvslog.cgi?file=%p%F&rev=%t\"";
|
||||
map_branch_alt = "alt=\"%t\" %2";
|
||||
map_rev_href = "href=\"cvsblame.cgi?file=%p%F&rev=%R\"";
|
||||
map_rev_alt = "alt=\"%a\" onmouseover=\"showMessage('%R')\" id=\"link_%R\" %3";
|
||||
map_diff_href = "href=\"%9cvsview2.cgi?diff_mode=context&whitespace_mode=show&file=%F&subdir=%p&command=DIFF_FRAMESET&rev1=%P&rev2=%R\"";
|
||||
map_diff_alt = "alt=\"%P <-> %R\" %4";
|
||||
|
||||
@@ -1,78 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
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";
|
||||
|
||||
my $CVS_ROOT = $::FORM{'root'};
|
||||
if( !defined($CVS_ROOT) || $CVS_ROOT eq '' ){
|
||||
$CVS_ROOT = pickDefaultRepository();
|
||||
}
|
||||
validateRepository($CVS_ROOT);
|
||||
|
||||
my $CVS_REPOS_SUFIX = $CVS_ROOT;
|
||||
$CVS_REPOS_SUFIX =~ s/\//_/g;
|
||||
|
||||
ConnectToDatabase();
|
||||
|
||||
my $f = SqlQuote($file);
|
||||
my $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";
|
||||
}
|
||||
|
||||
my (@row, $d, @fl, $s);
|
||||
|
||||
SendSQL($qstring);
|
||||
while(@row = FetchSQLData()){
|
||||
$d = $row[0];
|
||||
push @fl, "$d/$file";
|
||||
}
|
||||
|
||||
if( @fl == 0 ){
|
||||
print "<h3>No files matched this file name. It may have been added recently.</h3>";
|
||||
}
|
||||
elsif( @fl == 1 ){
|
||||
$s = $fl[0];
|
||||
print "<head>
|
||||
<meta http-equiv=Refresh
|
||||
content=\"0; URL=cvsblame.cgi?file=$s&rev=$rev&root=$CVS_ROOT&mark=$mark#$ln\">
|
||||
</head>
|
||||
";
|
||||
}
|
||||
else {
|
||||
print "<h3>Pick the file that best matches the one you are looking for:</h3>\n";
|
||||
for $s (@fl) {
|
||||
print "<dt><a href=cvsblame.cgi?file=$s&rev=$rev&mark=$mark#$ln>$s</a>";
|
||||
}
|
||||
}
|
||||
@@ -1,94 +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.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
|
||||
# Figure out which directory bonsai is in by looking at argv[0]
|
||||
|
||||
$bonsaidir = $0;
|
||||
$bonsaidir =~ s:/[^/]*$::; # Remove last word, and slash before it.
|
||||
if ($bonsaidir eq "") {
|
||||
$bonsaidir = ".";
|
||||
}
|
||||
|
||||
chdir $bonsaidir || die "Couldn't chdir to $bonsaidir";
|
||||
require "utils.pl";
|
||||
|
||||
if( $ARGV[0] eq '' ){
|
||||
$::CVS_ROOT = pickDefaultRepository();
|
||||
}
|
||||
else {
|
||||
$::CVS_ROOT = $ARGV[0];
|
||||
}
|
||||
|
||||
$CVS_REPOS_SUFIX = $::CVS_ROOT;
|
||||
$CVS_REPOS_SUFIX =~ s:/:_:g;
|
||||
|
||||
|
||||
$CHECKIN_DATA_FILE = "$bonsaidir/data/checkinlog${CVS_REPOS_SUFIX}";
|
||||
$CHECKIN_INDEX_FILE = "$bonsaidir/data/index${CVS_REPOS_SUFIX}";
|
||||
|
||||
&build_index;
|
||||
&print_keys;
|
||||
|
||||
sub build_index {
|
||||
open(CI, "<$CHECKIN_DATA_FILE") || die "could not open checkin data file\n";
|
||||
|
||||
$file_pos = 0;
|
||||
$lastlog = 0;
|
||||
$last_date = 0;
|
||||
$index = {};
|
||||
$now = time;
|
||||
while( <CI> ){
|
||||
if( /^LOGCOMMENT/ ){
|
||||
$done = 0;
|
||||
$file_pos += length;
|
||||
while( !$done && ($line = <CI>) ){
|
||||
if( $line =~ /^:ENDLOGCOMMENT/ ){
|
||||
$done = 1;
|
||||
}
|
||||
$file_pos += length($line);
|
||||
}
|
||||
}
|
||||
else {
|
||||
#print $_ . "\n";
|
||||
$ci = [split(/\|/)];
|
||||
$d = $ci->[1];
|
||||
|
||||
if( $d < $now && $d > ($last_date + 60*60*4) ){
|
||||
$index->{$d} = $file_pos;
|
||||
$last_date = $d;
|
||||
}
|
||||
$file_pos += length;
|
||||
}
|
||||
}
|
||||
close( CI );
|
||||
}
|
||||
|
||||
sub print_keys {
|
||||
Lock();
|
||||
open(INDEX , ">$CHECKIN_INDEX_FILE");
|
||||
for $i (sort {$b <=> $a} keys %{$index}) {
|
||||
print INDEX "$index->{$i}|$i\n";
|
||||
}
|
||||
close(INDEX);
|
||||
Unlock();
|
||||
}
|
||||
@@ -1,550 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
# cvslog.cgi -- cvslog with logs as popups and allowing html in comments.
|
||||
#
|
||||
# Created: Steve Lamm <slamm@netscape.com>, 31-Mar-98.
|
||||
#
|
||||
# Arguments (passed via GET or POST):
|
||||
# file - path to file name (e.g. ns/cmd/xfe/Makefile)
|
||||
# root - cvs root (e.g. /warp/webroot)
|
||||
# rev - revision (default is the latest version)
|
||||
# mark - highlight a revision
|
||||
# author - filter based on author
|
||||
#
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::CVS_ROOT;
|
||||
$zz = $::head_revision;
|
||||
$zz = $::revision_ctime;
|
||||
$zz = $::revision_log;
|
||||
}
|
||||
|
||||
require 'CGI.pl';
|
||||
require 'cvsblame.pl';
|
||||
use SourceChecker;
|
||||
|
||||
# Some Globals
|
||||
#
|
||||
$| = 1;
|
||||
|
||||
my @src_roots = getRepositoryList();
|
||||
|
||||
|
||||
# Handle the "file" argument
|
||||
#
|
||||
my $filename = '';
|
||||
$filename = $::FORM{'file'} if defined($::FORM{'file'});
|
||||
if ($filename eq '')
|
||||
{
|
||||
print "Content-Type:text/html\n\n";
|
||||
&print_usage;
|
||||
exit;
|
||||
}
|
||||
my ($file_head, $file_tail) = $filename =~ m@(.*/)?(.+)@;
|
||||
|
||||
|
||||
# Handle the "rev" argument
|
||||
#
|
||||
$::opt_rev = "";
|
||||
$::opt_rev = $::FORM{'rev'} if defined $::FORM{'rev'} && $::FORM{'rev'} !~ m/^(HEAD|MAIN)$/;
|
||||
my $revstr = '';
|
||||
$revstr = "&rev=$::opt_rev" unless $::opt_rev eq '';
|
||||
my $browse_revtag = 'HEAD';
|
||||
$browse_revtag = $::opt_rev if ($::opt_rev =~ /[A-Za-z]/);
|
||||
my $revision = '';
|
||||
|
||||
|
||||
# Handle the "root" argument
|
||||
#
|
||||
my $root = $::FORM{'root'};
|
||||
if (defined $root && $root ne '') {
|
||||
$root =~ s|/$||;
|
||||
validateRepository($root);
|
||||
if (-d $root) {
|
||||
unshift(@src_roots, $root);
|
||||
} else {
|
||||
print "Content-Type:text/html\n\n";
|
||||
&print_top;
|
||||
print "Error: Root, $root, is not a directory.<BR><BR>\n";
|
||||
print "</BODY></HTML>\n";
|
||||
&print_bottom;
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
# Find the rcs file
|
||||
#
|
||||
my $rcs_filename;
|
||||
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 "Content-Type:text/html\n\n";
|
||||
&print_top;
|
||||
my $escaped_filename = html_quote($filename);
|
||||
print "Rcs file, $escaped_filename, does not exist.<BR><BR>\n";
|
||||
print "</BODY></HTML>\n";
|
||||
&print_bottom;
|
||||
exit;
|
||||
|
||||
found_file:
|
||||
|
||||
my $rcs_path;
|
||||
($rcs_path) = $rcs_filename =~ m@$root/(.*)/.+?,v@;
|
||||
|
||||
|
||||
# Parse the rcs file ($::opt_rev is passed as a global)
|
||||
#
|
||||
$revision = &parse_cvs_file($rcs_filename);
|
||||
my $file_rev = $revision;
|
||||
|
||||
my $start_rev;
|
||||
if ($browse_revtag eq 'HEAD') {
|
||||
$start_rev = $::head_revision; # $::head_revision is a global from cvsblame.pl
|
||||
} else {
|
||||
$start_rev = map_tag_to_revision($browse_revtag);
|
||||
}
|
||||
print "Content-Type:text/html\n";
|
||||
print "Last-Modified: ".time2str("%a, %d %b %Y %T %Z", str2time($::revision_ctime{$start_rev}), "GMT")."\n";
|
||||
print "\n";
|
||||
|
||||
# Handle the "mark" argument
|
||||
#
|
||||
my %mark;
|
||||
my $mark_arg = '';
|
||||
$mark_arg = $::FORM{'mark'} if defined($::FORM{'mark'});
|
||||
foreach my $rev (split(',',$mark_arg)) {
|
||||
$mark{$rev} = 1;
|
||||
}
|
||||
|
||||
|
||||
# Handle the "author" argument
|
||||
#
|
||||
my %use_author;
|
||||
my $author_arg = '';
|
||||
$author_arg = $::FORM{'author'} if defined($::FORM{'author'});
|
||||
foreach my $author (split(',',$author_arg)) {
|
||||
$use_author{$author} = 1;
|
||||
}
|
||||
|
||||
|
||||
# Handle the "sort" argument
|
||||
my $opt_sort = '';
|
||||
$opt_sort = $::FORM{'sort'} if defined $::FORM{'sort'};
|
||||
|
||||
|
||||
# Start printing out the page
|
||||
#
|
||||
&print_top;
|
||||
print Param('bannerhtml', 1);
|
||||
|
||||
|
||||
# Print link at top for directory browsing
|
||||
#
|
||||
print q(
|
||||
<TABLE BORDER=0 CELLPADDING=5 CELLSPACING=0 WIDTH="100%">
|
||||
<TR>
|
||||
<TD ALIGN=LEFT VALIGN=CENTER>
|
||||
<NOBR><FONT SIZE="+2"><B>
|
||||
CVS Log
|
||||
</B></FONT></NOBR>
|
||||
<BR><B>
|
||||
);
|
||||
|
||||
my $link_path;
|
||||
my $lxr_path;
|
||||
foreach my $path (split('/',$rcs_path)) {
|
||||
$link_path .= url_encode2($path).'/';
|
||||
$lxr_path = Fix_LxrLink($link_path);
|
||||
print "<A HREF='$lxr_path'>$path</a>/ ";
|
||||
}
|
||||
$lxr_path = Fix_LxrLink("$link_path$file_tail");
|
||||
print "<A HREF='$lxr_path'>$file_tail</a> ";
|
||||
|
||||
my $graph_cell = Param('cvsgraph') ? <<"--endquote--" : "";
|
||||
</TR><TR>
|
||||
<TD>
|
||||
<A HREF="cvsgraph.cgi?file=$filename">graph</A>
|
||||
</TD><TD NOWRAP>
|
||||
View the revision history as a graph
|
||||
</TD>
|
||||
--endquote--
|
||||
|
||||
print " (";
|
||||
print "$browse_revtag:" unless $browse_revtag eq 'HEAD';
|
||||
print $revision if $revision;
|
||||
print ")";
|
||||
|
||||
print qq(
|
||||
</B>
|
||||
</TD>
|
||||
|
||||
<TD ALIGN=RIGHT VALIGN=TOP WIDTH="1%">
|
||||
<TABLE BORDER CELLPADDING=10 CELLSPACING=0>
|
||||
<TR>
|
||||
<TD NOWRAP BGCOLOR="#FAFAFA">
|
||||
<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
|
||||
<TR>
|
||||
<TD>
|
||||
<A HREF="$lxr_path">lxr</A>
|
||||
</TD><TD NOWRAP>
|
||||
Browse the source code as hypertext.
|
||||
</TD>
|
||||
</TR><TR>
|
||||
<TD>
|
||||
<A HREF="cvsview2.cgi?command=DIRECTORY&subdir=$rcs_path&files=$file_tail&branch=$::opt_rev">diff</A>
|
||||
</TD><TD NOWRAP>
|
||||
Compare any two version.
|
||||
</TD>
|
||||
</TR><TR>
|
||||
<TD>
|
||||
<A HREF="cvsblame.cgi?file=$filename&rev=$::opt_rev&cvsroot=$root">blame</A>
|
||||
</TD><TD NOWRAP>
|
||||
Annotate the author of each line.
|
||||
</TD>
|
||||
$graph_cell
|
||||
</TR>
|
||||
</TABLE>
|
||||
</TD>
|
||||
</TR>
|
||||
</TABLE>
|
||||
</TD>
|
||||
</TR>
|
||||
</TABLE>
|
||||
);
|
||||
|
||||
#&print_useful_links($filename);
|
||||
|
||||
# Create a table with header links to sort by column.
|
||||
#
|
||||
my $table_tag = "<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=3 WIDTH='100%'>";
|
||||
my $table_header_tag = "";
|
||||
if ($opt_sort eq 'author') {
|
||||
$table_header_tag .= "<TH ALIGN=LEFT><A HREF='cvslog.cgi?file=$filename&root=$root&rev=$browse_revtag&sort=revision&author=$author_arg'>Rev</A><TH ALIGN=LEFT>Author<TH ALIGN=LEFT><A HREF='cvslog.cgi?file=$filename&root=$root&rev=$browse_revtag&sort=date&author=$author_arg'>Date</A><TH><TH ALIGN=LEFT>Log";
|
||||
} else {
|
||||
$table_header_tag .= "<TH ALIGN=LEFT>Rev<TH ALIGN=LEFT><A HREF='cvslog.cgi?file=$filename&root=$root&rev=$browse_revtag&sort=author&author=$author_arg'>Author</A><TH ALIGN=LEFT>Date<TH><TH ALIGN=LEFT>Log";
|
||||
}
|
||||
|
||||
$table_header_tag = &url_encode3($table_header_tag);
|
||||
print "$table_tag$table_header_tag";
|
||||
|
||||
# Print each line of the revision, preceded by its annotation.
|
||||
#
|
||||
my $row_count = 0;
|
||||
my $max_rev_length = length($start_rev);
|
||||
my $max_author_length = 8;
|
||||
my @revisions = ($start_rev, ancestor_revisions($start_rev));
|
||||
@revisions = sort by_author @revisions if $opt_sort eq 'author';
|
||||
#@revisions = sort by_author @revisions if $opt_sort eq 'date' && $rev eq 'all';
|
||||
my $bgcolor;
|
||||
foreach $revision (@revisions)
|
||||
{
|
||||
my $author = $::revision_author{$revision};
|
||||
next unless $author_arg eq '' || $use_author{$author};
|
||||
|
||||
my $log = $::revision_log{$revision};
|
||||
$log =~ s/&/&/g;
|
||||
$log =~ s/</</g;
|
||||
$log =~ s/>/>/g;
|
||||
$log = MarkUpText($log);
|
||||
$log =~ s/\n|\r|\r\n/<BR>/g;
|
||||
|
||||
if ($revision eq $::opt_rev) {
|
||||
$bgcolor = ' BGCOLOR="LIGHTBLUE"';
|
||||
} elsif ($mark{$revision}) {
|
||||
$bgcolor = ' BGCOLOR="LIGHTGREEN"';
|
||||
} elsif (!defined $bgcolor || $bgcolor eq '') {
|
||||
$bgcolor = ' BGCOLOR="#E7E7E7"'; # Pick a grey that shows up on 8-bit.
|
||||
} else {
|
||||
$bgcolor = '';
|
||||
}
|
||||
|
||||
my $output = '';
|
||||
$row_count++;
|
||||
if ($row_count > 20) {
|
||||
$output .= "</TABLE>\n$table_tag";
|
||||
$row_count = 0;
|
||||
}
|
||||
|
||||
$output .= "<TR$bgcolor VALIGN=TOP><TD>"
|
||||
."<A NAME=$revision>";
|
||||
|
||||
my $anchor = "<A HREF=cvsview2.cgi";
|
||||
|
||||
if (defined($::prev_revision{$revision})) {
|
||||
$anchor .= "?diff_mode=context&whitespace_mode=show&file=$file_tail&branch=$::opt_rev"
|
||||
."&root=$root&subdir=$rcs_path&command=DIFF_FRAMESET"
|
||||
."&rev1=$::prev_revision{$revision}&rev2=$revision";
|
||||
} else {
|
||||
$anchor .= "?files=$file_tail"
|
||||
."&root=$root&subdir=$rcs_path\&command=DIRECTORY\&rev2=$revision&branch=$::opt_rev";
|
||||
$anchor .= "&branch=$browse_revtag" unless $browse_revtag eq 'HEAD';
|
||||
}
|
||||
|
||||
$anchor = &url_encode3($anchor);
|
||||
|
||||
$output .= $anchor;
|
||||
|
||||
$output .= ">$revision</A>"
|
||||
.' ' x ($max_rev_length - length($revision)).'</TD>';
|
||||
|
||||
$output .= "<TD>".$author
|
||||
.' ' x ($max_author_length - length($author)).'</TD>';
|
||||
my $rev_time = $::revision_ctime{$revision};
|
||||
# $rev_time =~ s/(19\d\d) (.\d:\d\d)/$1<BR><FONT SIZE=-2>$2<\/FONT>/;
|
||||
|
||||
# jwz: print the date the way "ls" does.
|
||||
#
|
||||
# What ls does is actually: print "Mmm DD HH:MM" unless the file is
|
||||
# more than six months old, or more than 1 hour in the future, in
|
||||
# which case, print "Mmm DD YYYY".
|
||||
#
|
||||
# What the following does is: "Mmm DD HH:MM" unless the year is not
|
||||
# the current year; else print "Mmm DD YYYY".
|
||||
#
|
||||
# If we had $rev_time as an actual time_t instead of as a string,
|
||||
# it would be easy to do the "ls" thing (see the code I wrote for
|
||||
# this in "lxr/source"). -jwz, 15-Jun-98.
|
||||
#
|
||||
{
|
||||
my $current_time = time;
|
||||
my @t = gmtime($current_time);
|
||||
my ($csec, $cmin, $chour, $cmday, $cmon, $cyear) = @t;
|
||||
$cyear += 1900;
|
||||
|
||||
$_ = $rev_time;
|
||||
my ($rday, $rmon, $ryear, $rhour, $rmin) =
|
||||
m/([0-9]+) ([A-Z][a-z]+) ([0-9][0-9]+) +([0-9]+):([0-9]+)/;
|
||||
$rmon =~ s/^(...).*$/$1/;
|
||||
|
||||
if (!$rday) {
|
||||
# parse error -- be annoying so somebody complains.
|
||||
$rev_time = "<BLINK>\"$rev_time\"</BLINK>";
|
||||
} elsif ($cyear ne $ryear) {
|
||||
$rev_time = sprintf("%s %2d %04d", $rmon, $rday, $ryear);
|
||||
} else {
|
||||
$rev_time = sprintf("%s %2d %02d:%02d",
|
||||
$rmon, $rday, $rhour, $rmin);
|
||||
}
|
||||
|
||||
$rev_time = "<FONT SIZE=\"-1\">$rev_time</FONT>";
|
||||
}
|
||||
|
||||
$output .= "<TD NOWRAP ALIGN=RIGHT>$rev_time</TD>";
|
||||
$output .= "<TD> </TD><TD WIDTH=99%>$log</TD>";
|
||||
|
||||
$output .= "</TR>\n";
|
||||
|
||||
print $output;
|
||||
}
|
||||
print "</TABLE>";
|
||||
&print_bottom;
|
||||
|
||||
## END of main script
|
||||
|
||||
sub by_revision {
|
||||
my (@a_parts) = split(/\./,$a);
|
||||
my (@b_parts) = split(/\./,$b);
|
||||
while(1) {
|
||||
my ($aa) = shift @a_parts;
|
||||
my ($bb) = shift @b_parts;
|
||||
return 1 if $aa eq '';
|
||||
return -1 if $bb eq '';
|
||||
return $bb <=> $aa if $aa ne $bb;
|
||||
}
|
||||
}
|
||||
|
||||
sub by_author {
|
||||
my ($a_author) = $::revision_author{$a};
|
||||
my ($b_author) = $::revision_author{$b};
|
||||
|
||||
return $a_author cmp $b_author if $a_author ne $b_author;
|
||||
return by_revision;
|
||||
}
|
||||
|
||||
sub revision_pad {
|
||||
my ($revision) = @_;
|
||||
return ' ' x ($max_rev_length - length($revision));
|
||||
}
|
||||
|
||||
sub sprint_author {
|
||||
my ($revision) = @_;
|
||||
my ($author) = $::revision_author{$revision};
|
||||
|
||||
return
|
||||
}
|
||||
|
||||
|
||||
sub print_top {
|
||||
my ($title_text) = "for $file_tail (";
|
||||
$title_text .= "$browse_revtag:" unless $browse_revtag eq 'HEAD';
|
||||
$title_text .= $revision if $revision;
|
||||
$title_text .= ")";
|
||||
$title_text =~ s/\(\)//;
|
||||
|
||||
print <<__TOP__;
|
||||
<HTML>
|
||||
<HEAD>
|
||||
<TITLE>CVS Log $title_text</TITLE>
|
||||
</HEAD>
|
||||
<BODY BGCOLOR=WHITE TEXT=BLACK>
|
||||
|
||||
__TOP__
|
||||
} # print_top
|
||||
|
||||
sub print_usage {
|
||||
my ($linenum_message) = '';
|
||||
my ($new_linenum, $src_roots_list);
|
||||
my ($title_text) = "Usage";
|
||||
|
||||
$src_roots_list = join('<BR>', @src_roots);
|
||||
|
||||
print <<__USAGE__;
|
||||
<HTML>
|
||||
<HEAD>
|
||||
<TITLE>CVS Log $title_text</TITLE>
|
||||
</HEAD><BODY>
|
||||
<H2>CVS Log Usage</H2>
|
||||
Add parameters to the query string to view a file.
|
||||
<P>
|
||||
<TABLE BORDER CELLPADDING=3>
|
||||
<TR ALIGN=LEFT>
|
||||
<TH>Param</TH>
|
||||
<TH>Default</TH>
|
||||
<TH>Example</TH>
|
||||
<TH>Description</TH>
|
||||
</TR><TR>
|
||||
<TD>file</TD>
|
||||
<TD>--</TD>
|
||||
<TD>ns/cmd/Makefile</TD>
|
||||
<TD>Path to file name</TD>
|
||||
</TR><TR>
|
||||
<TD>root</TD>
|
||||
<TD>$src_roots_list</TD>
|
||||
<TD>/warp/webroot</TD>
|
||||
<TD>CVS root</TD>
|
||||
</TR><TR>
|
||||
<TD>rev</TD>
|
||||
<TD>HEAD</TD>
|
||||
<TD>1.3
|
||||
<BR>ACTRA_branch</TD>
|
||||
<TD>Revision</TD>
|
||||
</TR><TR>
|
||||
<TD>author</TD>
|
||||
<TD>--</TD>
|
||||
<TD>slamm,mtoy</TD>
|
||||
<TD>Filter out these authors</TD>
|
||||
</TR>
|
||||
</TR><TR>
|
||||
<TD>#<rev_number></TD>
|
||||
<TD>--</TD>
|
||||
<TD>#1.2</TD>
|
||||
<TD>Jump to a revision</TD>
|
||||
</TR>
|
||||
</TABLE>
|
||||
|
||||
<P>Examples:
|
||||
<TABLE><TR><TD> </TD><TD>
|
||||
<A HREF="cvslog.cgi?file=ns/cmd/Makefile">
|
||||
cvslog.cgi?file=ns/cmd/Makefile</A>
|
||||
</TD></TR><TR><TD> </TD><TD>
|
||||
<A HREF="cvslog.cgi?file=ns/cmd/xfe/mozilla.c&rev=Dogbert4xEscalation_BRANCH">
|
||||
cvslog.cgi?file=ns/cmd/xfe/mozilla.c&rev=Dogbert4xEscalation_BRANCH</A>
|
||||
</TD></TR><TR><TD> </TD><TD>
|
||||
<A HREF="cvslog.cgi?file=projects/bonsai/cvslog.cgi&root=/warp/webroot">
|
||||
cvslog.cgi?file=projects/bonsai/cvslog.cgi&root=/warp/webroot</A>
|
||||
</TD></TR><TR><TD> </TD><TD>
|
||||
<A HREF="cvslog.cgi?file=ns/cmd/xfe/dialogs.c#1.19">
|
||||
cvslog.cgi?file=ns/cmd/xfe/dialogs.c#1.19</A>
|
||||
</TD></TR></TABLE>
|
||||
<P>
|
||||
You may also begin a query with the <A HREF="cvsqueryform.cgi">CVS Query Form</A>.
|
||||
</P>
|
||||
__USAGE__
|
||||
&print_bottom;
|
||||
} # sub print_usage
|
||||
|
||||
sub 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:$maintainer?subject=About the cvslog script"><$maintainer></A>.
|
||||
</FONT></BODY>
|
||||
</HTML>
|
||||
__BOTTOM__
|
||||
} # print_bottom
|
||||
|
||||
sub print_useful_links {
|
||||
my ($path) = @_;
|
||||
my ($dir, $file) = $path =~ m@(.*/)?(.+)@;
|
||||
$dir =~ s@/$@@;
|
||||
|
||||
my $diff_base = "cvsview2.cgi";
|
||||
my $blame_base = "cvsblame.cgi";
|
||||
|
||||
my $lxr_path = $path;
|
||||
my $lxr_link = Fix_LxrLink($lxr_path);
|
||||
my $diff_link = "$diff_base?command=DIRECTORY\&subdir=$dir\&files=$file\&branch=$::opt_rev";
|
||||
my $blame_link = "$blame_base?root=$::CVS_ROOT\&file=$path\&rev=$::opt_rev";
|
||||
|
||||
print "<DIV ALIGN=RIGHT>
|
||||
<TABLE BORDER CELLPADDING=10 CELLSPACING=0>
|
||||
<TR>
|
||||
<TD>
|
||||
<TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0>
|
||||
<TR>
|
||||
<TD VALIGN=TOP ALIGN=RIGHT><A HREF=\"$lxr_link\"><B>lxr:</B></A> </TD>
|
||||
<TD>browse the source code as hypertext.</TD>
|
||||
</TR>
|
||||
<TR>
|
||||
<TD VALIGN=TOP ALIGN=RIGHT><A HREF=\"$diff_link\"><B>diff:</B></A> </TD>
|
||||
<TD>compare any two versions.</TD>
|
||||
</TR>
|
||||
<TR>
|
||||
<TD VALIGN=TOP ALIGN=RIGHT><A HREF=\"$blame_link\"><B>blame:</B></A> </TD>
|
||||
<TD>annotate the author of each line.</TD>
|
||||
</TR>
|
||||
</TABLE>
|
||||
</TD>
|
||||
</TR>
|
||||
</TABLE>
|
||||
</DIV>
|
||||
";
|
||||
}
|
||||
@@ -1,67 +0,0 @@
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
1;
|
||||
|
||||
require 'utils.pl';
|
||||
|
||||
sub cvsmenu {
|
||||
my($extra) = @_;
|
||||
loadConfigData();
|
||||
print "
|
||||
<table border=1 bgcolor=#ffffcc $extra><tr><th>Menu</tr><tr><td>
|
||||
<p><dl>";
|
||||
|
||||
my $pass;
|
||||
my $i;
|
||||
foreach $pass ("cvsqueryform|Query",
|
||||
"rview|Browse",
|
||||
"moduleanalyse|Examine Modules") {
|
||||
($page, $title) = split(/\|/, $pass);
|
||||
print "<b>$title</b><br><ul>\n";
|
||||
foreach $i (@treelist) {
|
||||
my $branch = $treeinfo{$i}->{'branch'};
|
||||
if ($branch ne "") {
|
||||
$branch = "&branch=" . $branch;
|
||||
}
|
||||
$desc = $treeinfo{$i}->{'shortdesc'};
|
||||
if ($desc eq "") {
|
||||
$desc = $treeinfo{$i}->{'description'};
|
||||
}
|
||||
print "<li><a href=$page.cgi?cvsroot=$treeinfo{$i}->{'repository'}&module=$treeinfo{$i}->{'module'}$branch>$desc</a>\n";
|
||||
};
|
||||
print "</ul>\n";
|
||||
};
|
||||
|
||||
if (open(EXTRA, "<data/cvsmenuextra")) {
|
||||
while (<EXTRA>) {
|
||||
print $_;
|
||||
}
|
||||
close EXTRA;
|
||||
}
|
||||
|
||||
print "</dl>
|
||||
<p></tr><tr><td><font size=-1> Questions, Comments, Feature requests? mail <a href=mailto:terry\@netscape.com>terry</a>
|
||||
</tr></table>
|
||||
";
|
||||
|
||||
}
|
||||
|
||||
@@ -1,681 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::CI_BRANCH;
|
||||
$zz = $::CI_REPOSITORY;
|
||||
$zz = $::lines_added;
|
||||
$zz = $::lines_removed;
|
||||
$zz = $::query_begin_tag;
|
||||
$zz = $::query_branchtype;
|
||||
$zz = $::query_date_max;
|
||||
$zz = $::query_debug;
|
||||
$zz = $::query_end_tag;
|
||||
$zz = $::query_filetype;
|
||||
$zz = $::query_logexpr;
|
||||
$zz = $::query_whotype;
|
||||
}
|
||||
|
||||
|
||||
|
||||
require 'CGI.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();
|
||||
|
||||
require 'cvsquery.pl';
|
||||
|
||||
my $userdomain = Param('userdomain');
|
||||
my $registryurl = Param('registryurl');
|
||||
$registryurl =~ s@/$@@;
|
||||
$| = 1;
|
||||
|
||||
my $sm_font_tag = "<font face='Arial,Helvetica' size=-2>";
|
||||
|
||||
my $generateBackoutCVSCommands = 0;
|
||||
if (defined $::FORM{'generateBackoutCVSCommands'}) {
|
||||
$generateBackoutCVSCommands = 1;
|
||||
}
|
||||
|
||||
if (!$generateBackoutCVSCommands) {
|
||||
print "Content-type: text/html
|
||||
|
||||
";
|
||||
|
||||
print setup_script();
|
||||
}
|
||||
|
||||
#print "<pre>";
|
||||
|
||||
|
||||
my $CVS_REPOS_SUFIX = $::CVS_ROOT;
|
||||
$CVS_REPOS_SUFIX =~ s/\//_/g;
|
||||
|
||||
my $CHECKIN_DATA_FILE = "data/checkinlog${CVS_REPOS_SUFIX}";
|
||||
my $CHECKIN_INDEX_FILE = "data/index${CVS_REPOS_SUFIX}";
|
||||
|
||||
|
||||
my $SORT_HEAD="bgcolor=\"#DDDDDD\"";
|
||||
|
||||
#
|
||||
# Log the query
|
||||
Log("Query [$ENV{'REMOTE_ADDR'}]: $ENV{'QUERY_STRING'}");
|
||||
|
||||
#
|
||||
# build a module map
|
||||
#
|
||||
$::query_module = $::FORM{'module'};
|
||||
|
||||
#
|
||||
# allow ?file=/a/b/c/foo.c to be synonymous with ?dir=/a/b/c&file=foo.c
|
||||
#
|
||||
$::FORM{'file'} = "" unless defined $::FORM{'file'};
|
||||
unless ($::FORM{'dir'}) {
|
||||
$::FORM{'file'} = Fix_BonsaiLink($::FORM{'file'});
|
||||
if ($::FORM{'file'} =~ m@(.*?/)([^/]*)$@) {
|
||||
$::FORM{'dir'} = $1;
|
||||
$::FORM{'file'} = $2;
|
||||
} else {
|
||||
$::FORM{'dir'} = "";
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# build a directory map
|
||||
#
|
||||
@::query_dirs = split(/[;, \t]+/, $::FORM{'dir'});
|
||||
|
||||
$::query_file = $::FORM{'file'};
|
||||
$::query_filetype = $::FORM{'filetype'};
|
||||
$::query_logexpr = $::FORM{'logexpr'};
|
||||
|
||||
#
|
||||
# date
|
||||
#
|
||||
$::query_date_type = $::FORM{'date'};
|
||||
if( $::query_date_type eq 'hours' ){
|
||||
$::query_date_min = time - $::FORM{'hours'}*60*60;
|
||||
}
|
||||
elsif( $::query_date_type eq 'day' ){
|
||||
$::query_date_min = time - 24*60*60;
|
||||
}
|
||||
elsif( $::query_date_type eq 'week' ){
|
||||
$::query_date_min = time - 7*24*60*60;
|
||||
}
|
||||
elsif( $::query_date_type eq 'month' ){
|
||||
$::query_date_min = time - 30*24*60*60;
|
||||
}
|
||||
elsif( $::query_date_type eq 'all' ){
|
||||
$::query_date_min = 0;
|
||||
}
|
||||
elsif( $::query_date_type eq 'explicit' ){
|
||||
if ($::FORM{'mindate'}) {
|
||||
$::query_date_min = parse_date($::FORM{'mindate'});
|
||||
}
|
||||
|
||||
if ($::FORM{'maxdate'}) {
|
||||
$::query_date_max = parse_date($::FORM{'maxdate'});
|
||||
}
|
||||
}
|
||||
else {
|
||||
$::query_date_min = time-60*60*2;
|
||||
}
|
||||
|
||||
#
|
||||
# who
|
||||
#
|
||||
$::query_who = $::FORM{'who'};
|
||||
$::query_whotype = $::FORM{'whotype'};
|
||||
|
||||
|
||||
my $show_raw = 0;
|
||||
if ($::FORM{'raw'}) {
|
||||
$show_raw = 1;
|
||||
}
|
||||
|
||||
#
|
||||
# branch
|
||||
#
|
||||
$::query_branch = $::FORM{'branch'};
|
||||
if (!defined $::query_branch) {
|
||||
$::query_branch = 'HEAD';
|
||||
}
|
||||
$::query_branchtype = $::FORM{'branchtype'};
|
||||
|
||||
|
||||
#
|
||||
# tags
|
||||
#
|
||||
$::query_begin_tag = $::FORM{'begin_tag'};
|
||||
$::query_end_tag = $::FORM{'end_tag'};
|
||||
|
||||
|
||||
#
|
||||
# Get the query in english and print it.
|
||||
#
|
||||
my ($t, $e);
|
||||
$t = $e = &query_to_english;
|
||||
$t =~ s/<[^>]*>//g;
|
||||
|
||||
$::query_debug = $::FORM{'debug'};
|
||||
|
||||
my %mod_map = ();
|
||||
my $result= &query_checkins( %mod_map );
|
||||
|
||||
my %w;
|
||||
|
||||
for my $i (@{$result}) {
|
||||
my $aname=$i->[$::CI_WHO];
|
||||
# the else is for compatibility w/ something that uses the other format
|
||||
# the regexp is probably not the best, but I think it might work
|
||||
if ($aname =~ /%\w*.\w\w+/) {
|
||||
my $tmp = join("@",split("%",$aname));
|
||||
$w{"$tmp"} = 1;
|
||||
}else{
|
||||
$w{"$i->[$::CI_WHO]\@$userdomain"} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
my @p = sort keys %w;
|
||||
my $pCount = @p;
|
||||
my $s = join(",%20", @p);
|
||||
|
||||
$e =~ s/Checkins in/In/;
|
||||
|
||||
my $menu = "
|
||||
<p align=center>$e
|
||||
<p align=left>
|
||||
<a href=cvsqueryform.cgi?$ENV{QUERY_STRING}>Modify Query</a>
|
||||
";
|
||||
if ($pCount) {
|
||||
$menu .= "
|
||||
<br><a href=mailto:$s>Mail everyone on this page</a>
|
||||
<NOBR>($pCount people)</NOBR>
|
||||
<br><a href=cvsquery.cgi?$ENV{QUERY_STRING}&generateBackoutCVSCommands=1>Show commands which could be used to back out these changes</a>
|
||||
";
|
||||
}
|
||||
|
||||
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
|
||||
# backout the changes selected by your query.
|
||||
|
||||
";
|
||||
unless ($pCount) {
|
||||
print "
|
||||
#
|
||||
# No changes occurred during this interval.
|
||||
# There is nothing to back out.
|
||||
#
|
||||
|
||||
";
|
||||
exit;
|
||||
}
|
||||
|
||||
foreach my $ci (reverse @{$result}) {
|
||||
if ($ci->[$::CI_REV] eq "") {
|
||||
print "echo 'Changes made to $ci->[$::CI_DIR]/$ci->[$::CI_FILE] need to be backed out by hand'\n";
|
||||
next;
|
||||
}
|
||||
my $prev_revision = PrevRev($ci->[$::CI_REV]);
|
||||
print "cvs update -j$ci->[$::CI_REV] -j$prev_revision $ci->[$::CI_DIR]/$ci->[$::CI_FILE]\n";
|
||||
}
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
PutsHeader($t, "CVS Checkins", "$menu");
|
||||
|
||||
#
|
||||
# Test code to print the results
|
||||
#
|
||||
|
||||
$|=1;
|
||||
|
||||
my $head_who = '';
|
||||
my $head_file = '';
|
||||
my $head_directory = '';
|
||||
my $head_delta = '';
|
||||
my $head_date = '';
|
||||
|
||||
if( !$show_raw ) {
|
||||
|
||||
$::FORM{"sortby"} ||= "";
|
||||
|
||||
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_result($result);
|
||||
}
|
||||
else {
|
||||
print "<pre>";
|
||||
for my $ci (@$result) {
|
||||
$ci->[$::CI_LOG] = '';
|
||||
$s = join("|",@$ci);
|
||||
print "$s\n";
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
sub print_result {
|
||||
my ($result) = @_;
|
||||
my ($ci,$i,$k,$j,$max, $l, $span);
|
||||
|
||||
&print_head;
|
||||
|
||||
$i = 20;
|
||||
$k = 0;
|
||||
$max = @{$result};
|
||||
|
||||
while( $k < $max ){
|
||||
$ci = $result->[$k];
|
||||
$span = 1;
|
||||
if( ($l = $ci->[$::CI_LOG]) ne '' ){
|
||||
#
|
||||
# Calculate the number of consecutive logs that are
|
||||
# the same and nuke them
|
||||
#
|
||||
$j = $k+1;
|
||||
while( $j < $max && $result->[$j]->[$::CI_LOG] eq $l ){
|
||||
$result->[$j]->[$::CI_LOG] = '';
|
||||
$j++;
|
||||
}
|
||||
|
||||
#
|
||||
# Make sure we don't break over a description block
|
||||
#
|
||||
$span = $j-$k;
|
||||
if( $span-1 > $i ){
|
||||
$i = $j-$k;
|
||||
}
|
||||
}
|
||||
|
||||
&print_ci( $ci, $span );
|
||||
|
||||
|
||||
if( $i <= 0 ){
|
||||
$i = 20;
|
||||
print "</TABLE><TABLE border cellspacing=2>\n";
|
||||
}
|
||||
else {
|
||||
$i--;
|
||||
}
|
||||
$k++;
|
||||
}
|
||||
|
||||
&print_foot;
|
||||
}
|
||||
|
||||
my $descwidth;
|
||||
|
||||
sub print_ci {
|
||||
my ($ci, $span) = @_;
|
||||
|
||||
my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $ci->[$::CI_DATE] );
|
||||
my $t = sprintf("%02d/%02d/%04d %02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
|
||||
|
||||
my $log = &html_log($ci->[$::CI_LOG]);
|
||||
my $rev = $ci->[$::CI_REV];
|
||||
my $url_who = url_quote($ci->[$::CI_WHO]);
|
||||
|
||||
print "<tr>\n";
|
||||
print "<TD width=2%>${sm_font_tag}$t</font>";
|
||||
print "<TD width=2%><a href='$registryurl/who.cgi?email=$url_who'"
|
||||
. " onClick=\"return js_who_menu('$url_who','',event);\" >"
|
||||
. "$ci->[$::CI_WHO]</a>\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];
|
||||
# if( (length $ci->[$::CI_DIR]) > 30 ){
|
||||
# $d =~ s/([^\n]*\/)(classes\/)/$1classes\/<br>  /;
|
||||
# # Insert a <BR> before any directory named
|
||||
# # 'classes.'
|
||||
# }
|
||||
# print " $d/<br> $ci->[$::CI_FILE]<a>\n";
|
||||
# }
|
||||
# else{
|
||||
# print " $ci->[$::CI_DIR]/$ci->[$::CI_FILE]<a>\n";
|
||||
# }
|
||||
my $d = "$ci->[$::CI_DIR]/$ci->[$::CI_FILE]";
|
||||
if (defined $::query_module && $::query_module eq 'allrepositories') {
|
||||
$d = "$ci->[$::CI_REPOSITORY]/$d";
|
||||
}
|
||||
$d =~ s:/:/ :g; # Insert a whitespace after any slash, so that
|
||||
# we'll break long names at a reasonable place.
|
||||
print "$d\n";
|
||||
|
||||
if( $rev ne '' ){
|
||||
my $prevrev = &PrevRev( $rev );
|
||||
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 width=2%>\ \n";
|
||||
}
|
||||
|
||||
if( !$::query_branch_head ){
|
||||
print "<TD width=2%><TT><FONT SIZE=-1>$ci->[$::CI_BRANCH] </FONT></TT>\n";
|
||||
}
|
||||
|
||||
print "<TD width=2%>${sm_font_tag}$ci->[$::CI_LINES_ADDED]/$ci->[$::CI_LINES_REMOVED]</font> \n";
|
||||
if( $log ne '' ){
|
||||
$log = MarkUpText($log);
|
||||
# Makes numbers into links to bugsplat.
|
||||
|
||||
$log =~ s/\n/<BR>/g;
|
||||
# Makes newlines into <BR>'s
|
||||
|
||||
if( $span > 1 ){
|
||||
print "<TD WIDTH=$descwidth% VALIGN=TOP ROWSPAN=$span>$log\n";
|
||||
}
|
||||
else {
|
||||
print "<TD WIDTH=$descwidth% VALIGN=TOP>$log\n";
|
||||
}
|
||||
}
|
||||
print "</tr>\n";
|
||||
}
|
||||
|
||||
sub print_head {
|
||||
|
||||
if ($::versioninfo) {
|
||||
print "<FORM action='multidiff.cgi' method=post>";
|
||||
print "<INPUT TYPE='HIDDEN' name='allchanges' value = '$::versioninfo'>";
|
||||
print "<INPUT TYPE='HIDDEN' name='cvsroot' value = '$::CVS_ROOT'>";
|
||||
print "<INPUT TYPE=SUBMIT VALUE='Show me ALL the Diffs'>";
|
||||
print "</FORM>";
|
||||
print "<tt>(+$::lines_added/$::lines_removed)</tt> Lines changed.";
|
||||
}
|
||||
|
||||
my $anchor = $ENV{QUERY_STRING};
|
||||
$anchor =~ s/\&sortby\=[A-Za-z\ \+]*//g;
|
||||
$anchor = "<a href=cvsquery.cgi?$anchor";
|
||||
|
||||
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 ){
|
||||
print "<TH width=2%>Branch\n";
|
||||
$descwidth -= 2;
|
||||
}
|
||||
|
||||
print "<TH width=2% $head_delta>${anchor}&sortby=Change+Size>+/-</a>\n";
|
||||
print "<TH WIDTH=$descwidth%>Description\n";
|
||||
print "</TR></b>\n";
|
||||
}
|
||||
|
||||
|
||||
sub print_foot {
|
||||
print "</TABLE>";
|
||||
print "<br><br>";
|
||||
}
|
||||
|
||||
sub html_log {
|
||||
my ( $log ) = @_;
|
||||
$log =~ s/&/&/g;
|
||||
$log =~ s/</</g;
|
||||
return $log;
|
||||
}
|
||||
|
||||
sub PrevRev {
|
||||
my( $rev ) = @_;
|
||||
my( $i, $j, $ret, @r );
|
||||
|
||||
@r = split( /\./, $rev );
|
||||
|
||||
$i = @r-1;
|
||||
|
||||
$r[$i]--;
|
||||
if( $r[$i] == 0 ){
|
||||
$i -= 2;
|
||||
}
|
||||
|
||||
$j = 0;
|
||||
while( $j < $i ){
|
||||
$ret .= "$r[$j]\.";
|
||||
$j++
|
||||
}
|
||||
$ret .= $r[$i];
|
||||
}
|
||||
|
||||
|
||||
sub parse_date {
|
||||
my($d) = @_;
|
||||
|
||||
my($result) = str2time($d);
|
||||
if (defined $result) {
|
||||
return $result;
|
||||
} elsif ($d > 7000000) {
|
||||
return $d;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub setup_script {
|
||||
|
||||
my $script_str = qq{
|
||||
<script $::script_type><!--
|
||||
var event = 0; // Nav3.0 compatibility
|
||||
|
||||
function js_who_menu(n,extra,d) {
|
||||
if( parseInt(navigator.appVersion) < 4 ||
|
||||
navigator.userAgent.toLowerCase().indexOf("msie") != -1 ){
|
||||
return true;
|
||||
}
|
||||
l = document.layers['popup'];
|
||||
l.src="$registryurl/who.cgi?email="+n+extra;
|
||||
|
||||
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;
|
||||
}
|
||||
l.left = d.target.x - 6;
|
||||
|
||||
l.visibility="show";
|
||||
return false;
|
||||
}
|
||||
|
||||
function js_file_menu(repos,dir,file,rev,branch,d) {
|
||||
var fileName="";
|
||||
if( parseInt(navigator.appVersion) < 4 ||
|
||||
navigator.userAgent.toLowerCase().indexOf("msie") != -1 ){
|
||||
return true;
|
||||
}
|
||||
for (var i=0;i<d.target.text.length;i++)
|
||||
{
|
||||
if (d.target.text.charAt(i)!=" ") {
|
||||
fileName+=d.target.text.charAt(i);
|
||||
}
|
||||
}
|
||||
l = document.layers['popup'];
|
||||
l.src="$registryurl/file.cgi?cvsroot="+repos+"&file="+file+"&dir="+dir+"&rev="+rev+"&branch="+branch+"&linked_text="+fileName;
|
||||
|
||||
l.top = d.target.y - 6;
|
||||
l.left = d.target.x - 6;
|
||||
if( l.left + l.clipWidth > window.width ){
|
||||
l.left = window.width - l.clipWidth;
|
||||
}
|
||||
l.visibility="show";
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
//--></script>
|
||||
|
||||
<layer name="popup" onMouseOut="this.visibility='hide';" left=0 top=0 bgcolor="#ffffff" visibility="hide">
|
||||
</layer>
|
||||
|
||||
};
|
||||
|
||||
return $script_str;
|
||||
}
|
||||
|
||||
#
|
||||
# Actually do the query
|
||||
#
|
||||
sub query_to_english {
|
||||
my $english = 'Checkins ';
|
||||
|
||||
$::query_module = 'all' unless defined $::query_module;
|
||||
if( $::query_module eq 'allrepositories' ){
|
||||
$english .= "to <i>All Repositories</i> ";
|
||||
}
|
||||
elsif( $::query_module ne 'all' && @::query_dirs == 0 ){
|
||||
$english .= "to module <i>" . html_quote($::query_module) . "</i> ";
|
||||
}
|
||||
elsif( $::FORM{dir} ne "" ) {
|
||||
my $word = "directory";
|
||||
if (@::query_dirs > 1) {
|
||||
$word = "directories";
|
||||
}
|
||||
$english .= "to $word <i>" . html_quote($::FORM{dir}) . "</i> ";
|
||||
}
|
||||
|
||||
if ($::query_file ne "") {
|
||||
if ($english ne 'Checkins ') {
|
||||
$english .= "and ";
|
||||
}
|
||||
$english .= "to file " . html_quote($::query_file) . " ";
|
||||
}
|
||||
|
||||
if( ! ($::query_branch =~ /^[ ]*HEAD[ ]*$/i) ){
|
||||
if($::query_branch eq '' ){
|
||||
$english .= "on all branches ";
|
||||
}
|
||||
else {
|
||||
$english .= "on branch <i>" . html_quote($::query_branch) . "</i> ";
|
||||
}
|
||||
}
|
||||
|
||||
if( $::query_who) {
|
||||
$english .= "by " . html_quote($::query_who) . " ";
|
||||
}
|
||||
|
||||
$::query_date_type = $::FORM{'date'};
|
||||
if( $::query_date_type eq 'hours' ){
|
||||
$english .="in the last " . html_quote($::FORM{hours}) . " hours";
|
||||
}
|
||||
elsif( $::query_date_type eq 'day' ){
|
||||
$english .="in the last day";
|
||||
}
|
||||
elsif( $::query_date_type eq 'week' ){
|
||||
$english .="in the last week";
|
||||
}
|
||||
elsif( $::query_date_type eq 'month' ){
|
||||
$english .="in the last month";
|
||||
}
|
||||
elsif( $::query_date_type eq 'all' ){
|
||||
$english .="since the beginning of time";
|
||||
}
|
||||
elsif( $::query_date_type eq 'explicit' ){
|
||||
my ($w1, $w2);
|
||||
if ( $::FORM{mindate} && $::FORM{maxdate}) {
|
||||
$w1 = "between";
|
||||
$w2 = "and" ;
|
||||
}
|
||||
else {
|
||||
$w1 = "since";
|
||||
$w2 = "before";
|
||||
}
|
||||
|
||||
if( $::FORM{'mindate'}){
|
||||
my $dd = &parse_date($::FORM{'mindate'});
|
||||
my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
|
||||
my $t = sprintf("%02d/%02d/%04d %02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
|
||||
$english .= "$w1 <i>$t</i> ";
|
||||
}
|
||||
|
||||
if( $::FORM{'maxdate'}){
|
||||
my $dd = &parse_date($::FORM{'maxdate'});
|
||||
my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
|
||||
my $t = sprintf("%02d/%02d/%04d %02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
|
||||
$english .= "$w2 <i>$t</i> ";
|
||||
}
|
||||
}
|
||||
return $english . ":";
|
||||
}
|
||||
|
||||
PutsTrailer();
|
||||
@@ -1,446 +0,0 @@
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
require 'globals.pl';
|
||||
require 'get_line.pl';
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub cvsquery_pl_sillyness {
|
||||
my $zz;
|
||||
$zz = $::CI_BRANCH;
|
||||
$zz = $::CI_CHANGE;
|
||||
$zz = $::CI_DATE;
|
||||
$zz = $::CI_STICKY;
|
||||
$zz = $::TreeID;
|
||||
$zz = $::query_debug;
|
||||
$zz = $::query_filetype;
|
||||
$zz = $::versioninfo;
|
||||
};
|
||||
|
||||
#
|
||||
# Constants
|
||||
#
|
||||
$::CI_CHANGE=0;
|
||||
$::CI_DATE=1;
|
||||
$::CI_WHO=2;
|
||||
$::CI_REPOSITORY=3;
|
||||
$::CI_DIR=4;
|
||||
$::CI_FILE=5;
|
||||
$::CI_REV=6;
|
||||
$::CI_STICKY=7;
|
||||
$::CI_BRANCH=8;
|
||||
$::CI_LINES_ADDED=9;
|
||||
$::CI_LINES_REMOVED=10;
|
||||
$::CI_LOG=11;
|
||||
|
||||
my $NOT_LOCAL = 1;
|
||||
my $IS_LOCAL = 2;
|
||||
|
||||
chomp($::CVS_ROOT) if defined($::CVS_ROOT);
|
||||
if (!defined($::CVS_ROOT) || $::CVS_ROOT eq "" ){
|
||||
$::CVS_ROOT = pickDefaultRepository();
|
||||
}
|
||||
|
||||
#global variables
|
||||
|
||||
$::lines_added = 0;
|
||||
$::lines_removed = 0;
|
||||
|
||||
$::modules = {};
|
||||
|
||||
my $CVS_MODULES="$::CVS_ROOT/CVSROOT/modules";
|
||||
|
||||
open( MOD, "<$CVS_MODULES") || die "can't open ${CVS_MODULES}";
|
||||
&parse_modules;
|
||||
close( MOD );
|
||||
|
||||
1;
|
||||
|
||||
#
|
||||
# Actually do the query
|
||||
#
|
||||
sub query_checkins {
|
||||
my (%mod_map) = @_;
|
||||
my ($ci,$result,$lastlog,$rev,$begin_tag,$end_tag);
|
||||
my $have_mod_map;
|
||||
|
||||
$::query_module = 'all' unless defined $::query_module;
|
||||
if( $::query_module ne 'all' && $::query_module ne 'allrepositories' && @::query_dirs == 0 ){
|
||||
$have_mod_map = 1;
|
||||
%mod_map = &get_module_map( $::query_module );
|
||||
}
|
||||
else {
|
||||
$have_mod_map = 0;
|
||||
%mod_map = ();
|
||||
}
|
||||
|
||||
for my $i (@::query_dirs ){
|
||||
$i =~ s:^/::; # Strip leading slash.
|
||||
$i =~ s:/$::; # Strip trailing slash.
|
||||
|
||||
if( !$have_mod_map ){
|
||||
%mod_map = ();
|
||||
$have_mod_map = 1;
|
||||
}
|
||||
$mod_map{$i} = $NOT_LOCAL;
|
||||
}
|
||||
|
||||
if( $::query_branch =~ /^[ ]*HEAD[ ]*$/i ){
|
||||
$::query_branch_head = 1;
|
||||
}
|
||||
|
||||
$begin_tag = "";
|
||||
$end_tag = "";
|
||||
|
||||
if (defined($::query_begin_tag) && $::query_begin_tag ne '') {
|
||||
$begin_tag = load_tag($::query_begin_tag);
|
||||
}
|
||||
|
||||
if (defined($::query_end_tag) && $::query_end_tag ne '') {
|
||||
$end_tag = load_tag($::query_end_tag);
|
||||
}
|
||||
|
||||
|
||||
$result = [];
|
||||
|
||||
ConnectToDatabase();
|
||||
|
||||
my $qstring = "select type, UNIX_TIMESTAMP(ci_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";
|
||||
|
||||
if( $::query_module ne 'allrepositories' ){
|
||||
$qstring .= " and repositories.repository = '$::CVS_ROOT'";
|
||||
}
|
||||
|
||||
if ($::query_date_min) {
|
||||
my $t = formatSqlTime($::query_date_min);
|
||||
$qstring .= " and ci_when >= '$t'";
|
||||
}
|
||||
if ($::query_date_max) {
|
||||
my $t = formatSqlTime($::query_date_max);
|
||||
$qstring .= " and ci_when <= '$t'";
|
||||
}
|
||||
if ($::query_branch_head) {
|
||||
$qstring .= " and branches.branch = ''";
|
||||
} elsif ($::query_branch ne '') {
|
||||
my $q = SqlQuote($::query_branch);
|
||||
if ($::query_branchtype eq 'regexp') {
|
||||
$qstring .=
|
||||
" and branches.branch regexp $q";
|
||||
} elsif ($::query_branchtype eq 'notregexp') {
|
||||
$qstring .=
|
||||
" and not (branches.branch regexp $q) ";
|
||||
} else {
|
||||
$qstring .=
|
||||
" and (branches.branch = $q or branches.branch = ";
|
||||
$qstring .= SqlQuote("T$::query_branch") . ")";
|
||||
}
|
||||
}
|
||||
|
||||
if (0 < @::query_dirs) {
|
||||
my @list;
|
||||
foreach my $i (@::query_dirs) {
|
||||
push(@list, "dirs.dir like " . SqlQuote("$i%"));
|
||||
}
|
||||
$qstring .= "and (" . join(" or ", @list) . ")";
|
||||
}
|
||||
|
||||
if (defined $::query_file && $::query_file ne '') {
|
||||
my $q = SqlQuote($::query_file);
|
||||
$::query_filetype ||= "exact";
|
||||
if ($::query_filetype eq 'regexp') {
|
||||
$qstring .= " and files.file regexp $q";
|
||||
} elsif ($::query_filetype eq 'notregexp') {
|
||||
$qstring .= " and not (files.file regexp $q)";
|
||||
} else {
|
||||
$qstring .= " and files.file = $q";
|
||||
}
|
||||
}
|
||||
if (defined $::query_who && $::query_who ne '') {
|
||||
my $q = SqlQuote($::query_who);
|
||||
$::query_whotype ||= "exact";
|
||||
if ($::query_whotype eq 'regexp') {
|
||||
$qstring .= " and people.who regexp $q";
|
||||
}
|
||||
elsif ($::query_whotype eq 'notregexp') {
|
||||
$qstring .= " and not (people.who regexp $q)";
|
||||
|
||||
} else {
|
||||
$qstring .= " and people.who = $q";
|
||||
}
|
||||
}
|
||||
|
||||
if (defined($::query_logexpr) && $::query_logexpr ne '') {
|
||||
my $q = SqlQuote($::query_logexpr);
|
||||
$qstring .= " and descs.description regexp $q";
|
||||
}
|
||||
|
||||
if ($::query_debug) {
|
||||
print "<pre wrap> Query: $qstring\nTreeID is $::TreeID\n";
|
||||
if ($have_mod_map) {
|
||||
print "Dump of module map:\n";
|
||||
foreach my $k (sort(keys %mod_map)) {
|
||||
print value_quote("$k => $mod_map{$k}") . "\n";
|
||||
}
|
||||
print "\n\nDump of parsed module file:\n";
|
||||
foreach my $k(sort(keys %$::modules)) {
|
||||
print value_quote("$k => " .
|
||||
join(",", @{$::modules->{$k}})) . "\n";
|
||||
}
|
||||
}
|
||||
print "</pre>\n";
|
||||
}
|
||||
|
||||
SendSQL($qstring);
|
||||
|
||||
$lastlog = 0;
|
||||
my @row;
|
||||
while (@row = FetchSQLData()) {
|
||||
#print "<pre>";
|
||||
$ci = [];
|
||||
for (my $i=0 ; $i<=$::CI_LOG ; $i++) {
|
||||
$ci->[$i] = $row[$i];
|
||||
#print "$row[$i] ";
|
||||
}
|
||||
#print "</pre>";
|
||||
|
||||
|
||||
my $key = "$ci->[$::CI_DIR]/$ci->[$::CI_FILE]";
|
||||
if (IsHidden("$ci->[$::CI_REPOSITORY]/$key")) {
|
||||
next;
|
||||
}
|
||||
|
||||
if( $have_mod_map &&
|
||||
!&in_module(\%mod_map, $ci->[$::CI_DIR], $ci->[$::CI_FILE] ) ){
|
||||
next;
|
||||
}
|
||||
|
||||
if( $begin_tag) {
|
||||
$rev = $begin_tag->{$key};
|
||||
print "<BR>$key begintag is $rev<BR>\n";
|
||||
if ($rev == "" || rev_is_after($ci->[$::CI_REV], $rev)) {
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
if( $end_tag) {
|
||||
$rev = $end_tag->{$key};
|
||||
print "<BR>$key endtag is $rev<BR>\n";
|
||||
if ($rev == "" || rev_is_after($rev, $ci->[$::CI_REV])) {
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
if (defined($::query_logexpr) &&
|
||||
$::query_logexpr ne '' &&
|
||||
!($ci->[$::CI_LOG] =~ /$::query_logexpr/i) ){
|
||||
next;
|
||||
}
|
||||
|
||||
push( @$result, $ci );
|
||||
}
|
||||
|
||||
for $ci (@{$result}) {
|
||||
$::lines_added += $ci->[$::CI_LINES_ADDED];
|
||||
$::lines_removed += $ci->[$::CI_LINES_REMOVED];
|
||||
$::versioninfo .= "$ci->[$::CI_WHO]|$ci->[$::CI_DIR]|$ci->[$::CI_FILE]|$ci->[$::CI_REV],";
|
||||
}
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub load_tag {
|
||||
my ($tagname) = @_;
|
||||
|
||||
my $tagfile;
|
||||
my $cvssuffix;
|
||||
my $s;
|
||||
my @line;
|
||||
my $time;
|
||||
my $cmd;
|
||||
my $dir;
|
||||
|
||||
$cvssuffix = $::CVS_ROOT;
|
||||
$cvssuffix =~ s/\//_/g;
|
||||
|
||||
$s = $tagname;
|
||||
|
||||
$s =~ s/ /\%20/g;
|
||||
$s =~ s/\%/\%25/g;
|
||||
$s =~ s/\//\%2f/g;
|
||||
$s =~ s/\?/\%3f/g;
|
||||
$s =~ s/\*/\%2a/g;
|
||||
|
||||
$tagfile = "data/taginfo/$cvssuffix/$s";
|
||||
|
||||
open(TAG, "<$tagfile") || die "Unknown tag $tagname";
|
||||
my $result = {};
|
||||
|
||||
|
||||
print "<br>parsing tag $tagname</br>\n";
|
||||
while ( <TAG> ) {
|
||||
chop;
|
||||
@line = split(/\|/);
|
||||
$time = shift @line;
|
||||
$cmd = shift @line;
|
||||
if ($cmd != "add") {
|
||||
# We ought to be able to cope with these... XXX
|
||||
next;
|
||||
}
|
||||
$dir = shift @line;
|
||||
$dir =~ s@^$::CVS_ROOT/@@;
|
||||
$dir =~ s:^\./::;
|
||||
|
||||
while (@line) {
|
||||
my $file = shift @line;
|
||||
$file = "$dir/$file";
|
||||
my $version = shift @line;
|
||||
$result->{$file} = $version;
|
||||
print "<br>Added ($file,$version) for tag $tagname<br>\n";
|
||||
}
|
||||
}
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub rev_is_after {
|
||||
my $r1 = shift @_;
|
||||
my $r2 = shift @_;
|
||||
|
||||
my @a = split /:/, $r1;
|
||||
my @b = split /:/, $r2;
|
||||
|
||||
if (@b > @a) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
if (@b < @a) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
for (my $i=0 ; $i<@a ; $i++) {
|
||||
if ($a[$i] > $b[$i]) {return 1;}
|
||||
if ($a[$i] < $b[$i]) {return 0;}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub in_module {
|
||||
my ($mod_map, $dirname, $filename ) = @_;
|
||||
my ( @path );
|
||||
my ( $i, $fp, $local );
|
||||
|
||||
#
|
||||
#quick check if it is already in there.
|
||||
#
|
||||
if( $$mod_map{$dirname} ){
|
||||
return 1;
|
||||
}
|
||||
|
||||
@path = split(/\//, $dirname);
|
||||
|
||||
$fp = '';
|
||||
|
||||
for( $i = 0; $i < @path; $i++){
|
||||
|
||||
$fp .= ($fp ne '' ? '/' : '') . $path[$i];
|
||||
|
||||
if( $local = $$mod_map{$fp} ){
|
||||
if( $local == $IS_LOCAL ){
|
||||
if( $i == (@path-1) ){
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Add directories to the map as we encounter them so we go
|
||||
# faster
|
||||
if (!exists($$mod_map{$dirname}) ||
|
||||
$$mod_map{$dirname} == 0) {
|
||||
$$mod_map{$dirname} = $IS_LOCAL;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
if( $$mod_map{ $fp . '/' . $filename} ) {
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub get_module_map {
|
||||
my($name) = @_;
|
||||
my(%mod_map);
|
||||
&build_map( $name, \%mod_map );
|
||||
return %mod_map;
|
||||
}
|
||||
|
||||
|
||||
sub parse_modules {
|
||||
my $l;
|
||||
while( $l = &get_line ){
|
||||
my ($mod_name, $flag, @params) = split(/[ \t]+/,$l);
|
||||
|
||||
if ( $#params eq -1 ) {
|
||||
@params = $flag;
|
||||
$flag = "";
|
||||
}
|
||||
elsif( $flag eq '-d' ){
|
||||
my $dummy;
|
||||
($mod_name, $dummy, $dummy, @params) = split(/[ \t]+/,$l);
|
||||
}
|
||||
elsif( $flag ne '-a' ){
|
||||
next;
|
||||
}
|
||||
$::modules->{$mod_name} = [@params];
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub build_map {
|
||||
my ($name,$mod_map) = @_;
|
||||
my ($bFound, $local);
|
||||
|
||||
$local = $NOT_LOCAL;
|
||||
$bFound = 0;
|
||||
|
||||
for my $i ( @{$::modules->{$name}} ){
|
||||
$bFound = 1;
|
||||
if( $i eq '-l' ){
|
||||
$local = $IS_LOCAL;
|
||||
}
|
||||
elsif($i eq $name || !build_map($i, $mod_map )){
|
||||
$mod_map->{$i} = $local;
|
||||
}
|
||||
}
|
||||
return $bFound;
|
||||
}
|
||||
|
||||
@@ -1,373 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
# Query the CVS database.
|
||||
#
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
$|=1;
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
LoadTreeConfig();
|
||||
$::CVS_ROOT = $::FORM{'cvsroot'};
|
||||
$::CVS_ROOT = pickDefaultRepository() unless $::CVS_ROOT;
|
||||
if (exists $::FORM{'module'}) {
|
||||
if (exists($::TreeInfo{$::FORM{'module'}}{'repository'})) {
|
||||
$::TreeID = $::FORM{'module'}
|
||||
}
|
||||
}
|
||||
|
||||
$::modules = {};
|
||||
require 'modules.pl';
|
||||
|
||||
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>
|
||||
";
|
||||
|
||||
|
||||
#
|
||||
# module selector
|
||||
#
|
||||
print "
|
||||
<TR><TH ALIGN=RIGHT>Module:</TH>
|
||||
<TD>
|
||||
<SELECT name='module' size=5>
|
||||
";
|
||||
|
||||
|
||||
#
|
||||
# check to see if there are multiple repositories
|
||||
#
|
||||
my @reposList = &getRepositoryList();
|
||||
my $bMultiRepos = (@reposList > 1);
|
||||
|
||||
#
|
||||
# This code sucks, I should rewrite it to be shorter
|
||||
#
|
||||
my $Module = 'default';
|
||||
|
||||
if (!exists $::FORM{module} || $::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' ){
|
||||
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";
|
||||
}
|
||||
my $escaped_module = html_quote($::FORM{module});
|
||||
print "<OPTION SELECTED VALUE='$escaped_module'>$escaped_module\n";
|
||||
}
|
||||
|
||||
#
|
||||
# Print out all the Different Modules
|
||||
#
|
||||
for my $k (sort( keys( %$::modules ) ) ){
|
||||
if (defined $::FORM{module} && $k eq $::FORM{module}) {
|
||||
next;
|
||||
}
|
||||
print "<OPTION value='$k'>$k\n";
|
||||
}
|
||||
|
||||
|
||||
print "</SELECT></td>\n";
|
||||
print "<td rowspan=2>";
|
||||
cvsmenu();
|
||||
print "</td></tr>";
|
||||
|
||||
#
|
||||
# Branch
|
||||
#
|
||||
if( defined $::FORM{branch} ){
|
||||
$b = $::FORM{branch};
|
||||
}
|
||||
else {
|
||||
$b = "HEAD";
|
||||
}
|
||||
print "<tr>
|
||||
<th align=right>Branch:</th>
|
||||
<td> <input type=text name=branch value='$b' size=25><br>\n" .
|
||||
regexpradio('branchtype') .
|
||||
"<br>(leaving this field empty will show you checkins on both
|
||||
<tt>HEAD</tt> and branches)
|
||||
</td></tr>";
|
||||
|
||||
#
|
||||
# Query by directory
|
||||
#
|
||||
|
||||
$::FORM{dir} ||= "";
|
||||
|
||||
print "
|
||||
<tr>
|
||||
<th align=right>Directory:</th>
|
||||
<td colspan=2>
|
||||
<input type=text name=dir value='$::FORM{dir}' size=45><br>
|
||||
(you can list multiple directories)
|
||||
</td>
|
||||
</tr>
|
||||
";
|
||||
|
||||
$::FORM{file} ||= "";
|
||||
|
||||
print "
|
||||
<tr>
|
||||
<th align=right>File:</th>
|
||||
<td colspan=2>
|
||||
<input type=text name=file value='$::FORM{file}' size=45><br>" .
|
||||
regexpradio('filetype') . "
|
||||
</td>
|
||||
</tr>
|
||||
";
|
||||
|
||||
|
||||
#
|
||||
# Who
|
||||
#
|
||||
|
||||
$::FORM{who} ||= "";
|
||||
|
||||
print "
|
||||
<tr>
|
||||
<th align=right>Who:</th>
|
||||
<td colspan=2> <input type=text name=who value='$::FORM{who}' size=45><br>" .
|
||||
regexpradio('whotype') . "
|
||||
</td>
|
||||
</tr>";
|
||||
|
||||
|
||||
#
|
||||
# Log contains
|
||||
#
|
||||
#print "
|
||||
#<tr>
|
||||
#<th align=right>Log contains:</th>
|
||||
#<td colspan=2> <input type=text name=logexpr value='$::FORM{logexpr}' size=45><br>
|
||||
#(you can use <a href=cvsregexp.html>regular expressions</a>)
|
||||
#</td>
|
||||
#</tr>
|
||||
#";
|
||||
|
||||
|
||||
#
|
||||
# Sort order
|
||||
#
|
||||
print "
|
||||
<tr>
|
||||
<th align=right>Sort By:</th>
|
||||
<td colspan=2>
|
||||
<SELECT name='sortby'>
|
||||
<OPTION" . &sortTest("Date") . ">Date
|
||||
<OPTION" . &sortTest("Who") . ">Who
|
||||
<OPTION" . &sortTest("File") . ">File
|
||||
<OPTION" . &sortTest("Change Size") . ">Change Size
|
||||
</SELECT>
|
||||
</td>
|
||||
</tr>
|
||||
";
|
||||
|
||||
#
|
||||
# Print the date selector
|
||||
#
|
||||
|
||||
my $startdate = fetchCachedStartDate($::CVS_ROOT);
|
||||
|
||||
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>
|
||||
<td colspan=2>
|
||||
<table BORDER=0 CELLSPACING=0 CELLPADDING=0>
|
||||
<tr>
|
||||
<td><input type=radio name=date " . &dateTest("hours") . "></td>
|
||||
<td>In the last <input type=text name=hours value=2 size=4> hours</td>
|
||||
</tr><tr>
|
||||
<td><input type=radio name=date " . &dateTest("day") . "></td>
|
||||
<td>In the last day</td>
|
||||
</tr><tr>
|
||||
<td><input type=radio name=date " . &dateTest("week") . "></td>
|
||||
<td>In the last week</td>
|
||||
</tr><tr>
|
||||
<td><input type=radio name=date " . &dateTest("month") . "></td>
|
||||
<td>In the last month</td>
|
||||
</tr><tr>
|
||||
<td><input type=radio name=date " . &dateTest("all") . "></td>
|
||||
<td>Since the beginning of time (which happens to be <TT><NOBR>$startdate</NOBR></TT> currently)</td>
|
||||
</tr><tr>
|
||||
<td><input type=radio name=date " . &dateTest("explicit") . "></td>
|
||||
<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>
|
||||
<td valign=top rowspan=2>You can use the form
|
||||
<B><TT><NOBR>mm/dd/yyyy hh:mm:ss</NOBR></TT></B> or a Unix <TT>time_t</TT>
|
||||
(seconds since the Epoch.)
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td VALIGN=TOP ALIGN=RIGHT NOWRAP>
|
||||
and <input type=text name=maxdate value='$::FORM{maxdate}' size=25></td>
|
||||
</tr>
|
||||
</table>
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
</tr>
|
||||
";
|
||||
|
||||
print "
|
||||
<tr>
|
||||
<th><BR></th>
|
||||
<td colspan=2>
|
||||
<INPUT TYPE=HIDDEN NAME=cvsroot VALUE='$::CVS_ROOT'>
|
||||
<INPUT TYPE=SUBMIT VALUE='Run Query'>
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
</FORM>";
|
||||
|
||||
|
||||
PutsTrailer();
|
||||
|
||||
sub sortTest {
|
||||
return ""
|
||||
unless (exists($::FORM{sortby}) && defined($_[0]) &&
|
||||
($_[0] eq $::FORM{sortby}));
|
||||
|
||||
return " SELECTED";
|
||||
}
|
||||
|
||||
refigureStartDateIfNecessary($::CVS_ROOT);
|
||||
|
||||
sub dateTest {
|
||||
if( $_[0] eq $::FORM{date} ){
|
||||
return " CHECKED value=$_[0]";
|
||||
}
|
||||
else {
|
||||
return "value=$_[0]";
|
||||
}
|
||||
}
|
||||
|
||||
sub regexpradio {
|
||||
my ($name) = @_;
|
||||
my ($c1, $c2, $c3);
|
||||
|
||||
$c1 = $c2 = $c3 = "";
|
||||
|
||||
my $n = $::FORM{$name} || "";
|
||||
|
||||
if( $n eq 'regexp'){
|
||||
$c2 = "checked";
|
||||
}
|
||||
elsif( $n eq 'notregexp'){
|
||||
$c3 = "checked";
|
||||
}
|
||||
else {
|
||||
$c1 = "checked";
|
||||
}
|
||||
return "
|
||||
<input type=radio name=$name value=match $c1>Exact match
|
||||
|
||||
<input type=radio name=$name value=regexp $c2><a href=cvsregexp.html>Regular expression</a>
|
||||
|
||||
<input type=radio name=$name value=notregexp $c3>Doesn't match <a href=cvsregexp.html>Reg Exp</a>";
|
||||
}
|
||||
|
||||
|
||||
my $rememberedcachedate;
|
||||
|
||||
sub fetchCachedStartDate {
|
||||
my ($repository) = @_;
|
||||
open(CACHE, "<data/cachedstartdates") || return "unknown";
|
||||
while (<CACHE>) {
|
||||
chop();
|
||||
my($rep,$date,$cachedate) = split(/\|/);
|
||||
if ($rep eq $repository) {
|
||||
$rememberedcachedate = $cachedate;
|
||||
return $date;
|
||||
}
|
||||
}
|
||||
return "unknown";
|
||||
}
|
||||
|
||||
sub refigureStartDateIfNecessary {
|
||||
my ($repository) = @_;
|
||||
my $now = time();
|
||||
if ((defined $rememberedcachedate) &&
|
||||
$now - $rememberedcachedate < 24*60*60 &&
|
||||
$rememberedcachedate < $now) {
|
||||
return;
|
||||
}
|
||||
|
||||
ConnectToDatabase();
|
||||
SendSQL("select min(ci_when)
|
||||
from checkins,repositories
|
||||
where repositories.id = repositoryid and
|
||||
repository = '$::CVS_ROOT'");
|
||||
|
||||
my $startdate = FetchOneColumn();
|
||||
if ($startdate eq "") {
|
||||
$startdate = "nonexistant";
|
||||
}
|
||||
open(OUTCACHE, ">data/cachedstartdates.$$") || die "Can't open output date cache file";
|
||||
if (open(INCACHE, "<data/cachedstartdates")) {
|
||||
while (<INCACHE>) {
|
||||
chop();
|
||||
my($rep,$date,$cachedate) = split(/\|/);
|
||||
if ($rep ne $repository) {
|
||||
print OUTCACHE "$_\n";
|
||||
}
|
||||
}
|
||||
close INCACHE;
|
||||
}
|
||||
print OUTCACHE "$repository|$startdate|$now\n";
|
||||
close OUTCACHE;
|
||||
rename "data/cachedstartdates.$$", "data/cachedstartdates";
|
||||
}
|
||||
@@ -1,257 +0,0 @@
|
||||
<HTML>
|
||||
<HEAD>
|
||||
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
|
||||
<META NAME="Author" CONTENT="lloyd tabb">
|
||||
<META NAME="GENERATOR" CONTENT="Mozilla/4.0 [en] (WinNT; I) [Netscape]">
|
||||
<TITLE>Regular expressions in the cvs query tool</TITLE>
|
||||
</HEAD>
|
||||
<BODY>
|
||||
|
||||
<H1>
|
||||
Description of MySQL regular expression syntax.</H1>
|
||||
Regular expressions are a powerful way of specifying complex searches.
|
||||
|
||||
<P><B>MySQL</B> uses Henry Spencer's implementation of regular expressions.
|
||||
And that is aimed to conform to POSIX 1003.2. <B>MySQL</B> uses the extended
|
||||
version.
|
||||
|
||||
<P>To get more exact information see Henry Spencer's regex.7 manual.
|
||||
|
||||
<P>This is a simplistic reference that skips the details. From here on
|
||||
a regular expression is called a regexp.
|
||||
|
||||
<P>A regular expression describes a set of strings. The simplest case is
|
||||
one that has no special characters in it. For example the regexp <TT>hello</TT>
|
||||
matches <TT>hello</TT> and nothing else.
|
||||
|
||||
<P>Nontrivial regular expressions use certain special constructs so that
|
||||
they can match more than one string. For example, the regexp <TT>hello|word</TT>
|
||||
matches either the string <TT>hello</TT> or the string <TT>word</TT>.
|
||||
|
||||
<P>And a more complex example regexp <TT>B[an]*s</TT> matches any of the
|
||||
strings <TT>Bananas</TT>, <TT>Baaaaas</TT>, <TT>Bs</TT> and all other string
|
||||
starting with a <TT>B</TT> and continuing with any number of <TT>a</TT>
|
||||
<TT>n</TT> and ending with a <TT>s</TT>.
|
||||
|
||||
<P>The following special characters/constructs are known.
|
||||
<DL COMPACT>
|
||||
<DT>
|
||||
<TT>^</TT></DT>
|
||||
|
||||
<DD>
|
||||
Start of whole string.</DD>
|
||||
|
||||
<PRE>mysql> select "fo\nfo" regexp "^fo$"; -> 0
|
||||
mysql> select "fofo" regexp "^fo"; -> 1</PRE>
|
||||
|
||||
<DT>
|
||||
<TT>$</TT></DT>
|
||||
|
||||
<DD>
|
||||
End of whole string.</DD>
|
||||
|
||||
<PRE>mysql> select "fo\no" regexp "^fo\no$"; -> 1
|
||||
mysql> select "fo\no" regexp "^fo$"; -> 0</PRE>
|
||||
|
||||
<DT>
|
||||
<TT>.</TT></DT>
|
||||
|
||||
<DD>
|
||||
Any character (including newline).</DD>
|
||||
|
||||
<PRE>mysql> select "fofo" regexp "^f.*"; -> 1
|
||||
mysql> select "fo\nfo" regexp "^f.*"; -> 1</PRE>
|
||||
|
||||
<DT>
|
||||
<TT>a*</TT></DT>
|
||||
|
||||
<DD>
|
||||
Any sequence of zero or more a's.</DD>
|
||||
|
||||
<PRE>mysql> select "Ban" regexp "^Ba*n"; -> 1
|
||||
mysql> select "Baaan" regexp "^Ba*n"; -> 1
|
||||
mysql> select "Bn" regexp "^Ba*n"; -> 1</PRE>
|
||||
|
||||
<DT>
|
||||
<TT>a+</TT></DT>
|
||||
|
||||
<DD>
|
||||
Any sequence of one or more a's.</DD>
|
||||
|
||||
<PRE>mysql> select "Ban" regexp "^Ba+n"; -> 1
|
||||
mysql> select "Bn" regexp "^Ba+n"; -> 0</PRE>
|
||||
|
||||
<DT>
|
||||
<TT>a?</TT></DT>
|
||||
|
||||
<DD>
|
||||
Either zero or one a.</DD>
|
||||
|
||||
<PRE>mysql> select "Bn" regexp "^Ba?n"; -> 1
|
||||
mysql> select "Ban" regexp "^Ba?n"; -> 1
|
||||
mysql> select "Baan" regexp "^Ba?n"; -> 0</PRE>
|
||||
|
||||
<DT>
|
||||
<TT>de|abc</TT></DT>
|
||||
|
||||
<DD>
|
||||
Either the sequence <TT>de</TT> or <TT>abc</TT>.</DD>
|
||||
|
||||
<PRE>mysql> select "pi" regexp "pi|apa"; -> 1
|
||||
mysql> select "axe" regexp "pi|apa"; -> 0
|
||||
mysql> select "apa" regexp "pi|apa"; -> 1
|
||||
mysql> select "apa" regexp "^(pi|apa)$"; -> 1
|
||||
mysql> select "pi" regexp "^(pi|apa)$"; -> 1
|
||||
mysql> select "pix" regexp "^(pi|apa)$"; -> 0</PRE>
|
||||
|
||||
<DT>
|
||||
<TT>(abc)*</TT></DT>
|
||||
|
||||
<DD>
|
||||
Zero or more times the sequence <TT>abc</TT>.</DD>
|
||||
|
||||
<PRE>mysql> select "pi" regexp "^(pi)+$"; -> 1
|
||||
mysql> select "pip" regexp "^(pi)+$"; -> 0
|
||||
mysql> select "pipi" regexp "^(pi)+$"; -> 1</PRE>
|
||||
|
||||
<DT>
|
||||
<TT>{1}</TT></DT>
|
||||
|
||||
<DT>
|
||||
<TT>{2,3}</TT></DT>
|
||||
|
||||
<DD>
|
||||
There is a more general way of writing regexps that match many occurrences.</DD>
|
||||
|
||||
<DL COMPACT>
|
||||
<DT>
|
||||
<TT>a*</TT></DT>
|
||||
|
||||
<DD>
|
||||
Can be written as <TT>a{0,}</TT>.</DD>
|
||||
|
||||
<DT>
|
||||
<TT>+</TT></DT>
|
||||
|
||||
<DD>
|
||||
Can be written as <TT>a{1,}</TT>.</DD>
|
||||
|
||||
<DT>
|
||||
<TT>?</TT></DT>
|
||||
|
||||
<DD>
|
||||
Can be written as <TT>a{0,1}</TT>.</DD>
|
||||
</DL>
|
||||
To be more precise, an atom followed by a bound containing one integer <TT>i</TT>
|
||||
and no comma matches a sequence of exactly <TT>i</TT> matches of the atom.
|
||||
An atom followed by a bound containing one integer <TT>i</TT> and a comma
|
||||
matches a sequence of <TT>i</TT> or more matches of the atom. An atom followed
|
||||
by a bound containing two integers <TT>i</TT> and <TT>j</TT> matches a
|
||||
sequence of <TT>i</TT> through <TT>j</TT> (inclusive) matches of the atom.
|
||||
Both arguments must <TT>0 >= value <= RE_DUP_MAX (default 255)</TT>,
|
||||
and if there are two of them, the second must be bigger or equal to the
|
||||
first.
|
||||
<DT>
|
||||
<TT>[a-dX]</TT></DT>
|
||||
|
||||
<DT>
|
||||
<TT>[^a-dX]</TT></DT>
|
||||
|
||||
<DD>
|
||||
Any character which is (not if ^ is used) either <TT>a</TT>, <TT>b</TT>,
|
||||
<TT>c</TT>, <TT>d</TT> or <TT>X</TT>. To include <TT>]</TT> it has to be
|
||||
written first. To include <TT>-</TT> it has to be written first or last.
|
||||
So <TT>[0-9]</TT> matches any decimal digit. All character that does not
|
||||
have a defined meaning inside a <TT>[]</TT> pair has no special meaning
|
||||
and matches only itself.</DD>
|
||||
|
||||
<PRE>mysql> select "aXbc" regexp "[a-dXYZ]"; -> 1
|
||||
mysql> select "aXbc" regexp "^[a-dXYZ]$"; -> 0
|
||||
mysql> select "aXbc" regexp "^[a-dXYZ]+$"; -> 1
|
||||
mysql> select "aXbc" regexp "^[^a-dXYZ]+$"; -> 0
|
||||
mysql> select "gheis" regexp "^[^a-dXYZ]+$"; -> 1
|
||||
mysql> select "gheisa" regexp "^[^a-dXYZ]+$"; -> 0</PRE>
|
||||
|
||||
<DT>
|
||||
<TT>[[.characters.]]</TT></DT>
|
||||
|
||||
<DD>
|
||||
The sequence of characters of that collating element. The sequence is a
|
||||
single element of the bracket expression's list. A bracket expression containing
|
||||
a multi-character collating element can thus match more than one character,
|
||||
e.g. if the collating sequence includes a <TT>ch</TT> collating element,
|
||||
then the RE <TT>[[.ch.]]*c</TT> matches the first five characters of <TT>chchcc</TT>.</DD>
|
||||
|
||||
<DT>
|
||||
<TT>[=character-class=]</TT></DT>
|
||||
|
||||
<DD>
|
||||
An equivalence class, standing for the sequences of characters of all collating
|
||||
elements equivalent to that one, including itself. For example, if <TT>o</TT>
|
||||
and <TT>(+)</TT> are the members of an equivalence class, then <TT>[[=o=]]</TT>,
|
||||
<TT>[[=(+)=]]</TT>, and <TT>[o(+)]</TT> are all synonymous. An equivalence
|
||||
class may not be an endpoint of a range.</DD>
|
||||
|
||||
<DT>
|
||||
<TT>[:character_class:]</TT></DT>
|
||||
|
||||
<DD>
|
||||
Within a bracket expression, the name of a character class enclosed in
|
||||
<TT>[:</TT> and <TT>:]</TT> stands for the list of all characters belonging
|
||||
to that class. Standard character class names are:</DD>
|
||||
|
||||
<TABLE BORDER WIDTH="100%" NOSAVE >
|
||||
<TR>
|
||||
<TD>alnum </TD>
|
||||
|
||||
<TD>digit </TD>
|
||||
|
||||
<TD>punct </TD>
|
||||
</TR>
|
||||
|
||||
<TR>
|
||||
<TD>alpha </TD>
|
||||
|
||||
<TD>graph </TD>
|
||||
|
||||
<TD>space </TD>
|
||||
</TR>
|
||||
|
||||
<TR>
|
||||
<TD>blank </TD>
|
||||
|
||||
<TD>lower </TD>
|
||||
|
||||
<TD>upper </TD>
|
||||
</TR>
|
||||
|
||||
<TR>
|
||||
<TD>cntrl </TD>
|
||||
|
||||
<TD>print </TD>
|
||||
|
||||
<TD>xdigit </TD>
|
||||
</TR>
|
||||
</TABLE>
|
||||
These stand for the character classes defined in ctype(3). A locale may
|
||||
provide others. A character class may not be used as an endpoint of a range.
|
||||
<PRE>mysql> select "justalnums" regexp "[[:alnum:]]+"; -> 1
|
||||
mysql> select "!!" regexp "[[:alnum:]]+"; -> 0</PRE>
|
||||
|
||||
<LI>
|
||||
[[:<:]]</LI>
|
||||
|
||||
<LI>
|
||||
[[:>:]] These match the null string at the beginning and end of a word
|
||||
respectively. A word is defined as a sequence of word characters which
|
||||
is neither preceded nor followed by word characters. A word character is
|
||||
an alnum character (as defined by ctype(3)) or an underscore.</LI>
|
||||
|
||||
<PRE>mysql> select "a word a" regexp "[[:<:]]word[[:>:]]"; -> 1
|
||||
mysql> select "a xword a" regexp "[[:<:]]word[[:>:]]"; -> 0</PRE>
|
||||
</DL>
|
||||
|
||||
<PRE>mysql> select "weeknights" regexp "^(wee|week)(knights|nights)$"; -> 1</PRE>
|
||||
|
||||
</BODY>
|
||||
</HTML>
|
||||
@@ -1,782 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
# cvsview.cgi - fake up some HTML based on RCS logs and diffs
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
# brendan and fur
|
||||
#
|
||||
# TODO in no particular order:
|
||||
# - Mocha-automate the main page's form so clicking on rev links in the table
|
||||
# change the default filename and revisions.
|
||||
# - Add a tab width input to the main page's form.
|
||||
# - Include log message in wasted horizontal real-estate of Shortcuts frame.
|
||||
# - Make old and new diff lines go to separate, side-by-side frames, and use
|
||||
# Mocha to slave their scrollbars together.
|
||||
# - Allow expansion of the top-level table to include the revision histories
|
||||
# of all the files in the directory.
|
||||
# - More more more xdiff/gdiff-like features...
|
||||
#
|
||||
|
||||
#
|
||||
# SRCROOTS is an array of repository roots under which to look for CVS files.
|
||||
#
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
use CGI;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::TreeInfo;
|
||||
$zz = $::TreeList;
|
||||
$zz = $::file_description;
|
||||
$zz = $::principal_branch;
|
||||
$zz = $::revision_ctime;
|
||||
$zz = %::timestamp;
|
||||
}
|
||||
|
||||
my $request = new CGI;
|
||||
|
||||
sub http_die {
|
||||
print $request->header();
|
||||
die (@_);
|
||||
}
|
||||
|
||||
my $anchor_num = 0;
|
||||
my $font_tag = "";
|
||||
# Figure out which directory bonsai is in by looking at argv[0]
|
||||
|
||||
my $bonsaidir = $0;
|
||||
$bonsaidir =~ s:/*[^/]*$::; # Remove last word and any slashes
|
||||
if ($bonsaidir eq '') {
|
||||
$bonsaidir = '.';
|
||||
}
|
||||
|
||||
chdir $bonsaidir || http_die "Can't chdir to $bonsaidir";
|
||||
require 'CGI.pl';
|
||||
|
||||
my $cocommand = Param('cocommand');
|
||||
my $rcsdiffcommand = Param('rcsdiffcommand');
|
||||
|
||||
LoadTreeConfig();
|
||||
|
||||
my @SRCROOTS;
|
||||
NEXTTREE: foreach my $i (@::TreeList) {
|
||||
my $r = $::TreeInfo{$i}->{'repository'};
|
||||
foreach my $j (@SRCROOTS) {
|
||||
if ($r eq $j) {
|
||||
next NEXTTREE;
|
||||
}
|
||||
}
|
||||
push @SRCROOTS, $r;
|
||||
}
|
||||
|
||||
my $debug = 0;
|
||||
|
||||
|
||||
my $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
|
||||
#
|
||||
# Until then, replace standard die built-in with our own.
|
||||
# sub die {
|
||||
# print 'fatal error: ';
|
||||
# print @_;
|
||||
# exit;
|
||||
# }
|
||||
|
||||
require 'cvsblame.pl';
|
||||
#
|
||||
# Print HTTP content-type header and the header-delimiting extra newline.
|
||||
#
|
||||
|
||||
my $request_method = $request->request_method(); # e.g., "GET", "POST", etc.
|
||||
my $script_name = $ENV{'SCRIPT_NAME'};
|
||||
my $prefix = $script_name . '?'; # prefix for HREF= entries
|
||||
$prefix = $script_name . $ENV{PATH_INFO} . '?' if (exists($ENV{PATH_INFO}));
|
||||
|
||||
|
||||
# Parse options in URL. For example,
|
||||
# http://w3/cgi/cvsview.pl?subdir=foo&file=bar would assign
|
||||
# $opt_subdir = foo and $opt_file = bar.
|
||||
|
||||
my $opt_rev1 = $request->param('rev1');
|
||||
my $opt_rev2 = $request->param('rev2');
|
||||
my $opt_root = $request->param('root');
|
||||
my $opt_files = $request->param('files');
|
||||
my $opt_skip = $request->param('skip') || 0;
|
||||
my $opt_diff_mode = $request->param('diff_mode') || 'context';
|
||||
my $opt_whitespace_mode = $request->param('whitespace_mode') || 'show';
|
||||
my $opt_file = $request->param('file');
|
||||
my $opt_rev = $request->param('diff_mode');
|
||||
my $opt_subdir = $request->param('subdir');
|
||||
my $opt_branch = $request->param('branch');
|
||||
my $opt_command = $request->param('command');
|
||||
|
||||
if (defined($opt_branch) && $opt_branch eq 'HEAD' ) { $opt_branch = ''; }
|
||||
|
||||
# Configuration colors for diff output.
|
||||
|
||||
my $stable_bg_color = 'White';
|
||||
my $skipping_bg_color = '#c0c0c0';
|
||||
my $header_bg_color = 'Orange';
|
||||
my $change_bg_color = 'LightBlue';
|
||||
my $addition_bg_color = 'LightGreen';
|
||||
my $deletion_bg_color = 'LightGreen';
|
||||
my $diff_bg_color = 'White';
|
||||
|
||||
# Ensure that necessary arguments are present
|
||||
http_die("command not defined in URL\n") if $opt_command eq '';
|
||||
http_die("command $opt_command: subdir not defined\n") if $opt_subdir eq '';
|
||||
if ($opt_command eq 'DIFF' ||
|
||||
$opt_command eq 'DIFF_FRAMESET' ||
|
||||
$opt_command eq 'DIFF_LINKS') {
|
||||
http_die("command $opt_command: file not defined in URL\n") if $opt_file eq '';
|
||||
http_die("command $opt_command: rev1 not defined in URL\n") if $opt_rev1 eq '';
|
||||
http_die("command $opt_command: rev2 not defined in URL\n") if $opt_rev2 eq '';
|
||||
|
||||
}
|
||||
|
||||
# Propagate diff options to created links
|
||||
$prefix .= "diff_mode=$opt_diff_mode";
|
||||
$prefix .= "&whitespace_mode=$opt_whitespace_mode";
|
||||
$prefix .= "&root=$opt_root";
|
||||
|
||||
# Create a shorthand for the longest common initial substring of our URL.
|
||||
my $magic_url = "$prefix&subdir=$opt_subdir";
|
||||
|
||||
# Now that we've munged QUERY_STRING into perl variables, set rcsdiff options.
|
||||
my $rcsdiff = "$rcsdiffcommand -f";
|
||||
$rcsdiff .= ' -w' if ($opt_whitespace_mode eq 'ignore');
|
||||
|
||||
# Handle the "root" argument
|
||||
#
|
||||
my $root = $opt_root;
|
||||
if (defined $root && $root ne '') {
|
||||
$root =~ s|/$||;
|
||||
if (-d $root) {
|
||||
unshift(@SRCROOTS, $root);
|
||||
} else {
|
||||
print "Error: Root, $root, is not a directory.<BR>\n";
|
||||
print "</BODY></HTML>\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
my $found = 0;
|
||||
my $dir;
|
||||
foreach $root (@SRCROOTS) {
|
||||
$dir = "$root/$opt_subdir";
|
||||
if (-d $dir) {
|
||||
$found = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
if (!$found) {
|
||||
print "<FONT SIZE=5><B>Error:</B> $opt_subdir not found.";
|
||||
exit;
|
||||
}
|
||||
|
||||
sub http_lastmod {
|
||||
&parse_cvs_file($dir.'/'.$opt_file.',v');
|
||||
my $lm=str2time($::revision_ctime{$opt_rev1});
|
||||
my $lm2=str2time($::revision_ctime{$opt_rev2});
|
||||
$lm = $lm2 if $lm2 > $lm;
|
||||
print "Last-Modified: ".time2str("%a, %d %b %Y %T %Z", $lm, "GMT")."\n";
|
||||
print $request->header();
|
||||
print "\n";
|
||||
}
|
||||
|
||||
# Create top-level frameset document.
|
||||
sub do_diff_frameset {
|
||||
chdir($dir);
|
||||
http_lastmod;
|
||||
print "<TITLE>$opt_file: $opt_rev1 vs. $opt_rev2</TITLE>\n";
|
||||
print "<FRAMESET ROWS='*,90' FRAMESPACING=0 BORDER=1>\n";
|
||||
|
||||
print " <FRAME NAME=diff+$opt_file+$opt_rev1+$opt_rev2 ",
|
||||
" SRC=\"$magic_url&command=DIFF";
|
||||
print "&root=$opt_root" if defined($opt_root);
|
||||
print "&file=$opt_file&rev1=$opt_rev1&rev2=$opt_rev2\">\n";
|
||||
|
||||
print " <FRAME SRC=\"$magic_url&command=DIFF_LINKS";
|
||||
print "&root=$opt_root" if defined($opt_root);
|
||||
print "&file=$opt_file&rev1=$opt_rev1&rev2=$opt_rev2\">\n";
|
||||
print "</FRAMESET>\n";
|
||||
}
|
||||
|
||||
|
||||
# Create links to document created by DIFF command.
|
||||
sub do_diff_links {
|
||||
http_lastmod;
|
||||
print qq%
|
||||
<HEAD>
|
||||
<SCRIPT $::script_type><!--
|
||||
var anchor = -1;
|
||||
function nextAnchor() {
|
||||
if (anchor < parent.frames[0].document.anchors.length)
|
||||
parent.frames[0].location.hash = ++anchor;
|
||||
};
|
||||
function prevAnchor() {
|
||||
if (anchor > 0)
|
||||
parent.frames[0].location.hash = --anchor;
|
||||
};
|
||||
//--></SCRIPT>
|
||||
<TITLE>$opt_file: $opt_rev1 vs. $opt_rev2</TITLE>
|
||||
</HEAD>
|
||||
<BODY BGCOLOR="#FFFFFF" TEXT="#000000"
|
||||
LINK="#0000EE" VLINK="#551A8B" ALINK="#FF0000">
|
||||
%;
|
||||
CheckHidden("$dir/$opt_file");
|
||||
|
||||
chdir($dir);
|
||||
|
||||
open(RCSDIFF, "$rcsdiff -r$opt_rev1 -r$opt_rev2 $opt_file 2>/dev/null |");
|
||||
|
||||
print '<FORM><TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0><TR VALIGN=TOP>';
|
||||
|
||||
my $diff_base = "cvsview2.cgi";
|
||||
my $blame_base = "cvsblame.cgi";
|
||||
|
||||
my $lxr_path = "$opt_subdir/$opt_file";
|
||||
my $lxr_link = Fix_LxrLink($lxr_path);
|
||||
|
||||
# Partial fix for bug 104313, which tries to fix blame links to be more intuitive.
|
||||
# In this case, make the default behavior be that blame revisions match the requested
|
||||
# diff version, rather than always showing the tip.
|
||||
|
||||
my $blame_link = "$blame_base?file=$opt_subdir/$opt_file&rev=$opt_rev2";
|
||||
$blame_link .= "&root=$opt_root" if defined($opt_root);
|
||||
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);
|
||||
my $graph_row = Param('cvsgraph') ? <<"--endquote--" : "";
|
||||
<TR><TD NOWRAP ALIGN=RIGHT VALIGN=TOP><A HREF="cvsgraph.cgi?file=$opt_subdir/$opt_file" TARGET="_top"><B>graph:</B></A></TD>
|
||||
<TD NOWRAP>View the revision tree as a graph</TD></TR>
|
||||
--endquote--
|
||||
|
||||
print "<TD NOWRAP ALIGN=LEFT VALIGN=CENTER>";
|
||||
print "<TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0>";
|
||||
print "<TR><TD NOWRAP ALIGN=RIGHT VALIGN=TOP><A HREF=\"$diff_link\" TARGET=_top><B>diff:</B></A> </TD>";
|
||||
print "<TD NOWRAP>Change diff parameters.</TD></TR>\n";
|
||||
print "<TR><TD NOWRAP ALIGN=RIGHT VALIGN=TOP><A HREF=\"$blame_link\" TARGET=_top><B>blame:</B></A></TD>";
|
||||
print "<TD NOWRAP>Annotate line authors.</TD></TR>\n";
|
||||
print "<TR><TD NOWRAP ALIGN=RIGHT VALIGN=TOP><A HREF=\"$lxr_link\" TARGET=_top><B>lxr:</B></A> </TD>";
|
||||
print "<TD NOWRAP>Browse source as hypertext.</TD></TR>\n";
|
||||
print $graph_row;
|
||||
print "</TABLE>";
|
||||
print "</TD>";
|
||||
|
||||
print "<TD WIDTH=8</TD>";
|
||||
|
||||
print "<TD>";
|
||||
print "<INPUT TYPE=button VALUE='Prev' ONCLICK='prevAnchor()'><BR>";
|
||||
print "<INPUT TYPE=button VALUE='Next' ONCLICK='nextAnchor()'>";
|
||||
print "</TD>";
|
||||
print "<TD WIDTH=8></TD>";
|
||||
|
||||
print "<TD><CODE>";
|
||||
|
||||
$anchor_num = 0;
|
||||
while (<RCSDIFF>) {
|
||||
# Get one command from the diff file
|
||||
my $line = "";
|
||||
if (/^(c|a)(\d+)/) {
|
||||
$line = $2;
|
||||
while (<RCSDIFF>) {
|
||||
last if /^\.$/;
|
||||
}
|
||||
} elsif (/^d(\d+)/) {
|
||||
$line = $1;
|
||||
} else {
|
||||
print "<FONT SIZE=5 COLOR=#ffffff><B>Internal error:</B>",
|
||||
" unknown command $_",
|
||||
" at $. in $opt_file $opt_rev1\n";
|
||||
}
|
||||
|
||||
print ' ' x (4 - length($line));
|
||||
print "<A TARGET='diff+$opt_file+$opt_rev1+$opt_rev2'",
|
||||
" HREF=\"$magic_url&command=DIFF";
|
||||
print "&root=$opt_root" if defined($opt_root);
|
||||
print "&file=$opt_file&rev1=$opt_rev1&rev2=$opt_rev2#$anchor_num\"",
|
||||
" ONCLICK='anchor = $anchor_num'>$line</A> ";
|
||||
$anchor_num++;
|
||||
}
|
||||
close(RCSDIFF);
|
||||
|
||||
print '</TD></TR></TABLE>';
|
||||
print "</FORM></BODY>\n";
|
||||
}
|
||||
|
||||
|
||||
# Default tab width, although it's frequently 4.
|
||||
my $tab_width = 8;
|
||||
|
||||
sub next_tab_stop {
|
||||
my ($pos) = @_;
|
||||
|
||||
return int(($pos + $tab_width) / $tab_width) * $tab_width;
|
||||
}
|
||||
|
||||
#
|
||||
# Look for the magic emacs tab width comment, or for long lines with more
|
||||
# than 4 leading tabs in more than 50% of the lines that start with a tab.
|
||||
# In the latter case, set $tab_width to 4.
|
||||
#
|
||||
sub guess_tab_width {
|
||||
my ($opt_file) = @_;
|
||||
my ($found_tab_width) = 0;
|
||||
my ($many_tabs, $any_tabs) = (0, 0);
|
||||
|
||||
open(RCSFILE, "$opt_file");
|
||||
while (<RCSFILE>) {
|
||||
if (/tab-width: (\d)/) {
|
||||
$tab_width = $1;
|
||||
$found_tab_width = 1;
|
||||
last;
|
||||
}
|
||||
if (/^(\t+)/) {
|
||||
$many_tabs++ if (length($1) >= 4);
|
||||
$any_tabs++;
|
||||
}
|
||||
}
|
||||
if (!$found_tab_width && $many_tabs > $any_tabs / 2) {
|
||||
$tab_width = 4;
|
||||
}
|
||||
close(RCSFILE);
|
||||
}
|
||||
|
||||
# Create gdiff-like output.
|
||||
sub do_diff {
|
||||
http_lastmod;
|
||||
print "<HTML><HEAD>";
|
||||
print "<TITLE>$opt_file: $opt_rev1 vs. $opt_rev2</TITLE>\n";
|
||||
print "</HEAD>";
|
||||
print "<BODY BGCOLOR=\"$diff_bg_color\" TEXT=\"#000000\"";
|
||||
print " LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">";
|
||||
|
||||
CheckHidden("$dir/$opt_file");
|
||||
|
||||
chdir($dir);
|
||||
|
||||
my ($rcsfile) = "$opt_file,v";
|
||||
$rcsfile = "Attic/$opt_file,v" if (! -r $rcsfile);
|
||||
&guess_tab_width($rcsfile);
|
||||
|
||||
&html_diff($rcsfile, $opt_rev1, $opt_rev2);
|
||||
print "\n</BODY>\n";
|
||||
}
|
||||
|
||||
|
||||
# Show specified CVS log entry.
|
||||
sub do_log {
|
||||
http_lastmod;
|
||||
print "<TITLE>$opt_file: $opt_rev CVS log entry</TITLE>\n";
|
||||
print '<PRE>';
|
||||
|
||||
CheckHidden("$dir/$opt_file");
|
||||
|
||||
chdir($dir);
|
||||
|
||||
open(RCSLOG, "rlog -r$opt_rev $opt_file |");
|
||||
|
||||
while (<RCSLOG>) {
|
||||
last if (/^revision $opt_rev$/);
|
||||
}
|
||||
|
||||
while (<RCSLOG>) {
|
||||
last if (/^===============================================/);
|
||||
print "$_<BR>";
|
||||
}
|
||||
close(RCSLOG);
|
||||
|
||||
print '</PRE>';
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Main script: generate a table of revision diff and log message hotlinks
|
||||
# for each modified file in $opt_subdir, and a form for choosing a file and any
|
||||
# two of its revisions.
|
||||
#
|
||||
sub do_directory {
|
||||
print $request->header();
|
||||
my $output = "<DIV ALIGN=LEFT>";
|
||||
my $link_path = "";
|
||||
|
||||
foreach my $path (split('/',$opt_subdir)) {
|
||||
$link_path .= $path;
|
||||
$output .= "<A HREF='rview.cgi?dir=$link_path";
|
||||
$output .= "&cvsroot=$opt_root" if defined $opt_root;
|
||||
$output .= "&rev=$opt_branch" if $opt_branch;
|
||||
$output .= "' onmouseover='window.status=\"Browse $link_path\";"
|
||||
." return true;'>$path</A>/ ";
|
||||
$link_path .= '/';
|
||||
}
|
||||
chop ($output);
|
||||
|
||||
if ($opt_branch) {
|
||||
$output .= "<BR>Branch: $opt_branch";
|
||||
}
|
||||
$output .= "</DIV>";
|
||||
|
||||
PutsHeader("CVS Differences", $output);
|
||||
|
||||
CheckHidden($dir);
|
||||
chdir($dir);
|
||||
|
||||
print "<TABLE BORDER CELLPADDING=2>\n";
|
||||
|
||||
foreach my $file (split(/\+/, $opt_files)) {
|
||||
my ($path) = "$dir/$file,v";
|
||||
|
||||
CheckHidden($path);
|
||||
$path = "$dir/Attic/$file,v" if (! -r $path);
|
||||
&parse_rcs_file($path);
|
||||
|
||||
my $lxr_path = "$opt_subdir/$file";
|
||||
my $lxr_link = Fix_LxrLink($lxr_path);
|
||||
|
||||
print "<TR><TD NOWRAP><B>";
|
||||
print "<A HREF=\"$lxr_link\">$file</A><BR>";
|
||||
print "<A HREF=\"cvslog.cgi?file=$opt_subdir/$file";
|
||||
print "&rev=$opt_branch" if $opt_branch;
|
||||
print "&root=$opt_root" if defined($opt_root);
|
||||
print "\">Change Log</A></B></TD>\n";
|
||||
|
||||
my $first_rev;
|
||||
if ($opt_branch) {
|
||||
$first_rev = &map_tag_to_revision($opt_branch);
|
||||
http_die("$0: error: -r: No such revision: $opt_branch\n")
|
||||
if ($first_rev eq '');
|
||||
} else {
|
||||
$first_rev = $::head_revision;
|
||||
}
|
||||
|
||||
my $skip = $opt_skip;
|
||||
my $revs_remaining = $MAX_REVS;
|
||||
my $prev;
|
||||
for (my $rev = $first_rev; $rev; $rev = $prev) {
|
||||
$prev = $::prev_revision{$rev};
|
||||
next if $skip-- > 0;
|
||||
if (!$revs_remaining--) {
|
||||
#print '<TD ROWSPAN=2 VALIGN=TOP>';
|
||||
print '<TD VALIGN=TOP>';
|
||||
print "<A HREF=\"$magic_url&command=DIRECTORY";
|
||||
print "&root=$opt_root" if defined($opt_root);
|
||||
print "&files=$opt_files&branch=$opt_branch&skip=", $opt_skip + $MAX_REVS, "\"><i>Prior revisions</i></A>", "</TD>\n";
|
||||
last;
|
||||
}
|
||||
|
||||
my $href_open = "";
|
||||
my $href_close = "";
|
||||
if ( $prev && $rev ) {
|
||||
$href_open = "<A HREF=\"$magic_url&command=DIFF_FRAMESET";
|
||||
$href_open .= "&root=$opt_root" if defined($opt_root);
|
||||
$href_open .= "&file=$file&rev1=$prev&rev2=$rev\">";
|
||||
$href_close = "</A>";
|
||||
}
|
||||
print "<TD>$href_open$rev$href_close<BR>";
|
||||
print "$::revision_author{$rev}</TD>";
|
||||
}
|
||||
|
||||
print "</TR>\n";
|
||||
|
||||
if (0) {
|
||||
print "<TR>\n";
|
||||
$skip = $opt_skip;
|
||||
$revs_remaining = $MAX_REVS;
|
||||
for (my $rev = $first_rev; $rev; $rev = $::prev_revision{$rev}) {
|
||||
next if $skip-- > 0;
|
||||
last if !$revs_remaining--;
|
||||
print "<TD><A HREF=\"$magic_url&command=LOG";
|
||||
print "root=$opt_root" if defined($opt_root);
|
||||
print "&file=$file&rev=$rev\">$::revision_author{$rev}</A>",
|
||||
"</TD>\n";
|
||||
}
|
||||
print "</TR>\n";}
|
||||
}
|
||||
|
||||
print "</TABLE><SPACER TYPE=VERTICAL SIZE=20>\n";
|
||||
print '<FORM METHOD=get>';
|
||||
print '<INPUT TYPE=hidden NAME=command VALUE=DIFF>';
|
||||
print "<INPUT TYPE=hidden NAME=subdir VALUE=$opt_subdir>";
|
||||
print '<FONT SIZE=+1><B>New Query:</B></FONT>';
|
||||
print '<UL><TABLE BORDER=1 CELLSPACING=0 CELLPADDING=7><TR><TD>';
|
||||
|
||||
|
||||
# pick something remotely sensible to put in the "Filename" field.
|
||||
my $file = $opt_file;
|
||||
unless (defined $opt_rev1) { $opt_rev1 = ''; }
|
||||
unless (defined $opt_rev2) { $opt_rev2 = ''; }
|
||||
|
||||
if ( !$file && $opt_files ) {
|
||||
$file = $opt_files;
|
||||
$file =~ s@\+.*@@;
|
||||
}
|
||||
|
||||
print "\n<TABLE CELLPADDING=0 CELLSPACING=0><TR><TD>\n",
|
||||
'Filename:',
|
||||
'</TD><TD>',
|
||||
'<INPUT TYPE=text NAME=file VALUE="', $file, '" SIZE=40>',
|
||||
"\n</TD></TR><TR><TD>\n",
|
||||
|
||||
'Old version:',
|
||||
'</TD><TD>',
|
||||
'<INPUT TYPE=text NAME=rev1 VALUE="', $opt_rev1, '" SIZE=20>',
|
||||
"\n</TD></TR><TR><TD>\n",
|
||||
|
||||
'New version:',
|
||||
'</TD><TD>',
|
||||
'<INPUT TYPE=text NAME=rev2 VALUE="', $opt_rev2, '" SIZE=20>',
|
||||
"\n</TD></TR></TABLE>\n";
|
||||
print '<TABLE BORDER=0 CELLPADDING=5 WIDTH="100%"><TR><TD>',
|
||||
'<INPUT TYPE=radio NAME=whitespace_mode VALUE="show" CHECKED>',
|
||||
' Show Whitespace',
|
||||
'<BR><INPUT TYPE=radio NAME=whitespace_mode VALUE="ignore">',
|
||||
' Ignore Whitespace',
|
||||
'</TD><TD>',
|
||||
'<INPUT TYPE=radio NAME=diff_mode VALUE="context" CHECKED>',
|
||||
' Context Diffs',
|
||||
'<BR><INPUT TYPE=radio NAME=diff_mode VALUE="full">',
|
||||
' Full Source Diffs';
|
||||
print '</TD></TR></TABLE>';
|
||||
print "<INPUT TYPE=submit>\n";
|
||||
print '</TD></TR></TABLE></UL>';
|
||||
print "</FORM>\n";
|
||||
|
||||
&print_bottom;
|
||||
}
|
||||
|
||||
#
|
||||
# This function generates a gdiff-style, side-by-side display using HTML.
|
||||
# It requires two arguments, each of which must be an open filehandle.
|
||||
# The first filehandle, DIFF, must be a `diff -f` style output containing
|
||||
# commands to convert the contents of the second filehandle, OLDREV, into
|
||||
# a later version of OLDREV's file.
|
||||
#
|
||||
sub html_diff {
|
||||
my ($file, $rev1, $rev2) = @_;
|
||||
my ($old_line_num) = 1;
|
||||
my ($old_line);
|
||||
my ($point, $mark);
|
||||
|
||||
open(DIFF, "$rcsdiff -f -r$rev1 -r$rev2 $file 2>/dev/null |");
|
||||
open(OLDREV, "$cocommand -p$rev1 $file 2>/dev/null |");
|
||||
|
||||
$anchor_num = 0;
|
||||
|
||||
if ($ENV{'HTTP_USER_AGENT'} =~ /Win/) {
|
||||
$font_tag = "<PRE><FONT FACE='Lucida Console' SIZE=-1>";
|
||||
} else {
|
||||
# We don't want your stinking Windows font
|
||||
$font_tag = "<PRE>";
|
||||
}
|
||||
print "<TABLE BGCOLOR=$stable_bg_color "
|
||||
.'CELLPADDING=0 CELLSPACING=0 WIDTH="100%" COLS=2>';
|
||||
print "<TR BGCOLOR=$header_bg_color><TH>Version $rev1<TH>Version $rev2</TR>";
|
||||
while (<DIFF>) {
|
||||
$mark = 0;
|
||||
if (/^a(\d+)/) {
|
||||
$point = $1;
|
||||
$old_line_num = skip_to_line($point + 1, $old_line_num);
|
||||
while (<DIFF>) {
|
||||
last if (/^\.$/);
|
||||
&print_row('', $stable_bg_color, $_, $addition_bg_color);
|
||||
}
|
||||
} elsif ((($point, $mark) = /^c(\d+) (\d+)$/) ||
|
||||
(($point) = /^c(\d+)$/)) {
|
||||
$mark = $point if (!$mark);
|
||||
$old_line_num = skip_to_line($point, $old_line_num);
|
||||
while (<DIFF>) {
|
||||
last if (/^\.$/);
|
||||
if ($old_line_num <= $mark) {
|
||||
$old_line = <OLDREV>;
|
||||
$old_line_num++;
|
||||
} else {
|
||||
$old_line = ''
|
||||
}
|
||||
&print_row($old_line, $change_bg_color, $_, $change_bg_color);
|
||||
}
|
||||
while ($old_line_num <= $mark) {
|
||||
$old_line = <OLDREV>;
|
||||
$old_line_num++;
|
||||
&print_row($old_line, $change_bg_color, '', $change_bg_color);
|
||||
}
|
||||
} elsif ((($point, $mark) = /^d(\d+) (\d+)$/) ||
|
||||
(($point) = /^d(\d+)$/)) {
|
||||
$mark = $point if (!$mark);
|
||||
$old_line_num = skip_to_line($point, $old_line_num);
|
||||
while (1) {
|
||||
$old_line = <OLDREV>;
|
||||
last unless defined $old_line;
|
||||
$old_line_num++;
|
||||
&print_row($old_line, $deletion_bg_color, '', $stable_bg_color);
|
||||
last if ($. == $mark);
|
||||
}
|
||||
} else {
|
||||
print "</TABLE><FONT SIZE=5 COLOR=#ffffff><B>Internal error:</B>",
|
||||
" unknown command $_",
|
||||
" at $. in $opt_file $opt_rev1\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Print the remaining lines in the original file. These are lines that
|
||||
# were not modified in the later revision
|
||||
#
|
||||
my ($base_old_line_num) = $old_line_num;
|
||||
while (1) {
|
||||
$old_line = <OLDREV>;
|
||||
last unless defined $old_line;
|
||||
$old_line_num++;
|
||||
&print_row($old_line, $stable_bg_color, $old_line, $stable_bg_color)
|
||||
if ($opt_diff_mode eq 'full' ||
|
||||
$old_line_num <= $base_old_line_num + 5);
|
||||
}
|
||||
|
||||
# print "</FONT></PRE>\n";
|
||||
print "</TABLE></FONT>\n";
|
||||
|
||||
&print_bottom;
|
||||
|
||||
close(OLDREV);
|
||||
close(DIFF);
|
||||
}
|
||||
|
||||
sub skip_to_line {
|
||||
my ($line_num, $old_line_num);
|
||||
($line_num, $old_line_num) = @_;
|
||||
my ($anchor_printed) = 0;
|
||||
my ($skip_line_printed) = ($line_num - $old_line_num <= 10);
|
||||
my ($base_old_line_num) = $old_line_num;
|
||||
|
||||
while ($old_line_num < $line_num) {
|
||||
if (!$anchor_printed && $old_line_num >= $line_num - 10) {
|
||||
print "<A NAME=$anchor_num>";
|
||||
$anchor_printed = 1;
|
||||
}
|
||||
|
||||
if ($opt_diff_mode eq 'context' && !$skip_line_printed &&
|
||||
$line_num - 5 <= $old_line_num) {
|
||||
print "</TABLE>";
|
||||
print "<TABLE BGCOLOR=$stable_bg_color "
|
||||
.'CELLPADDING=0 CELLSPACING=0 WIDTH="100%" COLS=2>';
|
||||
print "<TR BGCOLOR=$skipping_bg_color><TD>",
|
||||
"<B>Skipping to line $old_line_num:</B><TD> ";
|
||||
$skip_line_printed = 1;
|
||||
}
|
||||
|
||||
my $old_line = <OLDREV>;
|
||||
$old_line_num++;
|
||||
|
||||
&print_row($old_line, $stable_bg_color, $old_line, $stable_bg_color)
|
||||
if ($opt_diff_mode eq 'full' ||
|
||||
$old_line_num <= $base_old_line_num + 5 ||
|
||||
$line_num - 5 < $old_line_num);
|
||||
}
|
||||
|
||||
print "<A NAME=$anchor_num>" if (!$anchor_printed);
|
||||
print '</A>';
|
||||
$anchor_num++;
|
||||
return $old_line_num;
|
||||
}
|
||||
|
||||
sub print_cell {
|
||||
my ($line, $color) = @_;
|
||||
my ($i, $j, $k, $n);
|
||||
my ($c, $newline);
|
||||
|
||||
if ($color eq $stable_bg_color) {
|
||||
print "<TD>$font_tag";
|
||||
} else {
|
||||
print "<TD BGCOLOR=$color>$font_tag";
|
||||
}
|
||||
|
||||
chomp $line;
|
||||
$n = length($line);
|
||||
$newline = '';
|
||||
for ($i = $j = 0; $i < $n; $i++) {
|
||||
$c = substr($line, $i, 1);
|
||||
if ($c eq "\t") {
|
||||
for ($k = &next_tab_stop($j); $j < $k; $j++) {
|
||||
$newline .= ' ';
|
||||
}
|
||||
} else {
|
||||
$newline .= $c;
|
||||
$j++;
|
||||
}
|
||||
}
|
||||
$newline =~ s/\s+$//;
|
||||
if (length($newline) <= 80) {
|
||||
$newline = sprintf("%-80.80s", $newline);
|
||||
} else {
|
||||
$newline =~ s/([^\n\r]{80})([^\n\r]*)/$1\n$2/g;
|
||||
}
|
||||
$newline =~ s/&/&/g;
|
||||
$newline =~ s/</</g;
|
||||
$newline =~ s/>/>/g;
|
||||
print $newline;
|
||||
}
|
||||
|
||||
sub print_row {
|
||||
my ($line1, $color1, $line2, $color2) = @_;
|
||||
print "<TR>";
|
||||
$line1 = "" unless defined $line1;
|
||||
$line2 = "" unless defined $line2;
|
||||
&print_cell($line1, $color1);
|
||||
&print_cell($line2, $color2);
|
||||
}
|
||||
|
||||
sub 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:$maintainer?subject=About the cvs differences script">$maintainer</A>.
|
||||
</TABLE>
|
||||
</BODY>
|
||||
</HTML>
|
||||
__BOTTOM__
|
||||
} # print_bottom
|
||||
|
||||
|
||||
sub do_cmd {
|
||||
if ($opt_command eq 'DIFF_FRAMESET') { do_diff_frameset; }
|
||||
elsif ($opt_command eq 'DIFF_LINKS') { do_diff_links; }
|
||||
elsif ($opt_command eq 'DIFF') { do_diff; }
|
||||
elsif ($opt_command eq 'LOG') { do_log; }
|
||||
elsif ($opt_command eq 'DIRECTORY') { do_directory; }
|
||||
else { print "invalid command \"$opt_command\"."; }
|
||||
exit;
|
||||
}
|
||||
|
||||
do_cmd;
|
||||
@@ -1,344 +0,0 @@
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Mozilla Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/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 "";
|
||||
}
|
||||
|
||||
|
||||
sub check_registryurl {
|
||||
my ($url) = (@_);
|
||||
if ($url !~ m:/$:) {
|
||||
return "must be a legal URL ending 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)
|
||||
# p -- A password text entry field
|
||||
# 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.",
|
||||
"p",
|
||||
"");
|
||||
|
||||
DefParam("dbiparam",
|
||||
"The first parameter to pass to the DBI->connect() method.<br>Example: <code>DBI:mysql:host=localhost;database=bonsai</code>",
|
||||
"t",
|
||||
"DBI:mysql:database=bonsai;");
|
||||
|
||||
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');
|
||||
|
||||
DefParam("cvsgraph",
|
||||
"cvsgraph is an application that will output, in the form of a
|
||||
graphic, every branch, tag, and revision that exists for a file. It requires
|
||||
that the <a href=\"http://www.akhphd.au.dk/~bertho/cvsgraph/\">cvsgraph
|
||||
executable</a> be installed on this system. If you don't wish to use
|
||||
cvsgraph, leave this param blank.",
|
||||
"t",
|
||||
"");
|
||||
|
||||
|
||||
##
|
||||
## 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("lxr_mungeregexp",
|
||||
'A regexp to use to munge a pathname from the $CVSROOT into a valid LXR pathname. So, for example, if we tend to have a lot of pathnames that start with "mozilla/", and the LXR URLs should not contain that leading mozilla/, then you would use something like: s@^mozilla/@@',
|
||||
"t",
|
||||
"");
|
||||
|
||||
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% substitution.',
|
||||
"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>'
|
||||
);
|
||||
|
||||
DefParam("registryurl",
|
||||
"A URL relative to urlbase (or an absolute URL) which leads to the
|
||||
installed 'registry' package (available from the mozilla.org repository as
|
||||
a sibling directory to the 'bonsai' directory.). This contains pages that
|
||||
generate lists of links about a person or a file.",
|
||||
"t",
|
||||
qq{../registry/},
|
||||
\&check_registryurl);
|
||||
|
||||
|
||||
|
||||
1;
|
||||
|
||||
@@ -1,169 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
|
||||
use strict;
|
||||
use diagnostics;
|
||||
|
||||
require 'CGI.pl';
|
||||
require 'adminfuncs.pl';
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
CheckPassword(FormData('password'));
|
||||
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
|
||||
my $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;
|
||||
|
||||
|
||||
|
||||
sub error_screen {
|
||||
my ($title, $err_str) = @_;
|
||||
|
||||
PutsHeader($title);
|
||||
print "\n<hr>\n$err_str\n\n";
|
||||
PutsTrailer();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
|
||||
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.");
|
||||
}
|
||||
|
||||
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;
|
||||
|
||||
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.");
|
||||
}
|
||||
|
||||
if ($::FORM{'doglobal'}) {
|
||||
CheckGlobalPassword($::FORM{'password'});
|
||||
$outfile = 'data/passwd';
|
||||
} else {
|
||||
$outfile = DataDir() . '/treepasswd';
|
||||
}
|
||||
|
||||
$encoded = crypt($::FORM{'newpassword'}, "aa");
|
||||
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,97 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>";
|
||||
|
||||
CheckPassword($::FORM{'password'});
|
||||
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
|
||||
my $busted = 0;
|
||||
|
||||
my $info;
|
||||
|
||||
if (!exists $::FORM{'id'}) {
|
||||
$busted = 1;
|
||||
} else {
|
||||
$info = eval("\\%" . $::FORM{'id'});
|
||||
|
||||
if (!exists $info->{'notes'}) {
|
||||
$info->{'notes'} = "";
|
||||
}
|
||||
|
||||
foreach my $i (sort(keys(%$info))) {
|
||||
if (FormData("orig$i") ne $info->{$i}) {
|
||||
$busted = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($busted) {
|
||||
Unlock();
|
||||
print "
|
||||
<TITLE>Oops!</TITLE>
|
||||
<H1>Someone else has been here!</H1>
|
||||
|
||||
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.";
|
||||
|
||||
PutsTrailer();
|
||||
exit();
|
||||
}
|
||||
|
||||
if (exists $::FORM{'nukeit'}) {
|
||||
Log("A checkin for $info->{person} has been nuked.");
|
||||
} else {
|
||||
Log("A checkin for $info->{person} has been modified.");
|
||||
}
|
||||
|
||||
$info->{date} = ParseTimeAndCheck(FormData('datestring'));
|
||||
foreach my $i ('person', 'dir', 'files', 'notes', 'treeopen', 'log') {
|
||||
$info->{$i} = FormData($i);
|
||||
}
|
||||
|
||||
if (exists $::FORM{'nukeit'}) {
|
||||
my $w = lsearch(\@::CheckInList, $::FORM{'id'});
|
||||
if ($w >= 0) {
|
||||
splice(@::CheckInList, $w, 1);
|
||||
}
|
||||
}
|
||||
|
||||
WriteCheckins();
|
||||
|
||||
print "OK, the checkin has been changed.";
|
||||
|
||||
PutsTrailer();
|
||||
|
||||
@@ -1,73 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::TreeID;
|
||||
$zz = $::TreeInfo;
|
||||
}
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
CheckPassword(FormData('password'));
|
||||
my $Filename = FormData('msgname');
|
||||
my $RealFilename = DataDir() . "/$Filename";
|
||||
Lock();
|
||||
|
||||
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 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();
|
||||
|
||||
LoadTreeConfig();
|
||||
PutsHeader("New $Filename", "New $Filename",
|
||||
"$Filename - $::TreeInfo{$::TreeID}{shortdesc}");
|
||||
print "The file <b>$Filename</b> has been changed.";
|
||||
PutsTrailer();
|
||||
@@ -1,68 +0,0 @@
|
||||
#!/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.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/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,84 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
require 'CGI.pl';
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
Lock();
|
||||
LoadWhiteboard();
|
||||
|
||||
my $oldvalue = FormData('origwhite');
|
||||
my $currentvalue = $::WhiteBoard;
|
||||
$oldvalue =~ s/[\n\r]//g; $currentvalue =~ s/[\n\r]//g;
|
||||
unless ($oldvalue eq $currentvalue) {
|
||||
Unlock();
|
||||
|
||||
print "
|
||||
<TITLE>Error -- pen stolen.</TITLE>
|
||||
<H1>Someone else just changed the whiteboard.</H1>
|
||||
|
||||
Somebody else has changed what's on the whiteboard. Your changes will
|
||||
stomp over theirs.
|
||||
<P>
|
||||
The whiteboard now reads:
|
||||
<hr>
|
||||
<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). "\">
|
||||
|
||||
Change the free-for-all whiteboard:<br>
|
||||
<TEXTAREA NAME=whiteboard ROWS=10 COLS=70>" . FormData('whiteboard') .
|
||||
"</TEXTAREA><BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Change the Whiteboard\">
|
||||
</FORM>
|
||||
";
|
||||
PutsTrailer();
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
my $newwhiteboard = trim(FormData('whiteboard'));
|
||||
|
||||
MailDiffs("whiteboard", $::WhiteBoard, $newwhiteboard);
|
||||
|
||||
$::WhiteBoard = $newwhiteboard;
|
||||
WriteWhiteboard();
|
||||
Unlock();
|
||||
|
||||
print "<TITLE>Where's my blue marker?</TITLE>
|
||||
<H1>The whiteboard has been changed.</H1>
|
||||
The whiteboard now reads:
|
||||
<hr>
|
||||
<PRE VARIABLE>$::WhiteBoard</PRE>
|
||||
";
|
||||
|
||||
Log("Whiteboard changed to be: $::WhiteBoard");
|
||||
PutsTrailer();
|
||||
exit;
|
||||
@@ -1,306 +0,0 @@
|
||||
#! /tools/ns/bin/perl5
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
|
||||
# You need to put this in your CVSROOT directory, and check it in. (Change the
|
||||
# first line above to point to a real live perl5.) Add "dolog.pl" to
|
||||
# CVSROOT/checkoutlist, and check it in. Then, add a line to your
|
||||
# CVSROOT/loginfo file that says something like:
|
||||
#
|
||||
# ALL $CVSROOT/CVSROOT/dolog.pl -r /cvsroot bonsai-checkin-daemon@my.bonsai.machine
|
||||
#
|
||||
# Replace "/cvsroot" with the name of the CVS root directory, and
|
||||
# "my.bonsai.machine" with the name of the machine Bonsai runs on.
|
||||
# Now, on my.bonsai.machine, add a mail alias so that mail sent to
|
||||
# "bonsai-checkin-daemon" will get piped to handleCheckinMail.tcl.
|
||||
# The first argument to handleCheckinMail.tcl is the directory that
|
||||
# bonsai is installed in.
|
||||
|
||||
use Socket;
|
||||
|
||||
$username = $ENV{"CVS_USER"} || getlogin || (getpwuid($<))[0] || "nobody";
|
||||
$envcvsroot = $ENV{'CVSROOT'};
|
||||
$cvsroot = $envcvsroot;
|
||||
$flag_debug = 0;
|
||||
$flag_tagcmd = 0;
|
||||
$repository = '';
|
||||
$repository_tag = '';
|
||||
$mailhost = 'localhost';
|
||||
$rlogcommand = '/usr/bin/rlog';
|
||||
|
||||
@mailto=();
|
||||
@changed_files = ();
|
||||
@added_files = ();
|
||||
@removed_files = ();
|
||||
@log_lines = ();
|
||||
@outlist = ();
|
||||
|
||||
$STATE_NONE = 0;
|
||||
$STATE_CHANGED = 1;
|
||||
$STATE_ADDED = 2;
|
||||
$STATE_REMOVED = 3;
|
||||
$STATE_LOG = 4;
|
||||
|
||||
&process_args;
|
||||
|
||||
if ($flag_debug ){
|
||||
print STDERR "----------------------------------------------\n";
|
||||
print STDERR "LOGINFO:\n";
|
||||
print STDERR " pwd:" . `pwd` . "\n";
|
||||
print STDERR " Args @ARGV\n";
|
||||
print STDERR " CVSROOT: $cvsroot\n";
|
||||
print STDERR " who: $username\n";
|
||||
print STDERR " Repository: $repository\n";
|
||||
print STDERR " mailto: @mailto\n";
|
||||
print STDERR "----------------------------------------------\n";
|
||||
}
|
||||
|
||||
if ($flag_tagcmd) {
|
||||
&process_tag_command;
|
||||
} else {
|
||||
&get_loginfo;
|
||||
&process_cvs_info;
|
||||
}
|
||||
|
||||
if( $flag_debug){
|
||||
print STDERR "----------------------------------------------\n";
|
||||
print STDERR @outlist;
|
||||
print STDERR "----------------------------------------------\n";
|
||||
}
|
||||
|
||||
&mail_notification;
|
||||
|
||||
0;
|
||||
|
||||
sub process_args {
|
||||
while (@ARGV) {
|
||||
$arg = shift @ARGV;
|
||||
|
||||
if ($arg eq '-d') {
|
||||
$flag_debug = 1;
|
||||
print STDERR "Debug turned on...\n";
|
||||
} elsif ($arg eq '-r') {
|
||||
$cvsroot = shift @ARGV;
|
||||
} elsif ($arg eq '-t') {
|
||||
$flag_tagcmd = 1;
|
||||
last; # Keep the rest in ARGV; they're handled later.
|
||||
} elsif ($arg eq '-h') {
|
||||
$mailhost = shift @ARGV;
|
||||
} else {
|
||||
push(@mailto, $arg);
|
||||
}
|
||||
}
|
||||
if( $repository eq '' ){
|
||||
open( REP, "<CVS/Repository");
|
||||
$repository = <REP>;
|
||||
chop($repository);
|
||||
close(REP);
|
||||
}
|
||||
$repository =~ s:^$cvsroot/::;
|
||||
$repository =~ s:^$envcvsroot/::;
|
||||
|
||||
if (!$flag_tagcmd) {
|
||||
if( open( REP, "<CVS/Tag") ) {
|
||||
$repository_tag = <REP>;
|
||||
chop($repository_tag);
|
||||
close(REP);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub get_loginfo {
|
||||
|
||||
if( $flag_debug){
|
||||
print STDERR "----------------------------------------------\n";
|
||||
}
|
||||
|
||||
# Iterate over the body of the message collecting information.
|
||||
#
|
||||
while (<STDIN>) {
|
||||
chop; # Drop the newline
|
||||
|
||||
if( $flag_debug){
|
||||
print STDERR "$_\n";
|
||||
}
|
||||
|
||||
if (/^In directory/) {
|
||||
next;
|
||||
}
|
||||
|
||||
if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
|
||||
if (/^Added Files/) { $state = $STATE_ADDED; next; }
|
||||
if (/^Removed Files/) { $state = $STATE_REMOVED; next; }
|
||||
if (/^Log Message/) { $state = $STATE_LOG; next; }
|
||||
|
||||
s/^[ \t\n]+//; # delete leading whitespace
|
||||
s/[ \t\n]+$//; # delete trailing whitespace
|
||||
|
||||
if ($state == $STATE_CHANGED && !(/^Tag:/)) { push(@changed_files, split); }
|
||||
if ($state == $STATE_ADDED && !(/^Tag:/)) { push(@added_files, split); }
|
||||
if ($state == $STATE_REMOVED && !(/^Tag:/)) { push(@removed_files, split); }
|
||||
if ($state == $STATE_LOG) { push(@log_lines, $_); }
|
||||
}
|
||||
|
||||
if( $flag_debug){
|
||||
print STDERR "----------------------------------------------\n"
|
||||
. "changed files: @changed_files\n"
|
||||
. "added files: @added_files\n"
|
||||
. "removed files: @removed_files\n";
|
||||
print STDERR "----------------------------------------------\n";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub process_cvs_info {
|
||||
local($d,$fn,$rev,$mod_time,$sticky,$tag,$stat,@d,$l,$rcsfile);
|
||||
if (!open(ENT, "<CVS/Entries.Log" )) {
|
||||
open(ENT, "<CVS/Entries");
|
||||
}
|
||||
$time = time;
|
||||
while( <ENT> ){
|
||||
chop;
|
||||
($d,$fn,$rev,$mod_time,$sticky,$tag) = split(/\//);
|
||||
$stat = 'C';
|
||||
for $i (@changed_files, "BEATME.NOW", @added_files ) {
|
||||
if( $i eq "BEATME.NOW" ){ $stat = 'A'; }
|
||||
if($i eq $fn ){
|
||||
$rcsfile = "$envcvsroot/$repository/$fn,v";
|
||||
if( ! -r $rcsfile ){
|
||||
$rcsfile = "$envcvsroot/$repository/Attic/$fn,v";
|
||||
}
|
||||
open(LOG, "$rlogcommand -N -r$rev $rcsfile |")
|
||||
|| print STDERR "dolog.pl: Couldn't run rlog\n";
|
||||
while(<LOG>){
|
||||
if (/^date:.* author: ([^;]*);.*/) {
|
||||
$username = $1;
|
||||
if (/lines: \+([0-9]*) -([0-9]*)/) {
|
||||
$lines_added = $1;
|
||||
$lines_removed = $2;
|
||||
}
|
||||
}
|
||||
}
|
||||
close( LOG );
|
||||
push(@outlist, ("$stat|$time|$username|$cvsroot|$repository|$fn|$rev|$sticky|$tag|$lines_added|$lines_removed\n"));
|
||||
}
|
||||
}
|
||||
}
|
||||
close(ENT);
|
||||
|
||||
for $i (@removed_files) {
|
||||
push( @outlist, ("R|$time|$username|$cvsroot|$repository|$i|||$repository_tag\n"));
|
||||
}
|
||||
|
||||
push (@outlist, "LOGCOMMENT\n");
|
||||
push (@outlist, join("\n",@log_lines));
|
||||
push (@outlist, "\n:ENDLOGCOMMENT\n");
|
||||
}
|
||||
|
||||
|
||||
sub process_tag_command {
|
||||
local($str,$part,$time);
|
||||
$time = time;
|
||||
$str = "Tag|$cvsroot|$time";
|
||||
while (@ARGV) {
|
||||
$part = shift @ARGV;
|
||||
$str .= "|" . $part;
|
||||
}
|
||||
push (@outlist, ("$str\n"));
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub do_commitinfo {
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
sub get_response_code {
|
||||
my ($expecting) = @_;
|
||||
# if ($flag_debug) {
|
||||
# print STDERR "SMTP: Waiting for code $expecting\n";
|
||||
# }
|
||||
while (1) {
|
||||
my $line = <S>;
|
||||
# if ($flag_debug) {
|
||||
# print STDERR "SMTP: $line";
|
||||
# }
|
||||
if ($line =~ /^[0-9]*-/) {
|
||||
next;
|
||||
}
|
||||
if ($line =~ /(^[0-9]*) /) {
|
||||
my $code = $1;
|
||||
if ($code == $expecting) {
|
||||
# if ($flag_debug) {
|
||||
# print STDERR "SMTP: got it.\n";
|
||||
# }
|
||||
return;
|
||||
}
|
||||
die "Bad response from SMTP -- $line";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
sub mail_notification {
|
||||
chop(my $hostname = `hostname`);
|
||||
|
||||
my ($remote,$port, $iaddr, $paddr, $proto, $line);
|
||||
|
||||
$remote = $mailhost;
|
||||
$port = 25;
|
||||
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
|
||||
die "No port" unless $port;
|
||||
$iaddr = inet_aton($remote) || die "no host: $remote";
|
||||
$paddr = sockaddr_in($port, $iaddr);
|
||||
|
||||
$proto = getprotobyname('tcp');
|
||||
socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
|
||||
connect(S, $paddr) || die "connect: $!";
|
||||
select(S); $| = 1; select(STDOUT);
|
||||
|
||||
get_response_code(220);
|
||||
print S "HELO $hostname\n";
|
||||
get_response_code(250);
|
||||
print S "MAIL FROM: bonsai-daemon\@$hostname\n";
|
||||
get_response_code(250);
|
||||
foreach $i (@mailto) {
|
||||
print S "RCPT TO: $i\n";
|
||||
get_response_code(250);
|
||||
}
|
||||
print S "DATA\n";
|
||||
get_response_code(354);
|
||||
# Get one line starting with "354 ".
|
||||
if ($flag_tagcmd) {
|
||||
print S "Subject: cvs tag in $repository\n";
|
||||
} else {
|
||||
print S "Subject: cvs commit to $repository\n";
|
||||
}
|
||||
print S "\n";
|
||||
print S @outlist, "\n";
|
||||
print S ".\n";
|
||||
get_response_code(250);
|
||||
print S "QUIT\n";
|
||||
close(S);
|
||||
}
|
||||
@@ -1,140 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::BatchID;
|
||||
}
|
||||
require 'CGI.pl';
|
||||
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>";
|
||||
|
||||
CheckPassword($::FORM{'password'});
|
||||
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
|
||||
if (!exists $::FORM{'command'}) {
|
||||
$::FORM{'command'} = 'nocommand';
|
||||
}
|
||||
|
||||
|
||||
my @list;
|
||||
|
||||
foreach my $i (keys %::FORM) {
|
||||
my $j = url_decode($i);
|
||||
if ($j =~ m/^\:\:checkin_/) {
|
||||
if (lsearch(\@::CheckInList, $j) >= 0) {
|
||||
push(@list, $j);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
my $origtree = $::TreeID;
|
||||
|
||||
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);
|
||||
}
|
||||
}
|
||||
$what = "deleted.";
|
||||
last SWITCH;
|
||||
};
|
||||
/^setopen$/ && do {
|
||||
foreach $i (@list) {
|
||||
my $info = eval("\\%" . $i);
|
||||
$info->{'treeopen'} = 1;
|
||||
}
|
||||
$what = "modified to be open.";
|
||||
last SWITCH;
|
||||
};
|
||||
|
||||
/^setclose$/ && do {
|
||||
foreach $i (@list) {
|
||||
my $info = eval("\\%" . $i);
|
||||
$info->{'treeopen'} = 0;
|
||||
}
|
||||
$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) {
|
||||
my $w = lsearch(\@::CheckInList, $i);
|
||||
if ($w >= 0) {
|
||||
splice(@::CheckInList, $w, 1);
|
||||
}
|
||||
}
|
||||
WriteCheckins();
|
||||
undef @::CheckInList;
|
||||
$::TreeID = $::FORM{'desttree'};
|
||||
undef $::BatchID;
|
||||
LoadCheckins();
|
||||
LoadTreeConfig();
|
||||
foreach $i (@list) {
|
||||
push(@::CheckInList, $i);
|
||||
}
|
||||
$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();
|
||||
|
||||
print "
|
||||
<H1>OK, done.</H1>
|
||||
The selected checkins have been $what
|
||||
";
|
||||
|
||||
$::TreeInfo = $origtree;
|
||||
|
||||
PutsTrailer();
|
||||
|
||||
@@ -1,113 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::TreeID;
|
||||
}
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
LoadCheckins();
|
||||
|
||||
my $info = eval("\\%" . $::FORM{'id'});
|
||||
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>
|
||||
<TITLE>Say the magic word.</TITLE>
|
||||
<H1>Edit a checkin.</H1>
|
||||
|
||||
Congratulations, you have found the hidden edit-a-checkin feature. Of course,
|
||||
you need to know the magic word to do anything from here.
|
||||
|
||||
<P>
|
||||
|
||||
<FORM method=get action=\"doeditcheckin.cgi\">
|
||||
<TABLE>
|
||||
<tr>
|
||||
<td align=right><B>Password:</B></td>
|
||||
<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></tr>
|
||||
";
|
||||
|
||||
if (!exists $info->{'notes'}) {
|
||||
$info->{'notes'} = "";
|
||||
}
|
||||
|
||||
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>";
|
||||
}
|
||||
|
||||
sub CheckString {
|
||||
my ($value) = (@_);
|
||||
if ($value) {
|
||||
return "CHECKED";
|
||||
} else {
|
||||
return "";
|
||||
}
|
||||
}
|
||||
|
||||
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 $isopen>Open
|
||||
</td></tr><tr><td></td>
|
||||
<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>
|
||||
</table>
|
||||
<INPUT TYPE=CHECKBOX NAME=nukeit>Check this box to blow away this checkin entirely.<br>
|
||||
|
||||
<INPUT TYPE=SUBMIT VALUE=Submit>
|
||||
};
|
||||
|
||||
foreach my $i (sort(keys(%$info))) {
|
||||
my $q = value_quote($info->{$i});
|
||||
print qq{<INPUT TYPE=HIDDEN NAME=orig$i VALUE="$q">\n};
|
||||
}
|
||||
|
||||
print "<INPUT TYPE=HIDDEN NAME=id VALUE=\"$::FORM{'id'}\">";
|
||||
|
||||
print "<INPUT TYPE=HIDDEN NAME=treeid VALUE=\"" . value_quote($::TreeID) . "\">";
|
||||
|
||||
|
||||
|
||||
print "</TABLE></FORM>";
|
||||
|
||||
PutsTrailer();
|
||||
|
||||
@@ -1,98 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::TreeInfo;
|
||||
}
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
my $Filename = FormData('msgname');
|
||||
my $RealFilename = DataDir() . "/$Filename";
|
||||
|
||||
my $Text = '';
|
||||
$Text = `cat $RealFilename` if -f $RealFilename;
|
||||
|
||||
LoadTreeConfig();
|
||||
PutsHeader("Message Editor", "Message Editor",
|
||||
"$Filename - $::TreeInfo{$::TreeID}{shortdesc}");
|
||||
|
||||
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>
|
||||
";
|
||||
|
||||
|
||||
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";
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
print "
|
||||
</TABLE>
|
||||
<FORM method=get action=\"doeditmessage.cgi\">
|
||||
<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=SUBMIT VALUE=\"Change this message\">
|
||||
</FORM>
|
||||
|
||||
";
|
||||
|
||||
|
||||
PutsTrailer();
|
||||
exit 0;
|
||||
|
||||
@@ -1,122 +0,0 @@
|
||||
#!/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.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/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";
|
||||
|
||||
#
|
||||
# Check to ensure they've logged in properly
|
||||
#
|
||||
|
||||
unless ((defined($::FORM{password})) && (CheckPassword($::FORM{password}))) {
|
||||
print "<form method=post action=editparams.cgi><table>\n";
|
||||
print "<H2>Sorry, you must enter a password to see Bonsai paramters.</H2>\n";
|
||||
print "<hr><B>Enter password to access parameters:</B> <INPUT NAME=password TYPE=password> <BR>";
|
||||
print "</form>\n";
|
||||
print "<input type=submit value=\"Enter Password\">\n";
|
||||
print "<hr>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
#
|
||||
# We're verified, now bring everything up
|
||||
#
|
||||
|
||||
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;
|
||||
};
|
||||
/^p/ && do {
|
||||
print "<input size=80 type=password 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,59 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::TreeID;
|
||||
}
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
LoadWhiteboard();
|
||||
|
||||
PutsHeader("Scritch, scritch.", "Edit Whiteboard");
|
||||
|
||||
print "
|
||||
<FORM method=post action=\"doeditwhiteboard.cgi\">
|
||||
<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
|
||||
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>
|
||||
<INPUT TYPE=SUBMIT VALUE=\"Change the Whiteboard\">
|
||||
</FORM>
|
||||
";
|
||||
|
||||
PutsTrailer();
|
||||
exit;
|
||||
@@ -1,63 +0,0 @@
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
# Get a line, dealing with '\'. Returns 'undef' when no more lines to return;
|
||||
# removes blank lines as it goes.
|
||||
# Allows spaces after a '\'. This is naughty but will probably not matter
|
||||
# *too* much, and I'm not changing it now.
|
||||
sub get_line {
|
||||
my($l, $save);
|
||||
$l='';
|
||||
$save='';
|
||||
|
||||
my $bContinue = 1;
|
||||
|
||||
while( $bContinue && ($l = <MOD>) ){
|
||||
chop($l);
|
||||
if( $l =~ /^[ \t]*\#/
|
||||
|| $l =~ /^[ \t]*$/ ){
|
||||
$l=''; # Starts with a "#", or is only whitespace.
|
||||
}
|
||||
if( $l =~ /\\[ \t]*$/ ){
|
||||
# Ends with a slash, so append it to the last line.
|
||||
chop ($l);
|
||||
$save .= $l . ' ';
|
||||
$l='';
|
||||
}
|
||||
elsif( $l eq '' && $save eq ''){
|
||||
# ignore blank lines
|
||||
}
|
||||
else {
|
||||
$bContinue = 0;
|
||||
}
|
||||
}
|
||||
if(!defined($l)) {
|
||||
if($save ne '') {
|
||||
return $save;
|
||||
} else {
|
||||
return $l;
|
||||
}
|
||||
} else {
|
||||
return $save . $l;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,52 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
|
||||
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;
|
||||
@@ -1,52 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
|
||||
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,66 +0,0 @@
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
|
||||
sub EmitHtmlTitleAndHeader {
|
||||
my($doctitle,$heading,$subheading) = @_;
|
||||
|
||||
print "<HTML><HEAD><TITLE>$doctitle</TITLE>";
|
||||
print "<link rel=\"icon\" href=\"http://mozilla.org/images/mozilla-16.png\" type=\"image/png\">";
|
||||
print "</HEAD>";
|
||||
print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\"";
|
||||
print "LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">";
|
||||
|
||||
if (open(BANNER, "<data/banner.html")) {
|
||||
while (<BANNER>) { print; }
|
||||
close BANNER;
|
||||
} elsif (open(BANNER, "<../bonsai/data/banner.html")) {
|
||||
while (<BANNER>) { print; }
|
||||
close BANNER;
|
||||
}
|
||||
|
||||
print "<TABLE BORDER=0 CELLPADDING=12 CELLSPACING=0 WIDTH=\"100%\">";
|
||||
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>$heading</NOBR></B></FONT>\n";
|
||||
print " </TD></TR><TR><TD VALIGN=TOP ALIGN=CENTER>\n";
|
||||
print " <B>$subheading</B>\n";
|
||||
print " </TD></TR>\n";
|
||||
print " </TABLE>\n";
|
||||
print " </TD>\n";
|
||||
print " <TD>\n";
|
||||
|
||||
if (open(BLURB, "<data/blurb")) {
|
||||
while (<BLURB>) { print; }
|
||||
close BLURB;
|
||||
}
|
||||
|
||||
print "</TD></TR></TABLE>\n";
|
||||
}
|
||||
|
||||
sub EmitHtmlHeader {
|
||||
my($heading,$subheading) = @_;
|
||||
EmitHtmlTitleAndHeader($heading,$heading,$subheading);
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -1,12 +0,0 @@
|
||||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Refresh"
|
||||
content="0; URL=cvsqueryform.cgi">
|
||||
</head>
|
||||
<body>
|
||||
Going to<br>
|
||||
<br>
|
||||
<a href="cvsqueryform.cgi">cvsqueryform.cgi</a>
|
||||
<br>
|
||||
</body>
|
||||
</html>
|
||||
@@ -1,50 +0,0 @@
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
if( $ARGV[0] eq '' ){
|
||||
$::CVS_ROOT = '/m/src';
|
||||
}
|
||||
else {
|
||||
$::CVS_ROOT = $ARGV[0];
|
||||
}
|
||||
|
||||
$CVS_REPOS_SUFIX = $::CVS_ROOT;
|
||||
$CVS_REPOS_SUFIX =~ s/\//_/g;
|
||||
|
||||
my $CHECKIN_DATA_FILE = "data/checkinlog${CVS_REPOS_SUFIX}";
|
||||
my $CHECKIN_INDEX_FILE = "data/index${CVS_REPOS_SUFIX}";
|
||||
|
||||
|
||||
open(INDEX , "<$CHECKIN_INDEX_FILE");
|
||||
open(CI, "<$CHECKIN_DATA_FILE") || die "could not open checkin data file\n";
|
||||
|
||||
while( <INDEX> ){
|
||||
chop;
|
||||
($o,$d) = split(/\|/);
|
||||
seek(CI, $o, 0);
|
||||
$line = <CI>;
|
||||
($j,$d1) = split(/\|/);
|
||||
print "$d|$d1\n";
|
||||
}
|
||||
|
||||
@@ -1,103 +0,0 @@
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
%form = ();
|
||||
&split_cgi_args;
|
||||
1;
|
||||
|
||||
sub split_cgi_args {
|
||||
local (@args, $pair, $key, $value, $s);
|
||||
|
||||
if ($ENV{"REQUEST_METHOD"} eq 'POST') {
|
||||
$s .= $_ while (<>);
|
||||
}
|
||||
else {
|
||||
$s = $ENV{"QUERY_STRING"};
|
||||
}
|
||||
|
||||
$s =~ tr/+/ /;
|
||||
@args= split(/\&/, $s );
|
||||
|
||||
for $pair (@args) {
|
||||
($key, $value) = split(/=/, $pair);
|
||||
$key =~ s/%([a-fA-F0-9]{2})/pack("C", hex($1))/eg;
|
||||
$value =~ s/%([a-fA-F0-9]{2})/pack("C", hex($1))/eg;
|
||||
$form{$key} = $value;
|
||||
}
|
||||
|
||||
# extract the cookies from the HTTP_COOKIE environment
|
||||
%cookie_jar = split('[;=] *',$ENV{'HTTP_COOKIE'});
|
||||
}
|
||||
|
||||
sub make_cgi_args {
|
||||
local($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 url_encode2 {
|
||||
local( $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 {
|
||||
local( $s ) = @_;
|
||||
|
||||
$s =~ s/\n/\%0a/g;
|
||||
$s =~ s/\r//g;
|
||||
$s =~ s/\"/\%22/g;
|
||||
$s =~ s/\+/\%2b/g;
|
||||
return $s;
|
||||
}
|
||||
|
||||
|
||||
@weekdays = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
|
||||
@months = ('Jan','Feb','Mar','Apr','May','Jun',
|
||||
'Jul','Aug','Sep','Oct','Nov','Dec');
|
||||
|
||||
sub toGMTString {
|
||||
local ($seconds) = $_[0];
|
||||
|
||||
local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
|
||||
= gmtime($seconds);
|
||||
$year += 1900;
|
||||
|
||||
sprintf('%s, %02d-%s-%d %02d:%02d:%02d GMT',
|
||||
$weekdays[$wday],$mday,$months[$mon],$year,$hour,$min,$sec);
|
||||
}
|
||||
@@ -1,171 +0,0 @@
|
||||
#!/bin/sh
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
USER=nobody
|
||||
PASSWORD=
|
||||
|
||||
if test x$PASSWORD = x ; then
|
||||
MYSQL="mysql -u $USER"
|
||||
else
|
||||
MYSQL="mysql -u $USER -p$PASSWORD"
|
||||
fi
|
||||
|
||||
echo
|
||||
echo "Will use user=\"$USER\" and password=\"$PASSWORD\" for bonsai database."
|
||||
echo "If you have a previous bonsai install, this script will drop all"
|
||||
echo "bonsai tables. Press ctrl-c to bail out now or return to continue."
|
||||
|
||||
read dummy
|
||||
|
||||
echo Dropping old tables
|
||||
|
||||
$MYSQL << OK_ALL_DONE
|
||||
|
||||
use bonsai;
|
||||
|
||||
drop table descs;
|
||||
drop table checkins;
|
||||
drop table people;
|
||||
drop table repositories;
|
||||
drop table dirs;
|
||||
drop table files;
|
||||
drop table branches;
|
||||
drop table tags;
|
||||
OK_ALL_DONE
|
||||
|
||||
echo creating new tables
|
||||
|
||||
$MYSQL << OK_ALL_DONE
|
||||
use bonsai;
|
||||
create table descs (
|
||||
id mediumint not null auto_increment primary key,
|
||||
description text,
|
||||
hash bigint not null,
|
||||
|
||||
index(hash)
|
||||
);
|
||||
|
||||
show columns from descs;
|
||||
show index from descs;
|
||||
|
||||
create table people (
|
||||
id mediumint not null auto_increment primary key,
|
||||
who varchar(32) binary not null,
|
||||
|
||||
unique(who)
|
||||
);
|
||||
|
||||
show columns from people;
|
||||
show index from people;
|
||||
|
||||
|
||||
create table repositories (
|
||||
id mediumint not null auto_increment primary key,
|
||||
repository varchar(64) binary not null,
|
||||
|
||||
unique(repository)
|
||||
);
|
||||
|
||||
show columns from repositories;
|
||||
show index from repositories;
|
||||
|
||||
|
||||
|
||||
create table dirs (
|
||||
id mediumint not null auto_increment primary key,
|
||||
dir varchar(255) binary not null,
|
||||
|
||||
unique(dir)
|
||||
);
|
||||
|
||||
show columns from dirs;
|
||||
show index from dirs;
|
||||
|
||||
|
||||
create table files (
|
||||
id mediumint not null auto_increment primary key,
|
||||
file varchar(255) binary not null,
|
||||
|
||||
unique(file)
|
||||
);
|
||||
|
||||
show columns from files;
|
||||
show index from files;
|
||||
|
||||
|
||||
|
||||
create table branches (
|
||||
id mediumint not null auto_increment primary key,
|
||||
branch varchar(64) binary not null,
|
||||
|
||||
unique(branch)
|
||||
);
|
||||
|
||||
show columns from branches;
|
||||
show index from branches;
|
||||
|
||||
|
||||
|
||||
create table checkins (
|
||||
type enum('Change', 'Add', 'Remove'),
|
||||
ci_when datetime not null,
|
||||
whoid mediumint not null,
|
||||
repositoryid mediumint not null,
|
||||
dirid mediumint not null,
|
||||
fileid mediumint not null,
|
||||
revision varchar(32) binary not null,
|
||||
stickytag varchar(255) binary not null,
|
||||
branchid mediumint not null,
|
||||
addedlines int not null,
|
||||
removedlines int not null,
|
||||
descid mediumint not null,
|
||||
|
||||
unique (repositoryid,dirid,fileid,revision),
|
||||
index(ci_when),
|
||||
index(whoid),
|
||||
index(repositoryid),
|
||||
index(dirid),
|
||||
index(fileid),
|
||||
index(branchid),
|
||||
index(descid)
|
||||
);
|
||||
|
||||
show columns from checkins;
|
||||
show index from checkins;
|
||||
|
||||
|
||||
create table tags (
|
||||
repositoryid mediumint not null,
|
||||
branchid mediumint not null,
|
||||
dirid mediumint not null,
|
||||
fileid mediumint not null,
|
||||
revision varchar(32) binary not null,
|
||||
|
||||
unique(repositoryid,dirid,fileid,branchid,revision),
|
||||
index(repositoryid),
|
||||
index(dirid),
|
||||
index(fileid),
|
||||
index(branchid)
|
||||
);
|
||||
|
||||
|
||||
|
||||
OK_ALL_DONE
|
||||
@@ -1,145 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
#
|
||||
# Unroll a module
|
||||
#
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::TreeID;
|
||||
$zz = $::TreeInfo;
|
||||
}
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
$|=1;
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
my $CVS_ROOT = $::FORM{'cvsroot'};
|
||||
$CVS_ROOT = pickDefaultRepository() unless $CVS_ROOT;
|
||||
|
||||
PutsHeader("CVS Module Analyzer", $CVS_ROOT);
|
||||
|
||||
cvsmenu("align=right width=20%");
|
||||
|
||||
print "
|
||||
<p><b>This tool will show you the directories and files that make up a given
|
||||
cvs module.</b>
|
||||
";
|
||||
|
||||
|
||||
print "
|
||||
<p>
|
||||
<FORM METHOD=GET ACTION='moduleanalyse.cgi'>
|
||||
";
|
||||
|
||||
|
||||
#
|
||||
# module selector
|
||||
#
|
||||
print "
|
||||
|
||||
<nobr><b>Module:</b>
|
||||
<SELECT name='module' size=5>
|
||||
";
|
||||
|
||||
my $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";
|
||||
$Module = $::FORM{module};
|
||||
}
|
||||
|
||||
#
|
||||
# Print out all the Different Modules
|
||||
#
|
||||
$::TreeID = $Module if (exists($::TreeInfo{$Module}{'repository'}));
|
||||
LoadDirList();
|
||||
for my $k (sort( grep(!/\*$/, @::LegalDirs) ) ){
|
||||
print "<OPTION value='$k'>$k\n" if ($k ne $Module);
|
||||
}
|
||||
|
||||
print "</SELECT></NOBR>\n";
|
||||
|
||||
|
||||
print "
|
||||
<br>
|
||||
<br>
|
||||
<INPUT TYPE=HIDDEN NAME=cvsroot VALUE='$CVS_ROOT'>
|
||||
<INPUT TYPE=SUBMIT VALUE='Examine Module'>
|
||||
</FORM>";
|
||||
|
||||
|
||||
if( $::FORM{module} ne '' ){
|
||||
my $mod = $::FORM{module};
|
||||
print "<h1>Examining Module '$mod'</h1>\n\n";
|
||||
|
||||
for my $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>";
|
||||
}
|
||||
elsif ( -r "$CVS_ROOT/$i,v" ){
|
||||
print "<dt><font color=blue><tt>File: </tt></font>";
|
||||
print "<a href=cvsblame.cgi?file=$i&root=$CVS_ROOT>$i</a>";
|
||||
}
|
||||
else {
|
||||
print "<dt><font color=red><tt>Error: </tt></font>";
|
||||
print "$i : Not a file or a directory.";
|
||||
}
|
||||
|
||||
# if( $mod_map->{$i} == $IS_LOCAL ){
|
||||
# print "<font color=blue><tt> LOCAL</tt></font>";
|
||||
# }
|
||||
print "\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub sortTest {
|
||||
if( $_[0] eq $::FORM{sortby} ){
|
||||
return " SELECTED";
|
||||
}
|
||||
else {
|
||||
return "";
|
||||
}
|
||||
}
|
||||
|
||||
sub dateTest {
|
||||
if( $_[0] eq $::FORM{date} ){
|
||||
return " CHECKED value=$_[0]";
|
||||
}
|
||||
else {
|
||||
return "value=$_[0]";
|
||||
}
|
||||
}
|
||||
@@ -1,152 +0,0 @@
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
require 'get_line.pl';
|
||||
|
||||
my $NOT_LOCAL = 1;
|
||||
my $IS_LOCAL = 2;
|
||||
|
||||
$::modules = {};
|
||||
|
||||
if( $::CVS_ROOT eq "" ){
|
||||
$::CVS_ROOT = pickDefaultRepository();
|
||||
}
|
||||
|
||||
my $CVS_MODULES;
|
||||
|
||||
if( defined($ENV{"OS"}) && $ENV{"OS"} eq "Windows_NT" ){
|
||||
$CVS_MODULES='modules';
|
||||
}
|
||||
else {
|
||||
$CVS_MODULES="$::CVS_ROOT/CVSROOT/modules";
|
||||
}
|
||||
|
||||
open( MOD, "<$CVS_MODULES") || die "can't open $CVS_MODULES";
|
||||
&parse_modules;
|
||||
close( MOD );
|
||||
|
||||
1;
|
||||
|
||||
sub in_module {
|
||||
my($mod_map, $dirname, $filename ) = @_;
|
||||
my( @path );
|
||||
my( $i, $fp, $local );
|
||||
|
||||
#
|
||||
#quick check if it is already in there.
|
||||
#
|
||||
if( $mod_map->{$dirname} ){
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
@path = split(/\//, $dirname);
|
||||
|
||||
$fp = '';
|
||||
|
||||
for( $i = 0; $i < @path; $i++){
|
||||
|
||||
$fp .= ($fp ne '' ? '/' : '') . $path[$i];
|
||||
|
||||
if( $local = $mod_map->{$fp} ){
|
||||
if( $local == $IS_LOCAL ){
|
||||
if( $i == (@path-1) ){
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Add directories to the map as we encounter them so we go
|
||||
# faster
|
||||
if( $mod_map->{$dirname} == 0 ){
|
||||
$mod_map->{$dirname} = $IS_LOCAL;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
if( $mod_map->{ $fp . '/' . $filename} ) {
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub get_module_map {
|
||||
my($name) = @_;
|
||||
my($mod_map);
|
||||
$mod_map = {};
|
||||
&build_map( $name, $mod_map );
|
||||
return $mod_map;
|
||||
}
|
||||
|
||||
sub parse_modules {
|
||||
my @finaloptions=();
|
||||
my $l;
|
||||
while( $l = &get_line ){
|
||||
@finaloptions=();
|
||||
|
||||
my ($mod_name, $flag, @params) = split(/[ \t]+/,$l);
|
||||
while ( $flag =~ /^-.$/){
|
||||
if( $flag eq '-a' ){
|
||||
$flag="";
|
||||
last;
|
||||
}
|
||||
if ( $flag eq '-l' ){ # then keep it
|
||||
push @finaloptions, ($flag, shift @params);
|
||||
$flag= @params ? shift @params : "";
|
||||
next;
|
||||
}
|
||||
if( $flag =~ /^-.$/ ){
|
||||
shift @params; # skip parameter's argument
|
||||
$flag= @params ? shift @params : "";
|
||||
next;
|
||||
}
|
||||
last; # No options found...
|
||||
}
|
||||
unshift @params, $flag if ( $flag ne "" );
|
||||
$::modules->{$mod_name} = [(@finaloptions,@params)];
|
||||
}
|
||||
}
|
||||
|
||||
sub build_map {
|
||||
my ($name,$mod_map) = @_;
|
||||
my ($bFound, $local);
|
||||
|
||||
$local = $NOT_LOCAL;
|
||||
$bFound = 0;
|
||||
|
||||
# printf "looking for $name in %s<br>\n",join(",", @{$::modules->{$name}});
|
||||
for my $i ( @{$::modules->{$name}} ){
|
||||
$bFound = 1;
|
||||
if( $i eq '-l' ){
|
||||
$local = $IS_LOCAL;
|
||||
}
|
||||
elsif( ($i eq $name) || !build_map($i, $mod_map )){
|
||||
$mod_map->{$i} = $local;
|
||||
}
|
||||
}
|
||||
return $bFound;
|
||||
}
|
||||
@@ -1,150 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
|
||||
#
|
||||
# Multi file diff cgi
|
||||
#
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
require 'globals.pl';
|
||||
|
||||
$|=1;
|
||||
|
||||
my %form;
|
||||
|
||||
print "Content-type: text/html
|
||||
|
||||
<PRE><FONT FACE='Lucida Console'>
|
||||
";
|
||||
|
||||
my @revs = ();
|
||||
|
||||
#if( $ENV{"QUERY_STRING"} eq "" ){
|
||||
# $ENV{"QUERY_STRING"}="brendan%2Cns%2Fjs%2Fsrc%2Cjsapi.c%2C-1=on&brendan%2Cns%2Fjs%2Fsrc%2Cjsapi.h%2C-1=on&brendan%2Cns%2Fjs%2Fsrc%2Cjsarray.c%2C-106=on&brendan%2Cns%2Fjs%2Fsrc%2Cjsarray.h%2C-0=on&brendan%2Cns%2Fjs%2Fsrc%2Cjsatom.c%2C-9=on";
|
||||
#}
|
||||
|
||||
&split_cgi_args;
|
||||
|
||||
#while( ($k,$v) = each(%ENV) ){
|
||||
# print "$k='$v'\n";
|
||||
#}
|
||||
|
||||
my $cvsroot;
|
||||
if( $form{"cvsroot"} ){
|
||||
$cvsroot = $form{"cvsroot"};
|
||||
}
|
||||
else {
|
||||
$cvsroot = pickDefaultRepository();
|
||||
}
|
||||
|
||||
if( $form{"allchanges"} ){
|
||||
@revs = split(/,/, $form{"allchanges"} );
|
||||
}
|
||||
else {
|
||||
while( my ($k, $v) = each( %form ) ){
|
||||
push( @revs, $k );
|
||||
}
|
||||
}
|
||||
|
||||
my $didone = 0;
|
||||
|
||||
my $rcsdiffcommand = Param('rcsdiffcommand');
|
||||
for my $k (@revs) {
|
||||
my ($who,$dir,$file,$rev) = split(/\|/, $k );
|
||||
if ($rev eq "") {
|
||||
next;
|
||||
}
|
||||
my $prevrev = &PrevRev($rev);
|
||||
|
||||
# this doesn't handle files in the attic
|
||||
my $fullname = "$cvsroot/$dir/$file,v";
|
||||
if (IsHidden($fullname)) {
|
||||
next;
|
||||
}
|
||||
open( DIFF, "$rcsdiffcommand -u -r$prevrev -r$rev $fullname 2>&1|" );
|
||||
while(<DIFF>){
|
||||
if (($_ =~ /RCS file/) || ($_ =~ /rcsdiff/)) {
|
||||
$_ =~ s/(^.*)(.*\/)(.*)/$1 $3/;
|
||||
print "$who: $_";
|
||||
} else {
|
||||
$_ =~ s/&/&/g;
|
||||
$_ =~ s/</</g;
|
||||
$_ =~ s/>/>/g;
|
||||
print "$who: $_";
|
||||
}
|
||||
}
|
||||
$didone = 1;
|
||||
}
|
||||
|
||||
if ($didone == 0) {
|
||||
print "No changes were selected. Please press <b>Back</b> and try again.\n";
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub split_cgi_args {
|
||||
my ($i,$var,$value, $s);
|
||||
|
||||
if( $ENV{"REQUEST_METHOD"} eq 'POST'){
|
||||
while(<> ){
|
||||
$s .= $_;
|
||||
}
|
||||
}
|
||||
else {
|
||||
$s = $ENV{"QUERY_STRING"};
|
||||
}
|
||||
|
||||
my @args= split(/\&/, $s );
|
||||
|
||||
for my $i (@args) {
|
||||
my ($var, $value) = split(/=/, $i);
|
||||
$var =~ tr/+/ /;
|
||||
$var =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
$value =~ tr/+/ /;
|
||||
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
||||
$form{$var} = $value;
|
||||
}
|
||||
}
|
||||
|
||||
sub PrevRev {
|
||||
my( $rev ) = @_;
|
||||
my( $i, $j, $ret, @r );
|
||||
|
||||
@r = split( /\./, $rev );
|
||||
|
||||
$i = @r-1;
|
||||
|
||||
$r[$i]--;
|
||||
if( $r[$i] == 0 ){
|
||||
$i -= 2;
|
||||
}
|
||||
|
||||
$j = 0;
|
||||
while( $j < $i ){
|
||||
$ret .= "$r[$j]\.";
|
||||
$j++
|
||||
}
|
||||
$ret .= $r[$i];
|
||||
}
|
||||
@@ -1,35 +0,0 @@
|
||||
From: bonsai-daemon
|
||||
To: %name%
|
||||
Subject: [Bonsai] You're on the hook now!
|
||||
Mime-Version: 1.0
|
||||
Content-Type: text/html
|
||||
|
||||
<HTML>
|
||||
|
||||
<H1>You are responsible to make sure the build works.</H1>
|
||||
|
||||
You just checked into <tt>%dir%</tt> the files <tt>%files%</tt>. At
|
||||
about <tt>%nextclose%</tt>, the tree will be frozen. From about
|
||||
an hour later on, you are to be available for the build team to pester
|
||||
in case of any problems.
|
||||
|
||||
<P>
|
||||
|
||||
Any further checkins you make before the tree closes will <i>not</i>
|
||||
cause you to receive more copies of this mail, but you'll be held
|
||||
responsible for them too.
|
||||
|
||||
<P>
|
||||
|
||||
For more info on the current state of the tree, see the
|
||||
<a href=http://warp/bonsai/toplevel.cgi>Bonsai main page</a>.
|
||||
|
||||
<P>
|
||||
|
||||
Your contact info and other vital data is listed below. Please
|
||||
<a href=http://warp/bonsai/profile.cgi?person=%name%>update</a>
|
||||
this info <b>immediately</b> if it is at all inaccurate or incorrect.
|
||||
|
||||
<hr>
|
||||
|
||||
%profile%
|
||||
@@ -1,6 +0,0 @@
|
||||
$::param{'cocommand'} = '_CO_';
|
||||
$::param{'cvscommand'} = '_CVS_';
|
||||
$::param{'rcsdiffcommand'} = '_RCSDIFF_';
|
||||
$::param{'rlogcommand'} = '_RLOG_';
|
||||
$::param{'cvsgraph'} = '_CVSGRAPH_';
|
||||
1;
|
||||
@@ -1,38 +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.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
# This takes a bunch of files that have been put into the 'bonsai
|
||||
# queue' (the 'queue' subdirectory) and processes them as checkins.
|
||||
# This is to work around worlds where we can't send mail from inside
|
||||
# the CVS loginfo file.
|
||||
#
|
||||
# Each file is expected to have the CVSROOT in the first line, any args in the
|
||||
# second line (currently unused), and the data fed to loginfo as the remaining
|
||||
# lines.
|
||||
|
||||
$inprocess = "data/queue/processing-$$";
|
||||
|
||||
foreach $file (sort(glob("data/queue/*.q"))) {
|
||||
rename $file, $inprocess || die "Couldn't rename queue file.";
|
||||
system "./dolog.pl < $inprocess";
|
||||
rename $inprocess, "$file.done";
|
||||
}
|
||||
@@ -1,277 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::RepositoryID;
|
||||
$zz = $::StartingDir;
|
||||
}
|
||||
|
||||
use File::Basename;
|
||||
|
||||
require "CGI.pl";
|
||||
|
||||
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);
|
||||
|
||||
print "$filename\n";
|
||||
|
||||
die "Unable to run rlog command '$rlog': $!\n"
|
||||
unless (open(RLOG_PROC, "$rlog"));
|
||||
undef (%branchname);
|
||||
|
||||
($filerealname = $filename) =~ s/,v$//g;
|
||||
$filehead =~ s!^$::Repository/*!!;
|
||||
$filehead = '.'
|
||||
unless ($filehead);
|
||||
$filetail = basename($filerealname);
|
||||
|
||||
while (<RLOG_PROC>) {
|
||||
chop;
|
||||
$line = $_;
|
||||
$trimmed = trim($line);
|
||||
|
||||
if ($doingtags) {
|
||||
if ($line !~ /^\t/) {
|
||||
$doingtags = 0;
|
||||
} else {
|
||||
$trimmed =~ /^([^:]*):([^:]*)/;
|
||||
$tag = trim($1);
|
||||
$version = trim($2);
|
||||
|
||||
next
|
||||
unless (length($tag) && length($version));
|
||||
|
||||
$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')"
|
||||
#
|
||||
|
||||
# Aha! Second-to-last being a zero is CVS's special way
|
||||
# of remembering a branch tag.
|
||||
$version =~ /(.*)\.(\d+)(\.\d+)$/;
|
||||
$branchname{"$1$3"} = $tag
|
||||
if ($2 eq '0');
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
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{4})/(\d+/\d+)!$2/$1!;
|
||||
$date = str2time($datestr, "GMT");
|
||||
if ($date >= $::StartFrom) {
|
||||
AddToDatabase("C|$date|$author|$::Repository|$filehead|$filetail|$revision||$branch|+$pluscount|-$minuscount", $desc);
|
||||
}
|
||||
}
|
||||
$indesc = 0;
|
||||
} else {
|
||||
$desc .= $line . "\n";
|
||||
}
|
||||
}
|
||||
|
||||
# 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 description.
|
||||
}
|
||||
|
||||
else {
|
||||
$indesc = 1;
|
||||
$desc = "$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
$line = <RLOG_PROC>;
|
||||
if (!defined $line) {
|
||||
last;
|
||||
}
|
||||
chop($line);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
close(RLOG_PROC);
|
||||
}
|
||||
|
||||
|
||||
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;
|
||||
|
||||
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 = '';
|
||||
|
||||
if (defined($::FORM{'modules'})) {
|
||||
$::Modules = trim(FormData('modules'));
|
||||
}
|
||||
|
||||
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();
|
||||
my @Dirs = grep(!/\*$/, @::LegalDirs);
|
||||
@Dirs = split(/,\s*/, $::Modules) if $::Modules;
|
||||
my $StartingDir;
|
||||
($StartingDir = "$::Repository/$::SubDir") =~ s!/.?$!! if $::SubDir;
|
||||
|
||||
|
||||
print "Doing directories: @Dirs ...\n";
|
||||
foreach my $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);
|
||||
} elsif (!-r $dir) {
|
||||
print "$Dir: not readable, skipping...\n";
|
||||
} else {
|
||||
print "$Dir: not a file or directory, skipping...\n";
|
||||
}
|
||||
}
|
||||
|
||||
exit 0;
|
||||
@@ -1,133 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>";
|
||||
|
||||
CheckPassword($::FORM{'password'});
|
||||
|
||||
my $startfrom = ParseTimeAndCheck(FormData('startfrom'));
|
||||
|
||||
Lock();
|
||||
LoadTreeConfig();
|
||||
LoadDirList();
|
||||
LoadCheckins();
|
||||
@::CheckInList = ();
|
||||
|
||||
|
||||
$| = 1;
|
||||
|
||||
ConnectToDatabase();
|
||||
|
||||
print "<TITLE> Rebooting, please wait...</TITLE>
|
||||
|
||||
<H1>Recreating the hook</H1>
|
||||
|
||||
<h3>$::TreeInfo{$::TreeID}->{'description'}</h3>
|
||||
|
||||
<p>
|
||||
Searching for first checkin after " . SqlFmtClock($startfrom) . "...<p>\n";
|
||||
|
||||
my $branch = $::TreeInfo{$::TreeID}->{'branch'};
|
||||
print "<p> $branch <p> \n";
|
||||
|
||||
my $sqlstring = "select type, UNIX_TIMESTAMP(ci_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 and branches.branch='$branch' and ci_when>='" . SqlFmtClock($startfrom) . "' order by ci_when;";
|
||||
print "<p> $sqlstring <p>\n";
|
||||
SendSQL("$sqlstring");
|
||||
|
||||
my ($change, $date, $who, $repos, $dir, $file, $rev, $sticky, $branch, $linesa, $linesr, $log);
|
||||
my ($lastchange, $lastdate, $lastwho, $lastrepos, $lastdir, $lastrev, $laststicky, $lastbranch, $lastlinesa, $lastlinesr, $lastlog);
|
||||
my ($id, $info, $lastdate, @files, @fullinfo);
|
||||
my ($d, $f, $okdir, $full);
|
||||
my ($r);
|
||||
$lastdate = "";
|
||||
$lastdir = "";
|
||||
@files = ();
|
||||
@fullinfo = ();
|
||||
while (($change, $date, $who, $repos, $dir, $file, $rev, $sticky, $branch, $linesa, $linesr, $log) = FetchSQLData()) {
|
||||
# print "<p>$change $date $who $repos $dir $file $rev $sticky $branch $linesa $linesr $log<p>\n ";
|
||||
if (($date ne $lastdate && $lastdate ne "") || ($dir ne $lastdir && $lastdir ne "")) {
|
||||
|
||||
$okdir = 0;
|
||||
LEGALDIR:
|
||||
foreach $d (sort( grep(!/\*$/, @::LegalDirs))) {
|
||||
if ($lastdir =~ m!^$d\b!) {
|
||||
$okdir = 1;
|
||||
last LEGALDIR;
|
||||
}
|
||||
}
|
||||
if ($okdir) {
|
||||
print "<br>";
|
||||
print "$lastchange $lastdate $lastwho $lastrepos <br> $lastdir ";
|
||||
print "<br>";
|
||||
foreach $f (@files) { print "$f ";}
|
||||
print " <br>$lastrev $laststicky $lastbranch $lastlinesa $lastlinesr <br>$lastlog";
|
||||
print "\n<br>--------------------------------------------------------<br>\n";
|
||||
$r++;
|
||||
$id = "::checkin_${lastdate}_$r";
|
||||
push @::CheckInList, $id;
|
||||
|
||||
$info = eval("\\\%$id");
|
||||
%$info = (
|
||||
person => $lastwho,
|
||||
date => $lastdate,
|
||||
dir => $lastdir,
|
||||
files => join('!NeXt!', @files),
|
||||
'log' => MarkUpText(html_quote(trim($lastlog))),
|
||||
treeopen => $::TreeOpen,
|
||||
fullinfo => join('!NeXt!', @fullinfo)
|
||||
);
|
||||
}
|
||||
|
||||
@files = ();
|
||||
@fullinfo = ();
|
||||
}
|
||||
$lastchange = $change;
|
||||
$lastdate = $date;
|
||||
$lastwho = $who;
|
||||
$lastrepos = $repos;
|
||||
$lastdir = $dir;
|
||||
$lastrev = $rev;
|
||||
$laststicky = $sticky;
|
||||
$lastbranch = $branch;
|
||||
$lastlinesa = $linesa;
|
||||
$lastlinesr = $linesr;
|
||||
$lastlog = $log;
|
||||
|
||||
if (!($file=~/Tag:/ || ($file=~/$branch/) && ($branch) )) {
|
||||
push @files, $file;
|
||||
push @fullinfo, "$file|$rev|$linesa|$linesr|";
|
||||
}
|
||||
}
|
||||
|
||||
WriteCheckins();
|
||||
Unlock();
|
||||
|
||||
print "<p>OK, done. \n";
|
||||
|
||||
PutsTrailer();
|
||||
@@ -1,64 +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.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
if( $ARGV[0] eq '' ){
|
||||
$::CVS_ROOT = '/m/src';
|
||||
}
|
||||
else {
|
||||
$::CVS_ROOT = $ARGV[0];
|
||||
}
|
||||
|
||||
$CVS_REPOS_SUFIX = $::CVS_ROOT;
|
||||
$CVS_REPOS_SUFIX =~ s/\//_/g;
|
||||
|
||||
|
||||
$FILE_LIST = "/d/webdocs/projects/bonsai/data/reposfiles${CVS_REPOS_SUFIX}";
|
||||
|
||||
open FL, ">$FILE_LIST";
|
||||
|
||||
GoDir($::CVS_ROOT);
|
||||
|
||||
sub GoDir {
|
||||
local($dir) = @_;
|
||||
local(@dirs, $i);
|
||||
|
||||
chdir "$dir";
|
||||
|
||||
while(<*> ){
|
||||
if( $_ ne '.' && $_ ne '..' ){
|
||||
if( -d $_ ) {
|
||||
push @dirs, $_;
|
||||
}
|
||||
else {
|
||||
print FL "$dir/$_\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
for $i (@dirs) {
|
||||
GoDir( "$dir/$i");
|
||||
}
|
||||
}
|
||||
@@ -1,4 +0,0 @@
|
||||
User-agent: *
|
||||
Allow: /index.html
|
||||
Allow: /cvsqueryform.cgi
|
||||
Disallow: /
|
||||
@@ -1,283 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
|
||||
#
|
||||
# Query the CVS database.
|
||||
#
|
||||
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::Setup_String;
|
||||
}
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
$|=1;
|
||||
|
||||
my $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
|
||||
|
||||
my $dir = $::FORM{"dir"};
|
||||
$dir = "" unless defined $dir;
|
||||
$dir = "" if ($dir =~ /^\.\.\/$/);
|
||||
$dir =~ s/^\/([^:]*)/$1/;
|
||||
$dir =~ s/([^:]*)\/$/$1/;
|
||||
|
||||
my $rev = $::FORM{"rev"};
|
||||
|
||||
if(!defined($rev)) {
|
||||
$rev='';
|
||||
}
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
|
||||
my $registryurl = Param('registryurl');
|
||||
$registryurl =~ s@/$@@;
|
||||
|
||||
my $script_str;
|
||||
|
||||
&setup_script;
|
||||
$::Setup_String = $script_str;
|
||||
|
||||
|
||||
if( $CVS_ROOT eq "" ){
|
||||
$CVS_ROOT = pickDefaultRepository();
|
||||
}
|
||||
|
||||
validateRepository($CVS_ROOT);
|
||||
|
||||
my $s = "";
|
||||
|
||||
if ($rev) {
|
||||
$s = "for branch <i>$rev</i>";
|
||||
}
|
||||
|
||||
CheckHidden("$CVS_ROOT/$dir");
|
||||
|
||||
my $revstr = '';
|
||||
$revstr = "&rev=$rev" unless $rev eq '';
|
||||
my $rootstr = '';
|
||||
$rootstr .= "&cvsroot=$::FORM{'cvsroot'}" if defined $::FORM{'cvsroot'};
|
||||
$rootstr .= "&module=$::TreeID";
|
||||
my $module = $::TreeInfo{$::TreeID}{'module'};
|
||||
|
||||
my $toplevel = Param('toplevel');
|
||||
|
||||
PutsHeader("Repository Directory $toplevel/$dir $s", "");
|
||||
|
||||
my $output = "<DIV ALIGN=LEFT>";
|
||||
$output .= "<A HREF='toplevel.cgi" . BatchIdPart('?') . "'>$toplevel</a>/ ";
|
||||
|
||||
my ($dir_head, $dir_tail) = $dir =~ m@(.*/)?(.+)@;
|
||||
$dir_head = "" unless defined $dir_head;
|
||||
$dir_tail = "" unless defined $dir_tail;
|
||||
my $link_path = "";
|
||||
foreach my $path (split('/',$dir_head)) {
|
||||
$link_path .= $path;
|
||||
$output .= "<A HREF='rview.cgi?dir=$link_path$rootstr$revstr'>$path</A>/ ";
|
||||
$link_path .= '/';
|
||||
}
|
||||
chop ($output);
|
||||
$output .= " $dir_tail/ $s ";
|
||||
$output .= "</DIV>";
|
||||
|
||||
print $output;
|
||||
print '<table width="100%"><tr><td width="70%">';
|
||||
|
||||
my $other_dir;
|
||||
|
||||
($other_dir = $dir) =~ s!^$module/?!!;
|
||||
my $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>
|
||||
<FORM action=rview.cgi method=get><TR><TD>
|
||||
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>
|
||||
<FORM action=rview.cgi method=get><TR><TD>
|
||||
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></FORM>
|
||||
</TABLE>
|
||||
|
||||
";
|
||||
|
||||
my @dirs = ();
|
||||
|
||||
|
||||
DIR:
|
||||
while( <*> ){
|
||||
if( -d $_ ){
|
||||
push @dirs, $_;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
my $j;
|
||||
my $split;
|
||||
|
||||
if( @dirs != 0 ){
|
||||
$j = 1;
|
||||
$split = int(@dirs/4)+1;
|
||||
print "<P><FONT SIZE=+1><B>Directories:</B></FONT><table><TR VALIGN=TOP><td>";
|
||||
|
||||
|
||||
for my $i (@dirs){
|
||||
$::FORM{"dir"} = ($dir ne "" ? "$dir/$i" : $i);
|
||||
my $anchor = &make_cgi_args;
|
||||
print "<dt><a href=rview.cgi${anchor}>$i</a>\n";
|
||||
if( $j % $split == 0 ){
|
||||
print "\n<td>\n";
|
||||
}
|
||||
$j++;
|
||||
}
|
||||
$::FORM{"dir"} = $dir;
|
||||
print "\n</tr></table>\n";
|
||||
}
|
||||
|
||||
|
||||
print "<P><FONT SIZE=+1><B>Files:</B></FONT>";
|
||||
print "<table><TR VALIGN=TOP><td>";
|
||||
my @files = <*,v>;
|
||||
$j = 1;
|
||||
$split = int(@files/4)+1;
|
||||
|
||||
for $_ (@files){
|
||||
$_ =~ s/\,v//;
|
||||
print qq{<dt><a href="$registryurl/file.cgi?cvsroot=$CVS_ROOT&file=$_&dir=$dir$revstr"}
|
||||
. " onclick=\"return js_file_menu('$dir','$_','$rev','$CVS_ROOT',event)\">\n";
|
||||
print "$_</a>\n";
|
||||
if( $j % $split == 0 ){
|
||||
print "\n</td><td>\n";
|
||||
}
|
||||
$j++;
|
||||
}
|
||||
print "\n</tr></table>\n</td><td>";
|
||||
cvsmenu("");
|
||||
print "\n</td></tr></table>\n";
|
||||
|
||||
PutsTrailer();
|
||||
|
||||
|
||||
sub setup_script {
|
||||
|
||||
$script_str = qq%
|
||||
<script $::script_type><!--
|
||||
|
||||
var event = new Object;
|
||||
|
||||
function js_who_menu(n,extra,d) {
|
||||
if( parseInt(navigator.appVersion) < 4 ||
|
||||
navigator.userAgent.toLowerCase().indexOf("msie") != -1 ){
|
||||
return true;
|
||||
}
|
||||
l = document.layers['popup'];
|
||||
l.src="$registryurl/who.cgi?email="+n+extra;
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
l.left = d.target.x - 6;
|
||||
|
||||
if( l.left + l.clipWidth > window.width ){
|
||||
l.left = window.width - l.clipWidth;
|
||||
}
|
||||
l.visibility="show";
|
||||
return false;
|
||||
}
|
||||
|
||||
function js_file_menu(dir,file,rev,root,d) {
|
||||
if( parseInt(navigator.appVersion) < 4 ||
|
||||
navigator.userAgent.toLowerCase().indexOf("msie") != -1 ){
|
||||
return true;
|
||||
}
|
||||
l = document.layers['popup'];
|
||||
l.src="$registryurl/file.cgi?file="+file+"&dir="+dir+"&rev="+rev+"&cvsroot="+root+"&linked_text="+d.target.text;
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
l.left = d.target.x - 6;
|
||||
|
||||
if( l.left + l.clipWidth > window.width ){
|
||||
l.left = window.width - l.clipWidth;
|
||||
}
|
||||
|
||||
l.visibility="show";
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
//--></script>
|
||||
|
||||
<layer name="popup" onMouseOut="this.visibility='hide';" left=0 top=0 bgcolor="#ffffff" visibility="hide">
|
||||
</layer>
|
||||
|
||||
%;
|
||||
|
||||
}
|
||||
|
||||
@@ -1,317 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
require 'CGI.pl';
|
||||
use vars qw(@TreeList);
|
||||
|
||||
print "Content-type: text/html\n\n";
|
||||
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
LoadTreeConfig();
|
||||
Unlock();
|
||||
|
||||
my %peoplearray = ();
|
||||
my @list = ();
|
||||
my $versioninfo = '';
|
||||
my $tweak = $::FORM{'tweak'};
|
||||
my $delta_size = 1;
|
||||
my ($title, $head, $subhead) = ('', '', '');
|
||||
my ($checkin, $info);
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
|
||||
if (exists($::FORM{'person'})) {
|
||||
my $escaped_person = html_quote($::FORM{'person'});
|
||||
$title = $head = "Checkins for $escaped_person";
|
||||
|
||||
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);
|
||||
|
||||
$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 {
|
||||
$title = $head = "All Checkins";
|
||||
@list = @::CheckInList;
|
||||
}
|
||||
|
||||
my $treepart = '';
|
||||
$treepart = "&treeid=$::TreeID" if ($::TreeID ne "default");
|
||||
my $branchpart = '';
|
||||
$branchpart = "&branch=$::TreeInfo{$::TreeID}{branch}"
|
||||
if ($::TreeInfo{$::TreeID}{branch});
|
||||
|
||||
$subhead .= "<br><font color=red>
|
||||
These checkins are <em>not</em> from <a
|
||||
href='showcheckins.cgi?$treepart$branchpart'>the current
|
||||
hook</a>!</font><br>"
|
||||
if (Param('readonly'));
|
||||
$subhead .= "View a <a href=\"viewold.cgi?" . BatchIdPart('?') . "&target=showcheckins\">different
|
||||
day's checkins</a>.<br>";
|
||||
|
||||
PutsHeader($title, $head, $subhead);
|
||||
|
||||
$::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 $rval = 0;
|
||||
my $key;
|
||||
my $aref = eval("\\\%$a");
|
||||
my $bref = eval("\\\%$b");
|
||||
|
||||
foreach $key (@fields) {
|
||||
if ($key eq 'date') {
|
||||
$rval = $$bref{$key} cmp $$aref{$key};
|
||||
} else {
|
||||
$rval = $$aref{$key} cmp $$bref{$key};
|
||||
}
|
||||
return $rval unless ($rval == 0);
|
||||
}
|
||||
return $rval;
|
||||
}
|
||||
|
||||
my $total_added = 0;
|
||||
my $total_removed = 0;
|
||||
|
||||
#
|
||||
# Calculate delta information
|
||||
#
|
||||
CHECKIN:
|
||||
foreach my $infoname (@list) {
|
||||
$info = eval("\\\%$infoname");
|
||||
$$info{added} = 0;
|
||||
$$info{removed} = 0;
|
||||
|
||||
if (exists($$info{'fullinfo'})) {
|
||||
my @fullinfos = split(/!NeXt!/, $$info{'fullinfo'});
|
||||
INFO:
|
||||
foreach my $fullinfo (@fullinfos) {
|
||||
my ($file, $version, $addlines, $removelines, $sticky)
|
||||
= split(/\|/, $fullinfo);
|
||||
|
||||
# Skip binary files
|
||||
next INFO if (($file =~ /\.gif$/) ||
|
||||
($file =~ /\.bmp$/) ||
|
||||
($sticky =~ /-kb/));
|
||||
|
||||
if ($addlines) {
|
||||
$$info{added} += $addlines;
|
||||
}
|
||||
if ($removelines) {
|
||||
$$info{removed} += $removelines;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$$info{'lines_changed'} =
|
||||
sprintf("%7d", 1000000 - ($$info{added} - $$info{removed}));
|
||||
|
||||
$total_added += $$info{added};
|
||||
$total_removed += $$info{removed};
|
||||
}
|
||||
|
||||
|
||||
# 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);
|
||||
}
|
||||
|
||||
|
||||
|
||||
#
|
||||
# Print the table...
|
||||
#
|
||||
|
||||
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;
|
||||
|
||||
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>\n\n";
|
||||
|
||||
|
||||
my $count = 0;
|
||||
my $maxcount = 100;
|
||||
|
||||
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>%m/%d/%Y %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,";
|
||||
}
|
||||
my $comment = $$info{'log'};
|
||||
$comment =~ s/\n/<br>/g;
|
||||
print "<TD WIDTH=100%>$comment</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 "";
|
||||
}
|
||||
|
||||
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=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>\n";
|
||||
|
||||
foreach my $tree (@::TreeList) {
|
||||
print "<OPTION ". IsSelected($tree).
|
||||
" VALUE=$tree>$::TreeInfo{$tree}{description}\n"
|
||||
unless $::TreeInfo{$tree}{nobonsai};
|
||||
}
|
||||
|
||||
print "
|
||||
</SELECT><P>
|
||||
<B>Password:</B><INPUT NAME=password TYPE=password></td>
|
||||
<BR>
|
||||
<INPUT TYPE=SUBMIT VALUE=Submit>
|
||||
</FORM>\n";
|
||||
} else {
|
||||
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 (exists $::FORM{ltabbhack}) {
|
||||
print "<!-- StupidLloydHack " . join(',', sort(keys(%peoplearray))) .
|
||||
" -->\n";
|
||||
print "<!-- LloydHack2 $versioninfo -->\n";
|
||||
}
|
||||
|
||||
PutsTrailer();
|
||||
|
||||
|
||||
@@ -1,63 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
# Shut up misguided -w warnings about "used only once". "use vars" just
|
||||
# doesn't work for me.
|
||||
|
||||
sub sillyness {
|
||||
my $zz;
|
||||
$zz = $::TreeID;
|
||||
$zz = $::TreeList;
|
||||
}
|
||||
|
||||
require 'CGI.pl';
|
||||
print "Content-type: text/html\n\n";
|
||||
LoadTreeConfig();
|
||||
|
||||
sub IsChecked {
|
||||
my ($value) = @_;
|
||||
my $rval = '';
|
||||
|
||||
$rval = "CHECKED" if ($value eq $::TreeID);
|
||||
return $rval;
|
||||
}
|
||||
|
||||
my $title = "George, George, George of the jungle...";
|
||||
PutsHeader($title, "Switch-o-Matic");
|
||||
|
||||
print "
|
||||
<b>Which tree would you like to see?</b>
|
||||
<FORM method=get action=\"toplevel.cgi\">\n";
|
||||
|
||||
foreach my $i (@::TreeList) {
|
||||
next if (exists($::TreeInfo{$i}{nobosai}));
|
||||
|
||||
print "<INPUT TYPE=radio NAME=treeid VALUE=$i " . IsChecked($i) . ">\n";
|
||||
print "$::TreeInfo{$i}{description}<BR>\n";
|
||||
}
|
||||
|
||||
print "<INPUT TYPE=SUBMIT Value=\"Submit\"></FORM>\n";
|
||||
PutsTrailer();
|
||||
exit;
|
||||
@@ -1,12 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl --
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
|
||||
require 'utils.pl';
|
||||
|
||||
Lock();
|
||||
|
||||
print "Got lock.\n";
|
||||
|
||||
sleep 10;
|
||||
|
||||
Unlock();
|
||||
@@ -1,297 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
sub StupidFuncToShutUpWarningsByUsingVarsAgain {
|
||||
my $z;
|
||||
$z = $::CloseTimeStamp;
|
||||
$z = $::LastGoodTimeStamp;
|
||||
$z = $::MOTD;
|
||||
$z = $::WhiteBoard;
|
||||
$z = $::TreeList;
|
||||
}
|
||||
|
||||
print "Content-type: text/html\nRefresh: 300\n\n";
|
||||
|
||||
PutsHeader("Bonsai -- the art of effectively controlling trees",
|
||||
"Bonsai", "CVS Tree Control");
|
||||
|
||||
print "<IMG ALIGN=right SRC=bonsai.gif>";
|
||||
|
||||
|
||||
Lock();
|
||||
LoadCheckins();
|
||||
LoadMOTD();
|
||||
LoadWhiteboard();
|
||||
LoadTreeConfig();
|
||||
Unlock();
|
||||
|
||||
|
||||
my $openword;
|
||||
if ($::TreeOpen) {
|
||||
$openword = '<b><FONT SIZE=+2>OPEN</FONT></B>';
|
||||
} else {
|
||||
$openword = '<b><FONT SIZE=+3 COLOR=RED>CLOSED</FONT></B>';
|
||||
}
|
||||
|
||||
|
||||
print "
|
||||
|
||||
<FORM name=treeform>
|
||||
<H3>
|
||||
<SELECT name=treeid size=1 onchange='submit();'>
|
||||
";
|
||||
|
||||
|
||||
foreach my $tree (@::TreeList) {
|
||||
unless (exists $::TreeInfo{$tree}{nobonsai}) {
|
||||
my $c = ($tree eq $::TreeID) ? 'Selected' : '';
|
||||
print "<OPTION VALUE=\"$tree\" $c>$::TreeInfo{$tree}{description}\n";
|
||||
}
|
||||
}
|
||||
|
||||
print "</SELECT></H3></FORM>\n";
|
||||
|
||||
|
||||
my $treepart = '';
|
||||
$treepart = "&treeid=$::TreeID"
|
||||
if ($::TreeID ne "default");
|
||||
my $branchpart='';
|
||||
$branchpart="&branch=$::TreeInfo{$::TreeID}{branch}"
|
||||
if $::TreeInfo{$::TreeID}{branch};
|
||||
if (Param('readonly')) {
|
||||
print "<div style='border: 2px dotted grey; padding: 2px'><h2><font color=red>
|
||||
Be aware that this is <em>not</em> the <a href='toplevel.cgi?$treepart$branchpart'>current
|
||||
hook!</a></font></h2>\n";
|
||||
} else {
|
||||
print "<div><tt>" . time2str("%m/%d/%Y %T %Z", time())."</tt>:";
|
||||
}
|
||||
print " The tree is currently $openword<br>\n";
|
||||
unless ($::TreeOpen) {
|
||||
print "The tree has been closed since <tt>" .
|
||||
MyFmtClock($::CloseTimeStamp) . "</tt>.<BR>\n";
|
||||
}
|
||||
|
||||
print "</div>The last known good tree had a timestamp of <tt>";
|
||||
print time2str("%m/%d/%Y %T %Z", $::LastGoodTimeStamp) . "</tt>.<br>";
|
||||
print "<hr><pre variable>$::MOTD</pre><hr>";
|
||||
print "<br clear=all>";
|
||||
|
||||
my $bid_part = BatchIdPart('?');
|
||||
print "<b><a href=editwhiteboard.cgi$bid_part>
|
||||
Free-for-all whiteboard:</a></b>
|
||||
<pre>" . html_quote($::WhiteBoard) . "</pre><hr>\n";
|
||||
|
||||
|
||||
my %username;
|
||||
my %checkincount;
|
||||
my %closedcheckin;
|
||||
my %fullname;
|
||||
my %curcontact;
|
||||
|
||||
foreach my $checkin (@::CheckInList) {
|
||||
my $info = eval("\\\%$checkin");
|
||||
my $addr = EmailFromUsername($info->{'person'});
|
||||
|
||||
$username{$addr} = $info->{'person'};
|
||||
if (!exists $checkincount{$addr}) {
|
||||
$checkincount{$addr} = 1;
|
||||
} else {
|
||||
$checkincount{$addr}++;
|
||||
}
|
||||
if (!$info->{'treeopen'}) {
|
||||
if (!defined $closedcheckin{$addr}) {
|
||||
$closedcheckin{$addr} = 1;
|
||||
} else {
|
||||
$closedcheckin{$addr}++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
my $ldaperror = 0;
|
||||
|
||||
if (%checkincount) {
|
||||
my (@peoplelist, @list, $p, $i, $end, $checkins);
|
||||
my $ldapserver = Param('ldapserver');
|
||||
my $ldapport = Param('ldapport');
|
||||
|
||||
print "
|
||||
The following people are on \"the hook\", since they have made
|
||||
checkins to the tree since it last opened: <p>\n";
|
||||
|
||||
@peoplelist = sort(keys %checkincount);
|
||||
|
||||
@list = @peoplelist;
|
||||
while (1) {
|
||||
last if ($#list < 0);
|
||||
$end = 19;
|
||||
$end = $#list if ($end >= $#list);
|
||||
GetInfoForPeople(splice(@list, 0, $end + 1));
|
||||
}
|
||||
|
||||
if ($ldaperror) {
|
||||
print "<font color=red>
|
||||
Can't contact the directory server at $ldapserver:$ldapport</font>\n";
|
||||
}
|
||||
|
||||
print "
|
||||
<table border cellspacing=2>
|
||||
<th colspan=2>Who</th><th>What</th>\n";
|
||||
print "<th>How to contact</th>\n" if $ldapserver;
|
||||
|
||||
foreach $p (@peoplelist) {
|
||||
my ($uname, $namepart, $extra) = ('', '', '');
|
||||
|
||||
if (exists($closedcheckin{$p})) {
|
||||
$extra = " <font color=red>($closedcheckin{$p} while tree closed!)</font>";
|
||||
}
|
||||
|
||||
$uname = $username{$p};
|
||||
($namepart = $p) =~ s/\@.*//;
|
||||
$checkins = $checkincount{$p};
|
||||
|
||||
print "<tr>\n";
|
||||
if ($fullname{$p}) {
|
||||
print "<td>$fullname{$p}</td>\n<td>";
|
||||
} else {
|
||||
print "<td colspan=2>";
|
||||
}
|
||||
print GenerateUserLookUp($uname, $namepart, $p) . "</td>\n";
|
||||
print "<td><a href=\"showcheckins.cgi?person=" . url_quote($uname);
|
||||
print BatchIdPart() . "\"> $checkins ";
|
||||
print Pluralize('change', $checkins) . "</a>$extra</td>\n";
|
||||
print "<td>$curcontact{$p}\n" if $ldapserver;
|
||||
print "</tr>\n\n";
|
||||
}
|
||||
|
||||
print "</table>\n\n";
|
||||
|
||||
|
||||
$checkins = @::CheckInList;
|
||||
print Pluralize("$checkins checkin", $checkins) . ".<p>\n";
|
||||
|
||||
my $mailaddr =
|
||||
join(',', @peoplelist) . "?subject=Hook%3a%20Build%20Problem";
|
||||
$mailaddr .= "&cc=$::TreeInfo{$::TreeID}{cchookmail}"
|
||||
if (exists($::TreeInfo{$::TreeID}{cchookmail}));
|
||||
|
||||
|
||||
print "
|
||||
<a href=showcheckins.cgi" . BatchIdPart('?') . ">Show all checkins.</a><br>
|
||||
<a href=\"mailto:$mailaddr\">Send mail to \"the hook\".</a><br>\n";
|
||||
|
||||
} else {
|
||||
print "Nobody seems to have made any changes since the tree opened.";
|
||||
}
|
||||
|
||||
|
||||
my $cvsqueryurl = "cvsqueryform.cgi?" .
|
||||
"cvsroot=$::TreeInfo{$::TreeID}{repository}" .
|
||||
"&module=$::TreeInfo{$::TreeID}{module}" .
|
||||
$branchpart;
|
||||
my $bip = BatchIdPart('?');
|
||||
my $tinderboxbase = Param('tinderboxbase');
|
||||
my $tinderboxlink = '';
|
||||
$tinderboxlink = "<a href=\"$tinderboxbase/showbuilds.cgi\">Tinderbox
|
||||
continuous builds</a><br>" if ($tinderboxbase);
|
||||
|
||||
my $otherrefs = Param('other_ref_urls');
|
||||
|
||||
print "
|
||||
<hr>
|
||||
<table>
|
||||
<tr>
|
||||
<th>Useful links </th><th width=10%></th><th>Help and Documentation</th>
|
||||
</tr>
|
||||
<tr>
|
||||
<td valign=top>
|
||||
<a href=\"$cvsqueryurl\"><b>CVS Query Tool</b></a><br>
|
||||
<a href=\"switchtree.cgi$bip\">Switch to look at a different tree or branch</a><br>
|
||||
$tinderboxlink
|
||||
<a href=\"viewold.cgi$bip\">Time warp -- view a different day's hook.</a><br>
|
||||
<a href=\"countcheckins.cgi$bip\">See some stupid statistics about recent checkins.</a><br>
|
||||
<a href=\"admin.cgi$bip\">Administration menu.</a><br>
|
||||
</td><td>
|
||||
</td><td valign=top>
|
||||
$otherrefs
|
||||
</td>
|
||||
</tr></table>
|
||||
" ;
|
||||
|
||||
exit 0;
|
||||
|
||||
|
||||
|
||||
sub GetInfoForPeople {
|
||||
my (@peoplelist) = @_;
|
||||
my ($p, $query, $isempty);
|
||||
my $ldapserver = Param('ldapserver');
|
||||
my $ldapport = Param('ldapport');
|
||||
my $ldapcmd;
|
||||
|
||||
$query = "(| ";
|
||||
$isempty = 1;
|
||||
|
||||
foreach $p (@peoplelist) {
|
||||
$query .= "(mail=$p) ";
|
||||
$fullname{$p} = "";
|
||||
$curcontact{$p} = "";
|
||||
}
|
||||
|
||||
$query .= ")";
|
||||
return if ($ldaperror || ($ldapserver eq ''));
|
||||
|
||||
$ldapcmd = "./data/ldapsearch -b \"dc=netscape,dc=com\" " .
|
||||
"-h $ldapserver -p $ldapport -s sub " .
|
||||
"-S mail \"$query\" mail cn nscpcurcontactinfo";
|
||||
unless (open(LDAP, "$ldapcmd |")) {
|
||||
$ldaperror = 1;
|
||||
} else {
|
||||
my $doingcontactinfo = 0;
|
||||
my $curperson;
|
||||
while (<LDAP>) {
|
||||
chop;
|
||||
if ($doingcontactinfo) {
|
||||
if (/^ (.*)$/) {
|
||||
$curcontact{$curperson} .= "$1\n";
|
||||
next;
|
||||
}
|
||||
$doingcontactinfo = 0;
|
||||
}
|
||||
if (/^mail: (.*\@.*)$/) {
|
||||
$curperson = $1;
|
||||
} elsif (/^cn: (.*)$/) {
|
||||
$fullname{$curperson} = $1;
|
||||
} elsif (/^nscpcurcontactinfo: (.*)$/) {
|
||||
$curcontact{$curperson} = "$1\n";
|
||||
$doingcontactinfo = 1;
|
||||
}
|
||||
}
|
||||
close(LDAP);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1,9 +0,0 @@
|
||||
#include <stdio.h>
|
||||
#ifndef __bsdi__
|
||||
#include <crypt.h>
|
||||
#endif
|
||||
|
||||
main(int argc, char** argv) {
|
||||
printf("%s\n", crypt(argv[1], "aa"));
|
||||
return 0;
|
||||
}
|
||||
@@ -1,23 +0,0 @@
|
||||
# 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,176 +0,0 @@
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
use DBD::mysql;
|
||||
|
||||
require 'header.pl';
|
||||
|
||||
$lockcount = 0;
|
||||
|
||||
1;
|
||||
|
||||
|
||||
sub Lock {
|
||||
if ($lockcount <= 0) {
|
||||
$lockcount = 0;
|
||||
if (!open(LOCKFID, ">>data/lockfile")) {
|
||||
mkdir "data", 0777;
|
||||
chmod 0777, "data";
|
||||
open(LOCKFID, ">>data/lockfile") || die "Can't open lockfile.";
|
||||
}
|
||||
my $val = flock(LOCKFID,2);
|
||||
if (!$val) { # '2' is magic 'exclusive lock' const.
|
||||
print "Lock failed: $val\n";
|
||||
}
|
||||
chmod 0666, "data/lockfile";
|
||||
}
|
||||
$lockcount++;
|
||||
}
|
||||
|
||||
sub Unlock {
|
||||
$lockcount--;
|
||||
if ($lockcount <= 0) {
|
||||
flock(LOCKFID,8); # '8' is magic 'unlock' const.
|
||||
close LOCKFID;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub loadConfigData {
|
||||
if (@treelist > 0) {return;}
|
||||
local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
|
||||
$atime,$pmtime,$ctime,$blksize,$blocks) = stat("data/configdata.pl");
|
||||
local $tmtime;
|
||||
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
|
||||
$atime,$tmtime,$ctime,$blksize,$blocks) = stat("data/configdata");
|
||||
|
||||
if ($pmtime eq "" || $pmtime < $tmtime) {
|
||||
system "./perlifyconfig.tcl";
|
||||
}
|
||||
|
||||
open(CONFIGDATA, "<data/configdata.pl") || die "Can't open configdata.pl";
|
||||
while (<CONFIGDATA>) {
|
||||
eval;
|
||||
}
|
||||
close CONFIGDATA;
|
||||
}
|
||||
|
||||
|
||||
sub pickDefaultRepository {
|
||||
loadConfigData();
|
||||
return $treeinfo{$treelist[0]}->{'repository'};
|
||||
}
|
||||
|
||||
|
||||
sub getRepositoryList {
|
||||
loadConfigData();
|
||||
my @result = ();
|
||||
TREELOOP: foreach my $i (@treelist) {
|
||||
my $r = $treeinfo{$i}->{'repository'};
|
||||
foreach my $j (@result) {
|
||||
if ($j eq $r) {
|
||||
next TREELOOP;
|
||||
}
|
||||
}
|
||||
push @result, $r;
|
||||
}
|
||||
return @result;
|
||||
}
|
||||
|
||||
|
||||
sub validateRepository {
|
||||
my ($root) = @_;
|
||||
my @list = getRepositoryList();
|
||||
foreach my $r (@list) {
|
||||
if ($r eq $root) {
|
||||
return;
|
||||
}
|
||||
}
|
||||
print "Invalid repository $root selected. Send mail to $cvsadmin if you think this should have worked.\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
sub ConnectToDatabase {
|
||||
if ($dbh == "") {
|
||||
$dbh = DBI->connect("bonsai","$mysqluser","$mysqlpassword","mysql") || die "Can't connect to database server -- $DBD::mysql::db_errstr";
|
||||
}
|
||||
return $dbh;
|
||||
}
|
||||
|
||||
|
||||
sub formatSqlTime {
|
||||
my $when = @_[0];
|
||||
my($sec,$minute,$hour,$mday,$mon,$year) = localtime( $when );
|
||||
return sprintf("%04d-%02d-%02d %02d:%02d:%02d",
|
||||
$year + 1900, $mon + 1, $mday,
|
||||
$hour, $minute, $sec);
|
||||
}
|
||||
|
||||
|
||||
sub SqlQuote {
|
||||
$_ = @_[0];
|
||||
s/'/''/g;
|
||||
s/\\/\\\\/g;
|
||||
return $_;
|
||||
}
|
||||
|
||||
|
||||
# Returns true if the given directory or filename is one of the hidden ones
|
||||
# that we don't want to show users.
|
||||
|
||||
sub IsHidden {
|
||||
my ($name) = (@_);
|
||||
$name =~ s:///*:/:g; # Remove any multiple slashes.
|
||||
if (!defined @hidelist) {
|
||||
if (open(HIDE, "<data/hidelist")) {
|
||||
while (<HIDE>) {
|
||||
chop;
|
||||
s/^\s*//g; # Strip leading whitespace
|
||||
s/\s*$//g; # Strip trailing whitespace
|
||||
if ( /^#/ || /^$/) {
|
||||
next;
|
||||
}
|
||||
|
||||
push(@hidelist, $_);
|
||||
}
|
||||
close HIDE;
|
||||
} else {
|
||||
@hidelist = ();
|
||||
}
|
||||
}
|
||||
foreach my $item (@hidelist) {
|
||||
if ($name =~ m/$item/) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub CheckHidden {
|
||||
my ($name) = (@_);
|
||||
if (IsHidden($name)) {
|
||||
$| = 1;
|
||||
print "";
|
||||
die "Security violation; not allowed to access $name.";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -1,87 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
require 'CGI.pl';
|
||||
|
||||
use diagnostics;
|
||||
use strict;
|
||||
|
||||
LoadCheckins();
|
||||
|
||||
sub IsChecked {
|
||||
my ($value) = (@_);
|
||||
if ($value == $::BatchID) {
|
||||
return "CHECKED"
|
||||
} else {
|
||||
return ""
|
||||
}
|
||||
}
|
||||
|
||||
print "Content-type: text/html
|
||||
|
||||
<HTML>
|
||||
<TITLE>Let's do the time warp again...</TITLE>
|
||||
|
||||
Which hook would you like to see?
|
||||
";
|
||||
|
||||
my @list;
|
||||
|
||||
|
||||
foreach my $i (glob(DataDir() . "/batch-*\[0-9\].pl")) {
|
||||
if ($i =~ /batch-([0-9]*)\.pl/) {
|
||||
push(@list, $1);
|
||||
}
|
||||
}
|
||||
|
||||
@list = sort {$b <=> $a} @list;
|
||||
|
||||
print '<FORM method=get action="';
|
||||
if ($::FORM{'target'} eq 'showcheckins') {
|
||||
print 'showcheckins.cgi';
|
||||
} else {
|
||||
print 'toplevel.cgi';
|
||||
}
|
||||
print '">
|
||||
';
|
||||
print "<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>\n";
|
||||
print "<INPUT TYPE=SUBMIT Value=\"Submit\"><BR>\n";
|
||||
|
||||
my $value = shift(@list);
|
||||
|
||||
print "<INPUT TYPE=radio NAME=batchid VALUE=$value " . IsChecked($value). ">";
|
||||
print "The current hook.<BR>\n";
|
||||
|
||||
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";
|
||||
}
|
||||
|
||||
print "<INPUT TYPE=SUBMIT Value=\"Submit\">\n";
|
||||
print "</FORM>\n";
|
||||
|
||||
PutsTrailer();
|
||||
@@ -1,81 +0,0 @@
|
||||
#!/usr/bonsaitools/bin/perl -w
|
||||
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
||||
#
|
||||
# The contents of this file are subject to the Netscape Public
|
||||
# License Version 1.1 (the "License"); you may not use this file
|
||||
# except in compliance with the License. You may obtain a copy of
|
||||
# the License at http://www.mozilla.org/NPL/
|
||||
#
|
||||
# Software distributed under the License is distributed on an "AS
|
||||
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
# implied. See the License for the specific language governing
|
||||
# rights and limitations under the License.
|
||||
#
|
||||
# The Original Code is the Bonsai CVS tool.
|
||||
#
|
||||
# The Initial Developer of the Original Code is Netscape Communications
|
||||
# Corporation. Portions created by Netscape are
|
||||
# Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
# Rights Reserved.
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
require 'lloydcgi.pl';
|
||||
require 'utils.pl';
|
||||
|
||||
# use diagnostics;
|
||||
# use strict;
|
||||
|
||||
my $db = ConnectToDatabase();
|
||||
|
||||
$| = 1;
|
||||
|
||||
if (!defined $form{'repositoryid'}) {
|
||||
print "Content-type: text/html
|
||||
|
||||
This will create a cryptic report of all the people who have ever
|
||||
touched each file within a directory heirarchy.
|
||||
|
||||
<P>
|
||||
|
||||
<form>
|
||||
Repository: <select name='repositoryid'>
|
||||
";
|
||||
|
||||
my $query = $db->Query("select id, repository from repositories order by id");
|
||||
my @row;
|
||||
while (@row = $query->fetchrow()) {
|
||||
my ($id, $name) = (@row);
|
||||
print "<option value=$id>$name\n";
|
||||
}
|
||||
print "</select><br>
|
||||
Directory: <input size=60 name=dir>
|
||||
<input type=submit value='Submit'>
|
||||
</form>
|
||||
";
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
print "Content-type: text/plain\n\n";
|
||||
|
||||
my $qstr = "select distinct who, dir, file from checkins, people, dirs, files where repositoryid = $form{'repositoryid'} and dirid=dirs.id and dir like '$form{'dir'}%' and fileid=files.id and whoid=people.id order by dir, file";
|
||||
my $query = $db->Query($qstr);
|
||||
|
||||
if (!$query) {
|
||||
die "Bad query: $qstr \n\n $::db_errstr";
|
||||
}
|
||||
|
||||
|
||||
my @row;
|
||||
my $last = "";
|
||||
while (@row = $query->fetchrow()) {
|
||||
my ($who, $dir, $file) = (@row);
|
||||
my $cur = "$dir/$file";
|
||||
if ($cur ne $last) {
|
||||
print "\n$cur\n";
|
||||
$last = $cur;
|
||||
}
|
||||
print "$who\n";
|
||||
}
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user