Author: djpig
Date: 2007-07-08 19:49:48 +0000 (Sun, 08 Jul 2007)
New Revision: 849
Added:
branches/dpkg-shlibdeps-buxy/scripts/Dpkg/
branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Objdump.pm
branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs.pm
branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs/
branches/dpkg-shlibdeps-buxy/scripts/Dpkg/SymbolFile.pm
Removed:
branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Objdump.pm
branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs.pm
branches/dpkg-shlibdeps-buxy/scripts/Dpkg/SymbolFile.pm
branches/dpkg-shlibdeps-buxy/scripts/modules/
Modified:
branches/dpkg-shlibdeps-buxy/scripts/Makefile.am
Log:
Rename and Reorder modules directory
This should make it easier to use the modules from within the source,
which is important e.g. for testing. It also makes the hierarchy more
obvious.
Rename modules to Dpkg and add subdirectory Shlibs
Copied: branches/dpkg-shlibdeps-buxy/scripts/Dpkg (from rev 846,
branches/dpkg-shlibdeps-buxy/scripts/modules)
Deleted: branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Objdump.pm
===================================================================
--- branches/dpkg-shlibdeps-buxy/scripts/modules/Objdump.pm 2007-07-08
11:10:44 UTC (rev 846)
+++ branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Objdump.pm 2007-07-08
19:49:48 UTC (rev 849)
@@ -1,236 +0,0 @@
-package Dpkg::Shlibs::Objdump;
-
-require 'dpkg-gettext.pl';
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my $self = { 'objects' => {} };
- bless $self, $class;
- return $self;
-}
-
-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 $section = "none";
- while (defined($_ = <OBJDUMP>)) {
- chomp($_);
- next if (/^\s*$/);
-
- if ($_ =~ /^DYNAMIC SYMBOL TABLE:/) {
- $section = "dynsym";
- next;
- } elsif ($_ =~ /^Dynamic Section:/) {
- $section = "dyninfo";
- next;
- } elsif ($_ =~ /^Program Header:/) {
- $section = "header";
- next;
- } elsif ($_ =~ /^Version definitions:/) {
- $section = "verdef";
- next;
- } elsif ($_ =~ /^Version References:/) {
- $section = "verref";
- next;
- }
-
- if ($section eq "dynsym") {
- $self->parse_dynamic_symbol($_, $obj);
- } elsif ($section eq "dyninfo") {
- if ($_ =~ /^\s*NEEDED\s+(\S+)/) {
- push @{$obj->{NEEDED}}, $1;
- } elsif ($_ =~ /^\s*SONAME\s+(\S+)/) {
- $obj->{SONAME} = $1;
- } elsif ($_ =~ /^\s*HASH\s+(\S+)/) {
- $obj->{HASH} = $1;
- } elsif ($_ =~ /^\s*GNU_HASH\s+(\S+)/) {
- $obj->{GNU_HASH} = $1;
- } elsif ($_ =~ /^\s*RPATH\s+(\S+)/) {
- push @{$obj->{RPATH}}, split (/:/, $1);
- }
- } elsif ($section eq "none") {
- if ($_ =~ /^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
- $obj->{format} = $1;
- }
- }
- }
- close(OBJDUMP);
- if ($section eq "none") {
- return undef;
- } else {
- my $id = $obj->{SONAME} || $obj->{file};
- $self->{objects}{$id} = $obj;
- return $id;
- }
-}
-
-# Output format of objdump -w -T
-#
-# /lib/libc.so.6: format de fichier elf32-i386
-#
-# DYNAMIC SYMBOL TABLE:
-# 00056ef0 g DF .text 000000db GLIBC_2.2 getwchar
-# 00000000 g DO *ABS* 00000000 GCC_3.0 GCC_3.0
-# 00069960 w DF .text 0000001e GLIBC_2.0 bcmp
-# 00000000 w D *UND* 00000000 _pthread_cleanup_pop_restore
-# 0000b788 g DF .text 0000008e Base .protected xine_close
-# | ||||||| | | | |
-# | ||||||| | | Version str (.visibility) + Symbol name
-# | ||||||| | Alignment
-# | ||||||| Section name (or *UND* for an undefined symbol)
-# | ||||||F=Function,f=file,O=object
-# | |||||d=debugging,D=dynamic
-# | ||||I=Indirect
-# | |||W=warning
-# | ||C=constructor
-# | |w=weak
-# | g=global,l=local,!=both global/local
-# Size of the symbol
-#
-# GLIBC_2.2 is the version string associated to the symbol
-# (GLIBC_2.2) is the same but the symbol is hidden, a newer version of the
-# symbol exist
-
-sub parse_dynamic_symbol {
- my ($self, $line, $obj) = @_;
- 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+))/) {
-
- my ($flags, $sect, $ver, $name) = ($1, $2, $3, $4);
- my $symbol = {
- 'name' => $name,
- 'version' => defined($ver) ? $ver : '',
- 'section' => $sect,
- 'dynamic' => substr($flags, 5, 1) eq "D",
- 'debug' => substr($flags, 5, 1) eq "d",
- 'type' => substr($flags, 6, 1),
- 'weak' => substr($flags, 1, 1) eq "w",
- 'hidden' => 0,
- 'defined' => $sect ne '*UND*'
- };
-
- # Handle hidden symbols
- if (defined($ver) and $ver =~ /^\((.*)\)$/) {
- $ver = $1;
- $symbol->{'version'} = $1;
- $symbol->{'hidden'} = 1;
- }
-
- # Register symbol
- $obj->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 {
- main::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 main::subprocerr(sprintf(_g("objdump on \`%s'"),
$file));
- }
- }
-}
-
-sub is_elf {
- my ($file) = @_;
- open(FILE, "<", $file) || main::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 = {
- 'file' => $file,
- 'SONAME' => '',
- 'NEEDED' => [],
- 'RPATH' => [],
- 'dynsyms' => {}
- };
- bless $self, $class;
- return $self;
-}
-
-sub add_dynamic_symbol {
- my ($self, $symbol) = @_;
- $symbol->{soname} = $self->{SONAME};
- if ($symbol->{version}) {
- $self->{dynsyms}{$symbol->{name} . '@' . $symbol->{version}} = $symbol;
- } else {
- $self->{dynsyms}{$symbol->{name}} = $symbol;
- }
-}
-
-sub get_symbol {
- my ($self, $name) = @_;
- if (exists $self->{dynsyms}{$name}) {
- return $self->{dynsyms}{$name};
- }
- return undef;
-}
-
-sub get_exported_dynamic_symbols {
- my ($self) = @_;
- return grep { $_->{defined} && $_->{dynamic} }
- values %{$self->{dynsyms}};
-}
-
-sub get_undefined_dynamic_symbols {
- my ($self) = @_;
- return grep { (!$_->{defined}) && $_->{dynamic} }
- values %{$self->{dynsyms}};
-}
-
-sub get_needed_libraries {
- my $self = shift;
- return @{$self->{NEEDED}};
-}
-
-1;
Copied: branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Objdump.pm (from rev 848,
branches/dpkg-shlibdeps-buxy/scripts/modules/Objdump.pm)
===================================================================
--- branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Objdump.pm
(rev 0)
+++ branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Objdump.pm 2007-07-08
19:49:48 UTC (rev 849)
@@ -0,0 +1,252 @@
+# Copyright (C) 2007 Raphael Hertzog
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Shlibs::Objdump;
+
+require 'dpkg-gettext.pl';
+
+sub new {
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my $self = { 'objects' => {} };
+ bless $self, $class;
+ return $self;
+}
+
+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 $section = "none";
+ while (defined($_ = <OBJDUMP>)) {
+ chomp($_);
+ next if (/^\s*$/);
+
+ if ($_ =~ /^DYNAMIC SYMBOL TABLE:/) {
+ $section = "dynsym";
+ next;
+ } elsif ($_ =~ /^Dynamic Section:/) {
+ $section = "dyninfo";
+ next;
+ } elsif ($_ =~ /^Program Header:/) {
+ $section = "header";
+ next;
+ } elsif ($_ =~ /^Version definitions:/) {
+ $section = "verdef";
+ next;
+ } elsif ($_ =~ /^Version References:/) {
+ $section = "verref";
+ next;
+ }
+
+ if ($section eq "dynsym") {
+ $self->parse_dynamic_symbol($_, $obj);
+ } elsif ($section eq "dyninfo") {
+ if ($_ =~ /^\s*NEEDED\s+(\S+)/) {
+ push @{$obj->{NEEDED}}, $1;
+ } elsif ($_ =~ /^\s*SONAME\s+(\S+)/) {
+ $obj->{SONAME} = $1;
+ } elsif ($_ =~ /^\s*HASH\s+(\S+)/) {
+ $obj->{HASH} = $1;
+ } elsif ($_ =~ /^\s*GNU_HASH\s+(\S+)/) {
+ $obj->{GNU_HASH} = $1;
+ } elsif ($_ =~ /^\s*RPATH\s+(\S+)/) {
+ push @{$obj->{RPATH}}, split (/:/, $1);
+ }
+ } elsif ($section eq "none") {
+ if ($_ =~ /^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
+ $obj->{format} = $1;
+ }
+ }
+ }
+ close(OBJDUMP);
+ if ($section eq "none") {
+ return undef;
+ } else {
+ my $id = $obj->{SONAME} || $obj->{file};
+ $self->{objects}{$id} = $obj;
+ return $id;
+ }
+}
+
+# Output format of objdump -w -T
+#
+# /lib/libc.so.6: file format elf32-i386
+#
+# DYNAMIC SYMBOL TABLE:
+# 00056ef0 g DF .text 000000db GLIBC_2.2 getwchar
+# 00000000 g DO *ABS* 00000000 GCC_3.0 GCC_3.0
+# 00069960 w DF .text 0000001e GLIBC_2.0 bcmp
+# 00000000 w D *UND* 00000000 _pthread_cleanup_pop_restore
+# 0000b788 g DF .text 0000008e Base .protected xine_close
+# | ||||||| | | | |
+# | ||||||| | | Version str (.visibility) + Symbol name
+# | ||||||| | Alignment
+# | ||||||| Section name (or *UND* for an undefined symbol)
+# | ||||||F=Function,f=file,O=object
+# | |||||d=debugging,D=dynamic
+# | ||||I=Indirect
+# | |||W=warning
+# | ||C=constructor
+# | |w=weak
+# | g=global,l=local,!=both global/local
+# Size of the symbol
+#
+# GLIBC_2.2 is the version string associated to the symbol
+# (GLIBC_2.2) is the same but the symbol is hidden, a newer version of the
+# symbol exist
+
+sub parse_dynamic_symbol {
+ my ($self, $line, $obj) = @_;
+ 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+))/) {
+
+ my ($flags, $sect, $ver, $name) = ($1, $2, $3, $4);
+ my $symbol = {
+ 'name' => $name,
+ 'version' => defined($ver) ? $ver : '',
+ 'section' => $sect,
+ 'dynamic' => substr($flags, 5, 1) eq "D",
+ 'debug' => substr($flags, 5, 1) eq "d",
+ 'type' => substr($flags, 6, 1),
+ 'weak' => substr($flags, 1, 1) eq "w",
+ 'hidden' => 0,
+ 'defined' => $sect ne '*UND*'
+ };
+
+ # Handle hidden symbols
+ if (defined($ver) and $ver =~ /^\((.*)\)$/) {
+ $ver = $1;
+ $symbol->{'version'} = $1;
+ $symbol->{'hidden'} = 1;
+ }
+
+ # Register symbol
+ $obj->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 {
+ main::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 main::subprocerr(sprintf(_g("objdump on \`%s'"),
$file));
+ }
+ }
+}
+
+sub is_elf {
+ my ($file) = @_;
+ open(FILE, "<", $file) || main::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 = {
+ 'file' => $file,
+ 'SONAME' => '',
+ 'NEEDED' => [],
+ 'RPATH' => [],
+ 'dynsyms' => {}
+ };
+ bless $self, $class;
+ return $self;
+}
+
+sub add_dynamic_symbol {
+ my ($self, $symbol) = @_;
+ $symbol->{soname} = $self->{SONAME};
+ if ($symbol->{version}) {
+ $self->{dynsyms}{$symbol->{name} . '@' . $symbol->{version}} = $symbol;
+ } else {
+ $self->{dynsyms}{$symbol->{name}} = $symbol;
+ }
+}
+
+sub get_symbol {
+ my ($self, $name) = @_;
+ if (exists $self->{dynsyms}{$name}) {
+ return $self->{dynsyms}{$name};
+ }
+ return undef;
+}
+
+sub get_exported_dynamic_symbols {
+ my ($self) = @_;
+ return grep { $_->{defined} && $_->{dynamic} }
+ values %{$self->{dynsyms}};
+}
+
+sub get_undefined_dynamic_symbols {
+ my ($self) = @_;
+ return grep { (!$_->{defined}) && $_->{dynamic} }
+ values %{$self->{dynsyms}};
+}
+
+sub get_needed_libraries {
+ my $self = shift;
+ return @{$self->{NEEDED}};
+}
+
+1;
Deleted: branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs.pm
===================================================================
--- branches/dpkg-shlibdeps-buxy/scripts/modules/Shlibs.pm 2007-07-08
11:10:44 UTC (rev 846)
+++ branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs.pm 2007-07-08 19:49:48 UTC
(rev 849)
@@ -1,70 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-use warnings;
-
-require 'dpkg-gettext.pl';
-
-use IO::File;
-
-use Exporter 'import';
-our @EXPORT_OK = qw(@librarypaths find_library);
-
-our @librarypaths = qw(/lib /usr/lib /lib32 /usr/lib32 /lib64 /usr/lib64
- /emul/ia32-linux/lib /emul/ia32-linux/usr/lib);
-
-# Update library paths with LD_LIBRARY_PATH
-if ($ENV{LD_LIBRARY_PATH}) {
- foreach my $path (reverse split( /:/, $ENV{LD_LIBRARY_PATH} )) {
- $path =~ s{/+$}{};
- unless (scalar grep { $_ eq $path } @librarypaths) {
- unshift @librarypaths, $path;
- }
- }
-}
-
-# Update library paths with ld.so config
-parse_ldso_conf("/etc/ld.so.conf") if -e "/etc/ld.so.conf";
-
-sub parse_ldso_conf {
- my $file = shift;
- my $fh = new IO::File;
- $fh->open($file, "<")
- or main::syserr(sprintf(_g("couldn't open %s: %s"), $file, $!));
- while (<$fh>) {
- next if /^\s*$/;
- chomp;
- s{/+$}{};
- if (/^include\s+(\S.*\S)\s*$/) {
- foreach my $include (glob($1)) {
- parse_ldso_conf($include) if -e $include;
- }
- } elsif (m{^\s*/}) {
- s/^\s+//;
- my $libdir = $_;
- unless (scalar grep { $_ eq $libdir } @librarypaths) {
- push @librarypaths, $libdir;
- }
- }
- }
- $fh->close;
-}
-
-# find_library ($soname, [EMAIL PROTECTED], $format, $root)
-sub find_library {
- my ($lib, $rpath, $format, $root) = @_;
- $root = "" if not defined($root);
- $root =~ s{/+$}{};
- my @rpath = @{$rpath};
- foreach my $dir (@rpath, @librarypaths) {
- if (-e "$root$dir/$lib") {
- my $libformat = Dpkg::Shlibs::Objdump::get_format("$root$dir/$lib");
- if ($format eq $libformat) {
- return "$root$dir/$lib";
- }
- }
- }
- return undef;
-}
-
-1;
Copied: branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs.pm (from rev 848,
branches/dpkg-shlibdeps-buxy/scripts/modules/Shlibs.pm)
===================================================================
--- branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs.pm
(rev 0)
+++ branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs.pm 2007-07-08 19:49:48 UTC
(rev 849)
@@ -0,0 +1,84 @@
+# Copyright (C) 2007 Raphael Hertzog
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License along
+# 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;
+
+require 'dpkg-gettext.pl';
+
+use IO::File;
+
+use Exporter 'import';
+our @EXPORT_OK = qw(@librarypaths find_library);
+
+our @librarypaths = qw(/lib /usr/lib /lib32 /usr/lib32 /lib64 /usr/lib64
+ /emul/ia32-linux/lib /emul/ia32-linux/usr/lib);
+
+# Update library paths with LD_LIBRARY_PATH
+if ($ENV{LD_LIBRARY_PATH}) {
+ foreach my $path (reverse split( /:/, $ENV{LD_LIBRARY_PATH} )) {
+ $path =~ s{/+$}{};
+ unless (scalar grep { $_ eq $path } @librarypaths) {
+ unshift @librarypaths, $path;
+ }
+ }
+}
+
+# Update library paths with ld.so config
+parse_ldso_conf("/etc/ld.so.conf") if -e "/etc/ld.so.conf";
+
+sub parse_ldso_conf {
+ my $file = shift;
+ my $fh = new IO::File;
+ $fh->open($file, "<")
+ or main::syserr(sprintf(_g("couldn't open %s: %s"), $file, $!));
+ while (<$fh>) {
+ next if /^\s*$/;
+ chomp;
+ s{/+$}{};
+ if (/^include\s+(\S.*\S)\s*$/) {
+ foreach my $include (glob($1)) {
+ parse_ldso_conf($include) if -e $include;
+ }
+ } elsif (m{^\s*/}) {
+ s/^\s+//;
+ my $libdir = $_;
+ unless (scalar grep { $_ eq $libdir } @librarypaths) {
+ push @librarypaths, $libdir;
+ }
+ }
+ }
+ $fh->close;
+}
+
+# find_library ($soname, [EMAIL PROTECTED], $format, $root)
+sub find_library {
+ my ($lib, $rpath, $format, $root) = @_;
+ $root = "" if not defined($root);
+ $root =~ s{/+$}{};
+ my @rpath = @{$rpath};
+ foreach my $dir (@rpath, @librarypaths) {
+ if (-e "$root$dir/$lib") {
+ my $libformat = Dpkg::Shlibs::Objdump::get_format("$root$dir/$lib");
+ if ($format eq $libformat) {
+ return "$root$dir/$lib";
+ }
+ }
+ }
+ return undef;
+}
+
+1;
Deleted: branches/dpkg-shlibdeps-buxy/scripts/Dpkg/SymbolFile.pm
===================================================================
--- branches/dpkg-shlibdeps-buxy/scripts/modules/SymbolFile.pm 2007-07-08
11:10:44 UTC (rev 846)
+++ branches/dpkg-shlibdeps-buxy/scripts/Dpkg/SymbolFile.pm 2007-07-08
19:49:48 UTC (rev 849)
@@ -1,237 +0,0 @@
-package Dpkg::Shlibs::SymbolFile;
-
-require 'dpkg-gettext.pl';
-
-use Dpkg::Version qw(compare_versions);
-
-sub new {
- my $this = shift;
- my $file = shift;
- my $class = ref($this) || $this;
- my $self = { };
- bless $self, $class;
- if (defined($file) ) {
- $self->{file} = $file;
- $self->load($file) if -e $file;
- }
- return $self;
-}
-
-sub clear {
- my ($self) = @_;
- $self->{objects} = {};
-}
-
-sub clear_except {
- my ($self, @ids) = @_;
- my %has;
- $has{$_} = 1 foreach (@ids);
- foreach my $objid (keys %{$self->{objects}}) {
- delete $self->{objects}{$objid} unless exists $has{$objid};
- }
-}
-
-sub load {
- my ($self, $file) = @_;
- $self->{file} = $file;
- open(SYM_FILE, "<", $file) || main::syserr(sprintf(_g("Can't open %s:
%s"), $file));
- my ($object);
- while (defined($_ = <SYM_FILE>)) {
- chomp($_);
- if (/^\s+(\S+)\s(\S+)(?:\s(\d+))?/) {
- # New symbol
- my $sym = {
- 'minver' => $2,
- 'dep_id' => defined($3) ? $3 : 0,
- 'deprecated' => 0
- };
- $self->{objects}{$object}{syms}{$1} = $sym;
- } elsif (/^#DEPRECATED: ([^#]+)#\s*(\S+)\s(\S+)(?:\s(\d+))?/) {
- my $sym = {
- 'minver' => $3,
- 'dep_id' => defined($4) ? $4 : 0,
- 'deprecated' => $1
- };
- $self->{objects}{$object}{syms}{$2} = $sym;
- } elsif (/^\|\s*(.*)$/) {
- # Alternative dependency template
- push @{$self->{objects}{$object}{deps}}, "$1";
- } elsif (/^(\S+)\s+(.*)$/) {
- # New object and dependency template
- $object = $1;
- $self->{objects}{$object} = {
- 'syms' => {},
- 'deps' => [ "$2" ]
- };
- } else {
- main::warning(sprintf(_g("Failed to parse a line in %s: %s"),
$file, $_));
- }
- }
- close(SYM_FILE);
-}
-
-sub save {
- my ($self, $file) = @_;
- $file = $self->{file} unless defined($file);
- my $fh;
- if ($file eq "-") {
- $fh = \*STDOUT;
- } else {
- open(SYM_FILE, "> $file") || main::syserr(sprintf(_g("Can't open %s for
writing: %s"), $file, $!));
- $fh = \*SYM_FILE;
- }
- $self->dump($fh);
- close($fh) if ($file ne "-");
-}
-
-sub dump {
- my ($self, $fh) = @_;
- foreach my $soname (sort keys %{$self->{objects}}) {
- print $fh "$soname $self->{objects}{$soname}{deps}[0]\n";
- print $fh "| $_" foreach (@{$self->{objects}{$soname}{deps}}[ 1 .. -1
]);
- foreach my $sym (sort keys %{$self->{objects}{$soname}{syms}}) {
- my $info = $self->{objects}{$soname}{syms}{$sym};
- print $fh "#DEPRECATED: $info->{deprecated}#" if
$info->{deprecated};
- print $fh " $sym $info->{minver}";
- print $fh " $info->{dep_id}" if $info->{dep_id};
- print $fh "\n";
- }
- }
-}
-
-# merge_symbols($object, $minver)
-# Needs $Objdump->get_object($soname) as parameter
-sub merge_symbols {
- my ($self, $object, $minver) = @_;
- my $soname = $object->{SONAME} || main::error(_g("Can't merge symbols from
objects without SONAME."));
- my %dynsyms = map { $_ => $object->{dynsyms}{$_} }
- grep { local $a = $object->{dynsyms}{$_}; $a->{dynamic} &&
$a->{defined} }
- keys %{$object->{dynsyms}};
- # Scan all symbols provided by the objects
- foreach my $sym (keys %dynsyms) {
- if (exists $self->{objects}{$soname}{syms}{$sym}) {
- # If the symbol is already listed in the file
- my $info = $self->{objects}{$soname}{syms}{$sym};
- if ($info->{deprecated}) {
- # Symbol reappeared somehow
- $info->{deprecated} = 0;
- $info->{minver} = $minver;
- next;
- }
- # We assume that the right dependency information is already
- # there.
- if (compare_versions($minver, "lt", $info->{minver})) {
- $info->{minver} = $minver;
- }
- } else {
- # The symbol is new and not present in the file
- my $info = {
- 'minver' => $minver,
- 'deprecated' => 0,
- 'dep_id' => 0
- };
- $self->{objects}{$soname}{syms}{$sym} = $info;
- }
- }
-
- # Scan all symbols in the file and mark as deprecated those that are
- # no more provided
- foreach my $sym (keys %{$self->{objects}{$soname}{syms}}) {
- if (! exists $dynsyms{$sym}) {
- $self->{objects}{$soname}{syms}{$sym}{deprecated} = $minver;
- }
- }
-}
-
-sub has_object {
- my ($self, $soname) = @_;
- return exists $self->{objects}{$soname};
-}
-
-sub create_object {
- my ($self, $soname, @deps) = @_;
- $self->{objects}{$soname} = {
- "syms" => {},
- "deps" => [ @deps ]
- };
-}
-
-sub get_dependency {
- my ($self, $soname, $dep_id) = @_;
- $dep_id = 0 unless defined($dep_id);
- return $self->{objects}{$soname}{deps}[$dep_id];
-}
-
-sub lookup_symbol {
- my ($self, $name, $sonames) = @_;
- foreach my $so (@{$sonames}) {
- next if (! exists $self->{objects}{$so});
- if (exists $self->{objects}{$so}{syms}{$name} and
- not $self->{objects}{$so}{syms}{$name}{deprecated})
- {
- my $dep_id = $self->{objects}{$so}{syms}{$name}{dep_id};
- return {
- 'depends' => $self->{objects}{$so}{deps}[$dep_id],
- 'soname' => $so,
- %{$self->{objects}{$so}{syms}{$name}}
- };
- }
- }
- return undef;
-}
-
-sub has_lost_symbols {
- my ($self, $ref) = @_;
- foreach my $soname (keys %{$self->{objects}}) {
- my $mysyms = $self->{objects}{$soname}{syms};
- next if not exists $ref->{objects}{$soname};
- my $refsyms = $ref->{objects}{$soname}{syms};
- foreach my $sym (grep { not $refsyms->{$_}{deprecated} }
- keys %{$refsyms})
- {
- if ((not exists $mysyms->{$sym}) or
- $mysyms->{$sym}{deprecated})
- {
- return 1;
- }
- }
- }
- return 0;
-}
-
-sub has_new_symbols {
- my ($self, $ref) = @_;
- foreach my $soname (keys %{$self->{objects}}) {
- my $mysyms = $self->{objects}{$soname}{syms};
- next if not exists $ref->{objects}{$soname};
- my $refsyms = $ref->{objects}{$soname}{syms};
- foreach my $sym (grep { not $mysyms->{$_}{deprecated} }
- keys %{$mysyms})
- {
- if ((not exists $refsyms->{$sym}) or
- $refsyms->{$sym}{deprecated})
- {
- return 1;
- }
- }
- }
- return 0;
-}
-
-sub has_new_libs {
- my ($self, $ref) = @_;
- foreach my $soname (keys %{$self->{objects}}) {
- return 1 if not exists $ref->{objects}{$soname};
- }
- return 0;
-}
-
-sub has_lost_libs {
- my ($self, $ref) = @_;
- foreach my $soname (keys %{$ref->{objects}}) {
- return 1 if not exists $self->{objects}{$soname};
- }
- return 0;
-}
-
-1;
Copied: branches/dpkg-shlibdeps-buxy/scripts/Dpkg/SymbolFile.pm (from rev 848,
branches/dpkg-shlibdeps-buxy/scripts/modules/SymbolFile.pm)
===================================================================
--- branches/dpkg-shlibdeps-buxy/scripts/Dpkg/SymbolFile.pm
(rev 0)
+++ branches/dpkg-shlibdeps-buxy/scripts/Dpkg/SymbolFile.pm 2007-07-08
19:49:48 UTC (rev 849)
@@ -0,0 +1,253 @@
+# Copyright (C) 2007 Raphael Hertzog
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Shlibs::SymbolFile;
+
+require 'dpkg-gettext.pl';
+
+use Dpkg::Version qw(compare_versions);
+
+sub new {
+ my $this = shift;
+ my $file = shift;
+ my $class = ref($this) || $this;
+ my $self = { };
+ bless $self, $class;
+ if (defined($file) ) {
+ $self->{file} = $file;
+ $self->load($file) if -e $file;
+ }
+ return $self;
+}
+
+sub clear {
+ my ($self) = @_;
+ $self->{objects} = {};
+}
+
+sub clear_except {
+ my ($self, @ids) = @_;
+ my %has;
+ $has{$_} = 1 foreach (@ids);
+ foreach my $objid (keys %{$self->{objects}}) {
+ delete $self->{objects}{$objid} unless exists $has{$objid};
+ }
+}
+
+sub load {
+ my ($self, $file) = @_;
+ $self->{file} = $file;
+ open(SYM_FILE, "<", $file) || main::syserr(sprintf(_g("Can't open %s:
%s"), $file));
+ my ($object);
+ while (defined($_ = <SYM_FILE>)) {
+ chomp($_);
+ if (/^\s+(\S+)\s(\S+)(?:\s(\d+))?/) {
+ # New symbol
+ my $sym = {
+ 'minver' => $2,
+ 'dep_id' => defined($3) ? $3 : 0,
+ 'deprecated' => 0
+ };
+ $self->{objects}{$object}{syms}{$1} = $sym;
+ } elsif (/^#DEPRECATED: ([^#]+)#\s*(\S+)\s(\S+)(?:\s(\d+))?/) {
+ my $sym = {
+ 'minver' => $3,
+ 'dep_id' => defined($4) ? $4 : 0,
+ 'deprecated' => $1
+ };
+ $self->{objects}{$object}{syms}{$2} = $sym;
+ } elsif (/^\|\s*(.*)$/) {
+ # Alternative dependency template
+ push @{$self->{objects}{$object}{deps}}, "$1";
+ } elsif (/^(\S+)\s+(.*)$/) {
+ # New object and dependency template
+ $object = $1;
+ $self->{objects}{$object} = {
+ 'syms' => {},
+ 'deps' => [ "$2" ]
+ };
+ } else {
+ main::warning(sprintf(_g("Failed to parse a line in %s: %s"),
$file, $_));
+ }
+ }
+ close(SYM_FILE);
+}
+
+sub save {
+ my ($self, $file) = @_;
+ $file = $self->{file} unless defined($file);
+ my $fh;
+ if ($file eq "-") {
+ $fh = \*STDOUT;
+ } else {
+ open(SYM_FILE, "> $file") || main::syserr(sprintf(_g("Can't open %s for
writing: %s"), $file, $!));
+ $fh = \*SYM_FILE;
+ }
+ $self->dump($fh);
+ close($fh) if ($file ne "-");
+}
+
+sub dump {
+ my ($self, $fh) = @_;
+ foreach my $soname (sort keys %{$self->{objects}}) {
+ print $fh "$soname $self->{objects}{$soname}{deps}[0]\n";
+ print $fh "| $_" foreach (@{$self->{objects}{$soname}{deps}}[ 1 .. -1
]);
+ foreach my $sym (sort keys %{$self->{objects}{$soname}{syms}}) {
+ my $info = $self->{objects}{$soname}{syms}{$sym};
+ print $fh "#DEPRECATED: $info->{deprecated}#" if
$info->{deprecated};
+ print $fh " $sym $info->{minver}";
+ print $fh " $info->{dep_id}" if $info->{dep_id};
+ print $fh "\n";
+ }
+ }
+}
+
+# merge_symbols($object, $minver)
+# Needs $Objdump->get_object($soname) as parameter
+sub merge_symbols {
+ my ($self, $object, $minver) = @_;
+ my $soname = $object->{SONAME} || main::error(_g("Can't merge symbols from
objects without SONAME."));
+ my %dynsyms = map { $_ => $object->{dynsyms}{$_} }
+ grep { local $a = $object->{dynsyms}{$_}; $a->{dynamic} &&
$a->{defined} }
+ keys %{$object->{dynsyms}};
+ # Scan all symbols provided by the objects
+ foreach my $sym (keys %dynsyms) {
+ if (exists $self->{objects}{$soname}{syms}{$sym}) {
+ # If the symbol is already listed in the file
+ my $info = $self->{objects}{$soname}{syms}{$sym};
+ if ($info->{deprecated}) {
+ # Symbol reappeared somehow
+ $info->{deprecated} = 0;
+ $info->{minver} = $minver;
+ next;
+ }
+ # We assume that the right dependency information is already
+ # there.
+ if (compare_versions($minver, "lt", $info->{minver})) {
+ $info->{minver} = $minver;
+ }
+ } else {
+ # The symbol is new and not present in the file
+ my $info = {
+ 'minver' => $minver,
+ 'deprecated' => 0,
+ 'dep_id' => 0
+ };
+ $self->{objects}{$soname}{syms}{$sym} = $info;
+ }
+ }
+
+ # Scan all symbols in the file and mark as deprecated those that are
+ # no more provided
+ foreach my $sym (keys %{$self->{objects}{$soname}{syms}}) {
+ if (! exists $dynsyms{$sym}) {
+ $self->{objects}{$soname}{syms}{$sym}{deprecated} = $minver;
+ }
+ }
+}
+
+sub has_object {
+ my ($self, $soname) = @_;
+ return exists $self->{objects}{$soname};
+}
+
+sub create_object {
+ my ($self, $soname, @deps) = @_;
+ $self->{objects}{$soname} = {
+ "syms" => {},
+ "deps" => [ @deps ]
+ };
+}
+
+sub get_dependency {
+ my ($self, $soname, $dep_id) = @_;
+ $dep_id = 0 unless defined($dep_id);
+ return $self->{objects}{$soname}{deps}[$dep_id];
+}
+
+sub lookup_symbol {
+ my ($self, $name, $sonames) = @_;
+ foreach my $so (@{$sonames}) {
+ next if (! exists $self->{objects}{$so});
+ if (exists $self->{objects}{$so}{syms}{$name} and
+ not $self->{objects}{$so}{syms}{$name}{deprecated})
+ {
+ my $dep_id = $self->{objects}{$so}{syms}{$name}{dep_id};
+ return {
+ 'depends' => $self->{objects}{$so}{deps}[$dep_id],
+ 'soname' => $so,
+ %{$self->{objects}{$so}{syms}{$name}}
+ };
+ }
+ }
+ return undef;
+}
+
+sub has_lost_symbols {
+ my ($self, $ref) = @_;
+ foreach my $soname (keys %{$self->{objects}}) {
+ my $mysyms = $self->{objects}{$soname}{syms};
+ next if not exists $ref->{objects}{$soname};
+ my $refsyms = $ref->{objects}{$soname}{syms};
+ foreach my $sym (grep { not $refsyms->{$_}{deprecated} }
+ keys %{$refsyms})
+ {
+ if ((not exists $mysyms->{$sym}) or
+ $mysyms->{$sym}{deprecated})
+ {
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+sub has_new_symbols {
+ my ($self, $ref) = @_;
+ foreach my $soname (keys %{$self->{objects}}) {
+ my $mysyms = $self->{objects}{$soname}{syms};
+ next if not exists $ref->{objects}{$soname};
+ my $refsyms = $ref->{objects}{$soname}{syms};
+ foreach my $sym (grep { not $mysyms->{$_}{deprecated} }
+ keys %{$mysyms})
+ {
+ if ((not exists $refsyms->{$sym}) or
+ $refsyms->{$sym}{deprecated})
+ {
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+sub has_new_libs {
+ my ($self, $ref) = @_;
+ foreach my $soname (keys %{$self->{objects}}) {
+ return 1 if not exists $ref->{objects}{$soname};
+ }
+ return 0;
+}
+
+sub has_lost_libs {
+ my ($self, $ref) = @_;
+ foreach my $soname (keys %{$ref->{objects}}) {
+ return 1 if not exists $self->{objects}{$soname};
+ }
+ return 0;
+}
+
+1;
Modified: branches/dpkg-shlibdeps-buxy/scripts/Makefile.am
===================================================================
--- branches/dpkg-shlibdeps-buxy/scripts/Makefile.am 2007-07-08 19:42:16 UTC
(rev 848)
+++ branches/dpkg-shlibdeps-buxy/scripts/Makefile.am 2007-07-08 19:49:48 UTC
(rev 849)
@@ -1,6 +1,6 @@
## Process this file with automake to produce Makefile.in
-SUBDIRS = po modules
+SUBDIRS = po Dpkg
bin_SCRIPTS = \
822-date \
--
To UNSUBSCRIBE, email to [EMAIL PROTECTED]
with a subject of "unsubscribe". Trouble? Contact [EMAIL PROTECTED]
