scripts/Dpkg/Compression/Process.pm

   1 # Copyright © 2008-2010 Raphaël Hertzog <hertzog@debian.org>
   2 # Copyright © 2008-2022 Guillem Jover <guillem@debian.org>
   3 #
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  16
  17 =encoding utf8
  18
  19 =head1 NAME
  20
  21 Dpkg::Compression::Process - run compression/decompression processes
  22
  23 =head1 DESCRIPTION
  24
  25 This module provides an object oriented interface to run and manage
  26 compression/decompression processes.
  27
  28 =cut
  29
  30 package Dpkg::Compression::Process 1.00;
  31
  32 use strict;
  33 use warnings;
  34
  35 use Carp;
  36
  37 use Dpkg::Compression;
  38 use Dpkg::ErrorHandling;
  39 use Dpkg::Gettext;
  40 use Dpkg::IPC;
  41
  42 =head1 METHODS
  43
  44 =over 4
  45
  46 =item $proc = Dpkg::Compression::Process->new(%opts)
  47
  48 Create a new instance of the object. Supported options are "compression"
  49 and "compression_level" (see corresponding set_* functions).
  50
  51 =cut
  52
  53 sub new {
  54     my ($this, %args) = @_;
  55     my $class = ref($this) || $this;
  56     my $self = {};
  57     bless $self, $class;
  58     $self->set_compression($args{compression} || compression_get_default());
  59     $self->set_compression_level($args{compression_level} ||
  60         compression_get_default_level());
  61     return $self;
  62 }
  63
  64 =item $proc->set_compression($comp)
  65
  66 Select the compression method to use. It errors out if the method is not
  67 supported according to compression_is_supported() (of
  68 L<Dpkg::Compression>).
  69
  70 =cut
  71
  72 sub set_compression {
  73     my ($self, $method) = @_;
  74     error(g_('%s is not a supported compression method'), $method)
  75         unless compression_is_supported($method);
  76     $self->{compression} = $method;
  77 }
  78
  79 =item $proc->set_compression_level($level)
  80
  81 Select the compression level to use. It errors out if the level is not
  82 valid according to compression_is_valid_level() (of
  83 L<Dpkg::Compression>).
  84
  85 =cut
  86
  87 sub set_compression_level {
  88     my ($self, $level) = @_;
  89
  90     compression_set_level($self->{compression}, $level);
  91 }
  92
  93 =item @exec = $proc->get_compress_cmdline()
  94
  95 =item @exec = $proc->get_uncompress_cmdline()
  96
  97 Returns a list ready to be passed to exec(), its first element is the
  98 program name (either for compression or decompression) and the following
  99 elements are parameters for the program.
 100
 101 When executed the program acts as a filter between its standard input
 102 and its standard output.
 103
 104 =cut
 105
 106 sub get_compress_cmdline {
 107     my $self = shift;
 108
 109     return compression_get_cmdline_compress($self->{compression});
 110 }
 111
 112 sub get_uncompress_cmdline {
 113     my $self = shift;
 114
 115     return compression_get_cmdline_decompress($self->{compression});
 116 }
 117
 118 sub _check_opts {
 119     my ($self, %opts) = @_;
 120     # Check for proper cleaning before new start
 121     error(g_('Dpkg::Compression::Process can only start one subprocess at a time'))
 122         if $self->{pid};
 123     # Check options
 124     my $to = my $from = 0;
 125     foreach my $thing (qw(file handle string pipe)) {
 126         $to++ if $opts{"to_$thing"};
 127         $from++ if $opts{"from_$thing"};
 128     }
 129     croak 'exactly one to_* parameter is needed' if $to != 1;
 130     croak 'exactly one from_* parameter is needed' if $from != 1;
 131     return %opts;
 132 }
 133
 134 =item $proc->compress(%opts)
 135
 136 Starts a compressor program. You must indicate where it will read its
 137 uncompressed data from and where it will write its compressed data to.
 138 This is accomplished by passing one parameter C<to_*> and one parameter
 139 C<from_*> as accepted by Dpkg::IPC::spawn().
 140
 141 You must call wait_end_process() after having called this method to
 142 properly close the sub-process (and verify that it exited without error).
 143
 144 =cut
 145
 146 sub compress {
 147     my ($self, %opts) = @_;
 148
 149     $self->_check_opts(%opts);
 150     my @prog = $self->get_compress_cmdline();
 151     $opts{exec} = \@prog;
 152     $self->{cmdline} = "@prog";
 153     $self->{pid} = spawn(%opts);
 154     delete $self->{pid} if $opts{to_string}; # wait_child already done
 155 }
 156
 157 =item $proc->uncompress(%opts)
 158
 159 Starts a decompressor program. You must indicate where it will read its
 160 compressed data from and where it will write its uncompressed data to.
 161 This is accomplished by passing one parameter C<to_*> and one parameter
 162 C<from_*> as accepted by Dpkg::IPC::spawn().
 163
 164 You must call wait_end_process() after having called this method to
 165 properly close the sub-process (and verify that it exited without error).
 166
 167 =cut
 168
 169 sub uncompress {
 170     my ($self, %opts) = @_;
 171
 172     $self->_check_opts(%opts);
 173     my @prog = $self->get_uncompress_cmdline();
 174     $opts{exec} = \@prog;
 175     $self->{cmdline} = "@prog";
 176     $self->{pid} = spawn(%opts);
 177     delete $self->{pid} if $opts{to_string}; # wait_child already done
 178 }
 179
 180 =item $proc->wait_end_process(%opts)
 181
 182 Call Dpkg::IPC::wait_child() to wait until the sub-process has exited
 183 and verify its return code. Any given option will be forwarded to
 184 the wait_child() function. Most notably you can use the "nocheck" option
 185 to verify the return code yourself instead of letting wait_child() do
 186 it for you.
 187
 188 =cut
 189
 190 sub wait_end_process {
 191     my ($self, %opts) = @_;
 192     $opts{cmdline} //= $self->{cmdline};
 193     wait_child($self->{pid}, %opts) if $self->{pid};
 194     delete $self->{pid};
 195     delete $self->{cmdline};
 196 }
 197
 198 =back
 199
 200 =head1 CHANGES
 201
 202 =head2 Version 1.00 (dpkg 1.15.6)
 203
 204 Mark the module as public.
 205
 206 =cut
 207
 208 1;