#!/usr/bin/perl

use strict;
use warnings;

use Getopt::Long;

$| = 1;

my @filename;
my %color = ( same => q{#000000}, file1 => q{#FF0000}, file2 => q{#0000FF}, );
my $outfile = $0 . q{.html};

if ( scalar( grep( /^-/, @ARGV ) ) ) {
    my @local_color;
    GetOptions(
        'filename:s'   => \@filename,
        'outputfile:s' => \$outfile,
        'color:s'      => \@local_color,
        'help'         => \&help,
    );
    @filename = split( /,/, join( ',', @filename ) );
    while ( scalar @filename > 2 ) {
        pop @filename;
    }
    @local_color = split( /,/, join( ',', @local_color ) );
    if ( scalar @local_color >= 3 ) {
        $color{same}  = $local_color[0];
        $color{file1} = $local_color[1];
        $color{file2} = $local_color[2];
    }

    if ( scalar @filename < 2 ) {
        warn qq{Too few input files listed!\n};
        &help;
    }
}
else {
    &help;
}

#
# Actual code here
#

open my $INF1, $filename[0] or die $!;
open my $INF2, $filename[1] or die $!;
open my $OUTF, q{>}, $outfile or die $!;

write_header( $OUTF, \@filename, $outfile, \%color );

my $i = 0;

process_files( $INF1, $INF2, $OUTF, \$i, \@filename, \%color );

process_files( $INF1, $INF2, $OUTF, \$i, \@filename, \%color );

process_remaining_file( $INF1, $OUTF, 0, \$i, \@filename, \%color );
close $INF1;
process_remaining_file( $INF2, $OUTF, 1, \$i, \@filename, \%color );
close $INF2;

write_footer($OUTF);
close $OUTF;

sub process_files {
    my ( $INF1, $INF2, $OUTF, $linecount, $fn, $color ) = @_;

    while ( defined $INF1 and defined $INF2 ) {
        my @p1;
        my @p2;

        my $l1 = <$INF1>;
        last unless defined $l1;
        chomp $l1;
        @p1 = split //, $l1;
        my $l2 = <$INF2>;
        last unless defined $l2;
        chomp $l2;
        @p2 = split //, $l2;

        $$linecount++;
        my $out1 = sprintf q{<font color="%s">%06d: }, $color->{same}, $$linecount;
        my $out2 = sprintf q{<font color="%s">%06d: }, $color->{same}, $$linecount;
        my $state = 0;
        while ( scalar @p1 and scalar @p2 ) {
            my $e1 = shift @p1;
            my $e2 = shift @p2;
            if ( ( ( ord $e1 == ord $e2 ) and ( !$state ) ) or ( ( ord $e1 != ord $e2 ) and ($state) ) ) {
                $out1 .= $e1;
                $out2 .= $e2;
            }
            else {
                $state = !$state;
                $out1 .= sprintf qq{</font><font color="%s">%s}, $color->{ ( $state ? q{file1} : q{same} ) }, $e1;
                $out2 .= sprintf qq{</font><font color="%s">%s}, $color->{ ( $state ? q{file2} : q{same} ) }, $e2;
            }
        }
        if ( scalar @p1 ) {
            if ($state) {
                $out1 .= sprintf qq{%s</font>}, join( q{}, @p1 );
            }
            else {
                $out1 .= sprintf qq{</font><font color="%s">%s</font>}, $color->{file1}, join( q{}, @p1 );
            }
        }
        elsif ( scalar @p2 ) {
            if ($state) {
                $out2 .= sprintf qq{%s</font>}, join( q{}, @p2 );
            }
            else {
                $out2 .= sprintf qq{</font><font color="%s">%s</font>}, $color->{file2}, join( q{}, @p2 );
            }
        }
        $out1 .= qq{</font>\n};
        $out2 .= qq{</font>\n};

        print $OUTF $out1, $out2, qq{\n};
    }
}

sub process_remaining_file {
    my ( $inhandle, $outhandle, $file_id, $linecount, $fn, $color ) = @_;

    while ( defined $inhandle ) {
        my $line = <$inhandle>;
        last unless defined $line;
        $$linecount++;
        chomp $line;

        my $out1;
        my $out2;
        if ($file_id) {
            $out1 = sprintf qq{%06d: -%s closed-\n}, $$linecount, $fn->[0];
            $out2 = sprintf qq{%06d: <font color="%s">%s</font>\n}, $$linecount, $color->{file2}, $line;
        }
        else {
            $out2 = sprintf qq{%06d: -%s closed-\n}, $$linecount, $fn->[1];
            $out1 = sprintf qq{%06d: <font color="%s">%s</font>\n}, $$linecount, $color->{file1}, $line;
        }
        print $outhandle $out1, $out2, qq{\n};
    }
}

sub help {
    printf <<HELPTEXT, $0, $0;

%s -filename file1,file2 [-color #same,#file1,#file2]
    [-outputfile outfile] [-help]

    -filename file1,file2
        - files to process (only the first 2 will be processed; parameter may
        appear twice or names may be comma-separated
    -outputfile outfile
        - file HTML output is written to (default value is %s.html)
    -color #same,#file1,#file2
        - colors used for output of portions of line that match and differing
        portions. Written in #RRGGBB format. (default values are #000000,
        #FF0000, and #0000FF).
    -help            - display this help text

HELPTEXT
    exit;
}

sub write_header {
    my ( $OUTF, $filename, $outfilename, $color ) = @_;

    print $OUTF <<HEADER
<html>
<head>
</head>
<body>
  <p>Output filename: $outfilename</p>
  <table>
    <tr>
      <td>File</td>
      <td>Color</td>
    </tr>
    <tr>
      <td><font color="$color{same}">$color{same}</font></td>
      <td>Matching</td>
    </tr>
    <tr>
      <td><font color="$color{file1}">$color{file1}</font></td>
      <td>$filename->[0]</td>
    </tr>
    <tr>
      <td><font color="$color{file2}">$color{file2}</font></td>
      <td>$filename->[1]</td>
    </tr>
  </table>
  <hr />
  <pre>
HEADER
}

sub write_footer {
    my ($OUTF) = @_;
    print $OUTF <<FOOTER;
  </pre>
</body>
</html>
FOOTER
}