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