[SCM] Debian Qt/KDE packaging tools branch, master, updated. debian/0.6.6
Modestas Vainius
modax at alioth.debian.org
Sun Feb 28 18:58:46 UTC 2010
The following commit has been merged in the master branch:
commit cf54068997d3434f0fb6a8b925876c26f583a904
Author: Modestas Vainius <modestas at vainius.eu>
Date: Sun Feb 21 15:28:54 2010 +0200
Resync with dpkg.git master once again.
---
symbolshelper/Dpkg/Compression.pm | 216 +++++++++++++
symbolshelper/Dpkg/Compression/FileHandle.pm | 442 ++++++++++++++++++++++++++
symbolshelper/Dpkg/Compression/Process.pm | 203 ++++++++++++
symbolshelper/Dpkg/Interface/Storable.pm | 143 +++++++++
symbolshelper/Dpkg/Shlibs/Cppfilt.pm | 3 +
symbolshelper/Dpkg/Shlibs/Objdump.pm | 390 +++++++++++++++++++++++
symbolshelper/Dpkg/Shlibs/Symbol.pm | 5 +-
symbolshelper/Dpkg/Shlibs/SymbolFile.pm | 52 ++--
symbolshelper/dpkg-gensymbols.pl | 14 +-
9 files changed, 1432 insertions(+), 36 deletions(-)
diff --git a/symbolshelper/Dpkg/Compression.pm b/symbolshelper/Dpkg/Compression.pm
new file mode 100644
index 0000000..ce21c00
--- /dev/null
+++ b/symbolshelper/Dpkg/Compression.pm
@@ -0,0 +1,216 @@
+# Copyright © 2010 Raphaël Hertzog <hertzog at debian.org>
+#
+# 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, see <http://www.gnu.org/licenses/>.
+
+package Dpkg::Compression;
+
+use strict;
+use warnings;
+
+our $VERSION = "1.00";
+
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+
+use base qw(Exporter);
+our @EXPORT = qw($compression_re_file_ext compression_get_list
+ compression_is_supported compression_get_property
+ compression_guess_from_filename
+ compression_get_default compression_set_default
+ compression_get_default_level
+ compression_set_default_level
+ compression_is_valid_level);
+
+=head1 NAME
+
+Dpkg::Compression - simple database of available compression methods
+
+=head1 DESCRIPTION
+
+This modules provides a few public funcions and a public regex to
+interact with the set of supported compression methods.
+
+=head1 EXPORTED VARIABLES
+
+=over 4
+
+=cut
+
+my $COMP = {
+ "gzip" => {
+ "file_ext" => "gz",
+ "comp_prog" => "gzip",
+ "decomp_prog" => "gunzip",
+ },
+ "bzip2" => {
+ "file_ext" => "bz2",
+ "comp_prog" => "bzip2",
+ "decomp_prog" => "bunzip2",
+ },
+ "lzma" => {
+ "file_ext" => "lzma",
+ "comp_prog" => "lzma",
+ "decomp_prog" => "unlzma",
+ },
+ "xz" => {
+ "file_ext" => "xz",
+ "comp_prog" => "xz",
+ "decomp_prog" => "unxz",
+ },
+};
+
+our $default_compression = "gzip";
+our $default_compression_level = 9;
+
+=item $compression_re_file_ext
+
+A regex that matches a file extension of a file compressed with one of the
+supported compression methods.
+
+=back
+
+=cut
+
+my $regex = join "|", map { $_->{"file_ext"} } values %$COMP;
+our $compression_re_file_ext = qr/(?:$regex)/;
+
+=head1 EXPORTED FUNCTIONS
+
+=over 4
+
+=item my @list = compression_get_list()
+
+Returns a list of supported compression methods (sorted alphabetically).
+
+=cut
+
+sub compression_get_list {
+ return sort keys %$COMP;
+}
+
+=item compression_is_supported($comp)
+
+Returns a boolean indicating whether the give compression method is
+known and supported.
+
+=cut
+
+sub compression_is_supported {
+ return exists $COMP->{$_[0]};
+}
+
+=item compression_get_property($comp, $property)
+
+Returns the requested property of the compression method. Returns undef if
+either the property or the compression method doesn't exist. Valid
+properties currently include "file_ext" for the file extension,
+"comp_prog" for the name of the compression program and "decomp_prog" for
+the name of the decompression program.
+
+=cut
+
+sub compression_get_property {
+ my ($comp, $property) = @_;
+ return undef unless compression_is_supported($comp);
+ return $COMP->{$comp}{$property} if exists $COMP->{$comp}{$property};
+ return undef;
+}
+
+=item compression_guess_from_filename($filename)
+
+Returns the compression method that is likely used on the indicated
+filename based on its file extension.
+
+=cut
+
+sub compression_guess_from_filename {
+ my $filename = shift;
+ foreach my $comp (compression_get_list()) {
+ my $ext = compression_get_property($comp, "file_ext");
+ if ($filename =~ /^(.*)\.\Q$ext\E$/) {
+ return $comp;
+ }
+ }
+ return undef;
+}
+
+=item my $comp = compression_get_default()
+
+Return the default compression method. It's "gzip" unless
+C<compression_set_default> has been used to change it.
+
+=item compression_set_default($comp)
+
+Change the default compression methode. Errors out if the
+given compression method is not supported.
+
+=cut
+
+sub compression_get_default {
+ return $default_compression;
+}
+
+sub compression_set_default {
+ my ($method) = @_;
+ error(_g("%s is not a supported compression"), $method)
+ unless compression_is_supported($method);
+ $default_compression = $method;
+}
+
+=item my $level = compression_get_default_level()
+
+Return the default compression level used when compressing data. It's "9"
+unless C<compression_set_default_level> has been used to change it.
+
+=item compression_set_default_level($level)
+
+Change the default compression level. Errors out if the
+level is not valid (see C<compression_is_valid_level>).
+either a number between 1 and 9 or "fast"
+or "best".
+
+=cut
+
+sub compression_get_default_level {
+ return $default_compression_level;
+}
+
+sub compression_set_default_level {
+ my ($level) = @_;
+ error(_g("%s is not a compression level"), $level)
+ unless compression_is_valid_level($level);
+ $default_compression_level = $level;
+}
+
+=item compression_is_valid_level($level)
+
+Returns a boolean indicating whether $level is a valid compression level
+(it must be either a number between 1 and 9 or "fast" or "best")
+
+=cut
+
+sub compression_is_valid_level {
+ my ($level) = @_;
+ return $level =~ /^([1-9]|fast|best)$/;
+}
+
+=back
+
+=head1 AUTHOR
+
+Raphaël Hertzog <hertzog at debian.org>.
+
+=cut
+
+1;
diff --git a/symbolshelper/Dpkg/Compression/FileHandle.pm b/symbolshelper/Dpkg/Compression/FileHandle.pm
new file mode 100644
index 0000000..e9c975b
--- /dev/null
+++ b/symbolshelper/Dpkg/Compression/FileHandle.pm
@@ -0,0 +1,442 @@
+# Copyright © 2008-2010 Raphaël Hertzog <hertzog at debian.org>
+#
+# 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, see <http://www.gnu.org/licenses/>.
+
+package Dpkg::Compression::FileHandle;
+
+use strict;
+use warnings;
+
+our $VERSION = "1.00";
+
+use Dpkg::Compression;
+use Dpkg::Compression::Process;
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use POSIX qw(WIFSIGNALED WTERMSIG SIGPIPE);
+
+use base qw(FileHandle Tie::Handle);
+
+# Useful reference to understand some kludges required to
+# have the object behave like a filehandle
+# http://blog.woobling.org/2009/10/are-filehandles-objects.html
+
+=head1 NAME
+
+Dpkg::Compression::FileHandle - object dealing transparently with file compression
+
+=head1 SYNOPSIS
+
+ use Dpkg::Compression::FileHandle;
+
+ $fh = Dpkg::Compression::FileHandle->new(filename=>"sample.gz");
+ print $fh "Something\n";
+ close $fh;
+
+ $fh = Dpkg::Compression::FileHandle->new();
+ open($fh, ">", "sample.bz2");
+ print $fh "Something\n";
+ close $fh;
+
+ $fh = Dpkg::Compression::FileHandle->new();
+ $fh->open("sample.xz", "w");
+ $fh->print("Something\n");
+ $fh->close();
+
+ $fh = Dpkg::Compression::FileHandle->new(filename=>"sample.gz");
+ my @lines = <$fh>;
+ close $fh;
+
+ $fh = Dpkg::Compression::FileHandle->new();
+ open($fh, "<", "sample.bz2");
+ my @lines = <$fh>;
+ close $fh;
+
+ $fh = Dpkg::Compression::FileHandle->new();
+ $fh->open("sample.xz", "r");
+ my @lines = $fh->getlines();
+ $fh->close();
+
+=head1 DESCRIPTION
+
+Dpkg::Compression::FileHandle is an object that can be used
+like any filehandle and that deals transparently with compressed
+files. By default, the compression scheme is guessed from the filename
+but you can override this behaviour with the method C<set_compression>.
+
+If you don't open the file explicitely, it will be auto-opened on the
+first read or write operation based on the filename set at creation time
+(or later with the C<set_filename> method).
+
+Once a file has been opened, the filehandle must be closed before being
+able to open another file.
+
+=head1 STANDARD FUNCTIONS
+
+The standard functions acting on filehandles should accept a
+Dpkg::Compression::FileHandle object transparently including
+C<open> (only when using the variant with 3 parameters), C<close>,
+C<binmode>, C<eof>, C<fileno>, C<getc>, C<print>, C<printf>, C<read>,
+C<sysread>, C<say>, C<write>, C<syswrite>, C<seek>, C<sysseek>, C<tell>.
+
+Note however that C<seek> and C<sysseek> will only work on uncompressed
+files as compressed files are really pipes to the compressor programs
+and you can't seek on a pipe.
+
+=head1 FileHandle METHODS
+
+The object inherits from FileHandle so all methods that work on this
+object should work for Dpkg::Compression::FileHandle too. There
+may be exceptions though.
+
+=head1 PUBLIC METHODS
+
+=over 4
+
+=item my $fh = Dpkg::Compression::FileHandle->new(%opts)
+
+Creates a new filehandle supporting on-the-fly compression/decompression.
+Supported options are "filename", "compression", "compression_level" (see
+respective set_* functions) and "add_comp_ext". If "add_comp_ext"
+evaluates to true, then the extension corresponding to the selected
+compression scheme is automatically added to the recorded filename. It's
+obviously incompatible with automatic detection of the compression method.
+
+=cut
+
+# Object methods
+sub new {
+ my ($this, %args) = @_;
+ my $class = ref($this) || $this;
+ my $self = FileHandle->new();
+ # Tying is required to overload the open functions and to auto-open
+ # the file on first read/write operation
+ tie *$self, $class, $self;
+ bless $self, $class;
+ # Initializations
+ *$self->{"compression"} = "auto";
+ *$self->{"compressor"} = Dpkg::Compression::Process->new();
+ *$self->{"add_comp_ext"} = $args{"add_compression_extension"} ||
+ $args{"add_comp_ext"} || 0;
+ *$self->{"allow_sigpipe"} = 0;
+ if (exists $args{"filename"}) {
+ $self->set_filename($args{"filename"});
+ }
+ if (exists $args{"compression"}) {
+ $self->set_compression($args{"compression"});
+ }
+ if (exists $args{"compression_level"}) {
+ $self->set_compression_level($args{"compression_level"});
+ }
+ return $self;
+}
+
+=item $fh->ensure_open($mode)
+
+Ensure the file is opened in the requested mode ("r" for read and "w" for
+write). Opens the file with the recorded filename if needed. If the file
+is already open but not in the requested mode, then it errors out.
+
+=cut
+
+sub ensure_open {
+ my ($self, $mode) = @_;
+ if (exists *$self->{"mode"}) {
+ return if *$self->{"mode"} eq $mode;
+ internerr("ensure_open requested incompatible mode: $mode");
+ } else {
+ if ($mode eq "w") {
+ $self->open_for_write();
+ } elsif ($mode eq "r") {
+ $self->open_for_read();
+ } else {
+ internerr("invalid mode in ensure_open: $mode");
+ }
+ }
+}
+
+##
+## METHODS FOR TIED HANDLE
+##
+sub TIEHANDLE {
+ my ($class, $self) = @_;
+ return $self;
+}
+
+sub WRITE {
+ my ($self, $scalar, $length, $offset) = @_;
+ $self->ensure_open("w");
+ return *$self->{'file'}->write($scalar, $length, $offset);
+}
+
+sub READ {
+ my ($self, $scalar, $length, $offset) = @_;
+ $self->ensure_open("r");
+ return *$self->{'file'}->read($scalar, $length, $offset);
+}
+
+sub READLINE {
+ my ($self) = shift;
+ $self->ensure_open("r");
+ return *$self->{"file"}->getlines() if wantarray;
+ return *$self->{"file"}->getline();
+}
+
+sub OPEN {
+ my ($self) = shift;
+ if (scalar(@_) == 2) {
+ my ($mode, $filename) = @_;
+ $self->set_filename($filename);
+ if ($mode eq ">") {
+ $self->open_for_write();
+ } elsif ($mode eq "<") {
+ $self->open_for_read();
+ } else {
+ internerr("Unsupported open mode on Dpkg::Compression::FileHandle: $mode");
+ }
+ } else {
+ internerr("Dpkg::Compression::FileHandle only supports open() with 3 parameters");
+ }
+ return 1; # Always works (otherwise errors out)
+}
+
+sub CLOSE {
+ my ($self) = shift;
+ my $ret = 1;
+ if (defined *$self->{'file'}) {
+ $ret = *$self->{'file'}->close(@_) if *$self->{'file'}->opened();
+ } else {
+ $ret = 0;
+ }
+ $self->cleanup();
+ return $ret;
+}
+
+sub FILENO {
+ my ($self) = shift;
+ return *$self->{"file"}->fileno(@_) if defined *$self->{"file"};
+ return undef;
+}
+
+sub EOF {
+ my ($self) = shift;
+ return *$self->{"file"}->eof(@_) if defined *$self->{"file"};
+ return 1;
+}
+
+sub SEEK {
+ my ($self) = shift;
+ return *$self->{"file"}->seek(@_) if defined *$self->{"file"};
+ return 0;
+}
+
+sub TELL {
+ my ($self) = shift;
+ return *$self->{"file"}->tell(@_) if defined *$self->{"file"};
+ return -1;
+}
+
+sub BINMODE {
+ my ($self) = shift;
+ return *$self->{"file"}->binmode(@_) if defined *$self->{"file"};
+ return undef;
+}
+
+##
+## NORMAL METHODS
+##
+
+=item $fh->set_compression($comp)
+
+Defines the compression method used. $comp should one of the methods supported by
+B<Dpkg::Compression> or "none" or "auto". "none" indicates that the file is
+uncompressed and "auto" indicates that the method must be guessed based
+on the filename extension used.
+
+=cut
+
+sub set_compression {
+ my ($self, $method) = @_;
+ if ($method ne "none" and $method ne "auto") {
+ *$self->{"compressor"}->set_compression($method);
+ }
+ *$self->{"compression"} = $method;
+}
+
+=item $fh->set_compression_level($level)
+
+Indicate the desired compression level. It should be a value accepted
+by the function C<compression_is_valid_level> of B<Dpkg::Compression>.
+
+=cut
+
+sub set_compression_level {
+ my ($self, $level) = @_;
+ *$self->{"compressor"}->set_compression_level($level);
+}
+
+=item $fh->set_filename($name, [$add_comp_ext])
+
+Use $name as filename when the file must be opened/created. If
+$add_comp_ext is passed, it indicates whether the default extension
+of the compression method must be automatically added to the filename
+(or not).
+
+=cut
+
+sub set_filename {
+ my ($self, $filename, $add_comp_ext) = @_;
+ *$self->{"filename"} = $filename;
+ # Automatically add compression extension to filename
+ if (defined($add_comp_ext)) {
+ *$self->{"add_comp_ext"} = $add_comp_ext;
+ }
+ if (*$self->{"add_comp_ext"} and $filename =~ /\.$compression_re_file_ext$/) {
+ warning("filename %s already has an extension of a compressed file " .
+ "and add_comp_ext is active", $filename);
+ }
+}
+
+=item my $file = $fh->get_filename()
+
+Returns the filename that would be used when the filehandle must
+be opened (both in read and write mode). This function errors out
+if "add_comp_ext" is enableactivated while the compression method is set
+to "auto". The returned filename includes the extension of the compression
+method if "add_comp_ext" is enabled.
+
+=cut
+
+sub get_filename {
+ my $self = shift;
+ my $comp = *$self->{"compression"};
+ if (*$self->{'add_comp_ext'}) {
+ if ($comp eq "auto") {
+ internerr("automatic detection of compression is " .
+ "incompatible with add_comp_ext");
+ } elsif ($comp eq "none") {
+ return *$self->{"filename"};
+ } else {
+ return *$self->{"filename"} . "." .
+ compression_get_property($comp, "file_ext");
+ }
+ } else {
+ return *$self->{"filename"};
+ }
+}
+
+=item $ret = $fh->use_compression()
+
+Returns "0" if no compression is used and the compression method used
+otherwise. If the compression is set to "auto", the value returned
+depends on the extension of the filename obtained with the B<get_filename>
+method.
+
+=cut
+
+sub use_compression {
+ my ($self) = @_;
+ my $comp = *$self->{"compression"};
+ if ($comp eq "none") {
+ return 0;
+ } elsif ($comp eq "auto") {
+ $comp = compression_guess_from_filename($self->get_filename());
+ *$self->{"compressor"}->set_compression($comp) if $comp;
+ }
+ return $comp;
+}
+
+=item my $real_fh = $fh->get_filehandle()
+
+Returns the real underlying filehandle. Useful if you want to pass it
+along in a derived object.
+
+=cut
+
+sub get_filehandle {
+ my ($self) = @_;
+ return *$self->{"file"} if exists *$self->{"file"};
+}
+
+## INTERNAL METHODS
+
+sub open_for_write {
+ my ($self) = @_;
+ error("Can't reopen an already opened compressed file") if exists *$self->{"mode"};
+ my $filehandle;
+ if ($self->use_compression()) {
+ *$self->{'compressor'}->compress(from_pipe => \$filehandle,
+ to_file => $self->get_filename());
+ } else {
+ CORE::open($filehandle, ">", $self->get_filename) ||
+ syserr(_g("cannot write %s"), $self->get_filename());
+ }
+ *$self->{"mode"} = "w";
+ *$self->{"file"} = $filehandle;
+}
+
+sub open_for_read {
+ my ($self) = @_;
+ error("Can't reopen an already opened compressed file") if exists *$self->{"mode"};
+ my $filehandle;
+ if ($self->use_compression()) {
+ *$self->{'compressor'}->uncompress(to_pipe => \$filehandle,
+ from_file => $self->get_filename());
+ *$self->{'allow_sigpipe'} = 1;
+ } else {
+ CORE::open($filehandle, "<", $self->get_filename) ||
+ syserr(_g("cannot read %s"), $self->get_filename());
+ }
+ *$self->{"mode"} = "r";
+ *$self->{"file"} = $filehandle;
+}
+
+sub cleanup {
+ my ($self) = @_;
+ my $cmdline = *$self->{"compressor"}{"cmdline"} || "";
+ *$self->{"compressor"}->wait_end_process(nocheck => *$self->{'allow_sigpipe'});
+ if (*$self->{'allow_sigpipe'}) {
+ unless (($? == 0) || (WIFSIGNALED($?) && (WTERMSIG($?) == SIGPIPE))) {
+ subprocerr($cmdline);
+ }
+ *$self->{'allow_sigpipe'} = 0;
+ }
+ delete *$self->{"mode"};
+ delete *$self->{"file"};
+}
+
+=back
+
+=head1 DERIVED OBJECTS
+
+If you want to create an object that inherits from
+Dpkg::Compression::FileHandle you must be aware that
+the object is a reference to a GLOB that is returned by Symbol::gensym()
+and as such it's not a HASH.
+
+You can store internal data in a hash but you have to use
+C<*$self->{...}> to access the associated hash like in the example below:
+
+ sub set_option {
+ my ($self, $value) = @_;
+ *$self->{"option"} = $value;
+ }
+
+
+=head1 AUTHOR
+
+Raphaël Hertzog <hertzog at debian.org>
+
+=cut
+1;
diff --git a/symbolshelper/Dpkg/Compression/Process.pm b/symbolshelper/Dpkg/Compression/Process.pm
new file mode 100644
index 0000000..538490d
--- /dev/null
+++ b/symbolshelper/Dpkg/Compression/Process.pm
@@ -0,0 +1,203 @@
+# Copyright © 2008-2010 Raphaël Hertzog <hertzog at debian.org>
+#
+# 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, see <http://www.gnu.org/licenses/>.
+
+package Dpkg::Compression::Process;
+
+use strict;
+use warnings;
+
+our $VERSION = "1.00";
+
+use Dpkg::Compression;
+use Dpkg::ErrorHandling;
+use Dpkg::Gettext;
+use Dpkg::IPC;
+
+=head1 NAME
+
+Dpkg::Compression::Process - run compression/decompression processes
+
+=head1 DESCRIPTION
+
+This module provides an object oriented interface to run and manage
+compression/decompression processes.
+
+=head1 METHODS
+
+=over 4
+
+=item my $proc = Dpkg::Compression::Process->new(%opts)
+
+Create a new instance of the object. Supported options are "compression"
+and "compression_level" (see corresponding set_* functions).
+
+=cut
+
+sub new {
+ my ($this, %args) = @_;
+ my $class = ref($this) || $this;
+ my $self = {};
+ bless $self, $class;
+ $self->set_compression($args{"compression"} || compression_get_default());
+ $self->set_compression_level($args{"compression_level"} ||
+ compression_get_default_level());
+ return $self;
+}
+
+=item $proc->set_compression($comp)
+
+Select the compression method to use. It errors out if the method is not
+supported according to C<compression_is_supported> (of
+B<Dpkg::Compression>).
+
+=cut
+
+sub set_compression {
+ my ($self, $method) = @_;
+ error(_g("%s is not a supported compression method"), $method)
+ unless compression_is_supported($method);
+ $self->{"compression"} = $method;
+}
+
+=item $proc->set_compression_level($level)
+
+Select the compression level to use. It errors out if the level is not
+valid according to C<compression_is_valid_level> (of
+B<Dpkg::Compression>).
+
+=cut
+
+sub set_compression_level {
+ my ($self, $level) = @_;
+ error(_g("%s is not a compression level"), $level)
+ unless compression_is_valid_level($level);
+ $self->{"compression_level"} = $level;
+}
+
+=item my @exec = $proc->get_compress_cmdline()
+
+=item my @exec = $proc->get_uncompress_cmdline()
+
+Returns a list ready to be passed to C<exec>, its first element is the
+program name (either for compression or decompression) and the following
+elements are parameters for the program.
+
+When executed the program acts as a filter between its standard input
+and its standard output.
+
+=cut
+
+sub get_compress_cmdline {
+ my ($self) = @_;
+ my @prog = (compression_get_property($self->{"compression"}, "comp_prog"));
+ my $level = "-" . $self->{"compression_level"};
+ $level = "--" . $self->{"compression_level"}
+ if $self->{"compression_level"} !~ m/^[1-9]$/;
+ push @prog, $level;
+ return @prog;
+}
+
+sub get_uncompress_cmdline {
+ my ($self) = @_;
+ return (compression_get_property($self->{"compression"}, "decomp_prog"));
+}
+
+sub _sanity_check {
+ my ($self, %opts) = @_;
+ # Check for proper cleaning before new start
+ error(_g("Dpkg::Compression::Process can only start one subprocess at a time"))
+ if $self->{"pid"};
+ # Check options
+ my $to = my $from = 0;
+ foreach (qw(file handle string pipe)) {
+ $to++ if $opts{"to_$_"};
+ $from++ if $opts{"from_$_"};
+ }
+ internerr("exactly one to_* parameter is needed") if $to != 1;
+ internerr("exactly one from_* parameter is needed") if $from != 1;
+ return %opts;
+}
+
+=item $proc->compress(%opts)
+
+Starts a compressor program. You must indicate where it will read its
+uncompressed data from and where it will write its compressed data to.
+This is accomplished by passing one parameter C<to_*> and one parameter
+C<from_*> as accepted by B<Dpkg::IPC::spawn>.
+
+You must call C<wait_end_process> after having called this method to
+properly close the sub-process (and verify that it exited without error).
+
+=cut
+
+sub compress {
+ my $self = shift;
+ my %opts = $self->_sanity_check(@_);
+ my @prog = $self->get_compress_cmdline();
+ $opts{"exec"} = \@prog;
+ $self->{"cmdline"} = "@prog";
+ $self->{"pid"} = spawn(%opts);
+ delete $self->{"pid"} if $opts{"to_string"}; # wait_child already done
+}
+
+=item $proc->uncompress(%opts)
+
+Starts a decompressor program. You must indicate where it will read its
+compressed data from and where it will write its uncompressed data to.
+This is accomplished by passing one parameter C<to_*> and one parameter
+C<from_*> as accepted by B<Dpkg::IPC::spawn>.
+
+You must call C<wait_end_process> after having called this method to
+properly close the sub-process (and verify that it exited without error).
+
+=cut
+
+sub uncompress {
+ my $self = shift;
+ my %opts = $self->_sanity_check(@_);
+ my @prog = $self->get_uncompress_cmdline();
+ $opts{"exec"} = \@prog;
+ $self->{"cmdline"} = "@prog";
+ $self->{"pid"} = spawn(%opts);
+ delete $self->{"pid"} if $opts{"to_string"}; # wait_child already done
+}
+
+=item $proc->wait_end_process(%opts)
+
+Call B<Dpkg::IPC::wait_child> to wait until the sub-process has exited
+and verify its return code. Any given option will be forwarded to
+the C<wait_child> function. Most notably you can use the "nocheck" option
+to verify the return code yourself instead of letting C<wait_child> do
+it for you.
+
+=cut
+
+sub wait_end_process {
+ my ($self, %opts) = @_;
+ $opts{"cmdline"} ||= $self->{"cmdline"};
+ wait_child($self->{"pid"}, %opts) if $self->{'pid'};
+ delete $self->{"pid"};
+ delete $self->{"cmdline"};
+}
+
+=back
+
+=head1 AUTHOR
+
+Raphaël Hertzog <hertzog at debian.org>.
+
+=cut
+
+1;
diff --git a/symbolshelper/Dpkg/Interface/Storable.pm b/symbolshelper/Dpkg/Interface/Storable.pm
new file mode 100644
index 0000000..fa0043e
--- /dev/null
+++ b/symbolshelper/Dpkg/Interface/Storable.pm
@@ -0,0 +1,143 @@
+# Copyright © 2010 Raphaël Hertzog <hertzog at debian.org>
+#
+# 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, see <http://www.gnu.org/licenses/>.
+
+package Dpkg::Interface::Storable;
+
+use strict;
+use warnings;
+
+our $VERSION = "1.00";
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Compression::FileHandle;
+
+use overload
+ '""' => \&_stringify,
+ 'fallback' => 1;
+
+=head1 NAME
+
+Dpkg::Interface::Storable - common methods related to object serialization
+
+=head1 DESCRIPTION
+
+Dpkg::Interface::Storable is only meant to be used as parent
+class for other objects. It provides common methods that are
+all implemented on top of two basic methods parse() and output().
+
+=head1 BASE METHODS
+
+Those methods must be provided by the object that wish to inherit
+from Dpkg::Interface::Storable so that the methods provided can work.
+
+=over 4
+
+=item $obj->parse($fh, $desc)
+
+This methods initialize the object with the data stored in the
+filehandle. $desc is optional and is a textual description of
+the filehandle used in error messages.
+
+=item $string = $obj->output($fh)
+
+This method returns a string representation of the object in $string
+and it writes the same string to $fh (if it's defined).
+
+=back
+
+=head1 PROVIDED METHODS
+
+=over 4
+
+=item $obj->load($filename)
+
+Initialize the object with the data stored in the file. The file can be
+compressed, it will be uncompressed on the fly by using a
+Dpkg::Compression::FileHandle object. If $filename is "-", then the
+standard input is read (no compression is allowed in that case).
+
+=cut
+
+sub load {
+ my ($self, $file, @options) = @_;
+ unless ($self->can("parse")) {
+ internerr("%s cannot be loaded, it lacks the parse method", ref($self));
+ }
+ my ($desc, $fh) = ($file, undef);
+ if ($file eq "-") {
+ $fh = \*STDIN;
+ $desc = _g("<standard input>");
+ } else {
+ $fh = Dpkg::Compression::FileHandle->new();
+ open($fh, "<", $file) || syserr(_g("cannot read %s"), $file);
+ }
+ my $res = $self->parse($fh, $desc, @options);
+ if ($file ne "-") {
+ close($fh) || syserr(_g("cannot close %s"), $file);
+ }
+ return $res;
+}
+
+=item $obj->save($filename)
+
+Store the object in the file. If the filename ends with a known
+compression extension, it will be compressed on the fly by using a
+Dpkg::Compression::FileHandle object. If $filename is "-", then the
+standard output is used (data are written uncompressed in that case).
+
+=cut
+
+sub save {
+ my ($self, $file, @options) = @_;
+ unless ($self->can("output")) {
+ internerr("%s cannot be saved, it lacks the output method", ref($self));
+ }
+ my $fh;
+ if ($file eq "-") {
+ $fh = \*STDOUT;
+ } else {
+ $fh = Dpkg::Compression::FileHandle->new();
+ open($fh, ">", $file) || syserr(_g("cannot write %s"), $file);
+ }
+ $self->output($fh, @options);
+ if ($file ne "-") {
+ close($fh) || syserr(_g("cannot close %s"), $file);
+ }
+}
+
+=item "$obj"
+
+Return a string representation of the object.
+
+=cut
+
+sub _stringify {
+ my ($self) = @_;
+ unless ($self->can("output")) {
+ internerr("%s cannot be stringified, it lacks the output method", ref($self));
+ }
+ return $self->output();
+}
+
+=back
+
+=head1 AUTHOR
+
+Raphaël Hertzog <hertzog at debian.org>.
+
+=cut
+
+1;
diff --git a/symbolshelper/Dpkg/Shlibs/Cppfilt.pm b/symbolshelper/Dpkg/Shlibs/Cppfilt.pm
index 9898aa1..8ce77f9 100644
--- a/symbolshelper/Dpkg/Shlibs/Cppfilt.pm
+++ b/symbolshelper/Dpkg/Shlibs/Cppfilt.pm
@@ -17,6 +17,9 @@ package Dpkg::Shlibs::Cppfilt;
use strict;
use warnings;
+
+our $VERSION = "0.01";
+
use base 'Exporter';
use Dpkg::ErrorHandling;
diff --git a/symbolshelper/Dpkg/Shlibs/Objdump.pm b/symbolshelper/Dpkg/Shlibs/Objdump.pm
new file mode 100644
index 0000000..aa52a8a
--- /dev/null
+++ b/symbolshelper/Dpkg/Shlibs/Objdump.pm
@@ -0,0 +1,390 @@
+# Copyright © 2007 Raphaël Hertzog <hertzog at debian.org>
+#
+# 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, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+
+our $VERSION = "0.01";
+
+package Dpkg::Shlibs::Objdump;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+sub new {
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my $self = { 'objects' => {} };
+ bless $self, $class;
+ return $self;
+}
+
+sub add_object {
+ my ($self, $obj) = @_;
+ my $id = $obj->get_id;
+ if ($id) {
+ $self->{objects}{$id} = $obj;
+ }
+ return $id;
+}
+
+sub analyze {
+ my ($self, $file) = @_;
+ my $obj = Dpkg::Shlibs::Objdump::Object->new($file);
+
+ return $self->add_object($obj);
+}
+
+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 ($self->has_object($objid)) {
+ return $self->{objects}{$objid};
+ }
+ return undef;
+}
+
+sub has_object {
+ my ($self, $objid) = @_;
+ return exists $self->{objects}{$objid};
+}
+
+{
+ 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 %s"), "objdump");
+ while (<P>) {
+ chomp;
+ if (/^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
+ $format{$file} = $1;
+ return $format{$file};
+ }
+ }
+ close(P) or subprocerr(_g("objdump on \`%s'"), $file);
+ }
+ }
+}
+
+sub is_elf {
+ my ($file) = @_;
+ open(FILE, "<", $file) || syserr(_g("cannot read %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;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+
+sub new {
+ my $this = shift;
+ my $file = shift || '';
+ my $class = ref($this) || $this;
+ my $self = {};
+ bless $self, $class;
+
+ $self->reset;
+ if ($file) {
+ $self->analyze($file);
+ }
+
+ return $self;
+}
+
+sub reset {
+ my ($self) = @_;
+
+ $self->{file} = '';
+ $self->{id} = '';
+ $self->{SONAME} = '';
+ $self->{HASH} = '';
+ $self->{GNU_HASH} = '';
+ $self->{SONAME} = '';
+ $self->{NEEDED} = [];
+ $self->{RPATH} = [];
+ $self->{dynsyms} = {};
+ $self->{flags} = {};
+ $self->{dynrelocs} = {};
+
+ return $self;
+}
+
+
+sub analyze {
+ my ($self, $file) = @_;
+
+ $file ||= $self->{file};
+ return unless $file;
+
+ $self->reset;
+ $self->{file} = $file;
+
+ local $ENV{LC_ALL} = 'C';
+ open(my $objdump, "-|", "objdump", "-w", "-f", "-p", "-T", "-R", $file)
+ || syserr(_g("cannot fork for %s"), "objdump");
+ my $ret = $self->parse_objdump_output($objdump);
+ close($objdump);
+ return $ret;
+}
+
+sub parse_objdump_output {
+ my ($self, $fh) = @_;
+
+ my $section = "none";
+ while (defined($_ = <$fh>)) {
+ chomp;
+ next if /^\s*$/;
+
+ if (/^DYNAMIC SYMBOL TABLE:/) {
+ $section = "dynsym";
+ next;
+ } elsif (/^DYNAMIC RELOCATION RECORDS/) {
+ $section = "dynreloc";
+ $_ = <$fh>; # Skip header
+ 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($_);
+ } elsif ($section eq "dynreloc") {
+ if (/^\S+\s+(\S+)\s+(\S+)\s*$/) {
+ $self->{dynrelocs}{$2} = $1;
+ } else {
+ warning(_g("Couldn't parse dynamic relocation record: %s"), $_);
+ }
+ } elsif ($section eq "dyninfo") {
+ if (/^\s*NEEDED\s+(\S+)/) {
+ push @{$self->{NEEDED}}, $1;
+ } elsif (/^\s*SONAME\s+(\S+)/) {
+ $self->{SONAME} = $1;
+ } elsif (/^\s*HASH\s+(\S+)/) {
+ $self->{HASH} = $1;
+ } elsif (/^\s*GNU_HASH\s+(\S+)/) {
+ $self->{GNU_HASH} = $1;
+ } elsif (/^\s*RUNPATH\s+(\S+)/) {
+ # RUNPATH takes precedence over RPATH but is
+ # considered after LD_LIBRARY_PATH while RPATH
+ # is considered before (if RUNPATH is not set).
+ $self->{RPATH} = [ split (/:/, $1) ];
+ } elsif (/^\s*RPATH\s+(\S+)/) {
+ unless (scalar(@{$self->{RPATH}})) {
+ $self->{RPATH} = [ split (/:/, $1) ];
+ }
+ }
+ } elsif ($section eq "none") {
+ if (/^\s*.+:\s*file\s+format\s+(\S+)\s*$/) {
+ $self->{format} = $1;
+ } elsif (/^architecture:\s*\S+,\s*flags\s*\S+:\s*$/) {
+ # Parse 2 lines of "-f"
+ # architecture: i386, flags 0x00000112:
+ # EXEC_P, HAS_SYMS, D_PAGED
+ # start address 0x08049b50
+ $_ = <$fh>;
+ chomp;
+ $self->{flags}{$_} = 1 foreach (split(/,\s*/));
+ }
+ }
+ }
+ # Update status of dynamic symbols given the relocations that have
+ # been parsed after the symbols...
+ $self->apply_relocations();
+
+ return $section ne "none";
+}
+
+# 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
+# 0000b788 g DF .text 0000008e .hidden IA__g_free
+# | ||||||| | | | |
+# | ||||||| | | 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) = @_;
+ my $vis_re = '(\.protected|\.hidden|\.internal|0x\S+)';
+ if ($line =~ /^[0-9a-f]+ (.{7})\s+(\S+)\s+[0-9a-f]+(?:\s+(\S+))?(?:\s+$vis_re)?\s+(\S+)/) {
+
+ my ($flags, $sect, $ver, $vis, $name) = ($1, $2, $3, $4, $5);
+
+ # Special case if version is missing but extra visibility
+ # attribute replaces it in the match
+ if (defined($ver) and $ver =~ /^$vis_re$/) {
+ $vis = $ver;
+ $ver = '';
+ }
+
+ # Cleanup visibility field
+ $vis =~ s/^\.// if defined($vis);
+
+ 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",
+ local => substr($flags, 0, 1) eq "l",
+ global => substr($flags, 0, 1) eq "g",
+ visibility => defined($vis) ? $vis : '',
+ hidden => '',
+ defined => $sect ne '*UND*'
+ };
+
+ # Handle hidden symbols
+ if (defined($ver) and $ver =~ /^\((.*)\)$/) {
+ $ver = $1;
+ $symbol->{version} = $1;
+ $symbol->{hidden} = 1;
+ }
+
+ # Register 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
+ } elsif ($line =~ /^REG_G\d+\s+/) {
+ # Ignore some s390-specific output like
+ # REG_G6 g R *UND* 0000000000000000 #scratch
+ } else {
+ warning(_g("Couldn't parse dynamic symbol definition: %s"), $line);
+ }
+}
+
+sub apply_relocations {
+ my ($self) = @_;
+ foreach my $sym (values %{$self->{dynsyms}}) {
+ # We want to mark as undefined symbols those which are currently
+ # defined but that depend on a copy relocation
+ next if not $sym->{'defined'};
+ next if not exists $self->{dynrelocs}{$sym->{name}};
+ if ($self->{dynrelocs}{$sym->{name}} =~ /^R_.*_COPY$/) {
+ $sym->{'defined'} = 0;
+ }
+ }
+}
+
+sub add_dynamic_symbol {
+ my ($self, $symbol) = @_;
+ $symbol->{objid} = $symbol->{soname} = $self->get_id();
+ $symbol->{soname} =~ s{^.*/}{} unless $self->{SONAME};
+ if ($symbol->{version}) {
+ $self->{dynsyms}{$symbol->{name} . '@' . $symbol->{version}} = $symbol;
+ } else {
+ $self->{dynsyms}{$symbol->{name} . '@Base'} = $symbol;
+ }
+}
+
+sub get_id {
+ my $self = shift;
+ return $self->{SONAME} || $self->{file};
+}
+
+sub get_symbol {
+ my ($self, $name) = @_;
+ if (exists $self->{dynsyms}{$name}) {
+ return $self->{dynsyms}{$name};
+ }
+ if ($name !~ /@/) {
+ if (exists $self->{dynsyms}{$name . '@Base'}) {
+ return $self->{dynsyms}{$name . '@Base'};
+ }
+ }
+ return undef;
+}
+
+sub get_exported_dynamic_symbols {
+ my ($self) = @_;
+ return grep { $_->{defined} && $_->{dynamic} && !$_->{local} }
+ 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}};
+}
+
+sub is_executable {
+ my $self = shift;
+ return exists $self->{flags}{EXEC_P} && $self->{flags}{EXEC_P};
+}
+
+sub is_public_library {
+ my $self = shift;
+ return exists $self->{flags}{DYNAMIC} && $self->{flags}{DYNAMIC}
+ && exists $self->{SONAME} && $self->{SONAME};
+}
+
+1;
diff --git a/symbolshelper/Dpkg/Shlibs/Symbol.pm b/symbolshelper/Dpkg/Shlibs/Symbol.pm
index 717fde3..2612572 100644
--- a/symbolshelper/Dpkg/Shlibs/Symbol.pm
+++ b/symbolshelper/Dpkg/Shlibs/Symbol.pm
@@ -18,6 +18,9 @@ package Dpkg::Shlibs::Symbol;
use strict;
use warnings;
+
+our $VERSION = "0.01";
+
use Dpkg::Gettext;
use Dpkg::Deps;
use Dpkg::ErrorHandling;
@@ -81,7 +84,7 @@ sub parse_tagspec {
return undef;
}
-sub parse {
+sub parse_symbolspec {
my ($self, $symbolspec, %opts) = @_;
my $symbol;
my $symbol_templ;
diff --git a/symbolshelper/Dpkg/Shlibs/SymbolFile.pm b/symbolshelper/Dpkg/Shlibs/SymbolFile.pm
index 5dfb77f..fa079b2 100644
--- a/symbolshelper/Dpkg/Shlibs/SymbolFile.pm
+++ b/symbolshelper/Dpkg/Shlibs/SymbolFile.pm
@@ -18,6 +18,9 @@ package Dpkg::Shlibs::SymbolFile;
use strict;
use warnings;
+
+our $VERSION = "0.01";
+
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
use Dpkg::Version;
@@ -25,6 +28,8 @@ use Dpkg::Control::Fields;
use Dpkg::Shlibs::Symbol;
use Dpkg::Arch qw(get_host_arch);
+use base qw(Dpkg::Interface::Storable);
+
my %blacklist = (
'__bss_end__' => 1, # arm
'__bss_end' => 1, # arm
@@ -149,8 +154,8 @@ sub create_symbol {
my $symbol = (exists $opts{base}) ? $opts{base} :
Dpkg::Shlibs::Symbol->new();
- my $ret = ($opts{dummy}) ? $symbol->parse($spec, default_minver => 0) :
- $symbol->parse($spec);
+ my $ret = $opts{dummy} ? $symbol->parse_symbolspec($spec, default_minver => 0) :
+ $symbol->parse_symbolspec($spec);
if ($ret) {
$symbol->initialize(arch => $self->get_arch());
return $symbol;
@@ -185,8 +190,8 @@ sub add_symbol {
}
# Parameter seen is only used for recursive calls
-sub load {
- my ($self, $file, $seen, $obj_ref, $base_symbol) = @_;
+sub parse {
+ my ($self, $fh, $file, $seen, $obj_ref, $base_symbol) = @_;
sub new_symbol {
my $base = shift || 'Dpkg::Shlibs::Symbol';
@@ -205,9 +210,7 @@ sub load {
$$obj_ref = undef;
}
- open(my $sym_file, "<", $file)
- || syserr(_g("cannot open %s"), $file);
- while (defined($_ = <$sym_file>)) {
+ while (defined($_ = <$fh>)) {
chomp($_);
if (/^(?:\s+|#(?:DEPRECATED|MISSING): ([^#]+)#\s*)(.*)/) {
@@ -255,7 +258,6 @@ sub load {
warning(_g("Failed to parse a line in %s: %s"), $file, $_);
}
}
- close($sym_file);
delete $seen->{$file};
}
@@ -270,39 +272,30 @@ sub merge_object_from_symfile {
}
}
-sub save {
- my ($self, $file, %opts) = @_;
- $file = $self->{file} unless defined($file);
- my $fh;
- if ($file eq "-") {
- $fh = \*STDOUT;
- } else {
- open($fh, ">", $file)
- || syserr(_g("cannot write %s"), $file);
- }
- $self->dump($fh, %opts);
- close($fh) if ($file ne "-");
-}
-
-sub dump {
+sub output {
my ($self, $fh, %opts) = @_;
$opts{template_mode} = 0 unless exists $opts{template_mode};
$opts{with_deprecated} = 1 unless exists $opts{with_deprecated};
$opts{with_pattern_matches} = 0 unless exists $opts{with_pattern_matches};
+ my $res = "";
foreach my $soname (sort $self->get_sonames()) {
my @deps = $self->get_dependencies($soname);
my $dep = shift @deps;
$dep =~ s/#PACKAGE#/$opts{package}/g if exists $opts{package};
- print $fh "$soname $dep\n";
+ print $fh "$soname $dep\n" if defined $fh;
+ $res .= "$soname $dep\n" if defined wantarray;
+
foreach $dep (@deps) {
$dep =~ s/#PACKAGE#/$opts{package}/g if exists $opts{package};
- print $fh "| $dep\n";
+ print $fh "| $dep\n" if defined $fh;
+ $res .= "| $dep\n" if defined wantarray;
}
my $f = $self->{objects}{$soname}{fields};
foreach my $field (sort keys %{$f}) {
my $value = $f->{$field};
$value =~ s/#PACKAGE#/$opts{package}/g if exists $opts{package};
- print $fh "* $field: $value\n";
+ print $fh "* $field: $value\n" if defined $fh;
+ $res .= "* $field: $value\n" if defined wantarray;
}
my @symbols;
@@ -320,17 +313,20 @@ sub dump {
next if not $opts{template_mode} and
not $sym->arch_is_concerned($self->get_arch());
# Dump symbol specification. Dump symbol tags only in template mode.
- print $fh $sym->get_symbolspec($opts{template_mode}), "\n";
+ print $fh $sym->get_symbolspec($opts{template_mode}), "\n" if defined $fh;
+ $res .= $sym->get_symbolspec($opts{template_mode}) . "\n" if defined wantarray;
# Dump pattern matches as comments (if requested)
if ($opts{with_pattern_matches} && $sym->is_pattern()) {
for my $match (sort { $a->get_symboltempl() cmp
$b->get_symboltempl() } $sym->get_pattern_matches())
{
- print $fh "#MATCH:", $match->get_symbolspec(0), "\n";
+ print $fh "#MATCH:", $match->get_symbolspec(0), "\n" if defined $fh;
+ $res .= "#MATCH:" . $match->get_symbolspec(0) . "\n" if defined wantarray;
}
}
}
}
+ return $res;
}
# Tries to match a symbol name and/or version against the patterns defined.
diff --git a/symbolshelper/dpkg-gensymbols.pl b/symbolshelper/dpkg-gensymbols.pl
index e710031..e56747d 100755
--- a/symbolshelper/dpkg-gensymbols.pl
+++ b/symbolshelper/dpkg-gensymbols.pl
@@ -204,7 +204,7 @@ if (not scalar @files) {
my $od = Dpkg::Shlibs::Objdump->new();
foreach my $file (@files) {
print "Scanning $file for symbol information\n" if $debug;
- my $objid = $od->parse($file);
+ my $objid = $od->analyze($file);
unless (defined($objid) && $objid) {
warning(_g("Objdump couldn't parse %s\n"), $file);
next;
@@ -225,10 +225,10 @@ $symfile->clear_except(keys %{$od->{objects}});
# Write out symbols files
if ($stdout) {
$output = _g("<standard output>");
- $symfile->save("-", package => $oppackage,
- template_mode => $template_mode,
- with_pattern_matches => $verbose_output,
- with_deprecated => $verbose_output);
+ $symfile->output(\*STDOUT, package => $oppackage,
+ template_mode => $template_mode,
+ with_pattern_matches => $verbose_output,
+ with_deprecated => $verbose_output);
} else {
unless (defined($output)) {
unless($symfile->is_empty()) {
@@ -279,8 +279,8 @@ unless ($quiet) {
# Compare template symbols files before and after
my $before = File::Temp->new(TEMPLATE=>'dpkg-gensymbolsXXXXXX');
my $after = File::Temp->new(TEMPLATE=>'dpkg-gensymbolsXXXXXX');
- $ref_symfile->dump($before, package => $oppackage, template_mode => 1);
- $symfile->dump($after, package => $oppackage, template_mode => 1);
+ $ref_symfile->output($before, package => $oppackage, template_mode => 1);
+ $symfile->output($after, package => $oppackage, template_mode => 1);
seek($before, 0, 0); seek($after, 0, 0);
my ($md5_before, $md5_after) = (Digest::MD5->new(), Digest::MD5->new());
$md5_before->addfile($before);
--
Debian Qt/KDE packaging tools
More information about the pkg-kde-commits
mailing list