#!/usr/bin/perl
###########################################
# hd - Diff files side by side in HTML
# Derived from 'hdiff' (Bonsai team)
# Mike Schilli, 2002 ([email protected])
###########################################
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)));
}

You are viewing proxied material from gopher.rbfh.de. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.