#!/usr/bonsaitools/bin/perl -w # -*- Mode: perl; indent-tabs-mode: nil -*- # cvsview.cgi - fake up some HTML based on RCS logs and diffs # # The contents of this file are subject to the Netscape Public # License Version 1.1 (the "License"); you may not use this file # except in compliance with the License. You may obtain a copy of # the License at http://www.mozilla.org/NPL/ # # Software distributed under the License is distributed on an "AS # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or # implied. See the License for the specific language governing # rights and limitations under the License. # # The Original Code is the Bonsai CVS tool. # # The Initial Developer of the Original Code is Netscape Communications # Corporation. Portions created by Netscape are # Copyright (C) 1998 Netscape Communications Corporation. All # Rights Reserved. # # Contributor(s): # brendan and fur # # TODO in no particular order: # - Mocha-automate the main page's form so clicking on rev links in the table # change the default filename and revisions. # - Add a tab width input to the main page's form. # - Include log message in wasted horizontal real-estate of Shortcuts frame. # - Make old and new diff lines go to separate, side-by-side frames, and use # Mocha to slave their scrollbars together. # - Allow expansion of the top-level table to include the revision histories # of all the files in the directory. # - More more more xdiff/gdiff-like features... # # # SRCROOTS is an array of repository roots under which to look for CVS files. # use diagnostics; use strict; use CGI; # Shut up misguided -w warnings about "used only once". "use vars" just # doesn't work for me. sub sillyness { my $zz; $zz = $::TreeInfo; $zz = $::TreeList; $zz = $::file_description; $zz = $::principal_branch; $zz = $::revision_ctime; $zz = %::timestamp; } my $request = new CGI; sub http_die { print $request->header(); die (@_); } my $anchor_num = 0; my $font_tag = ""; # Figure out which directory bonsai is in by looking at argv[0] my $bonsaidir = $0; $bonsaidir =~ s:/*[^/]*$::; # Remove last word and any slashes if ($bonsaidir eq '') { $bonsaidir = '.'; } chdir $bonsaidir || http_die "Can't chdir to $bonsaidir"; require 'CGI.pl'; my $cocommand = Param('cocommand'); my $rcsdiffcommand = Param('rcsdiffcommand'); LoadTreeConfig(); my @SRCROOTS; NEXTTREE: foreach my $i (@::TreeList) { my $r = $::TreeInfo{$i}->{'repository'}; foreach my $j (@SRCROOTS) { if ($r eq $j) { next NEXTTREE; } } push @SRCROOTS, $r; } my $debug = 0; my $MAX_REVS = 8; # # Make sure both kinds of standard output go to STDOUT. # XXX dup stdout onto stderr and flush stdout after the following prints # # Until then, replace standard die built-in with our own. # sub die { # print 'fatal error: '; # print @_; # exit; # } require 'cvsblame.pl'; # # Print HTTP content-type header and the header-delimiting extra newline. # my $request_method = $request->request_method(); # e.g., "GET", "POST", etc. my $script_name = $ENV{'SCRIPT_NAME'}; my $prefix = $script_name . '?'; # prefix for HREF= entries $prefix = $script_name . $ENV{PATH_INFO} . '?' if (exists($ENV{PATH_INFO})); # Parse options in URL. For example, # http://w3/cgi/cvsview.pl?subdir=foo&file=bar would assign # $opt_subdir = foo and $opt_file = bar. my $opt_rev1 = $request->param('rev1'); my $opt_rev2 = $request->param('rev2'); my $opt_root = $request->param('root'); my $opt_files = $request->param('files'); my $opt_skip = $request->param('skip') || 0; my $opt_diff_mode = $request->param('diff_mode') || 'context'; my $opt_whitespace_mode = $request->param('whitespace_mode') || 'show'; my $opt_file = $request->param('file'); my $opt_rev = $request->param('diff_mode'); my $opt_subdir = $request->param('subdir'); my $opt_branch = $request->param('branch'); my $opt_command = $request->param('command'); if (defined($opt_branch) && $opt_branch eq 'HEAD' ) { $opt_branch = ''; } # Configuration colors for diff output. my $stable_bg_color = 'White'; my $skipping_bg_color = '#c0c0c0'; my $header_bg_color = 'Orange'; my $change_bg_color = 'LightBlue'; my $addition_bg_color = 'LightGreen'; my $deletion_bg_color = 'LightGreen'; my $diff_bg_color = 'White'; # Ensure that necessary arguments are present http_die("command not defined in URL\n") if $opt_command eq ''; http_die("command $opt_command: subdir not defined\n") if $opt_subdir eq ''; if ($opt_command eq 'DIFF' || $opt_command eq 'DIFF_FRAMESET' || $opt_command eq 'DIFF_LINKS') { http_die("command $opt_command: file not defined in URL\n") if $opt_file eq ''; http_die("command $opt_command: rev1 not defined in URL\n") if $opt_rev1 eq ''; http_die("command $opt_command: rev2 not defined in URL\n") if $opt_rev2 eq ''; } # Propagate diff options to created links $prefix .= "diff_mode=$opt_diff_mode"; $prefix .= "&whitespace_mode=$opt_whitespace_mode"; $prefix .= "&root=$opt_root"; # Create a shorthand for the longest common initial substring of our URL. my $magic_url = "$prefix&subdir=$opt_subdir"; # Now that we've munged QUERY_STRING into perl variables, set rcsdiff options. my $rcsdiff = "$rcsdiffcommand -f"; $rcsdiff .= ' -w' if ($opt_whitespace_mode eq 'ignore'); # Handle the "root" argument # my $root = $opt_root; if (defined $root && $root ne '') { $root =~ s|/$||; if (-d $root) { unshift(@SRCROOTS, $root); } else { print "Error: Root, $root, is not a directory.
\n"; print "\n"; exit; } } my $found = 0; my $dir; foreach $root (@SRCROOTS) { $dir = "$root/$opt_subdir"; if (-d $dir) { $found = 1; last; } } if (!$found) { print "Error: $opt_subdir not found."; exit; } sub http_lastmod { &parse_cvs_file($dir.'/'.$opt_file.',v'); my $lm=str2time($::revision_ctime{$opt_rev1}); my $lm2=str2time($::revision_ctime{$opt_rev2}); $lm = $lm2 if $lm2 > $lm; print "Last-Modified: ".time2str("%a, %d %b %Y %T %Z", $lm, "GMT")."\n"; print $request->header(); print "\n"; } # Create top-level frameset document. sub do_diff_frameset { chdir($dir); http_lastmod; print "$opt_file: $opt_rev1 vs. $opt_rev2\n"; print "\n"; print " \n"; print " \n"; print "\n"; } # Create links to document created by DIFF command. sub do_diff_links { http_lastmod; print qq% $opt_file: $opt_rev1 vs. $opt_rev2 %; CheckHidden("$dir/$opt_file"); chdir($dir); open(RCSDIFF, "$rcsdiff -r$opt_rev1 -r$opt_rev2 $opt_file 2>/dev/null |"); print '
'; my $diff_base = "cvsview2.cgi"; my $blame_base = "cvsblame.cgi"; my $lxr_path = "$opt_subdir/$opt_file"; my $lxr_link = Fix_LxrLink($lxr_path); # Partial fix for bug 104313, which tries to fix blame links to be more intuitive. # In this case, make the default behavior be that blame revisions match the requested # diff version, rather than always showing the tip. my $blame_link = "$blame_base?file=$opt_subdir/$opt_file&rev=$opt_rev2"; $blame_link .= "&root=$opt_root" if defined($opt_root); my $diff_link = "$magic_url&command=DIRECTORY&file=$opt_file&rev1=$opt_rev1&rev2=$opt_rev2"; $diff_link .= "&root=$opt_root" if defined($opt_root); my $graph_row = Param('cvsgraph') ? <<"--endquote--" : ""; --endquote-- print ""; print ""; print ""; print "
graph: View the revision tree as a graph
"; print ""; print ""; print "\n"; print ""; print "\n"; print ""; print "\n"; print $graph_row; print "
diff: Change diff parameters.
blame:Annotate line authors.
lxr: Browse source as hypertext.
"; print "
"; print ""; print "
"; print ""; print "
"; $anchor_num = 0; while () { # Get one command from the diff file my $line = ""; if (/^(c|a)(\d+)/) { $line = $2; while () { last if /^\.$/; } } elsif (/^d(\d+)/) { $line = $1; } else { print "Internal error:", " unknown command $_", " at $. in $opt_file $opt_rev1\n"; } print ' ' x (4 - length($line)); print "$line "; $anchor_num++; } close(RCSDIFF); print '
'; print "
\n"; } # Default tab width, although it's frequently 4. my $tab_width = 8; sub next_tab_stop { my ($pos) = @_; return int(($pos + $tab_width) / $tab_width) * $tab_width; } # # Look for the magic emacs tab width comment, or for long lines with more # than 4 leading tabs in more than 50% of the lines that start with a tab. # In the latter case, set $tab_width to 4. # sub guess_tab_width { my ($opt_file) = @_; my ($found_tab_width) = 0; my ($many_tabs, $any_tabs) = (0, 0); open(RCSFILE, "$opt_file"); while () { if (/tab-width: (\d)/) { $tab_width = $1; $found_tab_width = 1; last; } if (/^(\t+)/) { $many_tabs++ if (length($1) >= 4); $any_tabs++; } } if (!$found_tab_width && $many_tabs > $any_tabs / 2) { $tab_width = 4; } close(RCSFILE); } # Create gdiff-like output. sub do_diff { http_lastmod; print ""; print "$opt_file: $opt_rev1 vs. $opt_rev2\n"; print ""; print ""; CheckHidden("$dir/$opt_file"); chdir($dir); my ($rcsfile) = "$opt_file,v"; $rcsfile = "Attic/$opt_file,v" if (! -r $rcsfile); &guess_tab_width($rcsfile); &html_diff($rcsfile, $opt_rev1, $opt_rev2); print "\n\n"; } # Show specified CVS log entry. sub do_log { http_lastmod; print "$opt_file: $opt_rev CVS log entry\n"; print '
';

    CheckHidden("$dir/$opt_file");

    chdir($dir);

    open(RCSLOG, "rlog -r$opt_rev $opt_file |");

    while () {
        last if (/^revision $opt_rev$/);
    }

    while () {
        last if (/^===============================================/);
        print "$_
"; } close(RCSLOG); print '
'; } # # Main script: generate a table of revision diff and log message hotlinks # for each modified file in $opt_subdir, and a form for choosing a file and any # two of its revisions. # sub do_directory { print $request->header(); my $output = "
"; my $link_path = ""; foreach my $path (split('/',$opt_subdir)) { $link_path .= $path; $output .= "$path/ "; $link_path .= '/'; } chop ($output); if ($opt_branch) { $output .= "
Branch: $opt_branch"; } $output .= "
"; PutsHeader("CVS Differences", $output); CheckHidden($dir); chdir($dir); print "\n"; foreach my $file (split(/\+/, $opt_files)) { my ($path) = "$dir/$file,v"; CheckHidden($path); $path = "$dir/Attic/$file,v" if (! -r $path); &parse_rcs_file($path); my $lxr_path = "$opt_subdir/$file"; my $lxr_link = Fix_LxrLink($lxr_path); print "\n"; my $first_rev; if ($opt_branch) { $first_rev = &map_tag_to_revision($opt_branch); http_die("$0: error: -r: No such revision: $opt_branch\n") if ($first_rev eq ''); } else { $first_rev = $::head_revision; } my $skip = $opt_skip; my $revs_remaining = $MAX_REVS; my $prev; for (my $rev = $first_rev; $rev; $rev = $prev) { $prev = $::prev_revision{$rev}; next if $skip-- > 0; if (!$revs_remaining--) { #print '\n"; last; } my $href_open = ""; my $href_close = ""; if ( $prev && $rev ) { $href_open = ""; $href_close = ""; } print ""; } print "\n"; if (0) { print "\n"; $skip = $opt_skip; $revs_remaining = $MAX_REVS; for (my $rev = $first_rev; $rev; $rev = $::prev_revision{$rev}) { next if $skip-- > 0; last if !$revs_remaining--; print "\n"; } print "\n";} } print "
"; print "$file
"; print "Change Log
'; print ''; print "Prior revisions", "$href_open$rev$href_close
"; print "$::revision_author{$rev}
$::revision_author{$rev}", "
\n"; print '
'; print ''; print ""; print 'New Query:'; print '
    '; # pick something remotely sensible to put in the "Filename" field. my $file = $opt_file; unless (defined $opt_rev1) { $opt_rev1 = ''; } unless (defined $opt_rev2) { $opt_rev2 = ''; } if ( !$file && $opt_files ) { $file = $opt_files; $file =~ s@\+.*@@; } print "\n
    \n", 'Filename:', '', '', "\n
    \n", 'Old version:', '', '', "\n
    \n", 'New version:', '', '', "\n
    \n"; print '
    ', '', ' Show Whitespace', '
    ', ' Ignore Whitespace', '
    ', '', ' Context Diffs', '
    ', ' Full Source Diffs'; print '
    '; print "\n"; print '
'; print "
\n"; &print_bottom; } # # This function generates a gdiff-style, side-by-side display using HTML. # It requires two arguments, each of which must be an open filehandle. # The first filehandle, DIFF, must be a `diff -f` style output containing # commands to convert the contents of the second filehandle, OLDREV, into # a later version of OLDREV's file. # sub html_diff { my ($file, $rev1, $rev2) = @_; my ($old_line_num) = 1; my ($old_line); my ($point, $mark); open(DIFF, "$rcsdiff -f -r$rev1 -r$rev2 $file 2>/dev/null |"); open(OLDREV, "$cocommand -p$rev1 $file 2>/dev/null |"); $anchor_num = 0; if ($ENV{'HTTP_USER_AGENT'} =~ /Win/) { $font_tag = "
";
    } else {
        # We don't want your stinking Windows font
        $font_tag = "
";
    }
    print "';
    print "";
    while () {
        $mark = 0;
        if (/^a(\d+)/) {
            $point = $1;
            $old_line_num = skip_to_line($point + 1, $old_line_num);
            while () {
                last if (/^\.$/);
                &print_row('', $stable_bg_color, $_, $addition_bg_color);
            }
        } elsif ((($point, $mark) = /^c(\d+) (\d+)$/) ||
                 (($point) = /^c(\d+)$/)) {
            $mark = $point if (!$mark);
            $old_line_num = skip_to_line($point, $old_line_num);
            while () {
                last if (/^\.$/);
                if ($old_line_num <= $mark) {
                    $old_line = ;
                    $old_line_num++;
                } else {
                    $old_line = ''
                }
                &print_row($old_line, $change_bg_color, $_, $change_bg_color);
            }
            while ($old_line_num <= $mark) {
                $old_line = ;
                $old_line_num++;
                &print_row($old_line, $change_bg_color, '', $change_bg_color);
            }
        } elsif ((($point, $mark) = /^d(\d+) (\d+)$/) ||
                 (($point) = /^d(\d+)$/)) {
            $mark = $point if (!$mark);
            $old_line_num = skip_to_line($point, $old_line_num);
            while (1) {
                $old_line = ;
                last unless defined $old_line;
                $old_line_num++;
                &print_row($old_line, $deletion_bg_color, '', $stable_bg_color);
                last if ($. == $mark);
            }
        } else {
            print "
Version $rev1Version $rev2
Internal error:", " unknown command $_", " at $. in $opt_file $opt_rev1\n"; exit; } } # # Print the remaining lines in the original file. These are lines that # were not modified in the later revision # my ($base_old_line_num) = $old_line_num; while (1) { $old_line = ; last unless defined $old_line; $old_line_num++; &print_row($old_line, $stable_bg_color, $old_line, $stable_bg_color) if ($opt_diff_mode eq 'full' || $old_line_num <= $base_old_line_num + 5); } # print "
\n"; print "
\n"; &print_bottom; close(OLDREV); close(DIFF); } sub skip_to_line { my ($line_num, $old_line_num); ($line_num, $old_line_num) = @_; my ($anchor_printed) = 0; my ($skip_line_printed) = ($line_num - $old_line_num <= 10); my ($base_old_line_num) = $old_line_num; while ($old_line_num < $line_num) { if (!$anchor_printed && $old_line_num >= $line_num - 10) { print ""; $anchor_printed = 1; } if ($opt_diff_mode eq 'context' && !$skip_line_printed && $line_num - 5 <= $old_line_num) { print ""; print "'; print ""; $line1 = "" unless defined $line1; $line2 = "" unless defined $line2; &print_cell($line1, $color1); &print_cell($line2, $color2); } sub print_bottom { my $maintainer = Param('maintainer'); print <<__BOTTOM__;

", "Skipping to line $old_line_num: "; $skip_line_printed = 1; } my $old_line = ; $old_line_num++; &print_row($old_line, $stable_bg_color, $old_line, $stable_bg_color) if ($opt_diff_mode eq 'full' || $old_line_num <= $base_old_line_num + 5 || $line_num - 5 < $old_line_num); } print "" if (!$anchor_printed); print ''; $anchor_num++; return $old_line_num; } sub print_cell { my ($line, $color) = @_; my ($i, $j, $k, $n); my ($c, $newline); if ($color eq $stable_bg_color) { print "$font_tag"; } else { print "$font_tag"; } chomp $line; $n = length($line); $newline = ''; for ($i = $j = 0; $i < $n; $i++) { $c = substr($line, $i, 1); if ($c eq "\t") { for ($k = &next_tab_stop($j); $j < $k; $j++) { $newline .= ' '; } } else { $newline .= $c; $j++; } } $newline =~ s/\s+$//; if (length($newline) <= 80) { $newline = sprintf("%-80.80s", $newline); } else { $newline =~ s/([^\n\r]{80})([^\n\r]*)/$1\n$2/g; } $newline =~ s/&/&/g; $newline =~ s//>/g; print $newline; } sub print_row { my ($line1, $color1, $line2, $color2) = @_; print "

  Mail feedback and feature requests to $maintainer.  
__BOTTOM__ } # print_bottom sub do_cmd { if ($opt_command eq 'DIFF_FRAMESET') { do_diff_frameset; } elsif ($opt_command eq 'DIFF_LINKS') { do_diff_links; } elsif ($opt_command eq 'DIFF') { do_diff; } elsif ($opt_command eq 'LOG') { do_log; } elsif ($opt_command eq 'DIRECTORY') { do_directory; } else { print "invalid command \"$opt_command\"."; } exit; } do_cmd;