The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#
# This script extracts the layout of structures matching a given
# pattern from the debug information embedded in one or more object
# files.  (To ease debugging it also allows for pre-extracted object
# information in files ending with ".lst").
#
# Author: Thomas Dorner
# Copyright: (C) 2007-2012 by Thomas Dorner (Artistic License)

use strict;
use warnings;

use File::Spec;

BEGIN {
    # allow for usage in directory where archive got unpacked:
    my @split_path = File::Spec->splitpath($0);
    my $libpath = File::Spec->catpath(@split_path[0..1]);
    $libpath = File::Spec->catdir($libpath, '..', 'lib');
    $libpath = File::Spec->rel2abs($libpath);
    if (-d $libpath)
    {
	print 'adding ', $libpath, ' to @INC', "\n";
	unshift @INC, $libpath;
    }
    require Parse::Readelf;
};

die "usage: structure-layout.pl <regexp-for-identifier> <object-file>...\n"
    unless 2 <= @ARGV;

my $re_identifier = shift @ARGV;
$re_identifier = join('', <STDIN>) if $re_identifier eq '-';

# save commands to reset them if changed later:
my $prdl_cmd = $Parse::Readelf::Debug::Line::command;
my $prdi_cmd = $Parse::Readelf::Debug::Info::command;

{
    no warnings 'once';
    $Parse::Readelf::Debug::Info::re_substructure_filter =
	join('|',
	     # don't expand some of our special structures as substructures:
	     '^CVarArea$',
	     '^CVarString$',
	     '^TArea<',
	     '^TArray<',
	     '^TBit<',
	     '^TBitMatrix<',
	     '^TFixString<',
	     # ignore some standard structures when expanding substructures:
	     '^basic_string');
}

# loop over objects:
foreach my $object (@ARGV)
{
    # handle preextracted lists:
    if ($object eq '-'  or  $object =~ m/\.lst$/)
    {
	$Parse::Readelf::Debug::Line::command = 'cat';
	$Parse::Readelf::Debug::Info::command = 'cat';
    }
    else
    {
	$Parse::Readelf::Debug::Line::command = $prdl_cmd;
	$Parse::Readelf::Debug::Info::command = $prdi_cmd;
    }

    # parse object and print structure layout for matching identifiers:
    my $readelf_data = new Parse::Readelf($object);
    $readelf_data->print_structure_layout($re_identifier, 1);
}