#!/usr/bin/env perl
# $Id: compare-terminfo,v 1.3 2018/02/02 00:31:39 tom Exp $
# Use ncurses' infocmp to compare two terminfo files.  Its output is close, but
# is not sorted in a predictable manner that would allow diff'ing output from
# different comparisons.

use warnings;
use strict;
use diagnostics;

use Getopt::Std;
use File::Temp qw/ tempfile tempdir /;

our ( $opt_d, $opt_q );

sub read_pipe($) {
    my $pipe = shift;
    my $fh;
    my @data;
    if ( open( $fh, "$pipe |" ) ) {
        @data = <$fh>;
        close $fh;
    }
    else {
        warn "can't read from $pipe: $!";
    }
    return @data;
}

sub filter_tc($$) {
    my $target = shift;
    my $source = shift;
    $target .= "/$source";
    if ( open( my $fh, "$source" ) ) {
        my @data = <$fh>;
        close $fh;
        if ( open $fh, ">$target" ) {
            for my $n ( 0 .. $#data ) {
                $data[$n] =~ s/^..\|//
                  if ( $data[$n] =~ /^[[:print:]]{2,2}\|/ );
                printf $fh "%s", $data[$n];
            }
            close $fh;
        }
    }
}

sub compare($$) {
    my $ref     = shift;
    my $cmp     = shift;
    my $tempdir = tempdir( CLEANUP => 1 );
    &filter_tc( $tempdir, $ref );
    &filter_tc( $tempdir, $cmp );
    my $quiet = $opt_q ? "-q" : "";
    my @report = &read_pipe("cd $tempdir && infocmp $quiet -x -F $ref $cmp");
    my %report;
    my $state = -1;

    for my $n ( 0 .. $#report ) {
        chomp $report[$n];
        my $next = -1;
        if ( $report[$n] =~ /^In file 1.*/ ) {
            $next = 0;
        }
        elsif ( $report[$n] =~ /^In file 2.*/ ) {
            $next = 1;
        }
        elsif ( $report[$n] =~ /are equivalent:$/ ) {
            $next = 2;
        }
        elsif ( $report[$n] =~ /^Differing entries:/ ) {
            $next = 3;
        }
        $state = $next if ( $next >= 0 );
        printf "%d:%s\n", $state, $report[$n] if ($opt_d);
        next if ( $next >= 0 );
        my $name = $report[$n];
        $name =~ s/\s+$//;
        if ( $state == 3 ) {
            if ( $name =~ /^comparing / ) {
                $name =~ s/^[^\s]+\s+//;
                $name =~ s/\s.*//;
                $report{$name} = "~";
            }
        }
        elsif ( $state == 2 ) {
            my $test = $name;
            $test =~ s/ = .*//;
            $report{$test} = "=" if ( $name eq "$test = $test" );
        }
        elsif ( $name =~ /^\s/ and $state >= 0 ) {
            $name =~ s/^\s+//;
            $report{$name} = ( $state == 1 ) ? "+" : "-";
        }
    }
    my %total = qw{ = 0 ~ 0 + 0 - 0 };
    my $total = 0;
    for my $name ( sort keys %report ) {
        my $mark = $report{$name};
        $total{$mark}++;
        $total++;
        printf "%s %s\n", $mark, $name;
    }
    printf
      "$ref vs $cmp: %d total (%d same, %d changed, %d added, %d removed)\n",
      $total,
      $total{"="},
      $total{"~"},
      $total{"+"},
      $total{"-"};
}

sub main::HELP_MESSAGE() {
    printf STDERR <<EOF
Usage: $0 [options] terminfo1.src terminfo2.src

Options:

-d         debug
-q         passed to infocmp
EOF
      ;
    exit;
}

&getopts('dq') || &main::HELP_MESSAGE;
&main::HELP_MESSAGE unless ( $#ARGV == 1 );

&compare( $ARGV[0], $ARGV[1] );

1;
