mozilla
/
pjs
зеркало из https://github.com/mozilla/pjs.git
1
0
Форкнуть 0
Код Задачи Пакеты Проекты Релизы Вики Активность

Massive spank to put "use strict" in all Bonsai code.

This commit is contained in:
terry%mozilla.org 1999-10-18 22:55:01 +00:00
Родитель c35506fae6
Коммит b2df112085
33 изменённых файлов: 1100 добавлений и 764 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

3
webtools/bonsai/CGI.pl
Просмотреть файл

@ -228,7 +228,8 @@ sub make_popup {
}
sub make_cgi_args {
my ($k,$v,$ret);
my ($k,$v);
my $ret = "";
for $k (sort keys %::FORM){
$ret .= ($ret eq "" ? '?' : '&');

25
webtools/bonsai/SourceChecker.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl --
#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
@ -26,6 +26,9 @@
# ...
#
use diagnostics;
use strict;
use CGI;
use SourceChecker;
@ -35,7 +38,7 @@ use SourceChecker;
# Global
#
$query = new CGI;
my $query = new CGI;
@ -65,11 +68,11 @@ END_OF_TRAILER
$error_header = '<HR><H2>I couldn\'t process your request...</H2>';
my $error_header = '<HR><H2>I couldn\'t process your request...</H2>';
sub print_error($)
{
local $message = shift;
my $message = shift;
print "$error_header<P><EM>Error</EM>: $message</P>";
$error_header = '';
}
@ -119,7 +122,7 @@ sub print_query_building_form()
sub do_add_good_words($)
{
local $file = shift;
my $file = shift;
while ( <$file> )
{
@ -131,7 +134,7 @@ sub do_add_good_words($)
sub do_add_bad_words($)
{
local $file = shift;
my $file = shift;
while ( <$file> )
{
@ -143,7 +146,7 @@ sub do_add_bad_words($)
sub do_add_good_english($)
{
local $file = shift;
my $file = shift;
while ( <$file> )
{
@ -155,7 +158,7 @@ sub do_add_good_english($)
sub do_add_names($)
{
local $file = shift;
my $file = shift;
while ( <$file> )
{
@ -167,7 +170,7 @@ sub do_add_names($)
sub handle_query()
{
$dictionary_path = $query->param('dictionary');
my $dictionary_path = $query->param('dictionary');
if ( ! $dictionary_path )
{
print_error('You didn\'t supply a path to the dictionary file.');
@ -177,8 +180,10 @@ sub handle_query()
dbmopen %SourceChecker::token_dictionary, "$dictionary_path", 0666
|| print_error("The dictionary you named could not be opened.");
$added_some_words = 0;
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);

13
webtools/bonsai/adminfuncs.pl
Просмотреть файл

@ -16,6 +16,17 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
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;
@ -46,7 +57,7 @@ sub SendHookMail {
my (%substs, %headers, $body, $mail);
local *MAIL;
$pathname = DataDir() . "/$filename";
my $pathname = DataDir() . "/$filename";
return unless $hooklist;
return unless -f $pathname;

0
webtools/bonsai/branchspam.cgi
Просмотреть файл

0
webtools/bonsai/branchspammer.cgi
Просмотреть файл

3
webtools/bonsai/countcheckins.cgi
Просмотреть файл

@ -17,6 +17,9 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use diagnostics;
use strict;
require 'CGI.pl';
use vars qw($CloseTimeStamp);

160
webtools/bonsai/cvsblame.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl --
#!/usr/bonsaitools/bin/perl -w
# cvsblame.cgi -- cvsblame with logs as popups and allowing html in comments.
# -*- Mode: perl; indent-tabs-mode: nil -*-
@ -37,10 +37,25 @@
# 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';
use SourceChecker;
$| = 1;
# Cope with the cookie and print the header, first thing. That way, if
@ -57,22 +72,22 @@ print "\n";
# Some Globals
#
$Head = 'CVS Blame';
$SubHead = '';
my $Head = 'CVS Blame';
my $SubHead = '';
@src_roots = getRepositoryList();
my @src_roots = getRepositoryList();
# Do not use layers if the client does not support them.
$useLayers = 1;
$user_agent = $ENV{HTTP_USER_AGENT};
my $useLayers = 1;
my $user_agent = $ENV{HTTP_USER_AGENT};
if (not $user_agent =~ m@^Mozilla/4.@ or $user_agent =~ /MSIE/) {
$useLayers = 0;
}
# Init sanitiazation source checker
#
$sanitization_dictionary = $::FORM{'sanitize'};
$opt_sanitize = defined $sanitization_dictionary;
my $sanitization_dictionary = $::FORM{'sanitize'};
my $opt_sanitize = defined $sanitization_dictionary;
if ( $opt_sanitize )
{
dbmopen %SourceChecker::token_dictionary, "$sanitization_dictionary", 0664;
@ -80,32 +95,33 @@ if ( $opt_sanitize )
# Init byrd's 'feature' to allow html in comments
#
$opt_html_comments = &html_comments_init();
my $opt_html_comments = &html_comments_init();
# Handle the "file" argument
#
$filename = '';
my $filename = '';
$filename = $::FORM{'file'} if defined($::FORM{'file'});
if ($filename eq '')
{
&print_usage;
exit;
}
($file_head, $file_tail) = $filename =~ m@(.*/)?(.+)@;
my ($file_head, $file_tail) = $filename =~ m@(.*/)?(.+)@;
# Handle the "rev" argument
#
$opt_rev = '';
$opt_rev = $::FORM{'rev'} if defined($::FORM{'rev'} && $::FORM{'rev'} ne 'HEAD');
$browse_revtag = "HEAD";
$browse_revtag = $opt_rev if ($opt_rev =~ /[A-Za-z]/);
$revision = '';
$::opt_rev = '';
$::opt_rev = $::FORM{'rev'} if defined($::FORM{'rev'} && $::FORM{'rev'} ne 'HEAD');
my $browse_revtag = "HEAD";
$browse_revtag = $::opt_rev if ($::opt_rev =~ /[A-Za-z]/);
my $revision = '';
# Handle the "root" argument
#
if (defined($root = $::FORM{'root'}) && $root ne '') {
my $root = $::FORM{'root'};
if (defined $root && $root ne '') {
$root =~ s|/$||;
validateRepository($root);
if (-d $root) {
@ -122,6 +138,7 @@ if (defined($root = $::FORM{'root'}) && $root ne '') {
# Find the rcs file
#
my $rcs_filename;
foreach (@src_roots) {
$root = $_;
$rcs_filename = "$root/$filename,v";
@ -139,21 +156,22 @@ exit;
found_file:
my $rcs_path;
($rcs_path) = $rcs_filename =~ m@$root/(.*)/.+?,v@;
CheckHidden($rcs_filename);
# Parse the rcs file ($opt_rev is passed as a global)
# Parse the rcs file ($::opt_rev is passed as a global)
#
$revision = &parse_cvs_file($rcs_filename);
$file_rev = $revision;
my $file_rev = $revision;
# Handle the "line_nums" argument
#
$opt_line_nums = 1;
my $opt_line_nums = 1;
if (exists($::COOKIE{'line_nums'})) {
$opt_line_nums = 1 if $::COOKIE{'line_nums'} eq 'on';
$opt_line_nums = 1 if $::COOKIE{'line_nums'} eq 'on';
}
if (exists($::FORM{'line_nums'})) {
$opt_line_nums = 0 if $::FORM{'line_nums'} =~ /off|no|0/i;
@ -161,20 +179,24 @@ if (exists($::FORM{'line_nums'})) {
}
# Option to make links to included files
$opt_includes = 0;
my $opt_includes = 0;
$opt_includes = 1 if (exists($::FORM{'includes'}) &&
$::FORM{'includes'} =~ /on|yes|1/i);
$opt_includes = 1 if $opt_includes && $file_tail =~ /(.c|.h|.cpp)$/;
@text = &extract_revision($revision);
die "$progname: Internal consistency error" if ($#text != $#revision_map);
my @text = &extract_revision($revision);
die "$::progname: Internal consistency error" if ($#text != $#::revision_map);
my $use_html = 0;
$use_html = 1 if exists($::FORM{'use_html'}) && $::FORM{'use_html'} eq '1';
# Handle the "mark" argument
#
$mark_arg = '';
my %mark_line;
my $mark_arg = '';
$mark_arg = $::FORM{'mark'} if defined($::FORM{'mark'});
foreach $mark (split(',',$mark_arg)) {
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 '' || $end > $#text + 1;
@ -203,23 +225,24 @@ print q(
<BR><B>
);
foreach $path (split('/',$rcs_path)) {
my $link_path;
foreach my $path (split('/',$rcs_path)) {
# Customize this translation
# Customize this translation
$link_path .= url_encode2($path).'/';
$lxr_path = Fix_LxrLink($link_path);
my $lxr_path = Fix_LxrLink($link_path);
print "<A HREF='$lxr_path'>$path</a>/ ";
}
print "<A HREF='$link_path$file_tail'>$file_tail</a> ";
print " (<A HREF='cvsblame.cgi?file=$filename&rev=$revision&root=$root'";
print " onmouseover='return log(event,\"$prev_revision{$revision}\",\"$revision\");'" if $useLayers;
print " onmouseover='return log(event,\"$::prev_revision{$revision}\",\"$revision\");'" if $useLayers;
print ">";
print "$browse_revtag:" unless $browse_revtag eq 'HEAD';
print $revision if $revision;
print "</A>)";
$lxr_path = Fix_LxrLink("$link_path$file_tail");
my $lxr_path = Fix_LxrLink("$link_path$file_tail");
print qq(
</B>
</TD>
@ -246,26 +269,30 @@ print qq(
</TABLE>
);
$open_table_tag = '<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%">';
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.
#
$count = $#revision_map;
my $count = $#::revision_map;
if ($count == 0) {
$count = 1;
}
$line_num_width = int(log($count)/log(10)) + 1;
$revision_width = 3;
$author_width = 5;
$line = 0;
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;
$old_revision = 0;
$row_color = '';
$lines_in_table = 0;
foreach $revision (@revision_map)
my $old_revision = 0;
my $row_color = '';
my $lines_in_table = 0;
my $inMark = 0;
my $rev_count = 0;
foreach $revision (@::revision_map)
{
$text = $text[$line++];
my $text = $text[$line++];
$usedlog{$revision} = 1;
$lines_in_table++;
@ -283,9 +310,10 @@ foreach $revision (@revision_map)
# Add a link to traverse to included files
$text = &link_includes($text) if $opt_includes;
$output = '';
my $output = '';
# Highlight lines
my $mark_cmd;
if (defined($mark_cmd = $mark_line{$line})
&& $mark_cmd ne 'end') {
$output .= '</TD></TR><TR><TD BGCOLOR=LIGHTGREEN WIDTH="100%"><PRE>';
@ -320,15 +348,15 @@ foreach $revision (@revision_map)
$revision_width = max($revision_width,length($revision));
# $output .= "<A HREF=\"cvsblame.cgi?file=$filename&rev=$revision&root=$root\"";
if (defined $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}\"";
if (defined $::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=\"cvsview2.cgi?root=$root&subdir=$rcs_path&command=DIRECTORY&files=$file_tail\"";
$prev_revision{$revision} = '';
$::prev_revision{$revision} = '';
}
$output .= " onmouseover='return log(event,\"$prev_revision{$revision}\",\"$revision\");'" if $useLayers;
$output .= " onmouseover='return log(event,\"$::prev_revision{$revision}\",\"$revision\");'" if $useLayers;
$output .= ">";
$author = $revision_author{$revision};
my $author = $::revision_author{$revision};
$author =~ s/%.*$//;
$author_width = max($author_width,length($author));
$output .= sprintf("%-${author_width}s ", $author);
@ -347,8 +375,8 @@ foreach $revision (@revision_map)
# Close the highlighted section
if (defined($mark_cmd) and $mark_cmd ne 'begin') {
chop($output);
#if( defined($prev_revision{$file_rev})) {
# $output .= "</TD><TD ALIGN=RIGHT$row_color><A HREF=\"cvsblame.cgi?file=$filename&rev=$prev_revision{$file_rev}&root=$root&mark=$mark_arg\">Previous&nbsp;Revision&nbsp;($prev_revision{$file_rev})</A></TD><TD BGCOLOR=LIGHTGREEN>&nbsp;";
#if( defined($::prev_revision{$file_rev})) {
# $output .= "</TD><TD ALIGN=RIGHT$row_color><A HREF=\"cvsblame.cgi?file=$filename&rev=$::prev_revision{$file_rev}&root=$root&mark=$mark_arg\">Previous&nbsp;Revision&nbsp;($::prev_revision{$file_rev})</A></TD><TD BGCOLOR=LIGHTGREEN>&nbsp;";
#}
$output .= "</TD></TR><TR><TD colspan=3$row_color><PRE>";
$inMark = 0;
@ -362,25 +390,25 @@ if ($useLayers) {
# Write out cvs log messages as a JS variables
#
print "<SCRIPT>";
while (($revision, $junk) = each %usedlog) {
while (my ($revision, $junk) = each %usedlog) {
# Create a safe variable name for a revision log
$revisionName = $revision;
my $revisionName = $revision;
$revisionName =~ tr/./_/;
$log = $revision_log{$revision};
my $log = $::revision_log{$revision};
$log =~ s/([^\n\r]{80})([^\n\r]*)/$1\n$2/g;
$log = MarkUpText($log);
$log =~ s/\n|\r|\r\n/<BR>/g;
$log =~ s/"/\\"/g;
# Write JavaScript variable for log entry (e.g. log1_1 = "New File")
$author = $revision_author{$revision};
my $author = $::revision_author{$revision};
$author =~ tr/%/@/;
$author_email = EmailFromUsername($author);
my $author_email = EmailFromUsername($author);
print "log$revisionName = \""
."<b>$revision</b> &lt;<a href='mailto:$author_email'>$author</a>&gt;"
." <b>$revision_ctime{$revision}</b><BR>"
." <b>$::revision_ctime{$revision}</b><BR>"
."<SPACER TYPE=VERTICAL SIZE=5>$log\";\n";
}
print "</SCRIPT>";
@ -492,12 +520,13 @@ sub print_usage {
if ($ENV{"REQUEST_METHOD"} eq 'POST' && defined($::FORM{'set_line'})) {
# Expire the cookie 5 months from now
$set_cookie = "Set-Cookie: line_nums=$::FORM{'set_line'}; expires="
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 (!defined($cookie_jar{'line_nums'}) && !defined($::FORM{'set_line'})) {
if (!defined($::COOKIE{'line_nums'}) && !defined($::FORM{'set_line'})) {
$new_linenum = 'on';
} elsif ($cookie_jar{'line_nums'} eq 'off' || $::FORM{'set_line'} eq 'off') {
} elsif ($::COOKIE{'line_nums'} eq 'off' || $::FORM{'set_line'} eq 'off') {
$linenum_message = 'Line numbers are currently <b>off</b>.';
$new_linenum = 'on';
} else {
@ -607,7 +636,7 @@ sub link_includes {
my ($text) = $_[0];
if ($text =~ /\#(\s*)include(\s*)"(.*?)"/) {
foreach $trial_root (($rcs_path, 'ns/include',
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"
@ -620,8 +649,13 @@ sub link_includes {
return $text;
}
my $in_comments = 0;
my $open_delim;
my $close_delim;
my $expected_delim;
sub html_comments_init {
return 0 unless defined($::FORM{'use_html'}) && $::FORM{'use_html'};
return 0 unless $use_html;
# Initialization for C comment context switching
$in_comments = 0;
@ -638,8 +672,8 @@ sub leave_html_comments {
my ($text) = $_[0];
# Allow HTML in the comments.
#
$newtext = "";
$oldtext = $text;
my $newtext = "";
my $oldtext = $text;
while ($oldtext =~ /(.*$expected_delim)(.*\n)/) {
$a = $1;
$b = $2;

345
webtools/bonsai/cvsblame.pl
Просмотреть файл

@ -28,38 +28,57 @@
#
##############################################################################
use Time::Local qw(timegm); # timestamps
use POSIX qw(strftime); # human-readable dates
use diagnostics;
use strict;
$debug = 0;
$opt_m = 0 unless (defined($opt_m));
# 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) =~ /([^\/]+)$/;
($::progname = $0) =~ /([^\/]+)$/;
&cvsblame_init;
1;
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;
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 - $opt_m * $SECS_PER_DAY;
$::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;
my ($dir, $nlink);
local *callback;
($dir, *callback, $nlink) = @_;
my ($dev, $ino, $mode, $subcount);
@ -84,12 +103,12 @@ sub traverse_cvs_tree {
next if $_ eq '.';
next if $_ eq '..';
next if $_ eq 'CVS';
$name = "$dir/$_";
my $name = "$dir/$_";
($dev, $ino, $mode, $nlink) = lstat($name);
next unless -d _;
if (-x _ && -r _) {
print STDERR "$progname: Entering $name\n";
print STDERR "$::progname: Entering $name\n";
&traverse_cvs_tree($name, *callback, $nlink);
} else {
warn("Couldn't chdir to $name");
@ -101,6 +120,9 @@ sub traverse_cvs_tree {
# 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));
@ -118,7 +140,7 @@ sub get_token {
# ...or an RCS-encoded string that starts with an @ character.
$line_buffer =~ s/^@([^@]*)//o;
$token = $1;
my $token = $1;
# Detect single @ character used to close RCS-encoded string.
while ($line_buffer !~ /@/o || # Short-circuit optimization
@ -129,7 +151,7 @@ sub get_token {
}
# Retain the remainder of the line after the terminating @ character.
$i = rindex($line_buffer, '@');
my $i = rindex($line_buffer, '@');
$token .= substr($line_buffer, 0, $i);
$line_buffer = substr($line_buffer, $i + 1);
@ -143,6 +165,8 @@ sub get_token {
return $token;
}
my $rcs_pathname;
# Consume a token from RCS filehandle and ensure that it matches
# the given string constant.
sub match_token {
@ -162,22 +186,22 @@ sub unget_token {
# Parses "administrative" header of RCS files, setting these globals:
#
# $head_revision -- Revision for which cleartext is stored
# $principal_branch
# $file_description
# %revision_symbolic_name -- mapping from numerical revision # to symbolic tag
# %tag_revision -- mapping from symbolic tag to numerical revision #
# $::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;
undef %::tag_revision;
undef %::revision_symbolic_name;
while (1) {
# Read initial token at beginning of line
$token = &get_token(RCSFILE);
$token = &get_token();
# We're done once we reach the description of the RCS tree
if ($token =~ /^\d/o) {
@ -188,10 +212,10 @@ sub parse_rcs_admin {
# print "token: $token\n";
if ($token eq "head") {
$head_revision = &get_token;
$::head_revision = &get_token;
&get_token; # Eat semicolon
} elsif ($token eq "branch") {
$principal_branch = &get_token;
$::principal_branch = &get_token;
&get_token; # Eat semicolon
} elsif ($token eq "symbols") {
@ -200,11 +224,11 @@ sub parse_rcs_admin {
while (($tag = &get_token) ne ';') {
($tag_name, $tag_revision) = split(':', $tag);
$tag_revision{$tag_name} = $tag_revision;
$revision_symbolic_name{$tag_revision} = $tag_name;
$::tag_revision{$tag_name} = $tag_revision;
$::revision_symbolic_name{$tag_revision} = $tag_name;
}
} elsif ($token eq "comment") {
$file_description = &get_token;
$::file_description = &get_token;
&get_token; # Eat semicolon
# Ignore all these other fields - We don't care about them.
@ -225,40 +249,44 @@ sub parse_rcs_admin {
# 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,
# %::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.
# %::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.
# %::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.
# %::next_delta -- revision number of next "delta". Inverts %::prev_delta.
#
# Also creates %last_revision, keyed by a branch revision number, which
# 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
# 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 %::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;
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;
@ -271,49 +299,50 @@ sub parse_rcs_tree {
$is_trunk_revision = ($revision =~ /^[0-9]+\.[0-9]+$/);
$tag_revision{$revision} = $revision;
$::tag_revision{$revision} = $revision;
($branch) = $revision =~ /(.*)\.[0-9]+/o;
$last_revision{$branch} = $revision;
$::last_revision{$branch} = $revision;
# Parse date
&match_token('date');
$date = &get_token;
$revision_date{$revision} = $date;
$::revision_date{$revision} = $date;
&match_token(';');
# Convert date into timestamp
@date_fields = reverse(split(/\./, $date));
my @date_fields = reverse(split(/\./, $date));
$date_fields[4]--; # Month ranges from 0-11, not 1-12
$timestamp{$revision} = timegm(@date_fields);
$::timestamp{$revision} = timegm(@date_fields);
# Pretty print the date string
my $formated_date = strftime("%d %b %Y %H:%M",
localtime($timestamp{$revision}));
$revision_ctime{$revision} = $formated_date;
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;
($time - $::timestamp{$revision}) / $SECS_PER_DAY;
# Parse author
&match_token('author');
$author = &get_token;
$revision_author{$revision} = $author;
$::revision_author{$revision} = $author;
&match_token(';');
# Parse state;
&match_token('state');
{} while &get_token ne ';';
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;
$::prev_revision{$token} = $revision;
$::prev_delta{$token} = $revision;
$branches .= "$token ";
}
$revision_branches{$revision} = $branches;
$::revision_branches{$revision} = $branches;
# Parse revision of next delta in chain
&match_token('next');
@ -321,12 +350,12 @@ sub parse_rcs_tree {
if (($token = &get_token) ne ';') {
$next = $token;
&get_token; # Eat semicolon
$next_delta{$revision} = $next;
$prev_delta{$next} = $revision;
$::next_delta{$revision} = $next;
$::prev_delta{$next} = $revision;
if ($is_trunk_revision) {
$prev_revision{$revision} = $next;
$::prev_revision{$revision} = $next;
} else {
$prev_revision{$next} = $revision;
$::prev_revision{$next} = $revision;
}
}
@ -342,14 +371,14 @@ sub parse_rcs_tree {
sub parse_rcs_description {
&match_token('desc');
$rcs_file_description = &get_token;
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,
# %::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
@ -357,19 +386,20 @@ sub parse_rcs_description {
# relative to its immediate predecessor if this
# revision is on a branch.
sub parse_rcs_deltatext {
undef %revision_log;
undef %revision_deltatext;
undef %::revision_log;
undef %::revision_deltatext;
while (!eof(RCSFILE)) {
$revision = &get_token;
my $revision = &get_token;
print "Reading delta for revision: $revision\n" if ($debug >= 3);
&match_token('log');
$revision_log{$revision} = &get_token;
$::revision_log{$revision} = &get_token;
&match_token('text');
$revision_deltatext{$revision} = &get_token;
$::revision_deltatext{$revision} = &get_token;
}
}
# Reads and parses complete RCS file from already-opened RCSFILE descriptor.
sub parse_rcs_file {
print "Reading RCS admin...\n" if ($debug >= 2);
@ -379,8 +409,8 @@ sub parse_rcs_file {
if( $debug >= 3 ){
print "<pre>Keys:\n\n";
for $i (keys %tag_revision ){
$k = $tag_revision{$i};
for my $i (keys %::tag_revision ){
my $k = $::tag_revision{$i};
print "yoyuo $i: $k\n";
}
print "</pre>\n";
@ -398,13 +428,13 @@ sub parse_rcs_file {
sub map_tag_to_revision {
my ($tag_or_revision) = @_;
my ($revision) = $tag_revision{$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) {
$branch = $1 . '.' . $2;
my $branch = $1 . '.' . $2;
# Return latest revision on the branch, if any.
return $last_revision{$branch} if (defined($last_revision{$branch}));
return $::last_revision{$branch} if (defined($::last_revision{$branch}));
return $1; # No revisions on branch - return branch point
} else {
return $revision;
@ -423,10 +453,10 @@ sub ancestor_revisions {
my ($revision) = @_;
my (@ancestors);
$revision = $prev_revision{$revision};
$revision = $::prev_revision{$revision};
while ($revision) {
push(@ancestors, $revision);
$revision = $prev_revision{$revision};
$revision = $::prev_revision{$revision};
}
return @ancestors;
@ -437,27 +467,28 @@ sub ancestor_revisions {
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};
$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});
my (@text) = split(/^/, $::revision_deltatext{$::head_revision});
# Iterate, applying deltas to previous revision
foreach $revision (@path) {
$adjust = 0;
@diffs = split(/^/, $revision_deltatext{$revision});
my $adjust = 0;
my @diffs = split(/^/, $::revision_deltatext{$revision});
my ($lines_added) = 0;
my ($lines_removed) = 0;
foreach $command (@diffs) {
foreach my $command (@diffs) {
if ($add_lines_remaining > 0) {
# Insertion lines from a prior "a" command.
splice(@text, $start_line + $adjust,
@ -479,67 +510,75 @@ sub extract_revision {
die "Error parsing diff commands";
}
}
$lines_removed{$revision} += $lines_removed;
$lines_added{$revision} += $lines_added;
$::lines_removed{$revision} += $lines_removed;
$::lines_added{$revision} += $lines_added;
}
return @text;
}
sub parse_cvs_file {
my ($rcs_pathname) = @_;
($rcs_pathname) = @_;
# Args in: $opt_rev - requested revision
# $opt_m - time since modified
# Args out: @revision_map
# $revision
# %timestamp
# (%revision_deltatext)
# Args in: $::opt_rev - requested revision
# $::opt_m - time since modified
# Args out: @::revision_map
# %::timestamp
# (%::revision_deltatext)
@revision_map = ();
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, " .
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') {
if (!defined($::opt_rev) || $::opt_rev eq '' || $::opt_rev eq 'HEAD') {
# Explicitly specified topmost revision in tree
$revision = $head_revision;
$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"
$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};
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.
return if ($opt_m && $timestamp{$revision} < $opt_m_timestamp);
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.
$line_count = 0;
if (exists ($revision_deltatext{$head_revision}) &&
$revision_deltatext{$head_revision}) {
my @tmp_array = split(/^/, $revision_deltatext{$head_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));
for ($rev = $prev_revision{$head_revision}; $rev;
$rev = $prev_revision{$rev}) {
@diffs = split(/^/, $revision_deltatext{$rev});
foreach $command (@diffs) {
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--;
@ -553,7 +592,7 @@ sub parse_cvs_file {
$skip = $count;
$line_count += $count;
} else {
die "$progname: error: illegal RCS file $rcs_pathname\n",
die "$::progname: error: illegal RCS file $rcs_pathname\n",
" error appears in revision $rev\n";
}
}
@ -572,23 +611,23 @@ sub parse_cvs_file {
# Create initial revision map for primordial version.
while ($line_count--) {
push(@revision_map, $primordial);
push(@::revision_map, $primordial);
}
@ancestors = &ancestor_revisions($revision);
my @ancestors = &ancestor_revisions($revision);
unshift (@ancestors, $revision); #
pop @ancestors; # Remove "1.1"
$last_revision = $primordial;
$::last_revision = $primordial;
foreach $revision (reverse @ancestors) {
$is_trunk_revision = ($revision =~ /^[0-9]+\.[0-9]+$/);
my $is_trunk_revision = ($revision =~ /^[0-9]+\.[0-9]+$/);
if ($is_trunk_revision) {
@diffs = split(/^/, $revision_deltatext{$last_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 $command (@diffs) {
foreach my $command (@diffs) {
if ($skip > 0) {
$skip--;
} else {
@ -599,10 +638,10 @@ sub parse_cvs_file {
while ($count--) {
push(@temp, $revision);
}
splice(@revision_map, $start_line - 1, 0, @temp);
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);
splice(@::revision_map, $start_line, $count);
$skip = $count;
} else {
die "Error parsing diff commands";
@ -613,15 +652,15 @@ sub parse_cvs_file {
# Revisions on a branch are arranged backwards from those on
# the trunk. They specify deltas that transform a revision
# into a later revision.
$adjust = 0;
@diffs = split(/^/, $revision_deltatext{$revision});
foreach $command (@diffs) {
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);
splice(@::revision_map, $start_line + $adjust - 1, $count);
$adjust -= $count;
} elsif ($command =~ /^a(\d+)\s(\d+)$/) { # Add command
($start_line, $count) = ($1, $2);
@ -631,7 +670,7 @@ sub parse_cvs_file {
while ($count--) {
push(@temp, $revision);
}
splice(@revision_map, $start_line + $adjust, 0, @temp);
splice(@::revision_map, $start_line + $adjust, 0, @temp);
$adjust += $skip;
} else {
die "Error parsing diff commands";
@ -639,11 +678,13 @@ sub parse_cvs_file {
}
}
}
$last_revision = $revision;
$::last_revision = $revision;
}
$revision;
return $revision;
}
1;
__END__
#
# The following are parts of the original cvsblame script that are not
@ -709,7 +750,7 @@ sub rcs_pathname {
}
if (!defined($cvs_revision{$pathname})) {
die "$progname: error: File '$pathname' does not appear to be under" .
die "$::progname: error: File '$pathname' does not appear to be under" .
" CVS control.\n"
}
@ -726,55 +767,55 @@ sub show_annotated_cvs_file {
my ($pathname) = @_;
my (@output) = ();
$revision = &parse_cvs_file($pathname);
my $revision = &parse_cvs_file($pathname);
@text = &extract_revision($revision);
die "$progname: Internal consistency error" if ($#text != $#revision_map);
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
$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 "\n$::progname: Listing file: $pathname\n"
}
# Print each line of the revision, preceded by its annotation.
$line = 0;
foreach $revision (@revision_map) {
foreach $revision (@::revision_map) {
$text = $text[$line++];
$annotation = '';
# Annotate with revision author
$annotation .= sprintf("%-8s", $revision_author{$revision}) if $opt_a;
$annotation .= sprintf("%-8s", $::revision_author{$revision}) if $::opt_a;
# Annotate with revision number
$annotation .= sprintf(" %-6s", $revision) if $opt_v;
$annotation .= sprintf(" %-6s", $revision) if $::opt_v;
# Date annotation
$annotation .= " $revision_ctime{$revision}" if $opt_d;
$annotation .= " $::revision_ctime{$revision}" if $::opt_d;
# Age annotation ?
$annotation .= sprintf(" (%3s)",
int($revision_age{$revision})) if $opt_A;
int($revision_age{$revision})) if $::opt_A;
# -m (if-modified-since) annotion ?
if ($opt_m && ($timestamp{$revision} < $opt_m_timestamp)) {
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*$/);
$annotation = $blank_annotation if $::opt_w && ($text =~ /^\s*$/);
# printf "%4d ", $line if $opt_l;
# printf "%4d ", $line if $::opt_l;
# print "$annotation - $text";
push(@output, sprintf("%4d ", $line)) if $opt_l;
push(@output, sprintf("%4d ", $line)) if $::opt_l;
push(@output, "$annotation - $text");
}
@output;
@ -782,7 +823,7 @@ sub show_annotated_cvs_file {
sub usage {
die
"$progname: usage: [options] [file|dir]...\n",
"$::progname: usage: [options] [file|dir]...\n",
" Options:\n",
" -r <revision> Specify CVS revision of file to display\n",
" <revision> can be any of:\n",
@ -801,8 +842,9 @@ sub usage {
;
}
&usage if (!&Getopts('r:m:Aadhlvw'));
&usage if ($opt_h); # help option
&usage if ($::opt_h); # help option
$multiple_files_on_command_line = 1 if ($#ARGV != 0);
@ -816,7 +858,7 @@ sub annotate_cvs_directory
&show_annotated_cvs_file("$dir/$file");
}
}
# No files on command-line ? Use current directory.
push(@ARGV, '.') if ($#ARGV == -1);
@ -832,3 +874,6 @@ while ($#ARGV >= 0) {
&show_annotated_cvs_file($pathname);
}
}
1;

7
webtools/bonsai/cvsguess.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl --
#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
@ -17,6 +17,9 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use diagnostics;
use strict;
require 'CGI.pl';
my $file= $::FORM{'file'};
@ -39,7 +42,7 @@ $CVS_REPOS_SUFIX =~ s/\//_/g;
ConnectToDatabase();
my $f = SqlQuote($file);
$qstring = "select distinct dirs.dir from checkins,dirs,files,repositories where dirs.id=dirid and files.id=fileid and repositories.id=repositoryid and repositories.repository='$CVS_ROOT' and files.file=$f order by dirs.dir";
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";

6
webtools/bonsai/cvsindex.pl
Просмотреть файл

@ -30,13 +30,13 @@ chdir $bonsaidir || die "Couldn't chdir to $bonsaidir";
require "utils.pl";
if( $ARGV[0] eq '' ){
$CVS_ROOT = pickDefaultRepository();
$::CVS_ROOT = pickDefaultRepository();
}
else {
$CVS_ROOT = $ARGV[0];
$::CVS_ROOT = $ARGV[0];
}
$CVS_REPOS_SUFIX = $CVS_ROOT;
$CVS_REPOS_SUFIX = $::CVS_ROOT;
$CVS_REPOS_SUFIX =~ s:/:_:g;

119
webtools/bonsai/cvslog.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl --
#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
@ -29,6 +29,20 @@
# 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;
@ -39,32 +53,33 @@ $| = 1;
print "Content-Type:text/html\n\n";
@src_roots = getRepositoryList();
my @src_roots = getRepositoryList();
# Handle the "file" argument
#
$filename = '';
my $filename = '';
$filename = $::FORM{'file'} if defined($::FORM{'file'});
if ($filename eq '')
{
&print_usage;
exit;
}
($file_head, $file_tail) = $filename =~ m@(.*/)?(.+)@;
my ($file_head, $file_tail) = $filename =~ m@(.*/)?(.+)@;
# Handle the "rev" argument
#
$opt_rev = $::FORM{'rev'} if defined($::FORM{'rev'} && $::FORM{'rev'} ne 'HEAD');
$browse_revtag = 'HEAD';
$browse_revtag = $opt_rev if ($opt_rev =~ /[A-Za-z]/);
$revision = '';
$::opt_rev = $::FORM{'rev'} if defined($::FORM{'rev'} && $::FORM{'rev'} ne 'HEAD');
my $browse_revtag = 'HEAD';
$browse_revtag = $::opt_rev if ($::opt_rev =~ /[A-Za-z]/);
my $revision = '';
# Handle the "root" argument
#
if (defined($root = $::FORM{'root'}) && $root ne '') {
my $root = $::FORM{'root'};
if (defined $root && $root ne '') {
$root =~ s|/$||;
validateRepository($root);
if (-d $root) {
@ -82,6 +97,7 @@ if (defined($root = $::FORM{'root'}) && $root ne '') {
# Find the rcs file
#
my $rcs_filename;
foreach (@src_roots) {
$root = $_;
$rcs_filename = "$root/$filename,v";
@ -98,36 +114,40 @@ print "</BODY></HTML>\n";
exit;
found_file:
($rcs_path) = $rcs_filename =~ m@$root/(.*)/.+?,v@;
my $rcs_path;
($rcs_path) = $rcs_filename =~ m@$root/(.*)/.+?,v@;
# Parse the rcs file ($opt_rev is passed as a global)
# Parse the rcs file ($::opt_rev is passed as a global)
#
$revision = &parse_cvs_file($rcs_filename);
$file_rev = $revision;
my $file_rev = $revision;
# Handle the "mark" argument
#
$mark_arg = '';
my %mark;
my $mark_arg = '';
$mark_arg = $::FORM{'mark'} if defined($::FORM{'mark'});
foreach $rev (split(',',$mark_arg)) {
$mark{$rev} = 1;
foreach my $rev (split(',',$mark_arg)) {
$mark{$rev} = 1;
}
# Handle the "author" argument
#
$author_arg = '';
my %use_author;
my $author_arg = '';
$author_arg = $::FORM{'author'} if defined($::FORM{'author'});
foreach $author (split(',',$author_arg)) {
foreach my $author (split(',',$author_arg)) {
$use_author{$author} = 1;
}
# Handle the "sort" argument
$opt_sort = '';
$opt_sort = $::FORM{'sort'};
my $opt_sort = '';
$opt_sort = $::FORM{'sort'} if defined $::FORM{'sort'};
# Start printing out the page
@ -148,7 +168,9 @@ print q(
<BR><B>
);
foreach $path (split('/',$rcs_path)) {
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>/ ";
@ -202,7 +224,8 @@ print qq(
# Create a table with header links to sort by column.
#
$table_tag = "<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=3 WIDTH='100%'>";
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 {
@ -214,23 +237,25 @@ print "$table_tag$table_header_tag";
# Print each line of the revision, preceded by its annotation.
#
my $start_rev;
if ($browse_revtag eq 'HEAD') {
$start_rev = $head_revision; # $head_revision is a global from cvsblame.pl
$start_rev = $::head_revision; # $::head_revision is a global from cvsblame.pl
} else {
$start_rev = map_tag_to_revision($browse_revtag);
}
$row_count = 0;
$max_rev_length = length($start_rev);
$max_author_length = 8;
@revisions = ($start_rev, ancestor_revisions($start_rev));
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)
{
$author = $revision_author{$revision};
my $author = $::revision_author{$revision};
next unless $author_arg eq '' || $use_author{$author};
$log = $revision_log{$revision};
my $log = $::revision_log{$revision};
$log =~ s/&/&amp;/g;
$log =~ s/</&lt;/g;
$log =~ s/>/&gt;/g;
@ -244,7 +269,7 @@ foreach $revision (@revisions)
$bgcolor = '';
}
$output = '';
my $output = '';
$row_count++;
if ($row_count > 20) {
$output .= "</TABLE>\n$table_tag";
@ -254,12 +279,12 @@ foreach $revision (@revisions)
$output .= "<TR$bgcolor VALIGN=TOP><TD>"
."<A NAME=$revision>";
$anchor = "<A HREF=cvsview2.cgi";
my $anchor = "<A HREF=cvsview2.cgi";
if (defined($prev_revision{$revision})) {
if (defined($::prev_revision{$revision})) {
$anchor .= "?diff_mode=context&whitespace_mode=show&file=$file_tail"
."&root=$root&subdir=$rcs_path&command=DIFF_FRAMESET"
."&rev1=$prev_revision{$revision}&rev2=$revision";
."&rev1=$::prev_revision{$revision}&rev2=$revision";
} else {
$anchor .= "?files=$file_tail"
."&root=$root&subdir=$rcs_path\&command=DIRECTORY\&rev2=$revision";
@ -275,7 +300,7 @@ foreach $revision (@revisions)
$output .= "<TD>".$author
.'&nbsp' x ($max_author_length - length($author)).'</TD>';
$rev_time = $revision_ctime{$revision};
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.
@ -328,11 +353,11 @@ print "</TABLE>";
## END of main script
sub by_revision {
local (@a_parts) = split(/\./,$a);
local (@b_parts) = split(/\./,$b);
my (@a_parts) = split(/\./,$a);
my (@b_parts) = split(/\./,$b);
while(1) {
local ($aa) = shift @a_parts;
local ($bb) = shift @b_parts;
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;
@ -340,28 +365,28 @@ sub by_revision {
}
sub by_author {
local ($a_author) = $revision_author{$a};
local ($b_author) = $revision_author{$b};
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 {
local ($revision) = @_;
my ($revision) = @_;
return '&nbsp' x ($max_rev_length - length($revision));
}
sub sprint_author {
local ($revision) = @_;
local ($author) = $revision_author{$revision};
my ($revision) = @_;
my ($author) = $::revision_author{$revision};
return
}
sub print_top {
local ($title_text) = "for $file_tail (";
my ($title_text) = "for $file_tail (";
$title_text .= "$browse_revtag:" unless $browse_revtag eq 'HEAD';
$title_text .= $revision if $revision;
$title_text .= ")";
@ -378,9 +403,9 @@ __TOP__
} # print_top
sub print_usage {
local ($linenum_message) = '';
local ($new_linenum, $src_roots_list);
local ($title_text) = "Usage";
my ($linenum_message) = '';
my ($new_linenum, $src_roots_list);
my ($title_text) = "Usage";
$src_roots_list = join('<BR>', @src_roots);
@ -473,7 +498,7 @@ sub print_useful_links {
my $lxr_path = $path;
my $lxr_link = Fix_LxrLink($lxr_path);
my $diff_link = "$diff_base?command=DIRECTORY\&subdir=$dir\&files=$file";
my $blame_link = "$blame_base?root=$CVS_ROOT\&file=$path";
my $blame_link = "$blame_base?root=$::CVS_ROOT\&file=$path";
print "<DIV ALIGN=RIGHT>
<TABLE BORDER CELLPADDING=10 CELLSPACING=0>

303
webtools/bonsai/cvsquery.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl --
#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
@ -17,11 +17,35 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
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';
require 'cvsquery.pl';
$CVS_ROOT = $::FORM{'cvsroot'};
$CVS_ROOT = pickDefaultRepository() unless $CVS_ROOT;
$::CVS_ROOT = $::FORM{'cvsroot'};
$::CVS_ROOT = pickDefaultRepository() unless $::CVS_ROOT;
$::TreeID = $::FORM{'module'}
if (!exists($::FORM{'treeid'}) &&
exists($::FORM{'module'}) &&
@ -35,7 +59,7 @@ LoadTreeConfig();
my $userdomain = Param('userdomain');
$| = 1;
$sm_font_tag = "<font face='Arial,Helvetica' size=-2>";
my $sm_font_tag = "<font face='Arial,Helvetica' size=-2>";
my $generateBackoutCVSCommands = 0;
if (defined $::FORM{'generateBackoutCVSCommands'}) {
@ -47,23 +71,20 @@ if (!$generateBackoutCVSCommands) {
";
$script_str='';
&setup_script;
print "$script_str";
print setup_script();
}
#print "<pre>";
$CVS_REPOS_SUFIX = $CVS_ROOT;
my $CVS_REPOS_SUFIX = $::CVS_ROOT;
$CVS_REPOS_SUFIX =~ s/\//_/g;
$CHECKIN_DATA_FILE = "data/checkinlog${CVS_REPOS_SUFIX}";
$CHECKIN_INDEX_FILE = "data/index${CVS_REPOS_SUFIX}";
my $CHECKIN_DATA_FILE = "data/checkinlog${CVS_REPOS_SUFIX}";
my $CHECKIN_INDEX_FILE = "data/index${CVS_REPOS_SUFIX}";
$SORT_HEAD="bgcolor=\"#DDDDDD\"";
my $SORT_HEAD="bgcolor=\"#DDDDDD\"";
#
# Log the query
@ -72,106 +93,112 @@ Log("Query [$ENV{'REMOTE_ADDR'}]: $ENV{'QUERY_STRING'}");
#
# build a module map
#
$query_module = $::FORM{'module'};
$::query_module = $::FORM{'module'};
#
# allow ?file=/a/b/c/foo.c to be synonymous with ?dir=/a/b/c&file=foo.c
#
if ( $::FORM{'dir'} eq '' ) {
$::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_dirs = split(/[;, \t]+/, $::FORM{'dir'});
$query_file = $::FORM{'file'};
$query_filetype = $::FORM{'filetype'};
$query_logexpr = $::FORM{'logexpr'};
$::query_file = $::FORM{'file'};
$::query_filetype = $::FORM{'filetype'};
$::query_logexpr = $::FORM{'logexpr'};
#
# date
#
$query_date_type = $::FORM{'date'};
if( $query_date_type eq 'hours' ){
$query_date_min = time - $::FORM{'hours'}*60*60;
$::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 '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 '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 'month' ){
$::query_date_min = time - 30*24*60*60;
}
elsif( $query_date_type eq 'all' ){
$query_date_min = 0;
elsif( $::query_date_type eq 'all' ){
$::query_date_min = 0;
}
elsif( $query_date_type eq 'explicit' ){
elsif( $::query_date_type eq 'explicit' ){
if ($::FORM{'mindate'} ne "") {
$query_date_min = parse_date($::FORM{'mindate'});
$::query_date_min = parse_date($::FORM{'mindate'});
}
if ($::FORM{'maxdate'} ne "") {
$query_date_max = parse_date($::FORM{'maxdate'});
$::query_date_max = parse_date($::FORM{'maxdate'});
}
}
else {
$query_date_min = time-60*60*2;
$::query_date_min = time-60*60*2;
}
#
# who
#
$query_who = $::FORM{'who'};
$query_whotype = $::FORM{'whotype'};
$::query_who = $::FORM{'who'};
$::query_whotype = $::FORM{'whotype'};
$show_raw = 0;
my $show_raw = 0;
$show_raw = $::FORM{'raw'} ne ''
if $::FORM{'raw'};
#
# branch
#
$query_branch = $::FORM{'branch'};
if (!defined $query_branch) {
$query_branch = 'HEAD';
$::query_branch = $::FORM{'branch'};
if (!defined $::query_branch) {
$::query_branch = 'HEAD';
}
$query_branchtype = $::FORM{'branchtype'};
$::query_branchtype = $::FORM{'branchtype'};
#
# tags
#
$query_begin_tag = $::FORM{'begin_tag'};
$query_end_tag = $::FORM{'end_tag'};
$::query_begin_tag = $::FORM{'begin_tag'};
$::query_end_tag = $::FORM{'end_tag'};
#
# Get the query in english and print it.
#
my ($t, $e);
$t = $e = &query_to_english;
$t =~ s/<[^>]*>//g;
$query_debug = $::FORM{'debug'};
$::query_debug = $::FORM{'debug'};
my %mod_map = ();
$result= &query_checkins( %mod_map );
my $result= &query_checkins( %mod_map );
for $i (@{$result}) {
$w{"$i->[$CI_WHO]\@$userdomain"} = 1;
my %w;
for my $i (@{$result}) {
$w{"$i->[$::CI_WHO]\@$userdomain"} = 1;
}
@p = sort keys %w;
$pCount = @p;
$s = join(",%20", @p);
my @p = sort keys %w;
my $pCount = @p;
my $s = join(",%20", @p);
$e =~ s/Checkins in/In/;
@ -193,12 +220,12 @@ if (defined $::FORM{'generateBackoutCVSCommands'}) {
";
foreach my $ci (@{$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";
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";
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;
}
@ -212,48 +239,48 @@ PutsHeader($t, "CVS Checkins", "$menu");
$|=1;
$head_who = '';
$head_file = '';
$head_directory = '';
$head_delta = '';
$head_date = '';
my $head_who = '';
my $head_file = '';
my $head_directory = '';
my $head_delta = '';
my $head_date = '';
if( !$show_raw ) {
if( $::FORM{"sortby"} eq "Who" ){
$result = [sort {
$a->[$CI_WHO] cmp $b->[$CI_WHO]
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
$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]
$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]
$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]
($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}] ;
$result = [sort {$b->[$::CI_DATE] <=> $a->[$::CI_DATE]} @{$result}] ;
$head_date = $SORT_HEAD;
}
@ -261,8 +288,8 @@ if( !$show_raw ) {
}
else {
print "<pre>";
for $ci (@$result) {
$ci->[$CI_LOG] = '';
for my $ci (@$result) {
$ci->[$::CI_LOG] = '';
$s = join("|",@$ci);
print "$s\n";
}
@ -272,8 +299,8 @@ else {
#
#
sub print_result {
local($result) = @_;
local($ci,$i,$k,$j,$max, $l, $span);
my ($result) = @_;
my ($ci,$i,$k,$j,$max, $l, $span);
&print_head;
@ -284,14 +311,14 @@ sub print_result {
while( $k < $max ){
$ci = $result->[$k];
$span = 1;
if( ($l = $ci->[$CI_LOG]) ne '' ){
if( ($l = $ci->[$::CI_LOG]) ne '' ){
#
# Calculate the number of consequitive logs that are
# the same and nuke them
#
$j = $k+1;
while( $j < $max && $result->[$j]->[$CI_LOG] eq $l ){
$result->[$j]->[$CI_LOG] = '';
while( $j < $max && $result->[$j]->[$::CI_LOG] eq $l ){
$result->[$j]->[$::CI_LOG] = '';
$j++;
}
@ -320,58 +347,60 @@ sub print_result {
&print_foot;
}
my $descwidth;
sub print_ci {
local($ci, $span) = @_;
local($sec,$minute,$hour,$mday,$mon,$year,$t);
local($log);
my ($ci, $span) = @_;
($sec,$minute,$hour,$mday,$mon,$year) = localtime( $ci->[$CI_DATE] );
$t = sprintf("%02d/%02d/%04d&nbsp;%02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $ci->[$::CI_DATE] );
my $t = sprintf("%02d/%02d/%04d&nbsp;%02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
$log = &html_log($ci->[$CI_LOG]);
$rev = $ci->[$CI_REV];
my $log = &html_log($ci->[$::CI_LOG]);
my $rev = $ci->[$::CI_REV];
print "<tr>\n";
print "<TD width=2%>${sm_font_tag}$t</font>";
print "<TD width=2%><a href='../registry/who.cgi?email=$ci->[$CI_WHO]' "
. "onClick=\"return js_who_menu('$ci->[$CI_WHO]','',event);\" >"
. "$ci->[$CI_WHO]</a>\n";
print "<TD 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 ){
print "<TD width=2%><a href='../registry/who.cgi?email=$ci->[$::CI_WHO]' "
. "onClick=\"return js_who_menu('$ci->[$::CI_WHO]','',event);\" >"
. "$ci->[$::CI_WHO]</a>\n";
print "<TD 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>&nbsp;&nbsp/;
# # Insert a <BR> before any directory named
# # 'classes.'
# }
# print " $d/<br>&nbsp;&nbsp;$ci->[$CI_FILE]<a>\n";
# print " $d/<br>&nbsp;&nbsp;$ci->[$::CI_FILE]<a>\n";
# }
# else{
# print " $ci->[$CI_DIR]/$ci->[$CI_FILE]<a>\n";
# print " $ci->[$::CI_DIR]/$ci->[$::CI_FILE]<a>\n";
# }
$d = "$ci->[$CI_DIR]/$ci->[$CI_FILE]";
if( $query_module eq 'allrepositories' ){ $d = "$ci->[$CI_REPOSITORY]/$d"; }
my $d = "$ci->[$::CI_DIR]/$ci->[$::CI_FILE]";
if ($::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 '' ){
$prevrev = &PrevRev( $rev );
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";
$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%>\&nbsp;\n";
}
if( !$query_branch_head ){
print "<TD width=2%><TT><FONT SIZE=-1>$ci->[$CI_BRANCH]&nbsp</FONT></TT>\n";
if( !$::query_branch_head ){
print "<TD width=2%><TT><FONT SIZE=-1>$ci->[$::CI_BRANCH]&nbsp</FONT></TT>\n";
}
print "<TD width=2%>${sm_font_tag}$ci->[$CI_LINES_ADDED]/$ci->[$CI_LINES_REMOVED]</font>&nbsp\n";
print "<TD width=2%>${sm_font_tag}$ci->[$::CI_LINES_ADDED]/$ci->[$::CI_LINES_REMOVED]</font>&nbsp\n";
if( $log ne '' ){
$log = MarkUpText($log);
# Makes numbers into links to bugsplat.
@ -391,16 +420,16 @@ sub print_ci {
sub print_head {
if ($versioninfo ne "") {
if ($::versioninfo ne "") {
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='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.";
print "<tt>(+$::lines_added/$::lines_removed)</tt> Lines changed.";
}
$anchor = $ENV{QUERY_STRING};
my $anchor = $ENV{QUERY_STRING};
$anchor =~ s/\&sortby\=[A-Za-z\ \+]*//g;
$anchor = "<a href=cvsquery.cgi?$anchor";
@ -412,7 +441,7 @@ print "<TH width=45% $head_file>${anchor}&sortby=File>File</a>\n";
print "<TH width=2%>Rev\n";
$descwidth = 47;
if( !$query_branch_head ){
if( !$::query_branch_head ){
print "<TH width=2%>Branch\n";
$descwidth -= 2;
}
@ -429,15 +458,15 @@ sub print_foot {
}
sub html_log {
local( $log ) = @_;
my ( $log ) = @_;
$log =~ s/&/&amp;/g;
$log =~ s/</&lt;/g;
return $log;
}
sub PrevRev {
local( $rev ) = @_;
local( $i, $j, $ret, @r );
my( $rev ) = @_;
my( $i, $j, $ret, @r );
@r = split( /\./, $rev );
@ -473,7 +502,7 @@ sub parse_date {
sub setup_script {
$script_str =<<'ENDJS';
my $script_str =<<'ENDJS';
<script>
var event = 0; // Nav3.0 compatibility
@ -528,6 +557,7 @@ function js_file_menu(repos,dir,file,rev,branch,d) {
ENDJS
return $script_str;
}
#
@ -536,57 +566,58 @@ ENDJS
sub query_to_english {
my $english = 'Checkins ';
if( $query_module eq 'allrepositories' ){
if( $::query_module eq 'allrepositories' ){
$english .= "to <i>All Repositories</i> ";
}
elsif( $query_module ne 'all' && @query_dirs == 0 ){
$english .= "to module <i>$query_module</i> ";
elsif( $::query_module ne 'all' && @::query_dirs == 0 ){
$english .= "to module <i>$::query_module</i> ";
}
elsif( $::FORM{dir} ne "" ) {
my $word = "directory";
if (@query_dirs > 1) {
if (@::query_dirs > 1) {
$word = "directories";
}
$english .= "to $word <i>$::FORM{dir}</i> ";
}
if ($query_file ne "") {
if ($::query_file ne "") {
if ($english ne 'Checkins ') {
$english .= "and ";
}
$english .= "to file $query_file ";
$english .= "to file $::query_file ";
}
if( ! ($query_branch =~ /^[ ]*HEAD[ ]*$/i) ){
if($query_branch eq '' ){
if( ! ($::query_branch =~ /^[ ]*HEAD[ ]*$/i) ){
if($::query_branch eq '' ){
$english .= "on all branches ";
}
else {
$english .= "on branch <i>$query_branch</i> ";
$english .= "on branch <i>$::query_branch</i> ";
}
}
if( $query_who ne '' ){
$english .= "by $query_who ";
if( $::query_who ne '' ){
$english .= "by $::query_who ";
}
$query_date_type = $::FORM{'date'};
if( $query_date_type eq 'hours' ){
$::query_date_type = $::FORM{'date'};
if( $::query_date_type eq 'hours' ){
$english .="in the last $::FORM{hours} hours";
}
elsif( $query_date_type eq 'day' ){
elsif( $::query_date_type eq 'day' ){
$english .="in the last day";
}
elsif( $query_date_type eq 'week' ){
elsif( $::query_date_type eq 'week' ){
$english .="in the last week";
}
elsif( $query_date_type eq 'month' ){
elsif( $::query_date_type eq 'month' ){
$english .="in the last month";
}
elsif( $query_date_type eq 'all' ){
elsif( $::query_date_type eq 'all' ){
$english .="since the beginning of time";
}
elsif( $query_date_type eq 'explicit' ){
elsif( $::query_date_type eq 'explicit' ){
my ($w1, $w2);
if ( $::FORM{mindate} ne "" && $::FORM{maxdate} ne "" ) {
$w1 = "between";
$w2 = "and" ;
@ -597,16 +628,16 @@ sub query_to_english {
}
if( $::FORM{'mindate'} ne "" ){
$dd = &parse_date($::FORM{'mindate'});
($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
$t = sprintf("%02d/%02d/%04d&nbsp;%02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
my $dd = &parse_date($::FORM{'mindate'});
my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
my $t = sprintf("%02d/%02d/%04d&nbsp;%02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
$english .= "$w1 <i>$t</i> ";
}
if( $::FORM{'maxdate'} ne "" ){
$dd = &parse_date($::FORM{'maxdate'});
($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
$t = sprintf("%02d/%02d/%04d&nbsp;%02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
my $dd = &parse_date($::FORM{'maxdate'});
my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
my $t = sprintf("%02d/%02d/%04d&nbsp;%02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
$english .= "$w2 <i>$t</i> ";
}
}

213
webtools/bonsai/cvsquery.pl
Просмотреть файл

@ -19,38 +19,56 @@
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;
$::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;
$NOT_LOCAL = 1;
$IS_LOCAL = 2;
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();
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;
$::lines_added = 0;
$::lines_removed = 0;
$modules = {};
$::modules = {};
$CVS_MODULES="${CVS_ROOT}/CVSROOT/modules";
my $CVS_MODULES="$::CVS_ROOT/CVSROOT/modules";
open( MOD, "<$CVS_MODULES") || die "can't open ${CVS_MODULES}";
&parse_modules;
@ -64,17 +82,18 @@ close( MOD );
sub query_checkins {
my (%mod_map) = @_;
my ($ci,$result,$lastlog,$rev,$begin_tag,$end_tag);
my $have_mod_map;
if( $query_module ne 'all' && $query_module ne 'allrepositories' && @query_dirs == 0 ){
if( $::query_module ne 'all' && $::query_module ne 'allrepositories' && @::query_dirs == 0 ){
$have_mod_map = 1;
%mod_map = &get_module_map( $query_module );
%mod_map = &get_module_map( $::query_module );
}
else {
$have_mod_map = 0;
%mod_map = ();
}
for $i (@query_dirs ){
for my $i (@::query_dirs ){
$i =~ s:^/::; # Strip leading slash.
$i =~ s:/$::; # Strip trailing slash.
@ -85,19 +104,19 @@ sub query_checkins {
$mod_map{$i} = $NOT_LOCAL;
}
if( $query_branch =~ /^[ ]*HEAD[ ]*$/i ){
$query_branch_head = 1;
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_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);
if (defined($::query_end_tag) && $::query_end_tag ne '') {
$end_tag = load_tag($::query_end_tag);
}
@ -107,49 +126,49 @@ sub query_checkins {
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_module ne 'allrepositories' ){
$qstring .= " and repositories.repository = '$::CVS_ROOT'";
}
if ($query_date_min) {
my $t = formatSqlTime($query_date_min);
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);
if ($::query_date_max) {
my $t = formatSqlTime($::query_date_max);
$qstring .= " and ci_when <= '$t'";
}
if ($query_branch_head) {
if ($::query_branch_head) {
$qstring .= " and branches.branch = ''";
} elsif ($query_branch ne '') {
my $q = SqlQuote($query_branch);
if ($query_branchtype eq 'regexp') {
} 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') {
} 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") . ")";
$qstring .= SqlQuote("T$::query_branch") . ")";
}
}
if (defined $query_file && $query_file ne '') {
my $q = SqlQuote($query_file);
if ($query_filetype eq 'regexp') {
if (defined $::query_file && $::query_file ne '') {
my $q = SqlQuote($::query_file);
if ($::query_filetype eq 'regexp') {
$qstring .= " and files.file regexp $q";
} else {
$qstring .= " and files.file = $q";
}
}
if (defined $query_who && $query_who ne '') {
my $q = SqlQuote($query_who);
if ($query_whotype eq 'regexp') {
if (defined $::query_who && $::query_who ne '') {
my $q = SqlQuote($::query_who);
if ($::query_whotype eq 'regexp') {
$qstring .= " and people.who regexp $q";
}
elsif ($query_whotype eq 'notregexp') {
elsif ($::query_whotype eq 'notregexp') {
$qstring .= " and not (people.who regexp $q)";
} else {
@ -157,12 +176,12 @@ sub query_checkins {
}
}
if (defined($query_logexpr) && $query_logexpr ne '') {
my $q = SqlQuote($query_logexpr);
if (defined($::query_logexpr) && $::query_logexpr ne '') {
my $q = SqlQuote($::query_logexpr);
$qstring .= " and descs.description regexp $q";
}
if ($query_debug) {
if ($::query_debug) {
print "<pre wrap> Query: $qstring\nTreeID is $::TreeID\n";
if ($have_mod_map) {
print "Dump of module map:\n";
@ -176,30 +195,31 @@ sub query_checkins {
SendSQL($qstring);
$lastlog = 0;
my @row;
while (@row = FetchSQLData()) {
#print "<pre>";
$ci = [];
for ($i=0 ; $i<=$CI_LOG ; $i++) {
for (my $i=0 ; $i<=$::CI_LOG ; $i++) {
$ci->[$i] = $row[$i];
#print "$row[$i] ";
}
#print "</pre>";
$key = "$ci->[$CI_DIR]/$ci->[$CI_FILE]";
if (IsHidden("$ci->[$CI_REPOSITORY]/$key")) {
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] ) ){
!&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)) {
if ($rev == "" || rev_is_after($ci->[$::CI_REV], $rev)) {
next;
}
}
@ -207,14 +227,14 @@ sub query_checkins {
if( $end_tag) {
$rev = $end_tag->{$key};
print "<BR>$key endtag is $rev<BR>\n";
if ($rev == "" || rev_is_after($rev, $ci->[$CI_REV])) {
if ($rev == "" || rev_is_after($rev, $ci->[$::CI_REV])) {
next;
}
}
if (defined($query_logexpr) &&
$query_logexpr ne '' &&
!($ci->[$CI_LOG] =~ /$query_logexpr/i) ){
if (defined($::query_logexpr) &&
$::query_logexpr ne '' &&
!($ci->[$::CI_LOG] =~ /$::query_logexpr/i) ){
next;
}
@ -222,9 +242,9 @@ sub query_checkins {
}
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],";
$::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;
}
@ -240,7 +260,7 @@ sub load_tag {
my $cmd;
my $dir;
$cvssuffix = $CVS_ROOT;
$cvssuffix = $::CVS_ROOT;
$cvssuffix =~ s/\//_/g;
$s = $tagname;
@ -254,7 +274,7 @@ sub load_tag {
$tagfile = "data/taginfo/$cvssuffix/$s";
open(TAG, "<$tagfile") || die "Unknown tag $tagname";
$result = {};
my $result = {};
print "<br>parsing tag $tagname</br>\n";
@ -268,13 +288,13 @@ print "<br>parsing tag $tagname</br>\n";
next;
}
$dir = shift @line;
$dir =~ s:^$CVS_ROOT/::;
$dir =~ s@^$::CVS_ROOT/@@;
$dir =~ s:^\./::;
while (@line) {
$file = shift @line;
my $file = shift @line;
$file = "$dir/$file";
$version = shift @line;
my $version = shift @line;
$result->{$file} = $version;
print "<br>Added ($file,$version) for tag $tagname<br>\n";
}
@ -309,47 +329,10 @@ sub rev_is_after {
sub find_date_offset {
local( $o, $d, $done, $line );
$done = 0;
local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat($CHECKIN_INDEX_FILE);
if ($mtime eq "" || time() - $mtime> 24 * 60 * 60) {
print "<h1>Please wait -- rebuilding index file...</h1>\n";
system "./cvsindex.pl $CVS_ROOT";
print "<h1>...OK, done.</h1>\n";
}
Lock();
if(! open(IDX , "<$CHECKIN_INDEX_FILE") ){
print "<h1>can't open index</h1>";
Unlock();
return 0;
}
$i = 0;
while(<IDX>) {
last if $done;
$line = $_;
chop($line);
($o,$d) = split(/\|/,$line);
if( $d && $query_date_min > $d ){
$done = 1;
}
$i++;
}
if( $F_DEBUG ){
print "seekdate($d) seekoffset($o) readcount($i)\n";
}
close IDX;
Unlock();
return $o;
}
sub in_module {
local($mod_map, $dirname, $filename ) = @_;
local( @path );
local( $i, $fp, $local );
my ($mod_map, $dirname, $filename ) = @_;
my ( @path );
my ( $i, $fp, $local );
#
#quick check if it is already in there.
@ -401,32 +384,34 @@ sub get_module_map {
sub parse_modules {
my $l;
while( $l = &get_line ){
($mod_name, $flag, @params) = split(/[ \t]+/,$l);
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];
$::modules->{$mod_name} = [@params];
}
}
sub build_map {
local($name,$mod_map) = @_;
local($bFound, $local);
my ($name,$mod_map) = @_;
my ($bFound, $local);
$local = $NOT_LOCAL;
$bFound = 0;
for $i ( @{$modules->{$name}} ){
for my $i ( @{$::modules->{$name}} ){
$bFound = 1;
if( $i eq '-l' ){
$local = $IS_LOCAL;

32
webtools/bonsai/cvsqueryform.cgi
Просмотреть файл

@ -20,6 +20,9 @@
# Query the CVS database.
#
use diagnostics;
use strict;
require 'CGI.pl';
$|=1;
@ -27,19 +30,19 @@ $|=1;
print "Content-type: text/html\n\n";
LoadTreeConfig();
$CVS_ROOT = $::FORM{'cvsroot'};
$CVS_ROOT = pickDefaultRepository() unless $CVS_ROOT;
$::CVS_ROOT = $::FORM{'cvsroot'};
$::CVS_ROOT = pickDefaultRepository() unless $::CVS_ROOT;
if (exists $::FORM{'module'}) {
if (exists($::TreeInfo{$::FORM{'module'}}{'repository'})) {
$::TreeID = $::FORM{'module'}
}
}
$modules = {};
$::modules = {};
require 'modules.pl';
PutsHeader("Bonsai - CVS Query Form", "CVS Query Form",
"$CVS_ROOT - $::TreeInfo{$::TreeID}{shortdesc}");
"$::CVS_ROOT - $::TreeInfo{$::TreeID}{shortdesc}");
print "
<p>
@ -63,13 +66,13 @@ print "
#
# check to see if there are multple repositories
#
@reposList = &getRepositoryList();
$bMultiRepos = (@reposList > 1);
my @reposList = &getRepositoryList();
my $bMultiRepos = (@reposList > 1);
#
# This code sucks, I should rewrite it to be shorter
#
$Module = 'default';
my $Module = 'default';
if (!exists $::FORM{module} || $::FORM{module} eq 'all' ||
$::FORM{module} eq '') {
@ -96,7 +99,7 @@ else {
#
# Print out all the Different Modules
#
for $k (sort( keys( %$modules ) ) ){
for my $k (sort( keys( %$::modules ) ) ){
print "<OPTION value='$k'>$k\n";
}
@ -197,10 +200,7 @@ print "
# Print the date selector
#
$CVS_REPOS_SUFFIX = $CVS_ROOT;
$CVS_REPOS_SUFFIX =~ s:/:_:g;
$startdate = fetchCachedStartDate($CVS_ROOT);
my $startdate = fetchCachedStartDate($::CVS_ROOT);
if (!defined($::FORM{date}) || $::FORM{date} eq "") {
$::FORM{date} = "hours";
@ -255,7 +255,7 @@ print "
<tr>
<th><BR></th>
<td colspan=2>
<INPUT TYPE=HIDDEN NAME=cvsroot VALUE='$CVS_ROOT'>
<INPUT TYPE=HIDDEN NAME=cvsroot VALUE='$::CVS_ROOT'>
<INPUT TYPE=SUBMIT VALUE='Run Query'>
</td>
</tr>
@ -273,7 +273,7 @@ sub sortTest {
return " SELECTED";
}
refigureStartDateIfNecessary($CVS_ROOT);
refigureStartDateIfNecessary($::CVS_ROOT);
sub dateTest {
if( $_[0] eq $::FORM{date} ){
@ -310,6 +310,8 @@ sub regexpradio {
}
my $rememberedcachedate;
sub fetchCachedStartDate {
my ($repository) = @_;
open(CACHE, "<data/cachedstartdates") || return "unknown";
@ -337,7 +339,7 @@ sub refigureStartDateIfNecessary {
SendSQL("select min(ci_when)
from checkins,repositories
where repositories.id = repositoryid and
repository = '$CVS_ROOT'");
repository = '$::CVS_ROOT'");
my $startdate = FetchOneColumn();
if ($startdate eq "") {

297
webtools/bonsai/cvsview2.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl --
#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
# cvsview.cgi - fake up some HTML based on RCS logs and diffs
#
@ -36,25 +36,44 @@
# SRCROOTS is an array of repository roots under which to look for CVS files.
#
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;
$zz = $::TreeList;
$zz = $::file_description;
$zz = $::principal_branch;
$zz = %::timestamp;
}
my $opt_command;
my $anchor_num = 0;
my $font_tag = "";
# Figure out which directory bonsai is in by looking at argv[0]
$bonsaidir = $0;
my $bonsaidir = $0;
$bonsaidir =~ s:/[^/]*$::; # Remove last word, and slash before it.
if ($bonsaidir eq '') {
$bonsaidir = '.';
}
chdir $bonsaidir || die "Couldn't chdir to $bonsaidir";
chdir $bonsaidir || die "Can't chdir to $bonsaidir";
require 'CGI.pl';
$cocommand = Param('cocommand');
$rcsdiffcommand = Param('rcsdiffcommand');
my $cocommand = Param('cocommand');
my $rcsdiffcommand = Param('rcsdiffcommand');
LoadTreeConfig();
NEXTTREE: foreach $i (@::TreeList) {
$r = $::TreeInfo{$i}->{'repository'};
foreach $j (@SRCROOTS) {
my @SRCROOTS;
NEXTTREE: foreach my $i (@::TreeList) {
my $r = $::TreeInfo{$i}->{'repository'};
foreach my $j (@SRCROOTS) {
if ($r eq $j) {
next NEXTTREE;
}
@ -62,16 +81,16 @@ NEXTTREE: foreach $i (@::TreeList) {
push @SRCROOTS, $r;
}
$opt_rev1 = '';
$opt_rev2 = '';
$opt_root = '';
$opt_files = '';
$opt_branch = '';
$opt_skip = 0;
$debug = 0;
my $opt_rev1 = '';
my $opt_rev2 = '';
my $opt_root = '';
my $opt_files = '';
my $opt_branch = '';
my $opt_skip = 0;
my $debug = 0;
$MAX_REVS = 8;
my $MAX_REVS = 8;
#
@ -79,11 +98,14 @@ $MAX_REVS = 8;
# 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;
}
# sub die {
# print 'fatal error: ';
# print @_;
# exit;
# }
my $line_buffer;
# Consume one token from the already opened RCSFILE filehandle.
# Unescape string tokens, if necessary.
@ -103,7 +125,7 @@ sub get_token {
# ...or an RCS-encoded string that starts with an @ character.
$line_buffer =~ s/^@([^@]*)//o;
$token = $1;
my $token = $1;
# Detect single @ character used to close RCS-encoded string.
while ($line_buffer !~ /^@[^@]*$/o) {
@ -124,9 +146,9 @@ sub get_token {
# Consume a token from RCS filehandle and ensure that it matches
# the given string constant.
sub match_token {
local ($match) = @_;
my ($match) = @_;
local ($token) = &get_token;
my ($token) = &get_token;
&die ("Unexpected parsing error in RCS file.\n",
"Expected token: $match, but saw: $token\n")
if ($token ne $match);
@ -134,29 +156,29 @@ sub match_token {
# Push RCS token back into the input buffer.
sub unget_token {
local ($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 -- mapping from numerical revision # to symbolic tag
# %tag_revision -- mapping from symbolic tag to numerical revision #
# $::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 {
local ($token, $tag, $tag_name, $tag_revision);
local (@tags);
my ($token, $tag, $tag_name, $tag_revision);
my (@tags);
# Undefine variables, because we may have already read another RCS file
undef %tag_revision;
undef %revision_symbolic_name;
undef %::tag_revision;
undef %::revision_symbolic_name;
while (1) {
# Read initial token at beginning of line
$token = &get_token(RCSFILE);
$token = &get_token();
# We're done once we reach the description of the RCS tree
if ($token =~ /^\d/o) {
@ -167,10 +189,10 @@ sub parse_rcs_admin {
# print "token: $token\n";
if ($token eq 'head') {
$head_revision = &get_token;
$::head_revision = &get_token;
&get_token; # Eat semicolon
} elsif ($token eq 'branch') {
$principal_branch = &get_token;
$::principal_branch = &get_token;
&get_token; # Eat semicolon
} elsif ($token eq 'symbols') {
@ -179,11 +201,11 @@ sub parse_rcs_admin {
while (($tag = &get_token) ne ';') {
($tag_name, $tag_revision) = split(':', $tag);
$tag_revision{$tag_name} = $tag_revision;
$revision_symbolic_name{$tag_revision} = $tag_name;
$::tag_revision{$tag_name} = $tag_revision;
$::revision_symbolic_name{$tag_revision} = $tag_name;
}
} elsif ($token eq 'comment') {
$file_description = &get_token;
$::file_description = &get_token;
&get_token; # Eat semicolon
# Ignore all these other fields - We don't care about them.
@ -204,38 +226,38 @@ sub parse_rcs_admin {
# 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,
# %::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.
# %::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
# %::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.
# %::next_delta -- revision number of next "delta". Inverts %::prev_delta.
#
# Also creates %last_revision, keyed by a branch revision number, which
# 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
# e.g. $::last_revision{"1.2.8"} == 1.2.8.5
#
sub parse_rcs_tree {
local($revision, $date, $author, $branches, $next);
local($branch, $is_trunk_revision);
my($revision, $date, $author, $branches, $next);
my($branch, $is_trunk_revision);
# Undefine variables, because we may have already read another RCS file
undef %revision_date;
undef %timestamp;
undef %revision_author;
undef %revision_branches;
undef %prev_revision;
undef %prev_delta;
undef %next_delta;
undef %last_revision;
undef %::revision_date;
undef %::timestamp;
undef %::revision_author;
undef %::revision_branches;
undef %::prev_revision;
undef %::prev_delta;
undef %::next_delta;
undef %::last_revision;
while (1) {
$revision = &get_token;
@ -248,25 +270,25 @@ sub parse_rcs_tree {
$is_trunk_revision = ($revision =~ /^[0-9]+\.[0-9]+$/);
$tag_revision{$revision} = $revision;
$::tag_revision{$revision} = $revision;
($branch) = $revision =~ /(.*)\.[0-9]+/o;
$last_revision{$branch} = $revision;
$::last_revision{$branch} = $revision;
# Parse date
&match_token('date');
$date = &get_token;
$revision_date{$revision} = $date;
$::revision_date{$revision} = $date;
&match_token(';');
# Convert date into timestamp
# @date_fields = reverse(split(/\./, $date));
# $date_fields[4]--; # Month ranges from 0-11, not 1-12
# $timestamp{$revision} = &timegm(@date_fields);
# $::timestamp{$revision} = &timegm(@date_fields);
# Parse author
&match_token('author');
$author = &get_token;
$revision_author{$revision} = $author;
$::revision_author{$revision} = $author;
&match_token(';');
# Parse state;
@ -276,12 +298,13 @@ sub parse_rcs_tree {
# Parse branches
&match_token('branches');
$branches = '';
my $token;
while (($token = &get_token) ne ';') {
$prev_revision{$token} = $revision;
$prev_delta{$token} = $revision;
$::prev_revision{$token} = $revision;
$::prev_delta{$token} = $revision;
$branches .= "$token ";
}
$revision_branches{$revision} = $branches;
$::revision_branches{$revision} = $branches;
# Parse revision of next delta in chain
&match_token('next');
@ -289,12 +312,12 @@ sub parse_rcs_tree {
if (($token = &get_token) ne ';') {
$next = $token;
&get_token; # Eat semicolon
$next_delta{$revision} = $next;
$prev_delta{$next} = $revision;
$::next_delta{$revision} = $next;
$::prev_delta{$next} = $revision;
if ($is_trunk_revision) {
$prev_revision{$revision} = $next;
$::prev_revision{$revision} = $next;
} else {
$prev_revision{$next} = $revision;
$::prev_revision{$next} = $revision;
}
}
@ -310,7 +333,7 @@ sub parse_rcs_tree {
# Reads and parses complete RCS file from already-opened RCSFILE descriptor.
sub parse_rcs_file {
local ($file) = @_;
my ($file) = @_;
&die("Couldn't open $file\n") if !open(RCSFILE, "< $file");
$line_buffer = '';
print "Reading RCS admin...\n" if ($debug);
@ -325,15 +348,15 @@ sub parse_rcs_file {
# branch tag, a symbolic revision tag, or an ordinary numerical
# revision number.
sub map_tag_to_revision {
local($tag_or_revision) = @_;
my($tag_or_revision) = @_;
local ($revision) = $tag_revision{$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) {
$branch = $1 . '.' . $2;
my $branch = $1 . '.' . $2;
# Return latest revision on the branch, if any.
return $last_revision{$branch} if (defined($last_revision{$branch}));
return $::last_revision{$branch} if (defined($::last_revision{$branch}));
return $1; # No revisions on branch - return branch point
} else {
return $revision;
@ -345,11 +368,11 @@ sub map_tag_to_revision {
#
print "Content-type: text/html\n\n";
$request_method = $ENV{'REQUEST_METHOD'}; # e.g., "GET", "POST", etc.
$script_name = $ENV{'SCRIPT_NAME'};
$prefix = $script_name . '?'; # prefix for HREF= entries
my $request_method = $ENV{'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}));
$query_string = $ENV{QUERY_STRING};
my $query_string = $ENV{QUERY_STRING};
# Undo % URL-encoding
while ($query_string =~ /(.*)\%([0-9a-fA-F][0-9a-fA-F])(.*)/) {
@ -361,13 +384,17 @@ while ($query_string =~ /(.*)\%([0-9a-fA-F][0-9a-fA-F])(.*)/) {
if ($request_method ne 'GET');
# Default option values
$opt_diff_mode = 'context';
$opt_whitespace_mode = 'show';
my $opt_diff_mode = 'context';
my $opt_whitespace_mode = 'show';
my $opt_file;
my $opt_rev;
my $opt_subdir;
# Parse options in URL. For example,
# http://w3/cgi/cvsview.pl?subdir=foo&file=bar would assign
# $opt_subdir = foo and $opt_file = bar.
foreach $option (split(/&/, $query_string)) {
foreach my $option (split(/&/, $query_string)) {
&die("command $opt_command: garbled option $option\n")
if ($option !~ /^([^=]+)=(.*)/);
eval('$opt_' . $1 . '="' . $2 . '";');
@ -377,13 +404,13 @@ if (defined($opt_branch) && $opt_branch eq 'HEAD' ) { $opt_branch = ''; }
# Configuration colors for diff output.
$stable_bg_color = 'White';
$skipping_bg_color = '#c0c0c0';
$header_bg_color = 'Orange';
$change_bg_color = 'LightBlue';
$addition_bg_color = 'LightGreen';
$deletion_bg_color = 'LightGreen';
$diff_bg_color = 'White';
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
&die("command not defined in URL\n") if $opt_command eq '';
@ -403,15 +430,16 @@ $prefix .= "&whitespace_mode=$opt_whitespace_mode";
$prefix .= "&root=$opt_root";
# Create a shorthand for the longest common initial substring of our URL.
$magic_url = "$prefix&subdir=$opt_subdir";
my $magic_url = "$prefix&subdir=$opt_subdir";
# Now that we've munged QUERY_STRING into perl variables, set rcsdiff options.
$rcsdiff = "$rcsdiffcommand -f";
my $rcsdiff = "$rcsdiffcommand -f";
$rcsdiff .= ' -w' if ($opt_whitespace_mode eq 'ignore');
# Handle the "root" argument
#
if (defined($root = $opt_root) && $root ne '') {
my $root = $opt_root;
if (defined $root && $root ne '') {
$root =~ s|/$||;
if (-d $root) {
unshift(@SRCROOTS, $root);
@ -421,6 +449,9 @@ if (defined($root = $opt_root) && $root ne '') {
exit;
}
}
my $found = 0;
my $dir;
foreach $root (@SRCROOTS) {
$dir = "$root/$opt_subdir";
if (-d $dir) {
@ -487,7 +518,8 @@ sub do_diff_links {
my $lxr_path = "$opt_subdir/$opt_file";
my $lxr_link = Fix_LxrLink($lxr_path);
my $blame_link = "$blame_base?root=$CVS_ROOT\&file=$opt_subdir/$opt_file";
my $blame_link = "$blame_base?file=$opt_subdir/$opt_file";
$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);
@ -515,6 +547,7 @@ sub do_diff_links {
$anchor_num = 0;
while (<RCSDIFF>) {
# Get one command from the diff file
my $line = "";
if (/^(c|a)(\d+)/) {
$line = $2;
while (<RCSDIFF>) {
@ -544,10 +577,10 @@ sub do_diff_links {
# Default tab width, although it's frequently 4.
$tab_width = 8;
my $tab_width = 8;
sub next_tab_stop {
local ($pos) = @_;
my ($pos) = @_;
return int(($pos + $tab_width) / $tab_width) * $tab_width;
}
@ -558,9 +591,9 @@ sub next_tab_stop {
# In the latter case, set $tab_width to 4.
#
sub guess_tab_width {
local ($opt_file) = @_;
local ($found_tab_width) = 0;
local ($many_tabs, $any_tabs) = (0, 0);
my ($opt_file) = @_;
my ($found_tab_width) = 0;
my ($many_tabs, $any_tabs) = (0, 0);
open(RCSFILE, "$opt_file");
while (<RCSFILE>) {
@ -593,7 +626,7 @@ sub do_diff {
chdir($dir);
local ($rcsfile) = "$opt_file,v";
my ($rcsfile) = "$opt_file,v";
$rcsfile = "Attic/$opt_file,v" if (! -r $rcsfile);
&guess_tab_width($rcsfile);
@ -634,9 +667,10 @@ sub do_log {
#
sub do_directory {
$output = "<DIV ALIGN=LEFT>";
my $output = "<DIV ALIGN=LEFT>";
my $link_path = "";
foreach $path (split('/',$opt_subdir)) {
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;
@ -659,8 +693,8 @@ sub do_directory {
print "<TABLE BORDER CELLPADDING=2>\n";
foreach $file (split(/\+/, $opt_files)) {
local ($path) = "$dir/$file,v";
foreach my $file (split(/\+/, $opt_files)) {
my ($path) = "$dir/$file,v";
CheckHidden($path);
$path = "$dir/Attic/$file,v" if (! -r $path);
@ -676,18 +710,20 @@ sub do_directory {
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);
&die("$0: error: -r: No such revision: $opt_branch\n")
if ($first_rev eq '');
} else {
$first_rev = $head_revision;
$first_rev = $::head_revision;
}
$skip = $opt_skip;
$revs_remaining = $MAX_REVS;
for ($rev = $first_rev; $rev; $rev = $prev) {
$prev = $prev_revision{$rev};
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>';
@ -707,7 +743,7 @@ sub do_directory {
$href_close = "</A>";
}
print "<TD>$href_open$rev$href_close<BR>";
print "$revision_author{$rev}</TD>";
print "$::revision_author{$rev}</TD>";
}
print "</TR>\n";
@ -716,12 +752,12 @@ sub do_directory {
print "<TR>\n";
$skip = $opt_skip;
$revs_remaining = $MAX_REVS;
for ($rev = $first_rev; $rev; $rev = $prev_revision{$rev}) {
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>",
print "&file=$file&rev=$rev>$::revision_author{$rev}</A>",
"</TD>\n";
}
print "</TR>\n";}
@ -783,8 +819,10 @@ sub do_directory {
# a later version of OLDREV's file.
#
sub html_diff {
local ($file, $rev1, $rev2) = @_;
local ($old_line_num) = 1;
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 |");
@ -804,7 +842,7 @@ sub html_diff {
$mark = 0;
if (/^a(\d+)/) {
$point = $1;
&skip_to_line($point + 1, *OLDREV, *old_line_num);
$old_line_num = skip_to_line($point + 1, *OLDREV, $old_line_num);
while (<DIFF>) {
last if (/^\.$/);
&print_row('', $stable_bg_color, $_, $addition_bg_color);
@ -812,7 +850,7 @@ sub html_diff {
} elsif ((($point, $mark) = /^c(\d+) (\d+)$/) ||
(($point) = /^c(\d+)$/)) {
$mark = $point if (!$mark);
&skip_to_line($point, *OLDREV, *old_line_num);
$old_line_num = skip_to_line($point, *OLDREV, $old_line_num);
while (<DIFF>) {
last if (/^\.$/);
if ($old_line_num <= $mark) {
@ -831,7 +869,7 @@ sub html_diff {
} elsif ((($point, $mark) = /^d(\d+) (\d+)$/) ||
(($point) = /^d(\d+)$/)) {
$mark = $point if (!$mark);
&skip_to_line($point, *OLDREV, *old_line_num);
$old_line_num = skip_to_line($point, *OLDREV, $old_line_num);
while ($old_line = <OLDREV>) {
$old_line_num++;
&print_row($old_line, $deletion_bg_color, '', $stable_bg_color);
@ -849,7 +887,7 @@ sub html_diff {
# Print the remaining lines in the original file. These are lines that
# were not modified in the later revision
#
local ($base_old_line_num) = $old_line_num;
my ($base_old_line_num) = $old_line_num;
while ($old_line = <OLDREV>) {
$old_line_num++;
&print_row($old_line, $stable_bg_color, $old_line, $stable_bg_color)
@ -867,10 +905,12 @@ sub html_diff {
}
sub skip_to_line {
local ($line_num, *OLDREV, *old_line_num) = @_;
local ($anchor_printed) = 0;
local ($skip_line_printed) = ($line_num - $old_line_num <= 10);
local ($base_old_line_num) = $old_line_num;
my ($line_num, $old_line_num);
local (*OLDREV);
($line_num, *OLDREV, $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) {
@ -889,7 +929,7 @@ sub skip_to_line {
$skip_line_printed = 1;
}
$old_line = <OLDREV>;
my $old_line = <OLDREV>;
$old_line_num++;
&print_row($old_line, $stable_bg_color, $old_line, $stable_bg_color)
@ -901,12 +941,13 @@ sub skip_to_line {
print "<A NAME=$anchor_num>" if (!$anchor_printed);
print '</A>';
$anchor_num++;
return $old_line_num;
}
sub print_cell {
local ($line, $color) = @_;
local ($i, $j, $k, $n);
local ($c, $newline);
my ($line, $color) = @_;
my ($i, $j, $k, $n);
my ($c, $newline);
if ($color eq $stable_bg_color) {
print "<TD>$font_tag";
@ -941,8 +982,10 @@ sub print_cell {
}
sub print_row {
local ($line1, $color1, $line2, $color2) = @_;
my ($line1, $color1, $line2, $color2) = @_;
print "<TR>";
$line1 = "" unless defined $line1;
$line2 = "" unless defined $line2;
&print_cell($line1, $color1);
&print_cell($line2, $color2);
}

7
webtools/bonsai/doadmin.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl
#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
@ -18,6 +18,9 @@
# Netscape Communications Corporation. All Rights Reserved.
use strict;
use diagnostics;
require 'CGI.pl';
require 'adminfuncs.pl';
@ -28,7 +31,7 @@ CheckPassword(FormData('password'));
Lock();
LoadCheckins();
$cmd = FormData('command');
my $cmd = FormData('command');
if ($cmd eq 'close') {
close_tree();

9
webtools/bonsai/doeditcheckin.cgi
Просмотреть файл

@ -17,6 +17,9 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use diagnostics;
use strict;
require 'CGI.pl';
print "Content-type: text/html
@ -37,11 +40,11 @@ if (!exists $::FORM{'id'}) {
} else {
$info = eval("\\%" . $::FORM{'id'});
if (!exists $info{'notes'}) {
$info{'notes'} = "";
if (!exists $info->{'notes'}) {
$info->{'notes'} = "";
}
foreach $i (sort(keys(%$info))) {
foreach my $i (sort(keys(%$info))) {
if (FormData("orig$i") ne $info->{$i}) {
$busted = 1;
last;

16
webtools/bonsai/doeditmessage.cgi
Просмотреть файл

@ -17,6 +17,18 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
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";
@ -48,11 +60,11 @@ open(FILE, "> $RealFilename")
print FILE $Text;
chmod(0666, $RealFilename);
close(FILE);
Log("$RealFilename set to $text");
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.";
print "The file <b>$Filename</b> has been changed.";
PutsTrailer();

5
webtools/bonsai/doeditwhiteboard.cgi
Просмотреть файл

@ -17,6 +17,9 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use diagnostics;
use strict;
require 'CGI.pl';
print "Content-type: text/html\n\n";
@ -58,7 +61,7 @@ Change the free-for-all whiteboard:<br>
my $newwhiteboard = trim(FormData('whiteboard'));
MailDiffs("whiteboard", $whiteboard, $newwhiteboard);
MailDiffs("whiteboard", $::WhiteBoard, $newwhiteboard);
$::WhiteBoard = $newwhiteboard;
WriteWhiteboard();

12
webtools/bonsai/dotweak.cgi
Просмотреть файл

@ -17,6 +17,16 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
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
@ -80,7 +90,7 @@ SWITCH: for ($::FORM{'command'}) {
last SWITCH;
};
/^movetree$/ && do {
if ($treeid eq $::FORM{'desttree'}) {
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";

13
webtools/bonsai/editcheckin.cgi
Просмотреть файл

@ -17,6 +17,17 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
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();
@ -89,7 +100,7 @@ foreach my $i (sort(keys(%$info))) {
print "<INPUT TYPE=HIDDEN NAME=id VALUE=\"$::FORM{'id'}\">";
print "<INPUT TYPE=HIDDEN NAME=treeid VALUE=\"" . value_quote($treeid) . "\">";
print "<INPUT TYPE=HIDDEN NAME=treeid VALUE=\"" . value_quote($::TreeID) . "\">";

11
webtools/bonsai/editmessage.cgi
Просмотреть файл

@ -17,6 +17,17 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
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";

11
webtools/bonsai/editwhiteboard.cgi
Просмотреть файл

@ -17,6 +17,17 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
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";

13
webtools/bonsai/indextest.pl
Просмотреть файл

@ -16,18 +16,21 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use diagnostics;
use strict;
if( $ARGV[0] eq '' ){
$CVS_ROOT = '/m/src';
$::CVS_ROOT = '/m/src';
}
else {
$CVS_ROOT = $ARGV[0];
$::CVS_ROOT = $ARGV[0];
}
$CVS_REPOS_SUFIX = $CVS_ROOT;
$CVS_REPOS_SUFIX = $::CVS_ROOT;
$CVS_REPOS_SUFIX =~ s/\//_/g;
$CHECKIN_DATA_FILE = "data/checkinlog${CVS_REPOS_SUFIX}";
$CHECKIN_INDEX_FILE = "data/index${CVS_REPOS_SUFIX}";
my $CHECKIN_DATA_FILE = "data/checkinlog${CVS_REPOS_SUFIX}";
my $CHECKIN_INDEX_FILE = "data/index${CVS_REPOS_SUFIX}";
open(INDEX , "<$CHECKIN_INDEX_FILE");

32
webtools/bonsai/moduleanalyse.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl --
#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
@ -17,17 +17,29 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
#
# 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";
$CVS_ROOT = $::FORM{'cvsroot'};
my $CVS_ROOT = $::FORM{'cvsroot'};
$CVS_ROOT = pickDefaultRepository() unless $CVS_ROOT;
PutsHeader("CVS Module Analyzer", $CVS_ROOT);
@ -55,7 +67,7 @@ print "
<SELECT name='module' size=5>
";
$Module = 'default';
my $Module = 'default';
if( $::FORM{module} eq 'all' || $::FORM{module} eq '' ){
print "<OPTION SELECTED VALUE='all'>All Files in the Repository\n";
}
@ -70,7 +82,7 @@ else {
#
$::TreeID = $Module if (exists($::TreeInfo{$Module}{'repository'}));
LoadDirList();
for $k (sort( grep(!/\*$/, @::LegalDirs) ) ){
for my $k (sort( grep(!/\*$/, @::LegalDirs) ) ){
print "<OPTION value='$k'>$k\n" if ($k ne $Module);
}
@ -86,10 +98,10 @@ print "
if( $::FORM{module} ne '' ){
$mod = $::FORM{module};
my $mod = $::FORM{module};
print "<h1>Examining Module '$mod'</h1>\n\n";
for $i (sort( grep(!/\*$/, @::LegalDirs) ) ){
for my $i (sort( grep(!/\*$/, @::LegalDirs) ) ){
if( -d "$CVS_ROOT/$i"){
print "<dt><tt>Dir:&nbsp;&nbsp;&nbsp;</tt>";
print "<a href=rview.cgi?dir=$i&cvsroot=$CVS_ROOT>$i</a>";
@ -103,9 +115,9 @@ if( $::FORM{module} ne '' ){
print "$i : Not a file or a directory.";
}
if( $mod_map->{$i} == $IS_LOCAL ){
print "<font color=blue><tt> LOCAL</tt></font>";
}
# if( $mod_map->{$i} == $IS_LOCAL ){
# print "<font color=blue><tt> LOCAL</tt></font>";
# }
print "\n";
}
}

48
webtools/bonsai/modules.pl
Просмотреть файл

@ -16,22 +16,27 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use diagnostics;
use strict;
require 'get_line.pl';
$NOT_LOCAL = 1;
$IS_LOCAL = 2;
my $NOT_LOCAL = 1;
my $IS_LOCAL = 2;
$modules = {};
$::modules = {};
if( $CVS_ROOT eq "" ){
$CVS_ROOT = pickDefaultRepository();
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";
$CVS_MODULES="$::CVS_ROOT/CVSROOT/modules";
}
open( MOD, "<$CVS_MODULES") || die "can't open $CVS_MODULES";
@ -41,14 +46,14 @@ close( MOD );
1;
sub in_module {
local($mod_map, $dirname, $filename ) = @_;
local( @path );
local( $i, $fp, $local );
my($mod_map, $dirname, $filename ) = @_;
my( @path );
my( $i, $fp, $local );
#
#quick check if it is already in there.
#
if( $mod_map{$dirname} ){
if( $mod_map->{$dirname} ){
return 1;
}
@ -70,8 +75,8 @@ sub in_module {
else {
# Add directories to the map as we encounter them so we go
# faster
if( $mod_map{$dirname} == 0 ){
$mod_map{$dirname} = $IS_LOCAL;
if( $mod_map->{$dirname} == 0 ){
$mod_map->{$dirname} = $IS_LOCAL;
}
return 1;
}
@ -87,19 +92,20 @@ sub in_module {
sub get_module_map {
local($name) = @_;
local($mod_map);
my($name) = @_;
my($mod_map);
$mod_map = {};
&build_map( $name, $mod_map );
return $mod_map;
}
sub parse_modules {
local @finaloptions=();
my @finaloptions=();
my $l;
while( $l = &get_line ){
@finaloptions=();
($mod_name, $flag, @params) = split(/[ \t]+/,$l);
my ($mod_name, $flag, @params) = split(/[ \t]+/,$l);
while ( $flag =~ /^-.$/){
if( $flag eq '-a' ){
$flag="";
@ -118,19 +124,19 @@ sub parse_modules {
last; # No options found...
}
unshift @params, $flag if ( $flag ne "" );
$modules->{$mod_name} = [(@finaloptions,@params)];
$::modules->{$mod_name} = [(@finaloptions,@params)];
}
}
sub build_map {
local($name,$mod_map) = @_;
local($bFound, $local);
my ($name,$mod_map) = @_;
my ($bFound, $local);
$local = $NOT_LOCAL;
$bFound = 0;
# printf "looking for $name in %s<br>\n",join(",", @{$modules->{$name}});
for $i ( @{$modules->{$name}} ){
# 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;

42
webtools/bonsai/multidiff.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl --
#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
@ -22,18 +22,21 @@
# Multi file diff cgi
#
require 'utils.pl';
use diagnostics;
use strict;
require 'globals.pl';
$|=1;
loadConfigData();
my %form;
print "Content-type: text/html
<PRE><FONT FACE='Lucida Console'>
";
@revs = ();
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";
@ -45,32 +48,35 @@ print "Content-type: text/html
# print "$k='$v'\n";
#}
if( $form{"cvsroot"} ne "" ){
my $cvsroot;
if( $form{"cvsroot"} ){
$cvsroot = $form{"cvsroot"};
}
else {
$cvsroot = pickDefaultRepository();
}
if( $form{"allchanges"} ne "" ){
if( $form{"allchanges"} ){
@revs = split(/,/, $form{"allchanges"} );
}
else {
while( ($k, $v) = each( %form ) ){
while( my ($k, $v) = each( %form ) ){
push( @revs, $k );
}
}
$didone = 0;
for $k (@revs) {
($who,$dir,$file,$rev) = split(/\|/, $k );
my $didone = 0;
my $rcsdiffcommand = Param('rcsdiffcommand');
for my $k (@revs) {
my ($who,$dir,$file,$rev) = split(/\|/, $k );
if ($rev eq "") {
next;
}
$prevrev = &PrevRev($rev);
my $prevrev = &PrevRev($rev);
# this doesn't handle files in the attic
$fullname = "$cvsroot/$dir/$file,v";
my $fullname = "$cvsroot/$dir/$file,v";
if (IsHidden($fullname)) {
next;
}
@ -91,7 +97,7 @@ if ($didone == 0) {
sub split_cgi_args {
local($i,$var,$value, $s);
my ($i,$var,$value, $s);
if( $ENV{"REQUEST_METHOD"} eq 'POST'){
while(<> ){
@ -102,10 +108,10 @@ sub split_cgi_args {
$s = $ENV{"QUERY_STRING"};
}
@args= split(/\&/, $s );
my @args= split(/\&/, $s );
for $i (@args) {
($var, $value) = split(/=/, $i);
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/+/ /;
@ -115,8 +121,8 @@ sub split_cgi_args {
}
sub PrevRev {
local( $rev ) = @_;
local( $i, $j, $ret, @r );
my( $rev ) = @_;
my( $i, $j, $ret, @r );
@r = split( /\./, $rev );

31
webtools/bonsai/rebuildcvshistory.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl
#!/usr/bonsaitools/bin/perl -w
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
@ -16,6 +16,18 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
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";
@ -97,7 +109,7 @@ sub ProcessOneFile {
$datestr =~ s!^(\d+)/(\d+/\d+)!$2/$1!;
$date = str2time($datestr, "GMT");
if ($date >= $::StartFrom) {
AddToDatabase("C|$date|$author|$Repository|$filehead|$filetail|$revision||$branch|+$pluscount|-$minuscount", $desc);
AddToDatabase("C|$date|$author|$::Repository|$filehead|$filetail|$revision||$branch|+$pluscount|-$minuscount", $desc);
}
}
$indesc = 0;
@ -144,8 +156,10 @@ sub ProcessOneFile {
}
}
last
unless ($line = <RLOG_PROC>);
$line = <RLOG_PROC>;
if (!defined $line) {
last;
}
chop($line);
}
}
@ -175,11 +189,11 @@ sub ProcessDirectory {
} else {
next unless ($file =~ /,v$/);
if ($FirstFile && ($FirstFile ne $file)) {
if ($::FirstFile && ($::FirstFile ne $file)) {
print "Skipping $file...\n";
next;
}
$FirstFile = 0;
$::FirstFile = 0;
ProcessOneFile($file);
}
}
@ -232,13 +246,14 @@ Rebuilding entire checkin history in $::Description, (`$::TreeID' tree) ...
Log("Rebuilding cvs history in $::Description, (`$::TreeID' tree)...");
LoadDirList();
@Dirs = grep(!/\*$/, @::LegalDirs);
my @Dirs = grep(!/\*$/, @::LegalDirs);
@Dirs = split(/,\s*/, $::Modules) if $::Modules;
my $StartingDir;
($StartingDir = "$::Repository/$::SubDir") =~ s!/.?$!! if $::SubDir;
print "Doing directories: @Dirs ...\n";
foreach $Dir (@Dirs) {
foreach my $Dir (@Dirs) {
my $dir = "$::Repository/$Dir";
unless (grep $Dir, @::LegalDirs) {

11
webtools/bonsai/reposfiles.pl
Просмотреть файл

@ -18,14 +18,17 @@
# Netscape Communications Corporation. All Rights Reserved.
use diagnostics;
use strict;
if( $ARGV[0] eq '' ){
$CVS_ROOT = '/m/src';
$::CVS_ROOT = '/m/src';
}
else {
$CVS_ROOT = $ARGV[0];
$::CVS_ROOT = $ARGV[0];
}
$CVS_REPOS_SUFIX = $CVS_ROOT;
$CVS_REPOS_SUFIX = $::CVS_ROOT;
$CVS_REPOS_SUFIX =~ s/\//_/g;
@ -33,7 +36,7 @@ $FILE_LIST = "/d/webdocs/projects/bonsai/data/reposfiles${CVS_REPOS_SUFIX}";
open FL, ">$FILE_LIST";
GoDir($CVS_ROOT);
GoDir($::CVS_ROOT);
sub GoDir {
local($dir) = @_;

57
webtools/bonsai/rview.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl --
#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
@ -21,11 +21,23 @@
#
# Query the CVS database.
#
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 = $::Setup_String;
}
require 'CGI.pl';
$|=1;
$CVS_ROOT = $::FORM{"cvsroot"};
my $CVS_ROOT = $::FORM{"cvsroot"};
$CVS_ROOT = pickDefaultRepository() unless $CVS_ROOT;
LoadTreeConfig();
@ -40,11 +52,11 @@ $::TreeID = 'default'
# get dir, remove leading and trailing slashes
$dir = $::FORM{"dir"};
my $dir = $::FORM{"dir"};
$dir =~ s/^\/([^:]*)/$1/;
$dir =~ s/([^:]*)\/$/$1/;
$rev = $::FORM{"rev"};
my $rev = $::FORM{"rev"};
if(!defined($rev)) {
$rev='';
@ -53,8 +65,10 @@ if(!defined($rev)) {
print "Content-type: text/html\n\n";
my $script_str;
&setup_script;
$Setup_String = $script_str;
$::Setup_String = $script_str;
if( $CVS_ROOT eq "" ){
@ -63,26 +77,30 @@ if( $CVS_ROOT eq "" ){
validateRepository($CVS_ROOT);
my $s = "";
if( $rev ne "" ){
$s = "for branch <i>$rev</i>";
}
CheckHidden("$CVS_ROOT/$dir");
$revstr = '';
my $revstr = '';
$revstr = "&rev=$rev" unless $rev eq '';
$rootstr = '';
my $rootstr = '';
$rootstr .= "&cvsroot=$::FORM{'cvsroot'}" if defined $::FORM{'cvsroot'};
$rootstr .= "&module=$::TreeID";
$module = $::TreeInfo{$::TreeID}{'module'};
my $module = $::TreeInfo{$::TreeID}{'module'};
$toplevel = Param('toplevel');
my $toplevel = Param('toplevel');
$output = "<DIV ALIGN=LEFT>";
my $output = "<DIV ALIGN=LEFT>";
$output .= "<A HREF='toplevel.cgi" . BatchIdPart('?') . "'>$toplevel</a>/ ";
($dir_head, $dir_tail) = $dir =~ m@(.*/)?(.+)@;
foreach $path (split('/',$dir_head)) {
my ($dir_head, $dir_tail) = $dir =~ m@(.*/)?(.+)@;
$dir_head = "" unless defined $dir_head;
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 .= '/';
@ -95,8 +113,10 @@ PutsHeader("Repository Directory $toplevel/$dir $s", $output);
cvsmenu("align=right width=30%");
my $other_dir;
($other_dir = $dir) =~ s!^$module/?!!;
$other_dir_used = 1;
my $other_dir_used = 1;
LoadDirList();
if (-d "$CVS_ROOT/$dir") {
@ -130,7 +150,7 @@ Branch:
";
@dirs = ();
my @dirs = ();
DIR:
@ -142,15 +162,18 @@ while( <*> ){
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 $i (@dirs){
for my $i (@dirs){
$::FORM{"dir"} = ($dir ne "" ? "$dir/$i" : $i);
$anchor = &make_cgi_args;
my $anchor = &make_cgi_args;
print "<dt><a href=rview.cgi${anchor}>$i</a>\n";
if( $j % $split == 0 ){
print "\n<td>\n";
@ -164,7 +187,7 @@ if( @dirs != 0 ){
print "<P><FONT SIZE=+1><B>Files:</B></FONT>";
print "<table><TR VALIGN=TOP><td>";
@files = <*,v>;
my @files = <*,v>;
$j = 1;
$split = int(@files/4)+1;

6
webtools/bonsai/showcheckins.cgi
Просмотреть файл

@ -17,6 +17,9 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use diagnostics;
use strict;
require 'CGI.pl';
use vars qw(@TreeList);
@ -118,7 +121,8 @@ my $total_removed = 0;
# Calculate delta information
#
CHECKIN:
foreach $info (@list) {
foreach my $infoname (@list) {
$info = eval("\\\%$infoname");
$$info{added} = 0;
$$info{removed} = 0;

12
webtools/bonsai/switchtree.cgi
Просмотреть файл

@ -17,6 +17,18 @@
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
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();

2
webtools/bonsai/whohastouchedwhat.cgi
Просмотреть файл

@ -1,4 +1,4 @@
#!/usr/bonsaitools/bin/perl --
#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License