bcheck.pl

#!/usr/bin/perl -w

use DB_File;
use Fcntl ':flock';

if (!defined($ARGV[0])) {
    print "usage: requires .class dump as parameter!\n";
    exit;
}

sub bailout
{
    untie %bcheckdb if(defined(%bcheckdb));

    if(defined(MYLOCK)) {
        flock MYLOCK, LOCK_UN;
        close(MYLOCK);
    }

    print @_;
    exit 5;
}

sub ask_user
{
    my ($dbkey, $dbchunk) = @_;

    if (defined($ENV{"BCHECK_UPDATE"})) {
        $bcheckdb{$dbkey} = $dbchunk;
        return;
    }

    &bailout("BC problem detected") if (! -t STDIN);

    print "(I)gnore / (Q)uit / (U)pdate: ";

    my $key;
    while(defined(read STDIN, $key, 1)) {
        $key = lc($key);

        print "got: >$key<\n";

        return if ($key eq 'i');

        &bailout("BC problem. aborted") if ($key eq 'q');

        if ($key eq 'u') {
            $bcheckdb{$dbkey} = $dbchunk;
            return;
        }
        print "\n(I)gnore / (Q)uit / (U)pdate: ";
    }
}

sub diff_chunk($$)
{
    my ($oldl, $newl) = @_;
    my @old = split /^/m, $oldl;
    my @new = split /^/m, $newl;
    my $haschanges = 0;
    my $max = $#old > $#new ? $#old : $#new;

    die "whoops. key different" if ($old[0] ne $new[0]);

    if ($#old != $#new) {
        warn ("Structural difference.\n");
        print @old;
        print "-----------------------------------------------\n";
        print @new;
        $haschanges = 1;