1 #!/usr/bin/perl -w
   2 
   3 use strict;
   4 use warnings;
   5 use bigint;
   6 use DBI;
   7 use Data::Dumper;
   8 
   9 my $db_file = shift;
  10 my $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 
  18 my ($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 
  25 while (($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();