← Back to branch summary

~ubuntu-branches/ubuntu/karmic/knowit/karmic

« back to all changes in this revision

Viewing changes to admin/bcheck.pl

  • Committer: Bazaar Package Importer
  • Author(s): Lorenzo Villani
  • Date: 2006-08-24 11:06:54 UTC
  • Revision ID: james.westby@ubuntu.com-20060824110654-npkpgbjxihzs4pfi
Tags: upstream-0.10
Import upstream version 0.10

Show diffs side-by-side

added added

removed removed

Lines of Context:
admin/bcheck.pl
 
1
#!/usr/bin/perl -w
 
2
 
 
3
use DB_File;
 
4
use Fcntl ':flock';
 
5
 
 
6
if (!defined($ARGV[0])) {
 
7
    print "usage: requires .class dump as parameter!\n";
 
8
    exit;
 
9
}
 
10
 
 
11
sub bailout
 
12
{
 
13
    untie %bcheckdb if(defined(%bcheckdb));
 
14
 
 
15
    if(defined(MYLOCK)) {
 
16
        flock MYLOCK, LOCK_UN;
 
17
        close(MYLOCK);
 
18
    }
 
19
 
 
20
    print @_;
 
21
    exit 5;
 
22
}
 
23
 
 
24
sub ask_user
 
25
{
 
26
    my ($dbkey, $dbchunk) = @_;
 
27
 
 
28
    if (defined($ENV{"BCHECK_UPDATE"})) {
 
29
        $bcheckdb{$dbkey} = $dbchunk;
 
30
        return;
 
31
    }
 
32
 
 
33
    &bailout("BC problem detected") if (! -t STDIN);
 
34
 
 
35
    print "(I)gnore / (Q)uit / (U)pdate: ";
 
36
 
 
37
    my $key;
 
38
    while(defined(read STDIN, $key, 1)) {
 
39
        $key = lc($key);
 
40
 
 
41
        print "got: >$key<\n";
 
42
 
 
43
        return if ($key eq 'i');
 
44
 
 
45
        &bailout("BC problem. aborted") if ($key eq 'q');
 
46
 
 
47
        if ($key eq 'u') {
 
48
            $bcheckdb{$dbkey} = $dbchunk;
 
49
            return;
 
50
        }
 
51
        print "\n(I)gnore / (Q)uit / (U)pdate: ";
 
52
    }
 
53
}
 
54
 
 
55
sub diff_chunk($$)
 
56
{
 
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;
 
62
 
 
63
    die "whoops. key different" if ($old[0] ne $new[0]);
 
64
 
 
65
    if ($#old != $#new) {
 
66
        warn ("Structural difference.\n");
 
67
        print @old;
 
68
        print "-----------------------------------------------\n";
 
69
        print @new;
 
70
        $haschanges = 1;
 
71
        return $haschanges;
 
72
    }
 
73
 
 
74
    print $old[0];
 
75
 
 
76
    my ($class) = ($old[0] =~ /^(?:Class |Vtable for )(\S+)/);
 
77
 
 
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);
 
85
 
 
86
        if(defined($class) and $n =~ /^(\d+\s+)\w+(::\S+\s*.*)$/) {
 
87
            next if ($n eq "$1$class$2");
 
88
        }
 
89
 
 
90
        $haschanges = 1;
 
91
 
 
92
        print "-$o\n+$n\n\n";
 
93
    }
 
94
 
 
95
    return $haschanges;
 
96
}
 
97
 
 
98
local $dblock = $ENV{"HOME"} . "/bcheck.lock";
 
99
my $dbfile = $ENV{"HOME"} . "/bcheck.db";
 
100
my $cdump  = $ARGV[0];
 
101
 
 
102
die "file $cdump is not readable: $!" if (! -f $cdump);
 
103
 
 
104
# make sure the advisory lock exists
 
105
open(MYLOCK, ">$dblock");
 
106
print MYLOCK "";
 
107
 
 
108
flock MYLOCK, LOCK_EX;
 
109
 
 
110
tie %bcheckdb, 'DB_File', $dbfile;
 
111
 
 
112
my $chunk = "";
 
113
 
 
114
open (IN, "<$cdump") or die "cannot open $cdump: $!";
 
115
while (<IN>) {
 
116
 
 
117
    chop;
 
118
 
 
119
    s/0x[0-9a-fA-F]+/0x......../g;
 
120
    s/base size=/size=/g;
 
121
    s/base align=/align=/g;
 
122
 
 
123
    $chunk .= $_ . "\n";
 
124
 
 
125
    if(/^\s*$/) {
 
126
        my @lines = split /^/m, $chunk;
 
127
        my $key = $lines[0];
 
128
        chomp $key;
 
129
 
 
130
        if($key !~ /<anonymous struct>/ &&
 
131
           $key !~ /<anonymous union>/) {
 
132
            if(defined($bcheckdb{$key})) {
 
133
                my $dbversion = $bcheckdb{$key};
 
134
 
 
135
                if($dbversion ne $chunk) {
 
136
                     &ask_user($key, $chunk) if(&diff_chunk($dbversion, $chunk));
 
137
                }
 
138
            }
 
139
            else {
 
140
                $bcheckdb{$key} = $chunk;
 
141
                print "NEW: $key\n";
 
142
            }
 
143
        }
 
144
 
 
145
        $chunk = "";
 
146
        next;
 
147
    }
 
148
 
 
149
}
 
150
close(IN);
 
151
 
 
152
untie %bcheckdb;
 
153
flock MYLOCK, LOCK_UN;
 
154
close(MYLOCK);
 
155
 
 
156
exit 0;