#!/usr/bin/perl
###########################################
# hd - Diff files side by side in HTML
# Derived from 'hdiff' (Bonsai team)
# Mike Schilli, 2002 (mschilli1@aol.com)
###########################################
use warnings;
use strict;

use SDiff qw(sdiff);
use CGI qw(:all *table *font *pre);
use CGI::Carp qw(fatalsToBrowser);
use File::Basename;
use Set::IntSpan;
use Text::Wrap;

$| = 1;

my $CVS_COMMAND = "/usr/bin/cvs";
my @CVSROOTS = (
  ["/home/mschilli/CVSROOT", 
   "My Local CVS"],
  [":pserver:anonymous\@anoncvs.gimp.org:" .
   "/cvs/gnome", 
   "Gimp"],
  [":pserver:mschilli\@east." .
   "bla.com:/data/cvs/host", 
   "Server"]);

my $STABLE_BG_COLOR   = "White";
my $ALT_BG_COLOR      = "#f0f0f0";
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";
my @MODES = (
    [file => "Compare Two Files"],
    [cvs  => "Compare Two CVS revisions"], 
    [chi  => "Compare before Check-In"]);
my $CONTEXT      = 5;
my $MAX_LINE_LEN = 80;

print header();

if(param("cfg") or !param("mode")) {
    # Display config page
    config_page();
    exit 0;
}

my($h1, $h2, $left, $right, $n,
   @run_list, $nof_lines, $ver);

my $cvsroot = 
     (param("aroot") || param("cvsroot"));

if(param("mode") eq "file") {
        # Compare two files
    $h1 = basename(param("f1"));
    $h2 = basename(param("f2"));

    ($left)  = readfile(file => 
                       param("f1"));
    ($right) = readfile(file => 
                       param("f2"));

} elsif(param("mode") eq "chi") {
        # Compare a local version with CVS
    ($left, $ver) = readfile(
        lpath   => param('path'),
        cvsroot => $cvsroot);

    my $filename = basename(param("path"));
    $h1 = "$filename (CVS $ver)";
    $h2 = "$filename (local copy)";

    ($right) = readfile(
        file   => param('path'));

} elsif(param("mode") eq "cvs") {
        # Compare two CVS versions
    my $f = basename(param("path"));
    $h1 = "$f (CVS " . param("r1") . ")";
    $h2 = "$f (CVS " . param("r2") . ")";

    ($left)  = readfile(
       cvsroot => $cvsroot,
       rpath   => param("path"),
       rev     => param("r1"));
    ($right) = readfile(
       cvsroot => $cvsroot,
       rpath   => param("path"),
       rev     => param("r2"));
}

chomp @$left;
chomp @$right;

my $set = Set::IntSpan->new();

my $diffs = sdiff($left, $right, \$set, 
                  $CONTEXT);
$nof_lines = @$diffs;

if(param("context")) {
    @run_list = split /,/, 
                      $set->run_list();
    @run_list = () if $set->empty();
} else {
    @run_list = ("0-$#$diffs");
}

print start_html( {BGCOLOR => 
                   $STABLE_BG_COLOR,
                   -title => 
                   param("comment")});

param("cfg" => 1);
print a({href => self_url}, "Configure");

print start_table( {BGCOLOR     => 
                          $STABLE_BG_COLOR,
                    RULES       => "all",
                    CELLPADDING => 0,
                    CELLSPACING => 0,
                    COLS        => 2}
                 );

print TR( {BGCOLOR => $DIFF_BG_COLOR}, 
          th( {colspan => 2}, 
              param("comment")) );
print TR( {BGCOLOR => $HEADER_BG_COLOR}, 
          th($h1), th($h2) );

my $cur_idx = 0;

while(@$diffs or @run_list) {

    my($from, $to);

    if(@run_list) {
        ($from, $to) = split /-/, 
                           shift @run_list;
    }

    if(!defined $from) {
        # Skip until the end
        $cur_idx = skip($diffs, $cur_idx, 
                            $nof_lines-1);
        last;
    }
        # Just one line? 
    $to = $from unless defined $to;

    if($cur_idx < $from) {
        # There are lines to skip
        $cur_idx = skip($diffs, $cur_idx, 
                        $from-1);
    }

    for($cur_idx..$to) {
        my $e = shift @$diffs;
        my($left, $right, $mod) = @$e;
        $cur_idx++;

        my $color =
         $mod eq "c" ? $CHANGE_BG_COLOR : 
         $mod eq "i" ? $ADDITION_BG_COLOR :
         $mod eq "d" ? $DELETION_BG_COLOR :
         $mod eq "u" ? $STABLE_BG_COLOR : 
                 "unknown";

        $n = sprintf "%2d", $cur_idx;

        $color = $ALT_BG_COLOR if 
               $mod eq "u" 
               and param("striped") 
               and $n % 2;

        print TR({BGCOLOR => $color}, 
                 td({align => "left"}, 
                    type("$n $left")),
                 td({align => "left"}, 
                    type("$n $right")));
    
        print "\n";
    }
}

print end_table();
param("cfg", "1");
print a({href => self_url}, "Configure");
print end_html();

###########################################
sub skip {
###########################################
    my($diffs, $cur_idx, $to) = @_;

    if($to-$cur_idx > 2*$CONTEXT) {
        print TR( {BGCOLOR => 
                   $SKIPPING_BG_COLOR}, 
                  td( { COLSPAN => 2 }, 
                      b("Skipping lines ", 
                        $cur_idx + 1,
                        "...", $to + 1)));
        splice @$diffs, 0, $to-$cur_idx+1;
        $cur_idx = $to+1;
    }

    return $cur_idx;
}

###########################################
sub readfile {
###########################################
    my (%opts) = @_;

    my $cmd;

        # Local file
    if(exists $opts{file}) {
        $cmd = "<$opts{file}";
    } else {
            # Get latest CVS version
        if(!exists $opts{rev}) {
            cvs_fill_in(\%opts);
        }
            # Get file
        $cmd = "$CVS_COMMAND -Q -d " . 
         "$opts{cvsroot} co -r " .
         "$opts{rev} -p $opts{rpath} |";
    }

    open F, "$cmd" or 
                  die "Cannot open '$cmd'";
    my @data = <F>;
    close F or die "$cmd failed";
    return (\@data, $opts{rev});
}

###########################################
sub cvs_fill_in {
###########################################
    my ($opts) = @_;

        # Get path within CVS/working path
    my $rep = dirname($opts->{lpath}) .
              "/CVS/Repository";
    open FILE, "<$rep" or 
          die "Cannot open $rep";
    chomp($opts->{rpath} = <FILE>);
    $opts->{rpath} .= "/" . 
                 basename($opts->{lpath});
    close FILE;

        # Get cvs version
    my $wdir = dirname($opts->{lpath});
    chdir $wdir or 
              die "Cannot chdir to $wdir";

    my $cmd = "$CVS_COMMAND -Q -d " .
          "$opts->{cvsroot} status " .
          basename($opts->{lpath}) .
          " 2>/dev/null";
    open PIPE, "$cmd |" or 
         die "Cannot open pipe";
    my $data = join '', <PIPE>;
    close PIPE or die "$cmd failed";
    ($opts->{rev}) = $data =~ 
    /Repository revision:\s*([\d\.]+)/;
}

###########################################
sub config_page {
###########################################
    print h1("Configuration");

    my $checked = "";
    my $current_mode = (param("mode") || 
                       "file");
    for (@MODES) {
        my ($mode, $text) = @$_;
        if($mode eq $current_mode) {
            print b($text);
        } else {
            param("mode", $mode);
            param("cfg", 1);
            print a({href => self_url}, 
                    $text);
        }
        print "&nbsp;\n";
    }

        # Set it back to current mode
    param("mode", $current_mode);
    param("cfg", undef);

    print start_html( {BGCOLOR => 
                       $STABLE_BG_COLOR} );
    print start_form(-method => "GET");
    print start_table({BGCOLOR => 
                       $ALT_BG_COLOR});

    if($current_mode eq "file") {
        print TR(td("File 1"), 
               td(textfield(-name => "f1", 
                            -size => 50)));
        print TR(td("File 2"), 
               td(textfield(-name => "f2", 
                            -size => 50)));

    } elsif($current_mode eq "chi") {
        display_cvs_form();

        print TR(td("Local Path and File"), 
             td(textfield(-name => "path", 
                          -size => 50)));

    } elsif($current_mode eq "cvs") {

        display_cvs_form();

        print TR(
           td("Path to file within CVS"), 
           td(textfield(-name => "path", 
                        -size => 50)));

        print TR(td("Rev 1"), 
           td(textfield(-name => "r1", 
                        -size => 10)));
        print TR(td("Rev 2"), 
               td(textfield(-name => "r2", 
                            -size => 10)));
    }

    print TR(td("Comment"), 
           td(textfield(-name => "comment", 
                        -size => 50)));
    print end_table();
    print hidden(-name => "mode");
    print checkbox(-name => "striped", 
                   -value => "on");
    print checkbox(-name => "context", 
                   -value => "on");
    print br();
    print submit(value => "View Diff");

    print end_form();
}

###########################################
sub type { 
###########################################

    @_ = map { s/&/&amp;/g;
               s/</&lt;/g; s/>/&gt;/g;
               $_ } @_;

    $Text::Wrap::columns = $MAX_LINE_LEN;
    $_[0] = join "\n", wrap("", "", $_[0]);

    return start_pre() .
           start_font(
             { FACE => "Lucida Console",
               SIZE => 1 }) . 
           join('', @_) .
           end_font();
}

###########################################
sub display_cvs_form { 
###########################################
    my %CVSROOTS = map { @$_ } @CVSROOTS;

    print TR(td("CVS Root"), 
             td(popup_menu(
     -name   => 'cvsroot',
     -values => [map {$_->[0]} @CVSROOTS],
     -labels => \%CVSROOTS)));

    print TR(td("Alternative CVS Root"), 
             td(textfield(-name => "aroot", 
                          -size => 50)));
}