← Back to branch summary

~ubuntu-branches/debian/sid/kdevelop/sid

« back to all changes in this revision

Viewing changes to parts/appwizard/common/admin/bcheck.pl

  • Committer: Bazaar Package Importer
  • Author(s): Jeremy Lainé
  • Date: 2010-05-05 07:21:55 UTC
  • mfrom: (1.2.3 upstream) (5.1.2 squeeze)
  • Revision ID: james.westby@ubuntu.com-20100505072155-h78lx19pu04sbhtn
Tags: 4:4.0.0-2
http://bugs.debian.org/579947
http://bugs.debian.org/481832
http://bugs.debian.org/562410
http://bugs.debian.org/546961
* Upload to unstable (Closes: #579947, #481832).
* Acknowledge obsolete NMU fixes (Closes: #562410, #546961).

Show diffs side-by-side

added added

removed removed

Lines of Context:
parts/appwizard/common/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/\(\)\s*$//g;
122
 
    s/base align=/align=/g;
123
 
 
124
 
    $chunk .= $_ . "\n";
125
 
 
126
 
    if(/^\s*$/) {
127
 
        my @lines = split /^/m, $chunk;
128
 
        my $key = $lines[0];
129
 
        chomp $key;
130
 
 
131
 
        if($key !~ /<anonymous struct>/ &&
132
 
           $key !~ /<anonymous union>/) {
133
 
            if(defined($bcheckdb{$key})) {
134
 
                my $dbversion = $bcheckdb{$key};
135
 
 
136
 
                if($dbversion ne $chunk) {
137
 
                     &ask_user($key, $chunk) if(&diff_chunk($dbversion, $chunk));
138
 
                }
139
 
            }
140
 
            else {
141
 
                $bcheckdb{$key} = $chunk;
142
 
                print "NEW: $key\n";
143
 
            }
144
 
        }
145
 
 
146
 
        $chunk = "";
147
 
        next;
148
 
    }
149
 
 
150
 
}
151
 
close(IN);
152
 
 
153
 
untie %bcheckdb;
154
 
flock MYLOCK, LOCK_UN;
155
 
close(MYLOCK);
156
 
 
157
 
exit 0;