1#!/usr/bin/perl -w
2
3use strict;
4use warnings;
5use bigint;
6use DBI;
7use Data::Dumper;
8
9my $db_file = shift;
10my $db = DBI->connect("dbi:SQLite:$db_file", "", "", {AutoCommit => 0});
11
12$db->do("PRAGMA cache_size = 800000");
13$db->do("PRAGMA journal_mode = OFF");
14$db->do("PRAGMA count_changes = OFF");
15$db->do("PRAGMA temp_store = MEMORY");
16$db->do("PRAGMA locking = EXCLUSIVE");
17
18my ($select, $select_type, $remove, $file, $caller, $function, $param, $src_param, $value, $type);
19
20$remove = $db->prepare_cached('DELETE FROM caller_info WHERE file = ? AND caller = ? AND function = ? AND parameter = ? AND type != 1014');
21$select = $db->prepare('SELECT file, caller, function, parameter, value FROM caller_info WHERE function LIKE "% param %" AND type = 1014 AND value LIKE "p %"');
22$select_type = $db->prepare_cached('SELECT value from function_type WHERE file = ? AND function = ? AND parameter = ? limit 1');
23$select->execute();
24
25while (($file, $caller, $function, $param, $value) = $select->fetchrow_array()) {
26
27    if ($value =~ /p (.*)/) {
28        $src_param = $1;
29    } else {
30        print "error:  unexpected source parameter $value\n";
31        next;
32    }
33
34    $select_type->execute($file, $caller, $src_param);
35    $type = $select_type->fetchrow_array();
36    if (!$type) {
37        next;
38    }
39    #FIXME: Why is this extra fetch() needed???
40    $select_type->fetch();
41
42    if (!($type =~ /^void\*$/) && !($type =~ /^ulong$/)) {
43        next;
44    }
45
46    $remove->execute($file, $caller, $function, $param);
47}
48
49$db->commit();
50$db->disconnect();
51