fdv.cgi #2

#!/usr/local/bin/perl5
# -*- perl -*-
use P4CGI ;
use strict ;
#
#####################################################################
##
##  CONFIGURATION INFORMATION 
##  All config info should be in $configFile (see init() in P4CGI.pm)
##
#####################################################################
##
##  File Diff Viewer
##
#####################################################################

# Set back references
my $homepage="index.cgi";
my $backtohome="Back to Home" ;

# Get filespec argument
my @files = split /,/,P4CGI::cgi()->param("FSPC") ;
&P4CGI::bail("No file specified") unless @files > 0 ;

# Get revision number
my @revs = split / /,P4CGI::cgi()->param("REV") ;
$files[0] =~ s/^([^\#]+)\#(\d+)/$1/ and do { $revs[0] = $2 ; } ;
&P4CGI::bail("No revision specified") unless @revs > 0 ;

# Get action
my @modes ;
@modes = split / /,P4CGI::cgi()->param("ACT") if defined P4CGI::cgi()->param("ACT") ;
&P4CGI::bail("No mode specified") unless @modes > 0 ;

# Get list of restricted files, if any
my @restrict = &P4CGI::RESTRICTED() ;

# Disallow viewing restricted files (single-file case)
if( @files == 1 ) {
  my $file = $files[0] ;
  if( @restrict ) {
    my $restricted ;
    foreach $restricted ( @restrict ) {
      chomp ;
      if ( $file =~ /\/${restricted}/ ) {
	my $legend = "" ;
	print
	  "",
	  &P4CGI::start_page("Diff Output",$legend,$homepage,$backtohome) ;
	print
	  "",
	  "<font color=red>Restricted file:</font>
	   <font color=green> $file</font>",
 	  &P4CGI::end_page() ;
	exit 1 ;
      }
    }
  }
}

# Get diff-file arg and rev, if specified
my @files2 ;
@files2 = 
    split /,/,P4CGI::cgi()->param("FSPC2") if defined P4CGI::cgi()->param("FSPC2") ;
my @revs2 ;
@revs2 = 
    split / /,P4CGI::cgi()->param("REV2") if defined P4CGI::cgi()->param("REV2") ;
if(defined $files2[0]) {
    $files2[0] =~ s/^([^\#]+)\#(\d+)/$1/ and do { $revs2[0] = $2 ; } ;
} ;

my $change = P4CGI::cgi()->param("CH") ;

# Disallow viewing restricted files (multi-file case)
my $skipfile  ;
my @skipfiles ;
my @showfiles ;
my @showrevs  ;
while ( @files ) {
  my $file = shift @files ;
  my $rev = shift @revs ;
  if( @restrict ) {
    my $restricted ;
    foreach $restricted ( @restrict ) {
      chomp ;
      if ( $file =~ /\/${restricted}/ ) {
	push ( @skipfiles, $file ) ; next ;
      }
    }
    if( grep(/${file}/, @skipfiles) ) { next ; }
    else { push ( @showfiles, $file ) ; push ( @showrevs, $rev ) ; }
  }
}


# Associate the files/revs to diff
my $n ;
for($n = 0 ; $n < @showfiles ; $n++) {
    $files2[$n] = $showfiles[$n] unless defined $files2[$n] ;
    $revs2[$n] = $showrevs[$n]-1 unless defined $revs2[$n] ;
}

# Make sure numbers of files and revision numbers match
if((@showfiles != @showrevs) ||
   (@showfiles != @files2)   ||
   (@showfiles != @revs2)) {
	&P4CGI::bail("Argument counts not correct") ;    
}

## Constants for the file diff display
#
# $NCONTEXT - number of context lines before and after a diff
my $NCONTEXT   = P4CGI::cgi()->param("CONTEXT") ;
$NCONTEXT   = 10 unless defined $NCONTEXT ;
#
# $MAXCONTEXT - max number of context lines between diffs
my $MAXCONTEXT = $NCONTEXT+20;

# Put it all together
local *LOG ;
open(*LOG,">>fdv.LOG") ;
print LOG "\n ------------\n" ;

my $title ;
if(@showfiles == 1) {
    if($showfiles[0] eq $files2[0]) {
	if($showrevs[0] < $revs2[0]) {
	    my $r = $revs2[0] ;
	    $revs2[0] = $showrevs[0] ;
	    $showrevs[0] = $r ;
	}
	$title = "Diff Output" ;
    }
    else {
	$title = "Diff Output" ;
    }
}
else {
    $title = "Diff Output" ;
}

my $nextNCONTEXT= $NCONTEXT*2 ;
my $pstr ;
my $p ;
foreach $p (&P4CGI::cgi()->param) {
    next if $p eq "CONTEXT" ;
    if(defined $pstr) {  $pstr .= "&" ; }
    else              {  $pstr = "" ; } ;
    $pstr .= $p . "=" . P4CGI::cgi()->param($p) ;
}
my $moreContext=&P4CGI::ahref($pstr,
			      "CONTEXT=$nextNCONTEXT",
			      "Show more context") ;
my $showWholeFile=&P4CGI::ahref($pstr,
				"CONTEXT=9999999",
				"Show complete file") ;

# Print title and legend
if( $modes[0] ne "NO" ) {
    print
	"",
	&P4CGI::start_page($title,
	&P4CGI::ul_list("<b>Line number:</b> to go to line in file viewer",
			"<hr>",
			"<b>$moreContext:</b> to see more context",
			"<b>$showWholeFile:</b> to see whole file"),
			$homepage,$backtohome) ;
}
else {
    print
	"",
	&P4CGI::start_page($title, "", $homepage, $backtohome) ;
}

my $currentFile ;
my $currentRev ;

local *P4 ;
my $P4lineNo ; 

sub getLine() 
{
    $P4lineNo++ if defined $P4lineNo ;
    return <P4> ;
}

# Print count and list of skipped files
my $skipfile ;
my $skipped = scalar( @skipfiles ) ;
if( $skipped > 0 ) {
  print
    "",
    "Change contains <b>$skipped</b> <font color=red>restricted</font> file",
    $skipped==1 ? "" : "s",
    ".<br>",
    "Not diffed:<br>" ;
  foreach $skipfile ( @skipfiles ) {
    print
      "&nbsp;&nbsp;&nbsp;",
      "<font color=green>$skipfile</font>",
      "<br>" ;
  }
  print
    "<hr>" ;
}
   
# Print diffs
while(@showfiles>0) {

    my $f1start= "<font color=blue>" ;
    my $f1end="</font>" ;
    my $f2start = "<font color=red><strike>" ;
    my $f2end = "</strike></font>" ;
    
    my $showfile   = shift @showfiles ;
    my $file2  = shift @files2 ;
    my $showrev    = shift @showrevs ;
    my $rev2   = shift @revs2 ;
    my $mode   = shift @modes ;

    if($showfile eq $file2) {
	if($showrev < $rev2) {
	    my $r = $rev2 ;
	    $rev2 = $showrev ;
	    $showrev = $r ;
	}
    }
    else {
	$f2start = "<font color=green>" ;
	$f2end = "</font>" ;
    }

    $currentFile = $showfile ;
    $currentRev = $showrev ;

    print
	&P4CGI::start_table("width=100% align=center bgcolor=white"),
	&P4CGI::table_row({-align=>"center",
			   -text =>"<big>$f1start$showfile\#$showrev$f1end<br>$f2start$file2\#$rev2$f2end</big>"}),
	&P4CGI::end_table(),
	"<pre>" ;
	
    my $f1 = "$showfile#$showrev";
    my $f2 = "$file2#$rev2";

    # Use "p4 diff2" to get a list of modifications (diff chunks)
    my $nchunk =0 ; # Counter for diff chunks 
    my @start ;     # Start line for chunk in latest file
    my @dels ;      # No. of deleted lines in chunk
    my @adds ;      # No. of added lines in chunk
    my @delLines ;  # Memory for deleted lines
    
    if ($mode ne 'add' && $mode ne 'delete' && $mode ne 'branch') {
	
	&P4CGI::p4call(*P4, "diff2 \"$f2\" \"$f1\"" );
	$_ = <P4>; 
	while (<P4>) {
	    
	    # Check if line matches start of a diff chunk
	    /(\d+),?(\d*)([acd])(\d+),?(\d*)/  or do { next ; } ;

	    # $la, $lb: start and end line in old (left) file
	    # $op: operation (one of a,d or c)
	    # $ra, $rb: start and end line in new (right) file
	    my ( $la, $lb, $op, $ra, $rb ) = ($1,$2,$3,$4,$5) ;
	    
	    # End lines may have to be calculated
	    if( !$lb ) { $lb = $op ne 'a' ? $la : $la - 1; }
	    if( !$rb ) { $rb = $op ne 'd' ? $ra : $ra - 1; }
	    	
	    my ( $dels, $adds ); # Temporary vars for No of adds/deletes
	    
	    # Calculate start position in new (right) file
	    $start[ $nchunk ] = $op ne 'd' ? $ra : $ra + 1;
	    # Calculate number of deleted lines
	    $dels[ $nchunk ] = $dels = $lb - $la + 1;
	    # Calculate number of added lines
	    $adds[ $nchunk ] = $adds = $rb - $ra + 1;
	    # Init deleted lines 
	    $delLines[ $nchunk ] = "";
	    
	    # Get the deleted lines from the old (left) file
	    while( $dels-- ) {
		$_ = <P4>;
		s/^. //;
		$_ = &P4CGI::fixSpecChar($_) ;
		$delLines[ $nchunk ] .= 
		    "<small>      </small> <font color=red>|</font>$_";
	    }
	    
	    # If it was a change, skip over separator
	    if ($op eq 'c') {	
		$_ = <P4>; 
	    }
	    
	    # Skip over added lines (we don't need to know them yet)
	    while( $adds-- ) {
		$_ = <P4>;
	    }

	    # Next chunk.
	    $nchunk++;
	}	
	close P4;
    }
    
    # Now walk through the diff chunks, reading the new (right) file and
    # displaying it as necessary.

    &P4CGI::p4call(*P4, "print -q \"$f1\"");

    if( $mode eq 'add' ) {
	print "<font color=blue>" ;
	while( <P4> ) {
	    print "<small>      </small> <font color=red>|</font>$_" ;
	}
	print "</font>" ;
    }
    
    $P4lineNo = 0 ;   # Current line    
    my $n ;
    for( $n = 0; $n < $nchunk; $n++ )
    {
	# print up to this chunk.
	&catchup( $start[ $n ] - $P4lineNo - 1 ) ;
	
	# display deleted lines -- we saved these from the diff
	if( $dels[ $n ] )
	{
	    print LOG "PrintDels\n" ;	    
	    print "$f2start";
	    print $delLines[ $n ];
	    print "$f2end";
	}
	
	# display added lines -- these are in the file stream.
	if( $adds[ $n ] )
	{
	    print "$f1start";
	    &display($adds[ $n ]) ;
	    print "$f1end";
	}
	
	# $curlin = $start[ $n ] + $adds[ $n ] ;
    }

    &catchup(999999999) ;

    close P4 ;

    print "</pre>" ;
}

# End the page
print &P4CGI::end_page() ;

# Subroutines for processing diff chunks.
#
# skip: skip lines in source file
# display: display lines in source file, handling funny chars 
# catchup: display & skip as necessary

# skip(<handle>,no of lines)
#    Returns: 0 or number of lines not skipped if file ends
sub skip {
    my $to = shift @_;
    print LOG "skip($to)\n" ; # DEBUG
    while( $to > 0 && ( $_ = &getLine() ) ) {
	$to--;
    }
    return $to;
}

# display(<handle>,no of lines)
#   Displays a number of lines from handle
sub display {
    my $to = shift @_;
    print LOG "display($to)\n" ; # DEBUG
    
    while( $to-- > 0 && ( $_ = &getLine() ) ) {
	my $line = &P4CGI::fixSpecChar($_) ;
	$line = &P4CGI::rmTabs($line) ;
	my $ls ;
	if(($P4lineNo % 5) == 0) {
	    $ls = sprintf("<small>%5d:</small>",$P4lineNo) ;
	    $ls = &P4CGI::ahref(-url=>&P4CGI::FV_URL() . "#L$P4lineNo",
				"FSPC=$currentFile",
				"REV=$currentRev",
				$ls) ;
	}
	else {
	    $ls = "<small>      </small>" ;
	}
	print "$ls <font color=red>|</font>$line" ;
    }
}

# catchup(<handle>,no of lines)
#   Print/skip lines to next diff chunk
sub catchup {
    my $to = shift @_;
    print LOG "catchup($to)\n" ; # DEBUG

    if( $to > $MAXCONTEXT )
    {
	my $skipped = $to - $NCONTEXT ; 
	if($P4lineNo > 0) {		
	    &display($NCONTEXT );
	    $skipped -= $NCONTEXT ;
	}
	$skipped -= &skip($skipped );
	
	print 
	    "<hr><center><strong>",
	    "$skipped lines skipped",
	    "</strong></center><hr>\n" if( $skipped );
	
	&display($NCONTEXT );
    }
    else
    {
	&display($to);
    }
}