#!/afs/sipb/project/perldev/p -w
#
# This script takes RPD information generated by gdb by using something like
#   (gdb) set print pretty on
#   (gdb) set print repeats 1024
#   (gdb) set print elements 10240
#   (gdb) set height 10000
#   (gdb) print cache
# and extracts useful data from it.

use strict;
use vars qw( @data $current $debug @names );

$debug = 1;

@names = qw( fd filename last_mod inode length question use next prev );


### first line: expect '{{'

print STDERR "Looking for first line...\n" if $debug;

1 while defined ($_ = <>) && !/\{\{/;
die "Missing the first line of data!" unless defined $_;

$current = {};

### keep reading

print STDERR "reading...\n" if $debug;

while (<>) {
  chomp;
  if (/^ {4}(\S+) = /) {
    # structure element
    my($name, $val) = ($1, $');
    $val =~ s/\s+$//;   $val =~ s/,$//;

    if ($val eq '0x0') {
      undef $val;
    } elsif ($val =~ /^0x[0-9a-f]+ (\".*\")$/i) {
      $val = $1;
    }

    $current->{$name} = $val;

  } elsif (/\}, \{/) {
    # next structure in the array
    push(@data, $current);
    $current = {};

  } elsif (/\}\}/) {
    # end of array
    push(@data, $current);
    undef $current;
    last;

  } else {
    # error!
    die "Parse error (line is '$_')\n";
  }
}
die "Unexpected end of file!\n" if defined $current;

print "done.\n" if $debug;

### process data

foreach (@data) {
  printf("%6d %6d %6d\n", length($_->{'question'}|| ''), $_->{'length'},
	 length($_->{'question'} || '') - $_->{'length'});
}