← Back to branch summary

~ubuntu-branches/ubuntu/utopic/alien/utopic-proposed

« back to all changes in this revision

Viewing changes to Alien/Package/Deb.pm

  • Committer: Package Import Robot
  • Author(s): Joey Hess
  • Date: 2014-06-13 12:03:54 UTC
  • Revision ID: package-import@ubuntu.com-20140613120354-k40r504k15knv8ir
Tags: 8.91
http://bugs.debian.org/718364
Support other deb data.tar compression schemes in fallback code.
Closes: #718364
Thanks, Guillem Jover

Show diffs side-by-side

added added

removed removed

Lines of Context:
Alien/Package/Deb.pm
9
9
package Alien::Package::Deb;
10
10
use strict;
11
11
use base qw(Alien::Package);
 
12
use List::Util qw(first);
12
13
 
13
14
=head1 DESCRIPTION
14
15
 
23
24
 
24
25
Set to a true value if dpkg-deb is available. 
25
26
 
 
27
=item deb_member_list
 
28
 
 
29
Set to the list of member names in the deb package.
 
30
 
26
31
=item dirtrans
27
32
 
28
33
After the build stage, set to a hash reference of the directories we moved
117
122
        }
118
123
}
119
124
 
 
125
=item get_deb_member_list
 
126
 
 
127
Helper method. Pass it the name of the deb and it will return the list of
 
128
ar members.
 
129
 
 
130
=cut
 
131
 
 
132
sub get_deb_member_list {
 
133
        my $this=shift;
 
134
        my $file=$this->filename;
 
135
        my $members=$this->deb_member_list;
 
136
 
 
137
        unless (defined $members) {
 
138
                $members = [ map { chomp; $_ } $this->runpipe(1, "ar -t '$file'") ];
 
139
                $this->deb_member_list($members);
 
140
        }
 
141
 
 
142
        return @{$members};
 
143
}
 
144
 
120
145
=item getcontrolfile
121
146
 
122
147
Helper method. Pass it the name of a control file, and it will pull it out
142
167
                                " tar xf - './$file' &&".
143
168
                                " cat '$file'; cd /; rm -rf /tmp/tar_out.$$)";
144
169
                }
145
 
                my $getcontrol = "ar -p '$file' control.tar.gz | gzip -dc | ".tar_out($controlfile)." 2>/dev/null";
 
170
                my $controlcomp;
 
171
                my $controlmember = first { /^control\.tar/ }
 
172
                                    $this->get_deb_member_list;
 
173
                if (! defined $controlmember) {
 
174
                        die 'Cannot find control member!';
 
175
                } elsif ($controlmember eq 'control.tar.gz') {
 
176
                        $controlcomp = 'gzip -dc';
 
177
                } elsif ($controlmember eq 'control.tar.xz') {
 
178
                        $controlcomp = 'xz -dc';
 
179
                } elsif ($controlmember eq 'control.tar') {
 
180
                        $controlcomp = 'cat';
 
181
                } else {
 
182
                        die 'Unknown control member!';
 
183
                }
 
184
                my $getcontrol = "ar -p '$file' $controlmember | $controlcomp | ".tar_out($controlfile)." 2>/dev/null";
146
185
                return $this->runpipe(1, $getcontrol);
147
186
        }
148
187
}
149
188
 
 
189
=item get_datamember_cmd
 
190
 
 
191
Helper method. Pass it the name of the deb and it will return the raw
 
192
command needed to extract the data.tar member.
 
193
 
 
194
=cut
 
195
 
 
196
sub get_datamember_cmd {
 
197
        my $this=shift;
 
198
        my $file=$this->filename;
 
199
 
 
200
        my $datacomp;
 
201
        my $datamember = first { /^data\.tar/ }
 
202
                         $this->get_deb_member_list;
 
203
        if (! defined $datamember) {
 
204
                die 'Cannot find data member!';
 
205
        } elsif ($datamember eq 'data.tar.gz') {
 
206
                $datacomp = 'gzip -dc';
 
207
        } elsif ($datamember eq 'data.tar.bz2') {
 
208
                $datacomp = 'bzip2 -dc';
 
209
        } elsif ($datamember eq 'data.tar.xz') {
 
210
                $datacomp = 'xz -dc';
 
211
        } elsif ($datamember eq 'data.tar.lzma') {
 
212
                $datacomp = 'xz -dc';
 
213
        } elsif ($datamember eq 'data.tar') {
 
214
                $datacomp = 'cat';
 
215
        } else {
 
216
                die 'Unknown data member!';
 
217
        }
 
218
 
 
219
        return "ar -p '$file' $datamember | $datacomp";
 
220
}
 
221
 
150
222
=item scan
151
223
 
152
224
Implement the scan method to read a deb file.
209
281
 
210
282
        # Read in the list of all files.
211
283
        # Note that tar doesn't supply a leading '/', so we have to add that.
212
 
        my @filelist;
 
284
        my $datamember_cmd;
213
285
        if ($this->have_dpkg_deb) {
214
 
                @filelist=map { chomp; s:\./::; "/$_" }
215
 
                          $this->runpipe(0, "dpkg-deb --fsys-tarfile '$file' | tar tf -");
 
286
                $datamember_cmd = "dpkg-deb --fsys-tarfile '$file'";
216
287
        }
217
288
        else {
218
 
                @filelist=map { chomp; s:\./::; "/$_" }
219
 
                          $this->runpipe(0, "ar -p '$file' data.tar.gz | gzip -dc | tar tf -");
 
289
                $datamember_cmd = $this->get_datamember_cmd($file);
220
290
        }
 
291
        my @filelist=map { chomp; s:\./::; "/$_" }
 
292
                     $this->runpipe(0, "$datamember_cmd | tar tf -");
221
293
        $this->filelist(\@filelist);
222
294
 
223
295
        # Read in the scripts, if any.
244
316
                        or die "Unpacking of '$file' failed: $!";
245
317
        }
246
318
        else {
247
 
                $this->do("ar -p $file data.tar.gz | gzip -dc | (cd ".$this->unpacked_tree."; tar xpf -)")
 
319
                my $datamember_cmd = $this->get_datamember_cmd($file);
 
320
 
 
321
                $this->do("$datamember_cmd | (cd ".$this->unpacked_tree."; tar xpf -)")
248
322
                        or die "Unpacking of '$file' failed: $!";
249
323
        }
250
324