#!/usr/bin/perl -w # cvsblame.cgi -- cvsblame with logs as popups and allowing html in comments. # -*- Mode: perl; indent-tabs-mode: nil -*- # # The contents of this file are subject to the Netscape Public # License Version 1.1 (the "License"); you may not use this file # except in compliance with the License. You may obtain a copy of # the License at http://www.mozilla.org/NPL/ # # Software distributed under the License is distributed on an "AS # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or # implied. See the License for the specific language governing # rights and limitations under the License. # # The Original Code is the Bonsai CVS tool. # # The Initial Developer of the Original Code is Netscape Communications # Corporation. Portions created by Netscape are # Copyright (C) 1998 Netscape Communications Corporation. All # Rights Reserved. # # Contributor(s): # Created: Steve Lamm , 12-Sep-97. # Modified: Marc Byrd , 19971030. # # Arguments (passed via GET or POST): # file - path to file name (e.g. ns/cmd/xfe/Makefile) # root - cvs root (e.g. /warp/webroot) # - default includes /m/src/ and /h/rodan/cvs/repository/1.0 # rev - revision (default is the latest version) # line_nums - boolean for line numbers on/off (use 1,0). # (1,on by default) # use_html - boolean for html comments on/off (use 1,0). # (0,off by default) # sanitize - path to sanitization dictionary # (e.g. /warp2/webdoc/projects/bonsai/dictionary/sanitization.db) # mark - highlight a line # use 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'; # Cope with the cookie and print the header, first thing. That way, if # any errors result, they will show up for the user. print "Content-Type:text/html\n"; if ($ENV{REQUEST_METHOD} eq 'POST' and defined $::FORM{set_line}) { # Expire the cookie 5 months from now print "Set-Cookie: line_nums=" . &ExpectOnOff("set_line", $::FORM{set_line}) . "; expires=" . &toGMTString(time + 86400 * 152) . "; path=/\n"; } # Some Globals # my $Head = 'CVS Blame'; my $SubHead = ''; my @src_roots = getRepositoryList(); # Init byrd's 'feature' to allow html in comments # my $opt_html_comments = &html_comments_init(); # Handle the "file" argument # my $filename = ''; $filename = $::FORM{file} if defined $::FORM{file}; if ($filename eq '') { print "\n"; &print_usage; exit; } my ($file_head, $file_tail) = $filename =~ m@(.*/)?(.+)@; $file_head = '' if !defined($file_head); my $url_filename = url_quote($filename); my $url_file_tail = url_quote($file_tail); # Handle the "rev" argument # $::opt_rev = ''; $::opt_rev = &SanitizeRevision($::FORM{rev}) if defined $::FORM{rev} and $::FORM{rev} ne 'HEAD'; my $revstr = ''; $revstr = "&rev=$::opt_rev" unless $::opt_rev eq ''; my $browse_revtag = 'HEAD'; $browse_revtag = $::opt_rev if ($::opt_rev =~ /[A-Za-z]/); my $revision = ''; # Handle the "root" argument # my $root = $::FORM{root}; if (defined $root and $root ne '') { $root =~ s|/$||; validateRepository($root); if (-d $root) { unshift(@src_roots, $root); } else { print "\n"; &print_top; print "Error: Root, " . &html_quote($root) . ", is not a directory.

\n"; print "\n"; &print_bottom; exit; } } # Find the rcs file # my $rcs_filename; my $found_rcs_file = 0; foreach (@src_roots) { $root = $_; $rcs_filename = "$root/$filename,v"; $rcs_filename = Fix_BonsaiLink($rcs_filename); $found_rcs_file = 1, last if -r $rcs_filename; $rcs_filename = "$root/${file_head}Attic/$file_tail,v"; $found_rcs_file = 1, last if -r $rcs_filename; } unless ($found_rcs_file) { print "\n"; &print_top; my $escaped_filename = html_quote($filename); my $shell_filename = shell_escape($filename); print STDERR "cvsblame.cgi: Rcs file, $shell_filename, does not exist.\n"; print "Invalid filename: $escaped_filename.\n"; &print_bottom; exit; } &ChrootFilename($root, $rcs_filename); my $rcs_path; ($rcs_path) = $rcs_filename =~ m@$root/(.*)/.+?,v@; # Parse the rcs file ($::opt_rev is passed as a global) # $revision = &parse_cvs_file($rcs_filename); my $file_rev = $revision; my @text = &extract_revision($revision); if ($#text != $#::revision_map) { print "\n"; die "$::progname: Internal consistency error" } # Raw data opt (so other scripts can parse and play with the data) if (defined $::FORM{data}) { print "\n"; &print_raw_data; exit; } print "Last-Modified: ".time2str("%a, %d %b %Y %T %Z", str2time($::revision_ctime{$::opt_rev}), "GMT")."\n"; print "Expires: ".time2str("%a, %d %b %Y %T %Z", time+1200, "GMT")."\n"; print "\n"; #ENDHEADERS!! # Handle the "line_nums" argument # my $opt_line_nums = 1; if (defined $::COOKIE{line_nums}) { $opt_line_nums = 0 if $::COOKIE{line_nums} eq 'off'; $opt_line_nums = 1 if $::COOKIE{line_nums} eq 'on'; } if (defined $::FORM{line_nums}) { $opt_line_nums = 0 if $::FORM{line_nums} =~ /off|no|0/i; $opt_line_nums = 1 if $::FORM{line_nums} =~ /on|yes|1/i; } # Option to make links to included files my $opt_includes = 0; $opt_includes = 1 if defined $::FORM{includes} and $::FORM{includes} =~ /on|yes|1/i; $opt_includes = 1 if $opt_includes and $file_tail =~ /(.c|.h|.cpp)$/; my $use_html = 0; $use_html = 1 if defined $::FORM{use_html} and $::FORM{use_html} eq '1'; # Handle the "mark" argument # my %mark_line; my $mark_arg = ''; $mark_arg = &SanitizeMark($::FORM{mark}) if defined $::FORM{mark}; foreach my $mark (split ',', $mark_arg) { my ($begin, $end); if ($mark =~ m/^(\d*)-(\d*)$/) { $begin = $1; $end = $2; $begin = 1 if $begin eq ''; $end = $#text + 1 if $end eq '' or $end > $#text + 1; next if $begin >= $end; $mark_line{$begin} = 'begin'; $mark_line{$end} = 'end'; } else { $mark_line{$mark} = 'single'; } } # Start printing out the page # &print_top; print Param('bannerhtml', 1); # Print link at top for directory browsing # print q( --endquote-- print " ("; print "$browse_revtag:" unless $browse_revtag eq 'HEAD'; print $revision if $revision; print ")"; print qq(
CVS Blame
); my $link_path = ""; foreach my $path (split('/',$rcs_path)) { # Customize this translation $link_path .= url_encode2($path).'/'; my $lxr_path = Fix_LxrLink($link_path); print "$path/ "; } my $lxr_path = Fix_LxrLink("$link_path$file_tail"); print "$file_tail "; my $graph_cell = Param('cvsgraph') ? <<"--endquote--" : "";
Revision Graph
$graph_cell
LXR: Cross Reference
Full Change Log
); my $open_table_tag = ''; print "$open_table_tag
";

# Print each line of the revision, preceded by its annotation.
#
my $count = $#::revision_map;
if ($count <= 0) {
    $count = 1;
}
my $line_num_width = int(log($count)/log(10)) + 1;
my $revision_width = 3;
my $author_width = 5;
my $line = 0;
my %usedlog;
$usedlog{$revision} = 1;
my $old_revision = 0;
my $row_color = '';
my $lines_in_table = 0;
my $inMark = 0;
my $rev_count = 0;
foreach $revision (@::revision_map)
{
    my $text = $text[$line++];
    $usedlog{$revision} = 1;
    $lines_in_table++;

    if ($opt_html_comments) {
        # Don't escape HTML in C/C++ comments
        $text = &leave_html_comments($text);
    } else {
        $text =~ s/&/&/g;
        $text =~ s//>/g;
    }
    # Add a link to traverse to included files
    $text = &link_includes($text) if $opt_includes;

    my $output = '';

    # Highlight lines
    my $mark_cmd;
    if (defined($mark_cmd = $mark_line{$line}) and $mark_cmd ne 'end') {
	$output .= '
';
	$inMark = 1;
    }

    if ($old_revision ne $revision and $line != 1) {
      if ($row_color eq '') {
	$row_color=' BGCOLOR="#e7e7e7"';
      } else {
	$row_color='';
      }
      if (not $inMark) {
	if ($lines_in_table > 100) {
	  $output .= "
$open_table_tag
";
	  $lines_in_table=0;
	} else {
	  $output .= "
";
	}
      }
    } elsif ($lines_in_table > 200 and not $inMark) {
      $output .= "$open_table_tag
";
      $lines_in_table=0;
    }

    $output .= "";

    $output .= sprintf("%${line_num_width}s ", $line) if $opt_line_nums;

    if ($old_revision ne $revision or $rev_count > 20) {

        $revision_width = max($revision_width,length($revision));

	if ($::prev_revision{$revision}) {
	  $output .= "\n";

if ($::use_layers || $::use_dom) {
  # Write out cvs log messages as a JS variables
  # or hidden 
's print qq|" if $::use_layers; } &print_bottom; ## END of main script sub max { my ($a, $b) = @_; return ($a > $b ? $a : $b); } sub print_top { my ($title_text) = "for " . &html_quote($file_tail) . " ("; $title_text .= "$browse_revtag:" unless $browse_revtag eq 'HEAD'; $title_text .= $revision if $revision; $title_text .= ")"; $title_text =~ s/\(\)//; $| = 1; print "CVS Blame $title_text"; print <<__TOP__ if $::use_layers; __TOP__ print <<__TOP__ if $::use_dom; __TOP__ print '' if not ($::use_layers || $::use_dom); } # print_top sub print_usage { my ($linenum_message) = ''; my ($new_linenum, $src_roots_list); my ($title_text) = "Usage"; if ($ENV{REQUEST_METHOD} eq 'POST' and defined $::FORM{set_line}) { # Expire the cookie 5 months from now my $set_cookie = "Set-Cookie: line_nums=" . &ExpectOnOff("set_line", $::FORM{set_line}) . "; expires=" .&toGMTString(time + 86400 * 152)."; path=/"; # XXX Hey, nothing is done with this handy cookie string! ### XXX } if ( not defined $::COOKIE{line_nums} and not defined $::FORM{set_line}) { $new_linenum = 'on'; } elsif ((defined($::COOKIE{line_nums}) && $::COOKIE{line_nums} eq 'off') or (defined($::FORM{line_nums}) && $::FORM{set_line} eq 'off')) { $linenum_message = 'Line numbers are currently off.'; $new_linenum = 'on'; } else { $linenum_message = 'Line numbers are currently on.'; $new_linenum = 'off'; } $src_roots_list = join('
', @src_roots); print <<__USAGE__; CVS Blame $title_text

CVS Blame Usage

Add parameters to the query string to view a file.

Param Default Example Description
file -- ns/cmd/Makefile path to file name
root $src_roots_list /warp/webroot cvs root
rev HEAD 1.3
ACTRA_branch
revision
line_nums on * on
off
line numbers
#<line_number> -- #111 jump to a line

Examples:
  cvsblame.cgi?file=ns/cmd/Makefile
  cvsblame.cgi?file=ns/cmd/xfe/mozilla.c&rev=Dogbert4xEscalation_BRANCH
  cvsblame.cgi?file=projects/bonsai/cvsblame.cgi&root=/warp/webroot
  cvsblame.cgi?file=ns/config/config.mk&line_nums=on
  cvsblame.cgi?file=ns/cmd/xfe/dialogs.c#2384

You may also begin a query with the CVS Query Form.

* Instead of the line_nums parameter, you can line numbers.
$linenum_message
__USAGE__ &print_bottom; } # sub print_usage sub print_bottom { my $maintainer = Param('maintainer'); print <<__BOTTOM__;
Page configuration and help. Mail feedback to <$maintainer>. __BOTTOM__ } # print_bottom sub print_raw_data { my %revs_seen = (); my $prev_rev = $::revision_map[0]; my $count = 0; print "
\n";
  for my $rev (@::revision_map) {
    if ($prev_rev eq $rev) {
      $count++;
    } else {
      print "$prev_rev:$count\n";
      $count = 1;
      $prev_rev = $rev;
      $revs_seen{$rev} = 1;
    }
  }
  print "$prev_rev:$count\n";
  print "REVISION DETAILS\n";
  for my $rev (sort keys %revs_seen) {
    print "$rev|$::revision_ctime{$rev}|$::revision_author{$rev}|$::revision_log{$rev}.\n";
  }
  print "
\n"; } sub link_includes { my ($text) = $_[0]; if ($text =~ /\#(\s*)include(\s*)"(.*?)"/) { foreach my $trial_root (($rcs_path, 'ns/include', "$rcs_path/Attic", "$rcs_path/..")) { if (-r "$root/$trial_root/$3,v") { $text = "$`#$1include$2\"$3\";$'"; last; } } } return $text; } my $in_comments = 0; my $open_delim; my $close_delim; my $expected_delim; sub html_comments_init { return 0 unless $use_html; # Initialization for C comment context switching $in_comments = 0; $open_delim = '\/\*'; $close_delim = '\*\/'; # Initialize the next expected delim $expected_delim = $open_delim; return 1; } sub leave_html_comments { my ($text) = $_[0]; # Allow HTML in the comments. # my $newtext = ""; my $oldtext = $text; while ($oldtext =~ /(.*$expected_delim)(.*\n)/) { $a = $1; $b = $2; # pay no attention to C++ comments within C comment context if ($in_comments == 0) { $a =~ s//>/g; $expected_delim = $close_delim; $in_comments = 1; } else { $expected_delim = $open_delim; $in_comments = 0; } $newtext = $newtext . $a; $oldtext = $b; } # Handle thre remainder if ($in_comments == 0){ $oldtext =~ s//>/g; } $text = $newtext . $oldtext; # Now fix the breakage of stuff on xfe. -byrd if ($text =~ /(.*)<(.*@.*)>(.*\n)/) { $text = $1 . "$2" . $3; } return $text; }