File Coverage

blib/lib/Parse/Readelf/Debug/Line.pm

Criterion	Covered	Total	%
statement	130	130	100.0
branch	71	76	93.4
condition	23	33	69.7
subroutine	13	13	100.0
pod	9	9	100.0
total	246	261	94.2

package Parse::Readelf::Debug::Line;

# Author, Copyright and License: see end of file

=head1 NAME

Parse::Readelf::Debug::Line - handle readelf's debug line section with a class

=head1 SYNOPSIS

  use Parse::Readelf::Debug::Line;

  my $line_info = new Parse::Readelf::Debug::Line($executable);

  my $object_id = $line_info->object_id("mocdule.c");

  my $file_name = $line_info->file($object_id, $number);
  my $directory_name = $line_info->directory($object_id, $number);
  my $path = $line_info->path($object_id, $number);

  my $object_name = $line_info->object_name($object_id);

  my $file_count = $line_info->files($object_id);
  my @files = $line_info->files($object_id);
  my $directory_count = $line_info->directories($object_id);
  my @directories = $line_info->directories($object_id);
  my $path_count = $line_info->paths($object_id);
  my @paths = $line_info->paths($object_id);

=head1 ABSTRACT

Parse::Readelf::Debug::Line parses the output of C
--debug-dump=line> and stores its interesting details in an object to
be available.  Normally it's not used directly but by other modules of
L>.

=head1 DESCRIPTION

Normally an object of this class is constructed with the file name of
an object file to be parsed.  Upon construction the file is analysed
and all relevant information about its debug line section is stored
inside of the object.  This information can be accessed afterwards
using a bunch of getter methods, see L for details.

Currently only output for B is supported.  Please
contact the author for other versions and provide some example
C outputs.

=cut

#########################################################################

use 5.006001;
use strict;
use warnings;
use Carp;

our $VERSION = '0.17';

#########################################################################

=head1 EXPORT

Nothing is exported by default as it's normally not needed to modify
any of the variables declared in the following export groups:

=head2 :all

all of the following groups

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

require Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw();

our %EXPORT_TAGS =
    (command => [ qw($command) ],
     fixed_regexps => [ qw($re_section_start $re_dwarf_version) ],
     versioned_regexps => [ qw(@re_directory_table
			       @re_file_name_table
			       @re_file_name_table_header) ]
    );
$EXPORT_TAGS{all} = [ map { @$_ } values(%EXPORT_TAGS) ];

our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} } );

#########################################################################

=head2 :command

=over

=item I<$command>

is the variable holding the command to run C to get the
information relevant for this module, normally C
--debug-dump=line>.

=back

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

our $command = 'readelf --debug-dump=line';

#########################################################################

=head2 :fixed_regexps

=over

=item I<$re_section_start>

is the regular expression that recognises the start of the line debug
output of C.

=item I<$re_dwarf_version>

is the regular expression that recognises the Dwarf version line in a
line debug output of C.  The version number must be an
integer number which will (must) be stored in C<$1>.

=back

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

our $re_section_start =
    qr(^(?:raw )?dump of debug contents of section \.debug_line:)i;

our $re_dwarf_version = qr(^\s*DWARF Version:\s+(\d+)\s*$)i;

#########################################################################

=head2 :versioned_regexps

=over

=item I<@re_directory_table>

is the version dependent regular expression that recognises the start
of the directory table in line debug output of C.

=item I<@re_file_name_table>

is the version dependent regular expression that recognises the start
of the non-empty file name table in line debug output of C.

=item I<@re_file_name_table_header>

is the version dependent regular expression that recognises the
heading line of the file name table in line debug output of
C.  If this must be modified this probably means the parsing
will not work correctly!

=back

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

our @re_directory_table =
    ( undef, undef, qr(^\s*The Directory Table)i );

our @re_file_name_table =
    (  undef, undef, qr(^\s*The File Name Table:)i );

our @re_file_name_table_header =
    (  undef, undef, qr(^\s*Entry\s+Dir\s+Time\s+Size\s+Name)i );

#########################################################################

=head2 new - get readelf's debug line section into an object

    $line_info = new Parse::Readelf::Debug::Line($file_name);

=head3 example:

    $line_info1 = new Parse::Readelf::Debug::Line('program');
    $line_info2 = new Parse::Readelf::Debug::Line('module.o');

=head3 parameters:

    $file_name          name of executable or object file

=head3 description:

    This method parses the output of C and
    stores its interesting details internally to be accessed later by
    getter methods described below.

=head3 global variables used:

    The method uses all of the variables described above in the
    L section.

=head3 returns:

    The method returns the blessed Parse::Readelf::Debug::Line object
    or an exception in case of an error.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub new($$)
{
    my $this = shift;
    my $class = ref($this) || $this;
    my ($file_name) = @_;
    my %self = (objects => [],
		object_map => {},
		directories => [],
		file_names => []);
    local $_;

    # checks:
    if (! $file_name)
    { croak 'bad call to new of ', __PACKAGE__; }
    if (ref($this))
    { carp 'cloning of a ', __PACKAGE__, " object is not supported"; }
    if (! -f $file_name)
    { croak __PACKAGE__, " can't find ", $file_name; }

    # call readelf and prepare parsing output:
    open READELF, '-|', $command.' '.$file_name  or
	croak "can't parse ", $file_name, ' with "', $command, '" in ',
	    __PACKAGE__, ': ', $!;

    # find start of section:
    while ()
    { last if m/$re_section_start/; }

    # parse section:
    my $version = -1;
    my @directory_list = ();
    while ()
    {

	if (m/$re_dwarf_version/)
	{
	    $version = $1;
	    confess 'DWARF version ', $version, ' not supported in ',
		__PACKAGE__
		    unless (defined $re_directory_table[$version]  and
			    defined $re_file_name_table[$version]  and
			    defined $re_file_name_table_header[$version]);
	}
	next unless $version >= 0;

	if (m/$re_directory_table[$version]/)
	{
	    @directory_list = ('.');
	    while ()
	    {
		s/^\s+//; s/\s+$//;
		last unless $_;
		push @directory_list, $_;
	    }
	}

	elsif (m/$re_file_name_table[$version]/)
	{
	     =~ m/$re_file_name_table_header[$version]/  or
		confess 'aborting: head line of file name table ',
		    'not recognised in ', __PACKAGE__;
	    my @file_name_table = ();
	    my @directory_table = ();
	    while ()
	    {
		s/[\r\n]+//;
		last unless m/\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(.*)/;
		my ($id, $directory_id, $time, $size, $name) =
		    ($1, $2, $3, $4, $5);
		if ($id == 1)
		{
		    push @{$self{objects}}, $name;
		    $self{object_map}{$name} = $#{$self{objects}};
		    push @{$self{directories}}, \@directory_table;
		    push @{$self{file_names}}, \@file_name_table;
		}
		$file_name_table[$id] = $name;
		$directory_table[$id] = $directory_list[$directory_id];
	    }
	    @directory_list = ();
	}
    }

    # now we're finished:
    close READELF  or
	croak 'error while attempting to parse ', $file_name,
	    ' (maybe not an object file?)';
    bless \%self, $class;
}

#########################################################################

=head2 object_id - get object ID of (named) source file

    $object_id = $line_info->object_id($file_name);

=head3 example:

    $object_id = $line_info->object_id('module.c');

=head3 parameters:

    $file_name          name of the source file (without directory)

=head3 description:

    This method returns the internal object ID of a module when given
    the name of its source file without directory.  This is a
    non-negative number.

=head3 returns:

    The method returns the object ID or -1 if no matching object was
    found.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub object_id($$)
{
    my $this = shift;
    my ($name) = @_;
    my $id = $this->{object_map}{$name};
    return defined $id ? $id : -1;
}

#########################################################################

=head2 object_name - get name of major source file for a given object ID

    $object_name = $line_info->object_name($object_id);

=head3 example:

    $object_name = $line_info->object_name(0);

=head3 parameters:

    $object_id          internal object ID of module

=head3 description:

    This method is the opposite method of L<|C>, it returns
    the name of the major source file for the given internal object ID
    of a module.

=head3 returns:

    The method returns the source name or an empty string if no
    matching object was found.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub object_name($$)
{
    my $this = shift;
    my ($id) = @_;
    my $name = $this->{objects}[$id];
    return defined $name ? $name : '';
}

#########################################################################

=head2 file - get file name of source for a given ID combination

    $file_name = $line_info->file($object_id, $source_number, $relax);

=head3 example:

    $file_name = $line_info->file(0, 0);
    $file_name = $line_info->file(0, 0, 1); # Dwarf-4

=head3 parameters:

    $object_id          internal object ID of module
    $source_number      number of the source
    $relax              optional flag to enable fallback code for object ID

=head3 description:

    This method returns the file name (without directory) of the
    source file number C<$source_number> for the given internal object
    ID of a module.  The source number is a positive integer.  1 is
    the number of the major source file, all others are usually
    include files.  Note that 0 is not used!

    Newer Dwarf versions don't seem to use different tables for
    different object IDs and put all sources into one table.  The
    optional flag C<$relax> tells the method to use this one table in
    those cases.

=head3 returns:

    The method returns the source name or an empty string if no
    matching source was found in the object.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub file($$$;$)
{
    my $this = shift;
    my ($id, $source, $relax) = @_;
    # TODO: compilation unit and ID seem to be totally different
    # things and I've never seen 2 file name tables in Dwarf-4 so far:
    my $table = $this->{file_names}[$id];
    if (not defined $table  and  $relax)
    { $table = $this->{file_names}[0]; }
    return '' unless defined $table and ref($table) eq 'ARRAY';
    my $name = $table->[$source];
    return defined $name ? $name : '';
}

#########################################################################

=head2 files - list of all source file names for a given object ID

    @file_names = $line_info->files($object_id);
    $file_count = $line_info->files($object_id);

=head3 example:

    @file_names = $line_info->files(1);
    $number_of_files = $line_info->files($object_id);

=head3 parameters:

    $object_id          internal object ID of module

=head3 description:

    In list context this method returns a list of all file names
    (without directory parts) for the given internal object ID of a
    module.  In scalar context it returns how many elements this list
    would have.  As number 1 is the first source number actually used
    in the internal representation of the list the number returned in
    scalar context is also the last number you can pass to the
    L<|C> method described above that returns a valid name (a
    non empty string).  Note also that the empty element 0 is not part
    of the list returned in list context.

=head3 returns:

    The method returns the list / the count as described above or an
    empty list / 0 if an unused or invalid object id was given.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub files($$)
{
    my $this = shift;
    my ($id) = @_;
    my $table = $this->{file_names}[$id];
    return wantarray ? () : 0 unless defined $table;
    if (wantarray)
    {
	return @{$table}[1..$#{$table}];
    }
    return $#{$table};
}

#########################################################################

=head2 directory - get directory name of source for a given ID combination

    $directory = $line_info->directory($object_id, $source_number);

=head3 example:

    $directory = $line_info->directory(0, 0);

=head3 parameters:

    $object_id          internal object ID of module
    $source_number      number of the source

=head3 description:

    This method returns the directory part of the file name of the
    source file number C<$source_number> for the given internal object
    ID of a module.  The source number is a positive integer.  1 is
    the number of the major source file, all others are usually
    include files.  Note that 0 is not used!

=head3 returns:

    The method returns the directory name or an empty string if no
    matching source was found in the object.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub directory($$$)
{
    my $this = shift;
    my ($id, $source) = @_;
    my $table = $this->{directories}[$id];
    return '' unless defined $table and ref($table) eq 'ARRAY';
    my $name = $table->[$source];
    return defined $name ? $name : '';
}

#########################################################################

=head2 directories - list of all directory names for a given object ID

    @directories = $line_info->directories($object_id);
    $dir_count = $line_info->directories($object_id);

=head3 example:

    @directories = $line_info->directories(1);
    $number_of_dirs = $line_info->directories($object_id);

=head3 parameters:

    $object_id          internal object ID of module

=head3 description:

    In list context this method returns a list of the directory parts
    of all file names for the given internal object ID of a module.
    As usually several used include files are found in the same
    directory this list normally will contain duplictes.  Those are NOT
    eliminated.  In scalar context it returns how many elements this
    list would have.  As number 1 is the first source number actually
    used in the internal representation of the list the number
    returned in scalar context is also the last number you can pass to
    the L<|C> method described above that returns a valid
    name (a non empty string).  Note also that the empty element 0 is
    not part of the list returned in list context.

=head3 returns:

    The method returns the list / the count as described above or an
    empty list / 0 if an unused or invalid object id was given.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub directories($$)
{
    my $this = shift;
    my ($id) = @_;
    my $table = $this->{directories}[$id];
    return wantarray ? () : 0 unless defined $table;
    if (wantarray)
    {
	return @{$table}[1..$#{$table}];
    }
    return $#{$table};
}

#########################################################################

=head2 path - get path to source file for a given ID combination

    $file_path = $line_info->path($object_id, $source_number);

=head3 example:

    $file_path = $line_info->path(0, 0);

=head3 parameters:

    $object_id          internal object ID of module
    $source_number      number of the source

=head3 description:

    This method returns the path (directory plus file name) of the
    source file number C<$source_number> for the given internal object
    ID of a module.  The source number is a positive integer.  1 is
    the number of the major source file, all others are usually
    include files.  Note that 0 is not used!

=head3 returns:

    The method returns the source name or an empty string if no
    matching source was found in the object.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub path($$$)
{
    my $this = shift;
    my ($id, $source) = @_;
    my $table = $this->{file_names}[$id];
    return '' unless defined $table  and  ref($table) eq 'ARRAY';
    my $name = $table->[$source];
    return '' unless defined $name;
    $table = $this->{directories}[$id];
    confess 'internal error: inconsistent table data for (',
	$id, ',', $source, ') in ', __PACKAGE__, '::path'
	    unless defined $table  and  ref($table) eq 'ARRAY';	# 1)
    my $name2 = $table->[$source];
    confess 'internal error: inconsistent name data for (',
	$id, ',', $source, ') in ', __PACKAGE__, '::path'
	    unless defined $name2; # 1)
    return $name2.'/'.$name;
}

#########################################################################

=head2 paths - list of paths to all sources for a given object ID

    @paths = $line_info->paths($object_id);
    $path_count = $line_info->paths($object_id);

=head3 example:

    @paths = $line_info->paths(1);
    $number_of_paths = $line_info->paths($object_id);

=head3 parameters:

    $object_id          internal object ID of module

=head3 description:

    In list context this method returns a list of all paths (directory
    plus file name) for the given internal object ID of a module.  In
    scalar context it returns how many elements this list would have.
    As number 1 is the first source number actually used in the
    internal representation of the list the number returned in scalar
    context is also the last number you can pass to the L<|C>
    method described above that returns a valid name (a non empty
    string).  Note also that the empty element 0 is not part of the
    list returned in list context.

=head3 returns:

    The method returns the list / the count as described above or an
    empty list / 0 if an unused or invalid object id was given.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub paths($$)
{
    my $this = shift;
    my ($id) = @_;
    my $dir_table = $this->{directories}[$id];
    my $file_table = $this->{file_names}[$id];
    unless (defined $dir_table  and  defined $file_table)
    {
	confess 'internal error: inconsistent table data for (',
	    $id, ') in ', __PACKAGE__, '::paths'
		if defined $dir_table  or  defined $file_table;
	return wantarray ? () : 0;
    }
    confess 'internal error: inconsistent table structure for (',
	$id, ') in ', __PACKAGE__, '::paths'
	    unless (ref($dir_table) eq 'ARRAY'  and
		    ref($file_table) eq 'ARRAY');
    confess 'internal error: inconsistent name data for (',
	$id, ') in ', __PACKAGE__, '::paths'
	    unless $#{$dir_table} == $#{$file_table};
    return $#{$dir_table} unless wantarray();
    return
	map { $dir_table->[$_] . '/' . $file_table->[$_] }
	    (1..$#{$dir_table});
}

1;

#########################################################################

__END__