1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
package SlackBuild::Archive;
use strict;
use warnings;
use parent 'SlackBuild::URI';
use SlackBuild::Archive::Extractor;
use SlackBuild::Info;
use File::Temp qw/ tempfile tempdir /;
use File::Basename;
use File::Spec;
use Carp;
*AUTOLOAD = \&SlackBuild::URI::AUTOLOAD;
sub new {
my ($class, $pname) = (shift, shift);
my $self = $class->SUPER::new(@_);
$self->{_package_name} = $pname;
return $self;
}
sub package_name { shift->{_package_name} }
sub dir {
my ($self, $n) = @_;
if (defined($n)) {
return undef unless $n <= @{$self->{_dir}};
return $self->{_dir}[$n];
}
return @{$self->{_dir}}
}
sub iterate {
my ($self, $cb) = @_;
for (my $i = 0; my $file = $self->dir($i); $i++) {
return 0 unless &{$cb}($file);
}
return 1;
}
sub add_file {
my $self = shift;
push @{$self->{_dir}}, map {
s{/$}{};
File::Spec->no_upwards(basename($_)) ? $_ : ()
} @_;
}
sub has_file {
my ($self, $file) = @_;
return grep { $_ eq $file } ($self->dir);
}
sub verify {
my $self = shift;
my $file = $self->package_name . '.SlackBuild';
return $self->error("no $file in archive")
unless $self->has_file($file);
# return $self->error("no slack-desc in archive")
# unless $self->has_file('slack-desc');
return 1;
}
sub download {
croak "bad number of arguments" unless @_ == 2;
my ($self, $dst) = @_;
my (undef, $tmp) = tempfile(DIR => dirname($dst), UNLINK => 1);
unless ($self->SUPER::download($tmp)) {
return $self->error($self->SUPER::download_status);
}
unless (SlackBuild::Archive::Extractor->backend($self, $tmp, $dst)
->extract) {
return 0;
}
$self->_read_info($dst);
return 1;
}
sub _read_info {
my ($self, $dst) = @_;
my $info = $self->package_name . '.info';
return unless $self->has_file($info);
$self->{_info} = new SlackBuild::Info(File::Spec->catfile($dst, $info));
}
sub info {
my ($self) = @_;
return $self->{_info} ||= new SlackBuild::Info;
}
sub download_success {
my $self = shift;
return $self->{_last_success};
}
sub download_status {
my $self = shift;
return $self->SUPER::download_status unless exists $self->{_last_status};
return $self->{_last_status};
}
sub error {
my $self = shift;
$self->{_last_success} = 0;
$self->{_last_status} = shift;
return 0;
}
1;
|
