#!/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 "Expires: ".time2str("%a, %d %b %Y %T %Z", time+1200, "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 qq| $opt_file: $opt_rev1 vs. $opt_rev2 |; 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 qq| |; } # 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;