package HTMLDiff;

=head2 rcsdiff(I<file>, I<version1>, I<version2>, I<diffoptions>)

=cut

# make lines breakable so that the columns do not
# exceed the width of the browser
my $hr_breakable = 1;

# give out function names in human readable diffs
# this just makes sense if we have C-files, otherwise
# diff's heuristic doesn't work well ..
# ( '-p' option to diff)
my $hr_funout = 0;

# ignore whitespaces for human readable diffs
# (indendation and stuff ..)
# ( '-w' option to diff)
my $hr_ignwhite = 1;

# ignore diffs which are caused by
# keyword-substitution like $Id - Stuff
# ( '-kk' option to rcsdiff)
my $hr_ignkeysubst = 1;

# Colors and font to show the diff type of code changes
my $diffcolorHeading    = '#99cccc';  # color of 'Line'-head of each diffed file
my $diffcolorEmpty      = '#cccccc';  # color of 'empty' lines
my $diffcolorRemove     = '#ff9999';  # Removed line(s) (left)  (  -  )
my $diffcolorChange     = '#99ff99';  # Changed line(s) (     both    )
my $diffcolorAdd        = '#ccccff';  # Added line(s)   (  - )  (right)
my $diffcolorDarkChange = '#99cc99';  # lines, which are empty in change
my $difffontface        = "Helvetica,Arial";
my $difffontsize        = "-1";

# the width of the textinput of the
# request-diff-form
my $inputTextSize = 12;

sub rcsdiff {
  my ($file, $ver1, $ver2, %args) = (shift, shift, shift);
  diff (DiffCommand => $args{DiffCommand} || 'rcsdiff', DiffOptions => "-r$ver1 -r$ver2", Files => $file, @_);
}

# Table of diff options for the different types
my %diffOptions = (
  'Context diff' => [ qw{ -c } ],
  'Side by Side' => [ qw{--side-by-side --width=164} ],
  'Long HTML' => [ qw{--unified=15} ],
  'HTML' => [ qw{-u} ],
  'Short HTML' => [ qw{--unified=0} ],
  'Unidiff' => [ qw{-u} ]
);

sub diff {
  my %args = (
    DiffCommand => 'diff',
    Type => 'HTML',
    Header => 0,
    IgnoreWhite => 1,
    ShowCFunction => 0,
    IgnoreKeywords => 1,
    ShowContext => 1,
    HTMLEscape => 1,
    DiffOut => [ ],
    @_ 
  );
  @{$args{DiffOptions}} = split(/\s+/, $args{DiffOptions}) 
    unless ref($args{DiffOptions});
  @{$args{DiffOptions}} = (
    @{$diffOptions{$args{Type}}}, 
    (ref $args{DiffOptions}) ? 
      (@{$args{DiffOptions}}) : split(/\s+/, $args{DiffOptions})
  );
  push(@{$args{DiffOptions}}, '-w') if $args{IgnoreWhite};
  push(@{$args{DiffOptions}}, '-p') if $args{FunctionOut};
  push(@{$args{DiffOptions}}, '-kk') if (
    $args{IgnoreKeywords} and $args{DiffCommand} =~ /rcsdiff$/);
  my $command = "$args{DiffCommand} " . join(' ', @{$args{DiffOptions}}) .
    " $args{Files}";
  $command =~ /(.*)/;             # untaint $command
  $command = $1;
  my @output = (@{$args{DiffOut}}) ? @{$args{DiffOut}} : `$command 2>&1`;
  my $formatOut = ($args{Type} =~ /\bHTML\b/);
  my $result;
  if ($args{Header}) {
    $result = "Content-type: " .
      ($formatOut) ? "text/html" : "text/plain" . "\n\n";
  }
  # my $htmlDiffProc = do {local(*HTMLDIFFPROC)};
  if ($formatOut) {
    $result .= human_readable_diff($args{Files}, \@output, 
      $args{ShowContext}, $args{EscapeHTML});
  } else {
    $result .= "@output";
  }
  return $result;
}
  
sub flush_diff_rows ($$$$)
{
    my $j;
    my ($leftColRef,$rightColRef,$leftRow,$rightRow) = @_;
    my $result;
    if ($state eq "PreChangeRemove") {          # we just got remove-lines before
      for ($j = 0 ; $j < $leftRow; $j++) {
          $result .=  "<tr><td bgcolor=\"$diffcolorRemove\">@$leftColRef[$j]</td>";
          $result .=  "<td bgcolor=\"$diffcolorEmpty\">&nbsp;</td></tr>\n";
      }
    }
    elsif ($state eq "PreChange") {             # state eq "PreChange"
      # we got removes with subsequent adds
      for ($j = 0; $j < $leftRow || $j < $rightRow ; $j++) {  # dump out both cols
          $result .=  "<tr>";
          if ($j < $leftRow) {
	      $result .=  "<td bgcolor=\"$diffcolorChange\">@$leftColRef[$j]</td>";
	  }
          else {
	      $result .=  "<td bgcolor=\"$diffcolorDarkChange\">&nbsp;</td>";
	  }
          if ($j < $rightRow) {
	      $result .=  "<td bgcolor=\"$diffcolorChange\">@$rightColRef[$j]</td>";
	  }
          else {
	      $result .=  "<td bgcolor=\"$diffcolorDarkChange\">&nbsp;</td>";
	  }
          $result .=  "</tr>\n";
      }
    }
    return $result;
}

sub human_readable_diff {
  my ($file, $fh, $showContext, $escapeHTML) = (shift, shift, shift, shift);
  my ($r1d, $r1r, $r2d, $r2r, $rev1, $date1, $rev2, $date2);
  foreach (@$fh) {
      ($r1d,$r1r) = /\t(.*)\t(.*)$/ if (/^--- /);
      ($r2d,$r2r) = /\t(.*)\t(.*)$/ if (/^\+\+\+ /);
      last if (/^\+\+\+ /);
  }
  if (defined($r1r) && $r1r =~ /^(\d+\.)+\d+$/) {
    $rev1 = $r1r;
    $date1 = $r1d;
  }
  if (defined($r2r) && $r2r =~ /^(\d+\.)+\d+$/) {
    $rev2 = $r2r;
    $date2 = $r2d;
  }
  
  # print "<h3 align=center>Diff for /$where_nd between version $rev1 and $rev2</h3>\n";
  my ($file1, $file2, $result);
  if (defined $rev1) {
    $result = "<h3 align=center>Diff for $file between version $rev1 and $rev2</h3>\n";
  } else {
    ($file1, $file2) = split /\s+/, $file;
    $result = "<h3 align=center>Diff between $file1 and $file2</h3>\n";
  }
  $result .= "<table border=0 cellspacing=0 cellpadding=0 width=\"100%\">\n";
  $result .= "<tr bgcolor=\"#ffffff\">\n";
  $result .= "<th width=\"50%\" valign=TOP>";
  if (defined $rev1) {
    $result .= "version $rev1";
  } else {
    $result .= $file1;
  }
  $result .= ", $date1" if (defined($date1));
  # print "<br>Tag: $sym1\n" if ($sym1);
  $result .= "</th>\n";
  $result .= "<th width=\"50%\" valign=TOP>";
  if (defined $rev2) {
    $result .= "version $rev2";
  } else {
    $result .= $file2;
  }
  $result .= ", $date2" if (defined($date2));
  # print "<br>Tag: $sym2\n" if ($sym1);
  $result .= "</th>\n";

  my $fs = "<font face=\"$difffontface\" size=\"$difffontsize\">";
  my $fe = "</font>";

  my $leftRow = 0;
  my $rightRow = 0;
  my ($oldline, $newline, $funname, $diffcode, $rest);
  # Process diff text
  # The diffrows are could make excellent use of
  # cascading style sheets because we've to set the
  # font and color for each row. anyone ...?
  ####
  foreach (@$fh) {
      $difftxt = $_;
      
      if ($difftxt =~ /^@@/) {
	  ($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;
          $result .=  "<tr bgcolor=\"$diffcolorHeading\"><td width=\"50%\">";
	  $result .=  "<table width=\"100%\" border=1 cellpadding=5><tr><td><b>Line $oldline</b>";
	  $result .=  "&nbsp;<font size=-1>$funname</font></td></tr></table>";
          $result .=  "</td><td width=\"50%\">";
	  $result .=  "<table width=\"100%\" border=1 cellpadding=5><tr><td><b>Line $newline</b>";
	  $result .=  "&nbsp;<font size=-1>$funname</font></td></tr></table>";
	  $result .=  "</td>\n";
	  $state = "dump";
	  $leftRow = 0;
	  $rightRow = 0;
      }
      else {
	  ($diffcode,$rest) = $difftxt =~ /^([-+ ])(.*)/;
	  $_ = ($escapeHTML) ? spacedHtmlText ($rest) : $rest;

	  # Add fontface, size
	  $_ = "$fs&nbsp;$_$fe";
	  
	  #########
	  # little state machine to parse unified-diff output (Hen, zeller@think.de)
	  # in order to get some nice 'ediff'-mode output
	  # states:
	  #  "dump"             - just dump the value
	  #  "PreChangeRemove"  - we began with '-' .. so this could be the start of a 'change' area or just remove
	  #  "PreChange"        - okey, we got several '-' lines and moved to '+' lines -> this is a change block
	  ##########

	  if ($diffcode eq '+') {
	      if ($state eq "dump") {  # 'change' never begins with '+': just dump out value
		  $result .=  "<tr><td bgcolor=\"$diffcolorEmpty\">&nbsp;</td><td bgcolor=\"$diffcolorAdd\">$_</td></tr>\n";
	      }
	      else {                   # we got minus before
		  $state = "PreChange";
		  $rightCol[$rightRow++] = $_;
	      }
	  } 
	  elsif ($diffcode eq '-') {
	      $state = "PreChangeRemove";
	      $leftCol[$leftRow++] = $_;
        }
        else {  # empty diffcode
            $result .= flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;
	      $result .=  "<tr><td>$_</td><td>$_</td></tr>\n" if $showContext;
	      $state = "dump";
	      $leftRow = 0;
	      $rightRow = 0;
	  }
      }
  }
  $result .= flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;

  # state is empty if we didn't have any change
  if (!$state) {
      $result .= "<tr><td colspan=2>&nbsp;</td></tr>";
      $result .= "<tr bgcolor=\"$diffcolorEmpty\" >";
      $result .= "<td colspan=2 align=center><b>- No viewable Change -</b></td></tr>";
  }
  $result .=  "</table>";
  # close($fh);

  $result .= "<br><hr noshade width=\"100%\">\n";

  $result .= "<table border=0>";

  $result .= "<tr><td>";
  # print legend
  $result .= "<table border=1><tr><td>";
  $result .=  "Legend:<br><table border=0 cellspacing=0 cellpadding=1>\n";
  if (defined $rev1) {
    $result .=  "<tr><td align=center bgcolor=\"$diffcolorRemove\">Removed from v.$rev1</td><td bgcolor=\"$diffcolorEmpty\">&nbsp;</td></tr>";
  } else {
    $result .=  "<tr><td align=center bgcolor=\"$diffcolorRemove\">Removed from $file1</td><td bgcolor=\"$diffcolorEmpty\">&nbsp;</td></tr>";
  }
  $result .=  "<tr bgcolor=\"$diffcolorChange\"><td align=center colspan=2>changed lines</td></tr>";
  if (defined $rev2) {
    $result .=  "<tr><td bgcolor=\"$diffcolorEmpty\">&nbsp;</td><td align=center bgcolor=\"$diffcolorAdd\">Added in v.$rev2</td></tr>";
  } else {
    $result .=  "<tr><td bgcolor=\"$diffcolorEmpty\">&nbsp;</td><td align=center bgcolor=\"$diffcolorAdd\">Added in $file2</td></tr>";
  }
  $result .=  "</table></td></tr></table>\n";

  # print "<td>";
  # Print format selector
  # print "<FORM METHOD=\"GET\" ACTION=\"${scriptwhere}\">\n";
  # foreach my $var (keys %input) {
  #   next if ($var eq "f");
  #  next if (defined($DEFAULTVALUE{$var})
  # 	     && $DEFAULTVALUE{$var} eq $input{$var});
  #    print "<INPUT TYPE=HIDDEN NAME=\"",urlencode($var),"\" VALUE=\"",
  # 	    urlencode($input{$var}),"\">\n";
  #  }
  # printDiffSelect();
  # print "<INPUT TYPE=SUBMIT VALUE=\"Show\">\n";
  # print "</FORM>\n";
  # print "</td>";

  $result .= "</tr></table>\n";
  return $result;
}


sub spacedHtmlText {
	my($string, $pr) = @_;

	# Cut trailing spaces
	s/\s+$//;

	# Expand tabs
	$string =~ s/\t+/' ' x (length($&) * $tabstop - length($`) % $tabstop)/e
	    if (defined($tabstop));

	# replace <tab> and <space> (§ is to protect us from htmlify)
	# gzip can make excellent use of this repeating pattern :-)
	$string =~ s/§/§%/g; #protect our & substitute
	if ($hr_breakable) {
	    # make every other space 'breakable'
	    $string =~ s/	/ §nbsp; §nbsp; §nbsp; §nbsp;/g;    # <tab>
	    $string =~ s/  / §nbsp;/g;                              # 2 * <space>
	    # leave single space as it is
	}
	else {
	    $string =~ s/	/§nbsp;§nbsp;§nbsp;§nbsp;§nbsp;§nbsp;§nbsp;§nbsp;/g; 
	    $string =~ s/ /§nbsp;/g;
	}

	$string = htmlify($string);

	# unescape
	$string =~ s/§([^%])/&$1/g;
	$string =~ s/§%/§/g;

	return $string;
}
 
  
sub htmlify {
	my($string, $pr) = @_;

	# Special Characters; RFC 1866
	$string =~ s/&/&amp;/g;
	$string =~ s/\"/&quot;/g; 
	$string =~ s/</&lt;/g;
	$string =~ s/>/&gt;/g;

	# get URL's as link ..
	$string =~ s§(http|ftp|https)(://[-a-zA-Z0-9%.~:_/]+)([?&]([-a-zA-Z0-9%.~:_]+)=([-a-zA-Z0-9%.~:_])+)*§<A HREF="$1$2$3">$1$2$3</A>§;
	# get e-mails as link
	$string =~ s§([-a-zA-Z0-9_.]+@([-a-zA-Z0-9]+\.)+[A-Za-z]{2,4})§<A HREF="mailto:$1">$1</A>§;

	# get #PR as link ..
	if ($pr && defined($prcgi)) {
	    $string =~ s!\b((pr[:#]?\s*#?)|((bin|conf|docs|gnu|i386|kern|misc|ports)\/))(\d+)\b!<A HREF="$prcgi?pr=$5">$&</A>!ig;
	}

	return $string;
}

1;