Merge branch 'maint'
[kdbg.git] / admin / bcheck.pl
blob46485e5f6ddfb7506d58b84a384f81414f0375f7
1 #!/usr/bin/perl -w
3 use DB_File;
4 use Fcntl ':flock';
6 if (!defined($ARGV[0])) {
7 print "usage: requires .class dump as parameter!\n";
8 exit;
11 sub bailout
13 untie %bcheckdb if(defined(%bcheckdb));
15 if(defined(MYLOCK)) {
16 flock MYLOCK, LOCK_UN;
17 close(MYLOCK);
20 print @_;
21 exit 5;
24 sub ask_user
26 my ($dbkey, $dbchunk) = @_;
28 if (defined($ENV{"BCHECK_UPDATE"})) {
29 $bcheckdb{$dbkey} = $dbchunk;
30 return;
33 &bailout("BC problem detected") if (! -t STDIN);
35 print "(I)gnore / (Q)uit / (U)pdate: ";
37 my $key;
38 while(defined(read STDIN, $key, 1)) {
39 $key = lc($key);
41 print "got: >$key<\n";
43 return if ($key eq 'i');
45 &bailout("BC problem. aborted") if ($key eq 'q');
47 if ($key eq 'u') {
48 $bcheckdb{$dbkey} = $dbchunk;
49 return;
51 print "\n(I)gnore / (Q)uit / (U)pdate: ";
55 sub diff_chunk($$)
57 my ($oldl, $newl) = @_;
58 my @old = split /^/m, $oldl;
59 my @new = split /^/m, $newl;
60 my $haschanges = 0;
61 my $max = $#old > $#new ? $#old : $#new;
63 die "whoops. key different" if ($old[0] ne $new[0]);
65 if ($#old != $#new) {
66 warn ("Structural difference.\n");
67 print @old;
68 print "-----------------------------------------------\n";
69 print @new;
70 $haschanges = 1;
71 return $haschanges;
74 print $old[0];
76 my ($class) = ($old[0] =~ /^(?:Class |Vtable for )(\S+)/);
78 my $c = 1;
79 while ($c < $max) {
80 my ($o, $n) = ($old[$c], $new[$c]);
81 chomp $o;
82 chomp $n;
83 $c++;
84 next if ($o eq $n);
86 if(defined($class) and $n =~ /^(\d+\s+)\w+(::\S+\s*.*)$/) {
87 next if ($n eq "$1$class$2");
90 $haschanges = 1;
92 print "-$o\n+$n\n\n";
95 return $haschanges;
98 local $dblock = $ENV{"HOME"} . "/bcheck.lock";
99 my $dbfile = $ENV{"HOME"} . "/bcheck.db";
100 my $cdump = $ARGV[0];
102 die "file $cdump is not readable: $!" if (! -f $cdump);
104 # make sure the advisory lock exists
105 open(MYLOCK, ">$dblock");
106 print MYLOCK "";
108 flock MYLOCK, LOCK_EX;
110 tie %bcheckdb, 'DB_File', $dbfile;
112 my $chunk = "";
114 open (IN, "<$cdump") or die "cannot open $cdump: $!";
115 while (<IN>) {
117 chop;
119 s/0x[0-9a-fA-F]+/0x......../g;
120 s/base size=/size=/g;
121 s/base align=/align=/g;
123 $chunk .= $_ . "\n";
125 if(/^\s*$/) {
126 my @lines = split /^/m, $chunk;
127 my $key = $lines[0];
128 chomp $key;
130 if($key !~ /<anonymous struct>/ &&
131 $key !~ /<anonymous union>/) {
132 if(defined($bcheckdb{$key})) {
133 my $dbversion = $bcheckdb{$key};
135 if($dbversion ne $chunk) {
136 &ask_user($key, $chunk) if(&diff_chunk($dbversion, $chunk));
139 else {
140 $bcheckdb{$key} = $chunk;
141 print "NEW: $key\n";
145 $chunk = "";
146 next;
150 close(IN);
152 untie %bcheckdb;
153 flock MYLOCK, LOCK_UN;
154 close(MYLOCK);
156 exit 0;