Dpkg::Shlibs::Objdump: API overhaul

Move most of Dpkg::Shlibs::Objdump::parse and
the complete ::parse_dynamic_symbol to ::Object
since these both actually only work on a specific
object. Also divide the parse function into to
parts _read and _parse where the first is responsible
for calling objdump and the second for parsing the output.
(Or any other filehandle it gets).

This allows for easier testing of the parsing part without
having actually to run objdump on a file.

Also add some tests to 200_Dpkg_Shlibs to verify that the
module still works after all these changes.

I tried to adapt dpkg-shlibdeps to the new API but haven't
verified that it still works.

scripts/Dpkg/Shlibs/Objdump.pm

@@ -14,6 +14,9 @@
 # with this program; if not, write to the Free Software Foundation, Inc.,
 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
+use strict;
+use warnings;
+
 package Dpkg::Shlibs::Objdump;
 
 use Dpkg::Gettext;
@@ -30,14 +33,125 @@ sub new {
 
 sub parse {
     my ($self, $file) = @_;
-    local $ENV{LC_ALL} = 'C';
-    open(OBJDUMP, "-|", "objdump", "-w", "-p", "-T", $file) ||
-	syserr(sprintf(_g("Can't execute objdump: %s"), $!));
     my $obj = Dpkg::Shlibs::Objdump::Object->new($file);
+
+    my $id = $obj->get_id;
+    if ($id) {
+	$self->{objects}{$id} = $obj;
+    }
+    return $id;
+}
+
+
+sub locate_symbol {
+    my ($self, $name) = @_;
+    foreach my $obj (values %{$self->{objects}}) {
+	my $sym = $obj->get_symbol($name);
+	if (defined($sym) && $sym->{defined}) {
+	    return $sym;
+	}
+    }
+    return undef;
+}
+
+sub get_object {
+    my ($self, $objid) = @_;
+    if (exists $self->{objects}{$objid}) {
+	return $self->{objects}{$objid};
+    }
+    return undef;
+}
+
+{
+    my %format; # Cache of result
+    sub get_format {
+	my ($file) = @_;
+
+	if (exists $format{$file}) {
+	    return $format{$file};
+	} else {
+	    local $ENV{LC_ALL} = "C";
+	    open(P, "-|", "objdump", "-a", "--", $file)
+		|| syserr(_g("cannot fork for objdump"));
+	    while (<P>) {
+		chomp;
+		if (/^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
+		    $format{$file} = $1;
+		    return $format{$file};
+		}
+	    }
+	    close(P) or subprocerr(sprintf(_g("objdump on \`%s'"), $file));
+	}
+    }
+}
+
+sub is_elf {
+    my ($file) = @_;
+    open(FILE, "<", $file) ||
+	syserr(sprintf(_g("Can't open %s for test: %s"), $file, $!));
+    my ($header, $result) = ("", 0);
+    if (read(FILE, $header, 4) == 4) {
+	$result = 1 if ($header =~ /^\177ELF$/);
+    }
+    close(FILE);
+    return $result;
+}
+
+package Dpkg::Shlibs::Objdump::Object;
+
+sub new {
+    my $this = shift;
+    my $file = shift || '';
+    my $class = ref($this) || $this;
+    my $self = {};
+    bless $self, $class;
+
+    $self->reset;
+    if ($file) {
+	$self->_read;
+    }
+
+    return $self;
+}
+
+sub reset {
+    my ($self) = @_;
+
+    $self->{file} = '';
+    $self->{id} = '';
+    $self->{SONAME} = '';
+    $self->{NEEDED} = [];
+    $self->{RPATH} = [];
+    $self->{dynsyms} = {};
+
+    return $self;
+}
+
+
+sub _read {
+    my ($self, $file) = @_;
+
+    $file ||= $self->{file};
+    return unless $file;
+
+    $self->reset;
+    $self->{file} = $file;
+
+    local $ENV{LC_ALL} = 'C';
+    open(my $objdump, "-|", "objdump", "-w", "-p", "-T", $file)
+	|| syserr(sprintf(_g("Can't execute objdump: %s"), $!));
+    my $ret = $self->_parse($objdump);
+    close($objdump);
+    return $ret;
+}
+
+sub _parse {
+    my ($self, $fh) = @_;
+
     my $section = "none";
-    while (defined($_ = <OBJDUMP>)) {
+    while (defined($_ = <$fh>)) {
 	chomp;
-	next if (/^\s*$/);
+	next if /^\s*$/;
 
 	if (/^DYNAMIC SYMBOL TABLE:/) {
 	    $section = "dynsym";
@@ -57,33 +171,27 @@ sub parse {
 	}
 
 	if ($section eq "dynsym") {
-	    $self->parse_dynamic_symbol($_, $obj);
+	    $self->parse_dynamic_symbol($_);
 	} elsif ($section eq "dyninfo") {
 	    if (/^\s*NEEDED\s+(\S+)/) {
-		push @{$obj->{NEEDED}}, $1;
+		push @{$self->{NEEDED}}, $1;
 	    } elsif (/^\s*SONAME\s+(\S+)/) {
-		$obj->{SONAME} = $1;
+		$self->{SONAME} = $1;
 	    } elsif (/^\s*HASH\s+(\S+)/) {
-		$obj->{HASH} = $1;
+		$self->{HASH} = $1;
 	    } elsif (/^\s*GNU_HASH\s+(\S+)/) {
-		$obj->{GNU_HASH} = $1;
+		$self->{GNU_HASH} = $1;
 	    } elsif (/^\s*RPATH\s+(\S+)/) {
-		push @{$obj->{RPATH}}, split (/:/, $1);
+		push @{$self->{RPATH}}, split (/:/, $1);
 	    }
 	} elsif ($section eq "none") {
 	    if (/^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
-		$obj->{format} = $1;
+		$self->{format} = $1;
 	    }
 	}
     }
-    close(OBJDUMP);
-    if ($section eq "none") {
-	return undef;
-    } else {
-	my $id = $obj->{SONAME} || $obj->{file};
-	$self->{objects}{$id} = $obj;
-	return $id;
-    }
+
+    return $section ne "none";
 }
 
 # Output format of objdump -w -T
@@ -114,7 +222,7 @@ sub parse {
 # symbol exist
 
 sub parse_dynamic_symbol {
-    my ($self, $line, $obj) = @_;
+    my ($self, $line) = @_;
     my $vis = '(?:\s+(?:\.protected|\.hidden|\.internal|0x\S+))?';
     if ($line =~ /^[0-9a-f]+ (.{7})\s+(\S+)\s+[0-9a-f]+\s+(\S+)?(?:$vis\s+(\S+))/) {
 
@@ -127,7 +235,7 @@ sub parse_dynamic_symbol {
 		debug => substr($flags, 5, 1) eq "d",
 		type => substr($flags, 6, 1),
 		weak => substr($flags, 1, 1) eq "w",
-		hidden => 0,
+		hidden => '',
 		defined => $sect ne '*UND*'
 	    };
 
@@ -139,84 +247,14 @@ sub parse_dynamic_symbol {
 	}
 
 	# Register symbol
-	$obj->add_dynamic_symbol($symbol);
+	$self->add_dynamic_symbol($symbol);
     } elsif ($line =~ /^[0-9a-f]+ (.{7})\s+(\S+)\s+[0-9a-f]+/) {
 	# Same start but no version and no symbol ... just ignore
     } else {
-	warning(sprintf(_g("Couldn't parse one line of objdump's output: %s"), $line));
-    }
-}
-
-sub locate_symbol {
-    my ($self, $name) = @_;
-    foreach my $obj (values %{$self->{objects}}) {
-	my $sym = $obj->get_symbol($name);
-	if (defined($sym) && $sym->{defined}) {
-	    return $sym;
-	}
-    }
-    return undef;
-}
-
-sub get_object {
-    my ($self, $objid) = @_;
-    if (exists $self->{objects}{$objid}) {
-	return $self->{objects}{$objid};
-    }
-    return undef;
-}
-
-{
-    my %format; # Cache of result
-    sub get_format {
-	my ($file) = @_;
-
-	if (exists $format{$file}) {
-	    return $format{$file};
-	} else {
-	    local $ENV{LC_ALL} = "C";
-	    open(P, "-|", "objdump", "-a", "--", $file)
-		|| syserr(_g("cannot fork for objdump"));
-	    while (<P>) {
-		chomp;
-		if (/^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
-		    $format{$file} = $1;
-		    return $format{$file};
-		}
-	    }
-	    close(P) or subprocerr(sprintf(_g("objdump on \`%s'"), $file));
-	}
-    }
-}
-
-sub is_elf {
-    my ($file) = @_;
-    open(FILE, "<", $file) ||
-	syserr(sprintf(_g("Can't open %s for test: %s"), $file, $!));
-    my ($header, $result) = ("", 0);
-    if (read(FILE, $header, 4) == 4) {
-	$result = 1 if ($header =~ /^\177ELF$/);
+	warning(sprintf(_g("Couldn't parse dynamic symbol definition: %s"), $line));
     }
-    close(FILE);
-    return $result;
 }
 
-package Dpkg::Shlibs::Objdump::Object;
-
-sub new {
-    my $this = shift;
-    my $file = shift || '';
-    my $class = ref($this) || $this;
-    my $self = {
-	file => $file,
-	SONAME => '',
-	NEEDED => [],
-	RPATH => [],
-	dynsyms => {}
-    };
-    bless $self, $class;
-    return $self;
-}
 
 sub add_dynamic_symbol {
     my ($self, $symbol) = @_;
@@ -228,6 +266,11 @@ sub add_dynamic_symbol {
     }
 }
 
+sub get_id {
+    my $self = shift;
+    return $self->{SONAME} || $self->{file};
+}
+
 sub get_symbol {
     my ($self, $name) = @_;
     if (exists $self->{dynsyms}{$name}) {

scripts/dpkg-shlibdeps.pl

@@ -94,9 +94,7 @@ foreach my $file (keys %exec) {
     $cur_field = $exec{$file};
     print "Scanning $file (for $cur_field field)\n" if $debug;
 
-    my $dump = Dpkg::Shlibs::Objdump->new();
-    my $id = $dump->parse($file);
-    my $obj = $dump->get_object($id);
+    my $obj = Dpkg::Shlibs::Objdump::Object->new($file);
 
     # Load symbols files for all needed libraries (identified by SONAME)
     my %libfiles;

scripts/t/200_Dpkg_Shlibs.t

@@ -1,6 +1,6 @@
 # -*- mode: cperl;-*-
 
-use Test::More tests => 4;
+use Test::More tests => 14;
 
 use strict;
 use warnings;
@@ -18,4 +18,36 @@ is_deeply([qw(/nonexistant32 /nonexistant/lib64
 	  \@Dpkg::Shlibs::librarypaths, "parsed library paths");
 
 use_ok('Dpkg::Shlibs::Objdump');
+
+my $obj = Dpkg::Shlibs::Objdump::Object->new;
+
+open my $objdump, '<', "t/200_Dpkg_Shlibs/objdump.libc6"
+  or die "t/200_Dpkg_Shlibs/objdump.libc6: $!";
+$obj->_parse($objdump);
+close $objdump;
+
+is($obj->{SONAME}, 'libc.so.6', 'SONAME');
+is($obj->{HASH}, '0x13d99c', 'HASH');
+is($obj->{GNU_HASH}, '0x194', 'GNU_HASH');
+is($obj->{format}, 'elf32-i386', 'format');
+is_deeply($obj->{NEEDED}, [ 'ld-linux.so.2' ], 'NEEDED');
+is_deeply([ $obj->get_needed_libraries ], [ 'ld-linux.so.2' ], 'NEEDED');
+
+my $sym = $obj->get_symbol('_sys_nerr@GLIBC_2.3');
+is_deeply( $sym, { name => '_sys_nerr', version => 'GLIBC_2.3',
+		   soname => 'libc.so.6', section => '.rodata', dynamic => 1,
+		   debug => '', type => 'O', weak => '',
+		   hidden => 1, defined => 1 }, 'Symbol' );
+$sym = $obj->get_symbol('_IO_stdin_used');
+is_deeply( $sym, { name => '_IO_stdin_used', version => '',
+		   soname => 'libc.so.6', section => '*UND*', dynamic => 1,
+		   debug => '', type => ' ', weak => 1,
+		   hidden => '', defined => '' }, 'Symbol 2' );
+
+my @syms = $obj->get_exported_dynamic_symbols;
+is( scalar @syms, 2231, 'defined && dynamic' );
+@syms = $obj->get_undefined_dynamic_symbols;
+is( scalar @syms, 9, 'undefined && dynamic' );
+
+
 use_ok('Dpkg::Shlibs::SymbolFile');