diff options
author | Raphaël Hertzog <hertzog@debian.org> | 2010-01-21 21:08:31 +0100 |
---|---|---|
committer | Raphaël Hertzog <hertzog@debian.org> | 2010-01-22 01:50:03 +0100 |
commit | 11a793f29a1b13065dc146ae203a8184a4bce780 (patch) | |
tree | 30c2d94c1570f465cad6f0e328aa4ef7a85d06d6 | |
parent | 31bde76e009e2a18c8813fe61816ee9719f2228d (diff) | |
download | dpkg-11a793f29a1b13065dc146ae203a8184a4bce780.tar.gz |
Dpkg::Compression::CompressedFile: update API
Change the Dpkg::Compression::CompressedFile API to make it behave like
a normal filehandle.
Update all users of the object to use the new API.
-rw-r--r-- | scripts/Dpkg/Compression/CompressedFile.pm | 357 | ||||
-rw-r--r-- | scripts/Dpkg/Index.pm | 12 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Archive.pm | 45 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Patch.pm | 61 | ||||
-rwxr-xr-x | scripts/dpkg-scanpackages.pl | 12 | ||||
-rwxr-xr-x | scripts/dpkg-scansources.pl | 18 |
6 files changed, 384 insertions, 121 deletions
diff --git a/scripts/Dpkg/Compression/CompressedFile.pm b/scripts/Dpkg/Compression/CompressedFile.pm index c7eae1352..1a85ba059 100644 --- a/scripts/Dpkg/Compression/CompressedFile.pm +++ b/scripts/Dpkg/Compression/CompressedFile.pm @@ -1,4 +1,4 @@ -# Copyright © 2008 Raphaël Hertzog <hertzog@debian.org> +# 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 @@ -22,20 +22,112 @@ use Dpkg::Compression; use Dpkg::Compression::Compressor; use Dpkg::Gettext; use Dpkg::ErrorHandling; -use POSIX; +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::CompressedFile - object dealing transparently with file compression + +=head1 SYNOPSIS + + use Dpkg::Compression::CompressedFile; + + $fh = Dpkg::Compression::CompressedFile->new(filename=>"sample.gz"); + print $fh "Something\n"; + close $fh; + + $fh = Dpkg::Compression::CompressedFile->new(); + open($fh, ">", "sample.bz2"); + print $fh "Something\n"; + close $fh; + + $fh = Dpkg::Compression::CompressedFile->new(); + $fh->open("sample.xz", "w"); + $fh->print("Something\n"); + $fh->close(); + + $fh = Dpkg::Compression::CompressedFile->new(filename=>"sample.gz"); + my @lines = <$fh>; + close $fh; + + $fh = Dpkg::Compression::CompressedFile->new(); + open($fh, "<", "sample.bz2"); + my @lines = <$fh>; + close $fh; + + $fh = Dpkg::Compression::CompressedFile->new(); + $fh->open("sample.xz", "r"); + my @lines = $fh->getlines(); + $fh->close(); + +=head1 DESCRIPTION + +Dpkg::Compression::CompressedFile 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::CompressedFile 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::CompressedFile too. There +may be exceptions though. + +=head1 PUBLIC METHODS + +=over 4 + +=item my $fh = Dpkg::Compression::CompressedFile->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 = { - "compression" => "auto" - }; + 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; - $self->{"compressor"} = Dpkg::Compression::Compressor->new(); - $self->{"add_comp_ext"} = $args{"add_compression_extension"} || + # Initializations + *$self->{"compression"} = "auto"; + *$self->{"compressor"} = Dpkg::Compression::Compressor->new(); + *$self->{"add_comp_ext"} = $args{"add_compression_extension"} || $args{"add_comp_ext"} || 0; - $self->{"allow_sigpipe"} = 0; + *$self->{"allow_sigpipe"} = 0; if (exists $args{"filename"}) { $self->set_filename($args{"filename"}); } @@ -48,102 +140,291 @@ sub new { return $self; } -sub reset { - my ($self) = @_; - %{$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::CompressedFile: $mode"); + } + } else { + internerr("Dpkg::Compression::CompressedFile only supports open() with 3 parameters"); + } + return 1; # Always works (otherwise errors out) +} + +sub CLOSE { + my ($self) = shift; + my $ret = 1; + $ret = *$self->{'file'}->close(@_) if *$self->{'file'}->opened(); + $self->cleanup(); + return $ret; +} + +sub FILENO { + my ($self) = shift; + return *$self->{"file"}->fileno(@_); +} + +sub EOF { + my ($self) = shift; + return *$self->{"file"}->eof(@_); +} + +sub SEEK { + my ($self) = shift; + return *$self->{"file"}->seek(@_); +} + +sub TELL { + my ($self) = shift; + return *$self->{"file"}->tell(@_); } +sub BINMODE { + my ($self) = shift; + return *$self->{"file"}->binmode(@_); +} + +## +## NORMAL METHODS +## + +=item $fh->set_compression($comp) + +Defines the compression method used. $comp should one of the methods supported by +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->{"compressor"}->set_compression($method); } - $self->{"compression"} = $method; + *$self->{"compression"} = $method; } +=item $fh->set_compression_level($level) + +Indicate the desired compression level. It should a value supported by +the B<set_compression_level> method of B<Dpkg::Compression::Compressor>. + +=cut + sub set_compression_level { my ($self, $level) = @_; - $self->{"compressor"}->set_compression_level($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; + *$self->{"filename"} = $filename; # Automatically add compression extension to filename if (defined($add_comp_ext)) { - $self->{"add_comp_ext"} = $add_comp_ext; + *$self->{"add_comp_ext"} = $add_comp_ext; } - if ($self->{"add_comp_ext"} and $filename =~ /\.$comp_regex$/) { + if (*$self->{"add_comp_ext"} and $filename =~ /\.$comp_regex$/) { 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'}) { + 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"}; + return *$self->{"filename"}; } else { - return $self->{"filename"} . "." . $comp_ext{$comp}; + return *$self->{"filename"} . "." . $comp_ext{$comp}; } } else { - return $self->{"filename"}; + 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, $update) = @_; - my $comp = $self->{"compression"}; + my ($self) = @_; + my $comp = *$self->{"compression"}; if ($comp eq "none") { return 0; } elsif ($comp eq "auto") { $comp = get_compression_from_filename($self->get_filename()); - $self->{"compressor"}->set_compression($comp) if $comp; + *$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) = @_; - my $handle; + error("Can't reopen an already opened compressed file") if exists *$self->{"mode"}; + my $filehandle; if ($self->use_compression()) { - $self->{'compressor'}->compress(from_pipe => \$handle, + *$self->{'compressor'}->compress(from_pipe => \$filehandle, to_file => $self->get_filename()); } else { - open($handle, '>', $self->get_filename()) || + CORE::open($filehandle, ">", $self->get_filename) || syserr(_g("cannot write %s"), $self->get_filename()); } - return $handle; + *$self->{"mode"} = "w"; + *$self->{"file"} = $filehandle; } sub open_for_read { my ($self) = @_; - my $handle; + error("Can't reopen an already opened compressed file") if exists *$self->{"mode"}; + my $filehandle; if ($self->use_compression()) { - $self->{'compressor'}->uncompress(to_pipe => \$handle, + *$self->{'compressor'}->uncompress(to_pipe => \$filehandle, from_file => $self->get_filename()); - $self->{'allow_sigpipe'} = 1; + *$self->{'allow_sigpipe'} = 1; } else { - open($handle, '<', $self->get_filename()) || + CORE::open($filehandle, "<", $self->get_filename) || syserr(_g("cannot read %s"), $self->get_filename()); } - return $handle; + *$self->{"mode"} = "r"; + *$self->{"file"} = $filehandle; } -sub cleanup_after_open { +sub cleanup { my ($self) = @_; - my $cmdline = $self->{"compressor"}{"cmdline"} || ""; - $self->{"compressor"}->wait_end_process(nocheck => $self->{'allow_sigpipe'}); - if ($self->{'allow_sigpipe'}) { + 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::CompressedFile 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/scripts/Dpkg/Index.pm b/scripts/Dpkg/Index.pm index d2e86dc99..7d8b47bc4 100644 --- a/scripts/Dpkg/Index.pm +++ b/scripts/Dpkg/Index.pm @@ -156,10 +156,8 @@ parsed. Handles compressed files transparently based on their extensions. sub load { my ($self, $file) = @_; my $cf = Dpkg::Compression::CompressedFile->new(filename => $file); - my $fh = $cf->open_for_read(); - my $res = $self->parse($fh, $file); - $cf->cleanup_after_open(); - close($fh) || syserr(_g("cannot close %s"), $file); + my $res = $self->parse($cf, $file); + close($cf) || syserr(_g("cannot close %s"), $file); return $res; } @@ -192,10 +190,8 @@ based on their extensions. sub save { my ($self, $file) = @_; my $cf = Dpkg::Compression::CompressedFile->new(filename => $file); - my $fh = $cf->open_for_write(); - $self->output($fh); - $cf->cleanup_after_open(); - close($fh) || syserr(_g("cannot close %s"), $file); + $self->output($cf); + close($cf) || syserr(_g("cannot close %s"), $file); } =item my $item = $index->new_item() diff --git a/scripts/Dpkg/Source/Archive.pm b/scripts/Dpkg/Source/Archive.pm index 3d0dcce96..202071873 100644 --- a/scripts/Dpkg/Source/Archive.pm +++ b/scripts/Dpkg/Source/Archive.pm @@ -38,33 +38,35 @@ sub create { # Possibly run tar from another directory if ($opts{"chdir"}) { $fork_opts{"chdir"} = $opts{"chdir"}; - $self->{"chdir"} = $opts{"chdir"}; + *$self->{"chdir"} = $opts{"chdir"}; } # Redirect input/output appropriately - $fork_opts{"to_handle"} = $self->open_for_write(); - $fork_opts{"from_pipe"} = \$self->{'tar_input'}; + $self->ensure_open("w"); + $fork_opts{"to_handle"} = $self->get_filehandle(); + $fork_opts{"from_pipe"} = \*$self->{'tar_input'}; # Call tar creation process $fork_opts{"delete_env"} = [ "TAR_OPTIONS" ]; $fork_opts{'exec'} = [ 'tar', '--null', '-T', '-', '--numeric-owner', '--owner', '0', '--group', '0', @{$opts{"options"}}, '-cf', '-' ]; - $self->{"pid"} = fork_and_exec(%fork_opts); - $self->{"cwd"} = getcwd(); + *$self->{"pid"} = fork_and_exec(%fork_opts); + *$self->{"cwd"} = getcwd(); } sub _add_entry { my ($self, $file) = @_; - internerr("call create() first") unless $self->{"tar_input"}; - $file = $2 if ($file =~ /^\Q$self->{'cwd'}\E\/(.+)$/); # Relative names - print({ $self->{'tar_input'} } "$file\0") || + my $cwd = *$self->{'cwd'}; + internerr("call create() first") unless *$self->{"tar_input"}; + $file = $2 if ($file =~ /^\Q$cwd\E\/(.+)$/); # Relative names + print({ *$self->{'tar_input'} } "$file\0") || syserr(_g("write on tar input")); } sub add_file { my ($self, $file) = @_; my $testfile = $file; - if ($self->{"chdir"}) { - $testfile = File::Spec->catfile($self->{"chdir"}, $file); + if (*$self->{"chdir"}) { + $testfile = File::Spec->catfile(*$self->{"chdir"}, $file); } internerr("add_file() doesn't handle directories") if not -l $testfile and -d _; $self->_add_entry($file); @@ -73,8 +75,8 @@ sub add_file { sub add_directory { my ($self, $file) = @_; my $testfile = $file; - if ($self->{"chdir"}) { - $testfile = File::Spec->catdir($self->{"chdir"}, $file); + if (*$self->{"chdir"}) { + $testfile = File::Spec->catdir(*$self->{"chdir"}, $file); } internerr("add_directory() only handles directories") unless not -l $testfile and -d _; $self->_add_entry($file); @@ -82,13 +84,13 @@ sub add_directory { sub finish { my ($self) = @_; - close($self->{'tar_input'}) or syserr(_g("close on tar input")); - wait_child($self->{'pid'}, cmdline => 'tar -cf -'); - delete $self->{'pid'}; - delete $self->{'tar_input'}; - delete $self->{'cwd'}; - delete $self->{'chdir'}; - $self->cleanup_after_open(); + close(*$self->{'tar_input'}) or syserr(_g("close on tar input")); + wait_child(*$self->{'pid'}, cmdline => 'tar -cf -'); + delete *$self->{'pid'}; + delete *$self->{'tar_input'}; + delete *$self->{'cwd'}; + delete *$self->{'chdir'}; + $self->close(); } sub extract { @@ -114,14 +116,15 @@ sub extract { } # Prepare stuff that handles the input of tar - $fork_opts{"from_handle"} = $self->open_for_read(); + $self->ensure_open("r"); + $fork_opts{"from_handle"} = $self->get_filehandle(); # Call tar extraction process $fork_opts{"delete_env"} = [ "TAR_OPTIONS" ]; $fork_opts{'exec'} = [ 'tar', '--no-same-owner', '--no-same-permissions', @{$opts{"options"}}, '-xkf', '-' ]; fork_and_exec(%fork_opts); - $self->cleanup_after_open(); + $self->close(); # Fix permissions on extracted files because tar insists on applying # our umask _to the original permissions_ rather than mostly-ignoring diff --git a/scripts/Dpkg/Source/Patch.pm b/scripts/Dpkg/Source/Patch.pm index e1b3dc24f..b7ba69dfd 100644 --- a/scripts/Dpkg/Source/Patch.pm +++ b/scripts/Dpkg/Source/Patch.pm @@ -19,7 +19,6 @@ use strict; use warnings; use Dpkg; -use Dpkg::Compression::CompressedFile; use Dpkg::Compression::Compressor; use Dpkg::Compression; use Dpkg::Gettext; @@ -40,9 +39,9 @@ use base 'Dpkg::Compression::CompressedFile'; sub create { my ($self, %opts) = @_; - $self->{'handle'} = $self->open_for_write(); - $self->{'errors'} = 0; - $self->{'empty'} = 1; + $self->ensure_open("w"); # Creates the file + *$self->{'errors'} = 0; + *$self->{'empty'} = 1; if ($opts{'old'} and $opts{'new'}) { $opts{'old'} = "/dev/null" unless -e $opts{'old'}; $opts{'new'} = "/dev/null" unless -e $opts{'new'}; @@ -59,7 +58,7 @@ sub create { sub set_header { my ($self, $header) = @_; - $self->{'header'} = $header; + *$self->{'header'} = $header; } sub add_diff_file { @@ -121,12 +120,11 @@ sub add_diff_file { chomp; error(_g("unknown line from diff -u on %s: `%s'"), $new, $_); } - if ($self->{'empty'} and defined($self->{'header'})) { - print { $self->{'handle'} } $self->{'header'} or - syserr(_g("failed to write")); - $self->{'empty'} = 0; + if (*$self->{'empty'} and defined(*$self->{'header'})) { + print $self *$self->{'header'} or syserr(_g("failed to write")); + *$self->{'empty'} = 0; } - print({ $self->{'handle'} } $_) || syserr(_g("failed to write")); + print $self $_ || syserr(_g("failed to write")); } close($diffgen) or syserr("close on diff pipe"); wait_child($diff_pid, nocheck => 1, @@ -259,16 +257,13 @@ sub add_diff_directory { sub finish { my ($self) = @_; - close($self->{'handle'}) || - syserr(_g("cannot close %s"), $self->get_filename()); - delete $self->{'handle'}; - $self->cleanup_after_open(); - return not $self->{'errors'}; + close($self) || syserr(_g("cannot close %s"), $self->get_filename()); + return not *$self->{'errors'}; } sub register_error { my ($self) = @_; - $self->{'errors'}++; + *$self->{'errors'}++; } sub _fail_with_msg { my ($self, $file, $msg) = @_; @@ -290,7 +285,6 @@ sub analyze { my ($self, $destdir, %opts) = @_; my $diff = $self->get_filename(); - my $diff_handle = $self->open_for_read(); my %filepatched; my %dirtocreate; my $diff_count = 0; @@ -313,14 +307,14 @@ sub analyze { $header =~ s/\s.*// unless ($header =~ s/\t.*//); return $header; } - $_ = getline($diff_handle); + $_ = getline($self); HUNK: - while (defined($_) || not eof($diff_handle)) { + while (defined($_) || not eof($self)) { my ($fn, $fn2); # skip comments leading up to patch (if any) until (/^--- /) { - last HUNK if not defined($_ = getline($diff_handle)); + last HUNK if not defined($_ = getline($self)); } $diff_count++; # read file header (---/+++ pair) @@ -335,7 +329,7 @@ sub analyze { error(_g("diff `%s' patches file with name ending .dpkg-orig"), $diff); } - unless (defined($_ = getline($diff_handle))) { + unless (defined($_ = getline($self))) { error(_g("diff `%s' finishes in middle of ---/+++ (line %d)"), $diff, $.); } unless (s/^\+\+\+ //) { @@ -380,14 +374,14 @@ sub analyze { # read hunks my $hunk = 0; - while (defined($_ = getline($diff_handle))) { + while (defined($_ = getline($self))) { # read hunk header (@@) next if /^\\ No newline/; last unless (/^@@ -\d+(,(\d+))? \+\d+(,(\d+))? @\@( .*)?$/); my ($olines, $nlines) = ($1 ? $2 : 1, $3 ? $4 : 1); # read hunk while ($olines || $nlines) { - unless (defined($_ = getline($diff_handle))) { + unless (defined($_ = getline($self))) { if (($olines == $nlines) and ($olines < 3)) { warning(_g("unexpected end of diff `%s'"), $diff); last; @@ -411,14 +405,13 @@ sub analyze { error(_g("expected ^\@\@ at line %d of diff `%s'"), $., $diff); } } - close($diff_handle); + close($self); unless ($diff_count) { warning(_g("diff `%s' doesn't contain any patch"), $diff); } - $self->cleanup_after_open(); - $self->{'analysis'}{$destdir}{"dirtocreate"} = \%dirtocreate; - $self->{'analysis'}{$destdir}{"filepatched"} = \%filepatched; - return $self->{'analysis'}{$destdir}; + *$self->{'analysis'}{$destdir}{"dirtocreate"} = \%dirtocreate; + *$self->{'analysis'}{$destdir}{"filepatched"} = \%filepatched; + return *$self->{'analysis'}{$destdir}; } sub prepare_apply { @@ -445,16 +438,16 @@ sub apply { my $analysis = $self->analyze($destdir, %opts); $self->prepare_apply($analysis, %opts); # Apply the patch - my $diff_handle = $self->open_for_read(); + $self->ensure_open("r"); fork_and_exec( 'exec' => [ 'patch', @{$opts{"options"}} ], 'chdir' => $destdir, 'env' => { LC_ALL => 'C', LANG => 'C' }, 'delete_env' => [ 'POSIXLY_CORRECT' ], # ensure expected patch behaviour 'wait_child' => 1, - 'from_handle' => $diff_handle + 'from_handle' => $self->get_filehandle(), ); - $self->cleanup_after_open(); + $self->close(); # Reset the timestamp of all the patched files # and remove .dpkg-orig files my $now = $opts{"timestamp"} || time; @@ -484,21 +477,21 @@ sub check_apply { my $analysis = $self->analyze($destdir, %opts); $self->prepare_apply($analysis, %opts); # Apply the patch - my $diff_handle = $self->open_for_read(); + $self->ensure_open("r"); my $error; my $patch_pid = fork_and_exec( 'exec' => [ 'patch', @{$opts{"options"}} ], 'chdir' => $destdir, 'env' => { LC_ALL => 'C', LANG => 'C' }, 'delete_env' => [ 'POSIXLY_CORRECT' ], # ensure expected patch behaviour - 'from_handle' => $diff_handle, + 'from_handle' => $self->get_filehandle(), 'to_file' => '/dev/null', 'error_to_file' => '/dev/null', ); wait_child($patch_pid, nocheck => 1); my $exit = WEXITSTATUS($?); subprocerr("patch --dry-run") unless WIFEXITED($?); - $self->cleanup_after_open(); + $self->close(); return ($exit == 0); } diff --git a/scripts/dpkg-scanpackages.pl b/scripts/dpkg-scanpackages.pl index 7f4d23656..9ab2b978b 100755 --- a/scripts/dpkg-scanpackages.pl +++ b/scripts/dpkg-scanpackages.pl @@ -88,9 +88,8 @@ sub load_override { my $override = shift; my $comp_file = Dpkg::Compression::CompressedFile->new(filename => $override); - my $override_fh = $comp_file->open_for_read(); - while (<$override_fh>) { + while (<$comp_file>) { s/\#.*//; s/\s+$//; next unless $_; @@ -128,17 +127,15 @@ sub load_override $overridden{$p} = 1; } - close($override_fh); - $comp_file->cleanup_after_open(); + close($comp_file); } sub load_override_extra { my $extra_override = shift; my $comp_file = Dpkg::Compression::CompressedFile->new(filename => $extra_override); - my $override_fh = $comp_file->open_for_read(); - while (<$override_fh>) { + while (<$comp_file>) { s/\#.*//; s/\s+$//; next unless $_; @@ -152,8 +149,7 @@ sub load_override_extra } } - close($override_fh); - $comp_file->cleanup_after_open(); + close($comp_file); } usage() and exit 1 if not $result; diff --git a/scripts/dpkg-scansources.pl b/scripts/dpkg-scansources.pl index 5dab85c7d..1a66a69e9 100755 --- a/scripts/dpkg-scansources.pl +++ b/scripts/dpkg-scansources.pl @@ -111,8 +111,7 @@ sub load_override { local $_; my $comp_file = Dpkg::Compression::CompressedFile->new(filename => $file); - my $override_fh = $comp_file->open_for_read(); - while (<$override_fh>) { + while (<$comp_file>) { s/#.*//; next if /^\s*$/; s/\s+$//; @@ -149,8 +148,7 @@ sub load_override { $Override{$package}[O_MAINT_TO] = $maintainer; } } - close($override_fh); - $comp_file->cleanup_after_open(); + close($comp_file); } sub load_src_override { @@ -177,8 +175,7 @@ sub load_src_override { debug "source override file $file"; my $comp_file = Dpkg::Compression::CompressedFile->new(filename => $file); - my $override_fh = $comp_file->open_for_read(); - while (<$override_fh>) { + while (<$comp_file>) { s/#.*//; next if /^\s*$/; s/\s+$//; @@ -200,17 +197,15 @@ sub load_src_override { $Override{$key} = []; $Override{$key}[O_SECTION] = $section; } - close($override_fh); - $comp_file->cleanup_after_open(); + close($comp_file); } sub load_override_extra { my $extra_override = shift; my $comp_file = Dpkg::Compression::CompressedFile->new(filename => $extra_override); - my $override_fh = $comp_file->open_for_read(); - while (<$override_fh>) { + while (<$comp_file>) { s/\#.*//; s/\s+$//; next unless $_; @@ -218,8 +213,7 @@ sub load_override_extra my ($p, $field, $value) = split(/\s+/, $_, 3); $Extra_Override{$p}{$field} = $value; } - close($override_fh); - $comp_file->cleanup_after_open(); + close($comp_file); } # Given PREFIX and DSC-FILE, process the file and returns the fields. |