diff options
author | Modestas Vainius <modestas@vainius.eu> | 2010-04-22 10:22:49 +0300 |
---|---|---|
committer | Modestas Vainius <modestas@vainius.eu> | 2010-04-22 10:58:58 +0300 |
commit | cbfaf310b446f0519b8a3cf43a559af52374e5f6 (patch) | |
tree | 7d10304db987e19c7a6903d3dfd0194d40b34ecc /datalib | |
parent | 055899a68a5a67a4860a2f134c66ffaaac505fc7 (diff) | |
download | pkg-kde-tools-cbfaf310b446f0519b8a3cf43a559af52374e5f6.tar.gz |
No longer ship stable (v1.0) libdpkg-perl interfaces in pkg-kde-tools.
git rm -r datalib/Dpkg/Compression* datalib/Dpkg/Interface.
Diffstat (limited to 'datalib')
-rw-r--r-- | datalib/Dpkg/Compression.pm | 216 | ||||
-rw-r--r-- | datalib/Dpkg/Compression/FileHandle.pm | 442 | ||||
-rw-r--r-- | datalib/Dpkg/Compression/Process.pm | 203 | ||||
-rw-r--r-- | datalib/Dpkg/Interface/Storable.pm | 143 |
4 files changed, 0 insertions, 1004 deletions
diff --git a/datalib/Dpkg/Compression.pm b/datalib/Dpkg/Compression.pm deleted file mode 100644 index ce21c00..0000000 --- a/datalib/Dpkg/Compression.pm +++ /dev/null @@ -1,216 +0,0 @@ -# Copyright © 2010 Raphaël Hertzog <hertzog@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@debian.org>. - -=cut - -1; diff --git a/datalib/Dpkg/Compression/FileHandle.pm b/datalib/Dpkg/Compression/FileHandle.pm deleted file mode 100644 index e9c975b..0000000 --- a/datalib/Dpkg/Compression/FileHandle.pm +++ /dev/null @@ -1,442 +0,0 @@ -# Copyright © 2008-2010 Raphaël Hertzog <hertzog@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@debian.org> - -=cut -1; diff --git a/datalib/Dpkg/Compression/Process.pm b/datalib/Dpkg/Compression/Process.pm deleted file mode 100644 index 538490d..0000000 --- a/datalib/Dpkg/Compression/Process.pm +++ /dev/null @@ -1,203 +0,0 @@ -# Copyright © 2008-2010 Raphaël Hertzog <hertzog@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@debian.org>. - -=cut - -1; diff --git a/datalib/Dpkg/Interface/Storable.pm b/datalib/Dpkg/Interface/Storable.pm deleted file mode 100644 index fa0043e..0000000 --- a/datalib/Dpkg/Interface/Storable.pm +++ /dev/null @@ -1,143 +0,0 @@ -# Copyright © 2010 Raphaël Hertzog <hertzog@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@debian.org>. - -=cut - -1; |