path: root/src/testpattern/compare-checksums.in

#!@PERL@
## Copyright (C) 2016-2017 Robert Krawitz
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2, or (at your option)
## any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

use strict;

my (%old_modes, %old_printers, %new_modes, %new_printers);
my ($detail1) = 0;

while ($#ARGV >= 0 && $ARGV[0] eq '-d') {
    $detail1++;
    shift @ARGV;
}

if ($#ARGV <= 0) {
    print_file($ARGV[0]);
} elsif ($#ARGV == 1) {
    compare_files($ARGV[0], $ARGV[1]);
} else {
    die "Usage: $0 [old_checksum_file] [new_checksum_file]\n";
}

sub get_printer($) {
    my ($mode) = @_;
    $mode =~ s/_PrintingMode.*//o;
    return $mode;
}

sub get_mode($) {
    my ($mode) = @_;
    $mode =~ s/.*_PrintingMode/PrintingMode/o;
    return $mode;
}

sub uncompress_chunk($$) {
    my ($chunk, $sub_table) = @_;
    $$sub_table{$chunk} = $chunk if (! defined $$sub_table{$chunk});
    return $$sub_table{$chunk};
}

sub open_file($) {
    my ($file) = @_;
    my $in;
    if ($file =~ /\.bz2$/) {
	open($in, '-|', "@BZIP2@ -d -c $file") || die("Can't open checksum file $file: $!\n");
    } elsif ($file =~ /.gz$/) {
	open($in, '-|', "@GZIP@ -d -c $file") || die("Can't open checksum file $file: $!\n");
    } elsif ($file =~ /.xz$/) {
	open($in, '-|', "@XZ@ -d -c $file") || die("Can't open checksum file $file: $!\n");
    } elsif ($file =~ /.lrz$/) {
	open($in, '-|', "cat $file | @LRZIP@ -d -q") || die("Can't open checksum file $file: $!\n");
    } elsif ($file =~ /.rz$/) {
	open($in, '-|', "@RZIP@ -d -c $file") || die("Can't open checksum file $file: $!\n");
    } else {
	open($in, '<', "$file") || die("Can't open checksum file $file: $!\n");
    }
    return $in;
}

sub create_underscore_table() {
    my (%us_table);
    my (@chars) = ('>', '%', "'", ',', '"', '!', '=');
    my ($us) = '__';
    foreach my $char (@chars) {
	$us_table{$char} = $us;
	$us = $us . "_";
    }
    return \%us_table;
}

sub create_substitution_table() {
    my (%sub_table);
    $sub_table{"PrintingMode"} = "P;";
    $sub_table{"PageSize"} = "S;";
    $sub_table{"DitherAlgorithm"} = "D;";
    $sub_table{"Resolution"} = "R;";
    $sub_table{"ColorCorrection"} = "C;";
    $sub_table{"Color"} = "c;";
    $sub_table{"MediaType"} = "M;";
    $sub_table{"InputSlot"} = "I;";
    %sub_table = reverse %sub_table;
    return \%sub_table;
}

sub initialize_file($) {
    my ($file) = @_;
    my (%ctx);
    if ($file eq '' || $file eq '-' || ! defined $file) {
	$ctx{"fh"} = \*STDIN;
    } else {
	$ctx{"fh"} = open_file($file);
    }
    $ctx{"sum"} = "";
    $ctx{"last_sum"} = "";
    $ctx{"kvals"} = [];
    $ctx{"sub_table"} = create_substitution_table();
    $ctx{"pchunks"} = [];
    $ctx{"active"} = 1;
    my ($us_table) = create_underscore_table();
    $ctx{"us_table"} = $us_table;
    return \%ctx;
}

sub get_next_datum($) {
    my ($ctx) = @_;
    return undef if (! $$ctx{"active"});
    if ((scalar @{$$ctx{"kvals"}}) == 0) {
	my ($fh) = $$ctx{"fh"};
	my ($inline);
	if (! ($inline = <$fh>)) {
	    close($fh) if ($fh != \*STDIN);
	    $$ctx{"active"} = 0;
	    return undef;
	}
	chomp $inline;
	$inline =~ s/([=!",'%>])/$$ctx{"us_table"}{$1}/go;
	$inline =~ s/([PSDRCcMI];)/$$ctx{"sub_table"}{$1}/go;
	$inline =~ s/(^| )\*/$1/go;
	$inline =~ s/\.prn( |$)/$1/go;
	my ($sum, @keys) = split(/ /o, $inline);
	my $osum = $$ctx{"sum"};
	$$ctx{"kvals"} = \@keys;
	if ($osum ne "" && ((length $sum) < (length $osum))) {
	    $sum = substr($osum, 0, ((length $osum) - (length $sum))) . $sum;
	}
	$$ctx{"sum"} = $sum;
	$$ctx{"pchunks"} = [];
    }
    my (@chunks) = split(/_/o, shift(@{$$ctx{"kvals"}}), -1);
    my $pchunks = $$ctx{"pchunks"};
    foreach my $i (0..$#chunks) {
	if ($chunks[$i] eq '') {
	    $chunks[$i] = $$pchunks[$i];
	} else {
	    if ($chunks[$i] =~ /^([0-9]+)\+(.*)/o) {
		$chunks[$i] = substr($$pchunks[$i], 0, $1) . $2;
	    } elsif ($chunks[$i] =~ /^\*(.*)/o) {
		$chunks[$i] = substr($$pchunks[$i], 0, 2) . $1;
	    }
	    if ($chunks[$i] =~ m,(.*)/([0-9]+)$,o) {
		$chunks[$i] = $1 . substr($$pchunks[$i], -$2);
	    } elsif ($chunks[$i] =~ /([^\\]*)\\$/o) {
		$chunks[$i] = $1 . substr($$pchunks[$i], -2);
	    }
	}
    }
    my ($val) = join('_', @chunks);
    $val =~ s/(^[^:]*)_:(.*)/$2_$1/o;
    $$ctx{"pchunks"} = \@chunks;
    return [$$ctx{"sum"}, $val];
}

sub load_file($\%\%) {
    my ($file, $modes, $printers) = @_;
    my ($ctx) = initialize_file($file);
    my ($answer);
    while ($answer = get_next_datum($ctx)) {
	my ($sum) = $$answer[0];
	my ($val) = $$answer[1];
	$$modes{$val} = $sum;
	$$printers{get_printer($val)} = 1;
    }
}

sub print_changes($$@) {
    my ($tag, $detail, @changes) = @_;
    my ($prev_printer);
    return if ($#changes < 0);
    if (! $detail1) {
	print "$tag:\n";
    }
    foreach my $m (@changes) {
	my ($printer) = get_printer($m);
	my ($mode) = get_mode($m);
	if ($detail > 1) {
	    print "${printer}_${mode}\n";
	} elsif ($detail) {
	    if ($printer ne $prev_printer) {
		print "    $printer:\n";
		$prev_printer = $printer;
	    }
	    print "        $mode\n";
	} else {
	    print "    $mode\n";
	}
    }
    print "\n";
}

sub compare_files($$) {
    my ($file1, $file2) = @_;
    load_file($file1, %old_modes, %old_printers);
    load_file($file2, %new_modes, %new_printers);

    my (%only_old_printers, %only_new_printers);

    foreach my $new_printer (keys %new_printers) {
	if (! defined $old_printers{$new_printer}) {
	    $only_new_printers{$new_printer} = 1;
	}
    }

    foreach my $old_printer (keys %old_printers) {
	if (! defined $new_printers{$old_printer}) {
	    $only_old_printers{$old_printer} = 1;
	}
    }

    my (@only_old_modes, @only_new_modes, @changed_modes);

    sub mode_ne($$) {
	my ($new, $old) = @_;
	if (length $new == length $old) {
	    return ($new ne $old);
	} elsif (length $new < length $old) {
	    return ($new ne substr($old, 0, length $new));
	} else {
	    return ($old ne substr($new, 0, length $old));
	}
    }

    foreach my $old_mode (sort keys %old_modes) {
	next if defined $only_old_printers{get_printer($old_mode)};
	if (defined $new_modes{$old_mode}) {
	    if (mode_ne($new_modes{$old_mode}, $old_modes{$old_mode})) {
		push @changed_modes, $old_mode;
	    }
	} else {
	    push @only_old_modes, $old_mode;
	}
    }

    foreach my $new_mode (sort keys %new_modes) {
	next if defined $only_new_printers{get_printer($new_mode)};
	if (!defined $old_modes{$new_mode}) {
	    push @only_new_modes, $new_mode;
	}
    }

    my (@only_old_printers) = sort keys %only_old_printers;
    my (@only_new_printers) = sort keys %only_new_printers;

    if (! $detail1) {
	print "*** Changes from $ARGV[0] to $ARGV[1] ***\n\n";
	print_changes("Printers removed from $ARGV[1]", 0, @only_old_printers);
	print_changes("Printers added to $ARGV[1]", 0, @only_new_printers);
	print_changes("Modes removed from $ARGV[1]", 1, @only_old_modes);
	print_changes("Modes added to $ARGV[1]", 1, @only_new_modes);
    }
    print_changes("Changed printing modes", 1 + $detail1, @changed_modes);
}

sub print_file($) {
    my ($file) = @_;
    my ($ctx) = initialize_file($file);
    my ($answer);
    while ($answer = get_next_datum($ctx)) {
	my ($sum) = $$answer[0];
	my ($val) = $$answer[1];
	print "$sum *$val.prn\n";
    }
}