File Coverage

blib/lib/Binutils/Objdump.pm

Criterion	Covered	Total	%
statement	15	77	19.4
branch	1	42	2.3
condition	0	11	0.0
subroutine	5	15	33.3
pod	10	10	100.0
total	31	155	20.0

#
# Copyright (c) 2009, 2011  Slade Maurer, Alexander Sviridenko
#
# See COPYRIGHT section in pod text below for usage and distribution rights.
#
package Binutils::Objdump;

our $VERSION = '0.1.2';

our @ISA = qw(Exporter);
our @EXPORT = qw(objdump objdumpopt objdumpwrap);
our @EXPORT_OK = qw(objdump objdumpopt objdumppath objdumpwrap
		    objdump_dynamic_reloc_info objdump_symtab
		    objdump_section_headers objdump_dynamic_symtab
		    objdump_sec_contents objdump_sec_disasm
    );
our %EXPORT_TAGS = (
    ALL => [qw(objdump objdumpopt objdumppath objdumpwrap
	       objdump_dynamic_reloc_info objdump_symtab objdump_section_headers
	       objdump_dynamic_symtab objdump_sec_contents objdump_sec_disasm)],
    );

use strict;
use warnings;

# Constants
use constant DEF_WRAPPER => 0; # default wrapper
use constant USR_WRAPPER => 1; # user's wrapper

# By default, if none of object files will not be set,
# will be used object file with such name.
our $default_objfile = 'a.out';

# Try to define the path for objdump automatically. Also can be changed by user.
if (($^O =~ /MSWin/) or ($^O eq "Windows NT")) {
}
# Use `which' on linux.
elsif ($^O =~ /linux/) {
    my $path = `which objdump`;
    chomp $path;
    objdumppath($path);
}

# Information.
our %objdumpinfo = ();

sub __objdumpinfo
{
    my ($id, @lines) = (shift, @_);
    my $ref = \%objdumpinfo;
    for (1..scalar(@$id)) {
        if ($_ < scalar(@$id)) {
            $ref->{$id->[$_-1]} = {}
	    if !defined $ref->{$id->[$_-1]};
            $ref = $ref->{$id->[$_-1]};
        } else {
            $ref->{$id->[$_-1]} = \@lines;
        }
    }
}

# The labels and their wrappers, that will be used during
# parsing process.
our %objdumpwrappers = (
    # Dynamic symbol table
    'DYNAMIC SYMBOL TABLE:'               => [sub { __objdumpinfo(['dynamic symbol table'        ] , @_) }], # -T
    # The summary information from the section headers of the object file
    'Sections:'                           => [sub { __objdumpinfo(['sections'                    ] , @_) }], # -h
    # The symbol table entries of the file
    'SYMBOL TABLE:'                       => [sub { __objdumpinfo(['symbol table'                ] , @_) }], # -t
    # The dynamic relocation entries of the file
    'DYNAMIC RELOCATION RECORDS:'         => [sub { __objdumpinfo(['dynamic relocation records'  ] , @_) }], # -R
    # Dump contents of section...
    'Contents of section .interp'         => [sub { __objdumpinfo(['contents' , '.interp'        ] , @_) }],
    'Contents of section .note.ABI-tag'   => [sub { __objdumpinfo(['contents' , '.note.ABI-tag'  ] , @_) }],
    'Contents of section .hash'           => [sub { __objdumpinfo(['contents' , '.hash'          ] , @_) }],
    'Contents of section .gnu.hash'       => [sub { __objdumpinfo(['contents' , '.gnu.hash'      ] , @_) }],
    'Contents of section .dynsym'         => [sub { __objdumpinfo(['contents' , '.dynsym'        ] , @_) }],
    'Contents of section .dynstr'         => [sub { __objdumpinfo(['contents' , '.dynstr'        ] , @_) }],
    'Contents of section .gnu.version'    => [sub { __objdumpinfo(['contents' , '.gnu.version'   ] , @_) }],
    'Contents of section .gnu.version_r'  => [sub { __objdumpinfo(['contents' , '.gnu.version_r' ] , @_) }],
    'Contents of section .rel.dyn'        => [sub { __objdumpinfo(['contents' , '.rel.dyn'       ] , @_) }],
    'Contents of section .rel.plt'        => [sub { __objdumpinfo(['contents' , '.rel.plt'       ] , @_) }],
    'Contents of section .init'           => [sub { __objdumpinfo(['contents' , '.init'          ] , @_) }],
    'Contents of section .plt'            => [sub { __objdumpinfo(['contents' , '.plt'           ] , @_) }],
    'Contents of section .text'           => [sub { __objdumpinfo(['contents' , '.text'          ] , @_) }],
    'Contents of section .fini'           => [sub { __objdumpinfo(['contents' , '.fini'          ] , @_) }],
    'Contents of section .rodata'         => [sub { __objdumpinfo(['contents' , '.rodata'        ] , @_) }],
    'Contents of section .eh_frame_hdr'   => [sub { __objdumpinfo(['contents' , '.eh_frame_hdr'  ] , @_) }],
    'Contents of section .eh_frame'       => [sub { __objdumpinfo(['contents' , '.eh_frame'      ] , @_) }],
    'Contents of section .ctors'          => [sub { __objdumpinfo(['contents' , '.ctors'         ] , @_) }],
    'Contents of section .dtors'          => [sub { __objdumpinfo(['contents' , '.dtors'         ] , @_) }],
    'Contents of section .jcr'            => [sub { __objdumpinfo(['contents' , '.jcr'           ] , @_) }],
    'Contents of section .dynamic'        => [sub { __objdumpinfo(['contents' , '.dynamic'       ] , @_) }],
    'Contents of section .got'            => [sub { __objdumpinfo(['contents' , '.got'           ] , @_) }],
    'Contents of section .got.plt'        => [sub { __objdumpinfo(['contents' , '.got.plt'       ] , @_) }],
    'Contents of section .data'           => [sub { __objdumpinfo(['contents' , '.data'          ] , @_) }],
    'Contents of section .comment'        => [sub { __objdumpinfo(['contents' , '.comment'       ] , @_) }],
    'Contents of section .debug_aranges'  => [sub { __objdumpinfo(['contents' , '.debug_aranges' ] , @_) }],
    'Contents of section .debug_pubnames' => [sub { __objdumpinfo(['contents' , '.debug_pubnames'] , @_) }],
    'Contents of section .debug_info'     => [sub { __objdumpinfo(['contents' , '.debug_info'    ] , @_) }],
    'Contents of section .debug_abbrev'   => [sub { __objdumpinfo(['contents' , '.debug_abbrev'  ] , @_) }],
    'Contents of section .debug_line'     => [sub { __objdumpinfo(['contents' , '.debug_line'    ] , @_) }],
    'Contents of section .debug_str'      => [sub { __objdumpinfo(['contents' , '.debug_str'     ] , @_) }],
    'Contents of section .debug_ranges'   => [sub { __objdumpinfo(['contents' , '.debug_ranges'  ] , @_) }],
    # Disassembly of section...
    'Disassembly of section .text'        => [sub { __objdumpinfo(['disassembly' , '.text'] , @_) }],
    'Disassembly of section .plt'         => [sub { __objdumpinfo(['disassembly' , '.plt' ] , @_) }],
    'Disassembly of section .init'        => [sub { __objdumpinfo(['disassembly' , '.init'] , @_) }],
    'Disassembly of section .fini'        => [sub { __objdumpinfo(['disassembly' , '.fini'] , @_) }],
);

sub objdumpwrap ($$)
{
    my ($label, $wrapper) = (shift, shift);
    if (ref($wrapper) eq 'CODE') {
	# Try to find out, if such label (but, maybe, not exactly the same)
	# already exist.
        foreach (keys %objdumpwrappers) {
	    $label = $_
		if (/^\s*$label\s*(\:)?\s*$/);
        }
	# Set a second wrapper by user.
        $objdumpwrappers{$label}->[USR_WRAPPER] = $wrapper;
    }
}

# The path to the objdump.
our $objdumppath;

sub objdumppath
{
    if (scalar(@_)) {
        $objdumppath = shift;
    }
    return $objdumppath;
}

# The string with options for objdump.
my $objdumpoptstr;

sub objdumpopt
{
    # If none options defined, then return current string of options
    if (!scalar(@_)) {
        return $objdumpoptstr || "";
    }
    # Form new string of options.
    $objdumpoptstr = "";
    foreach (@_) {
        $objdumpoptstr = join " ", $objdumpoptstr, split(/\s/, $_);
    }
}

sub objdump
{
    my @objfiles = @_;
    # Update information.
    %objdumpinfo = ();

    # If objdump cannot be found, then print an
    # error message and die.
    if (!-e objdumppath() || !-f objdumppath()) {
        die "Objdump '". objdumppath() ."' cannot be found.\n";
    }

    # If object files was not set, use default object file.
    if (!scalar(@objfiles)) {
        push @objfiles, $default_objfile;
    }

    my @infos = ();
    foreach my $objfile (@objfiles) {
        my $cmd = join(' ', objdumppath(), objdumpopt(), $objfile, '2>&1');
	my $info = `$cmd`;

        my @lines = split /\n/, $info;

        my @buff = ();
        my %passed_labels = ();
        my $label;
        my $wrappers;

      LINE: while (scalar(@lines)) {
          my $line = shift @lines;
          do {
              foreach (keys %objdumpwrappers) {
                  next if defined $passed_labels{$_};
                  if ($line =~/$_/) {
                      do { for (@$wrappers) { $_->(@buff) if defined $_ } } if defined $wrappers;
                      @buff = ();
                      ($label, $wrappers) = ($_, $objdumpwrappers{$_});
                      $passed_labels{$label}++;
                      next LINE;
                  }
              }
          } if (scalar(keys %passed_labels) < scalar(keys %objdumpwrappers));
          push @buff, $line;
        }
        # Run the last wrapper if such defined...
        do { for (@$wrappers) { $_->(@buff) if defined $_ } } if defined $wrappers;

	push @infos, $info;
    }

    return @infos;
}

sub objdump_dynamic_reloc_info { if (defined (my $lines = $objdumpinfo{'dynamic relocation records'})) { return @$lines } }
sub objdump_symtab { if (defined (my $lines = $objdumpinfo{'symbol table'})) { return @$lines } }
sub objdump_section_headers { if (defined (my $lines = $objdumpinfo{'sections'})) { return @$lines } }
sub objdump_dynamic_symtab { if (defined (my $lines = $objdumpinfo{'dynamic symbol table'})) { return @$lines } }
sub objdump_sec_contents { if (defined $_[0] && defined (my $lines = $objdumpinfo{'contents'}->{$_[0]})) { return @$lines } }
sub objdump_sec_disasm { if (defined $_[0] && defined (my $lines = $objdumpinfo{'disassembly'}->{$_[0]})) { return @$lines } }

1;

__END__