[Sandweb-commit] CVS: sandweb/lib/SandWeb Diff.pm,NONE,1.1

[Rob H. <for...@us...>]

Update of /cvsroot/sandweb/sandweb/lib/SandWeb
In directory usw-pr-cvs1:/tmp/cvs-serv7201

Added Files:
	Diff.pm 
Log Message:
checking in current diff code.

please note that this is not integrated with sandweb yet


--- NEW FILE ---
my %args = @_;
my @diff = args{'diff'};

my @rightCol = ();
my @leftCol = ();
my $state;
my $j;
my $tabstop;
my $hr_breakable;
my $string;
my $pr;
my $prcgi;

my $diffcolorHeading='#99BBBB';    # color of 'Line'-heading of each diffed file
my $diffcolorEmpty='#CCCCCC';      # color of 'empty' lines
my $diffcolorAdd='#FF9999';        # Removed line(s) (left)  (  -  )
my $diffcolorChange='#99FF99';     # Changed line(s) (     both    )
my $diffcolorRemove='#CCCCFF';     # Added line(s)   (  - )  (right)
my $diffcolorDarkChange ='#99CC99';# lines, which are empty in change
my $difffontface="Helvetica,Arial";
my $difffontsize="-1";

sub main {
  my($title,$file1,$file2) = @_;

  my($i,$difftxt, $where_nd, $filename, $pathname);

  ($where_nd = my $where) =~ s/.diff$//;
  ($filename = $where_nd) =~ s/^.*\///;
  ($pathname = $where_nd) =~ s/(Attic\/)?[^\/]*$//;
  (my $scriptwhere_nd = my $scriptwhere) =~ s/.diff$//;

  print "\n\n<center><font size=+2 face=Arial>$title</font></center><p>\n";
  print "<table border=0 cellspacing=0 cellpadding=0 width=100%>\n";
  print "<tr bgcolor=#ffffff>\n";
  print "<th width=\"50%\" valign=TOP>";
  print "SAMPLE DATA";
  print "</th>\n";
  print "<th width=\"50%\" valign=TOP>";
  print "SAMPLE DATA2";
  print "</th>\n";

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

  my $leftRow = 0;
  my $rightRow = 0;

  #
  # Process diff text
  #
  foreach my $difftxt (@diff) {
      
      if ($difftxt =~ /^@@/) {
	  my($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;
	  my $state = "dump";
	  $leftRow = 0;
	  $rightRow = 0;
      }
      else {
	  my($diffcode,$rest) = $difftxt =~ /^([-+ ])(.*)/;
	  $_= spacedHtmlText ($rest);
	  
	  # Add fontface, size
	  $_ = "$fs&nbsp;$_$fe";
	  
	  #########
	  # little state machine to parse unified-diff output (Hen, ze...@th...)
	  # 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
		  print  "<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
              flush_diff_rows( \@leftCol, \@rightCol, $leftRow, $rightRow);
	      print  "<tr><td>$_</td><td>$_</td></tr>\n";
	      $state = "dump";
	      $leftRow = 0;
	      $rightRow = 0;
	  }
      }
  }
  flush_diff_rows( \@leftCol, \@rightCol, $leftRow, $rightRow );

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

  print "</table>\n\n";
  print "<br><hr noshade width=100%>\n";

}

sub flush_diff_rows ($$$$)
{
    my $j;
    my ($leftColRef,$rightColRef,$leftRow,$rightRow) = @_;
    if ($state eq "PreChangeRemove") {          # we just got remove-lines before
      for ($j = 0 ; $j < $leftRow; $j++) {
          print  "<tr><td bgcolor=\"$diffcolorRemove\">@$leftColRef[$j]</td>";
          print  "<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
          print  "<tr>";
          if ($j < $leftRow) { print  "<td bgcolor=\"$diffcolorChange\">@$leftColRef[$j]</td>"; }
          else { print  "<td bgcolor=\"$diffcolorDarkChange\">&nbsp;</td>"; }
          if ($j < $rightRow) { print  "<td bgcolor=\"$diffcolorChange\">@$rightColRef[$j]</td>"; }
          else { print  "<td bgcolor=\"$diffcolorDarkChange\">&nbsp;</td>"; }
          print  "</tr>\n";
      }
    }
}

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)(://[-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;
}

&main();