line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Slackware::Slackget::Package; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
98069
|
use warnings; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
145
|
|
4
|
5
|
|
|
5
|
|
58
|
use strict; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
175
|
|
5
|
|
|
|
|
|
|
use overload |
6
|
5
|
|
|
|
|
39
|
'cmp' => \&compare_version, |
7
|
|
|
|
|
|
|
'<=>' => \&compare_version, |
8
|
5
|
|
|
5
|
|
4094
|
'fallback' => 1; |
|
5
|
|
|
|
|
3398
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
require Slackware::Slackget::MD5; |
11
|
5
|
|
|
5
|
|
3046
|
use Data::Dumper; |
|
5
|
|
|
|
|
25755
|
|
|
5
|
|
|
|
|
292
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use constant { |
14
|
5
|
|
|
|
|
20828
|
PKG_VER_EQ => 0, |
15
|
|
|
|
|
|
|
PKG_VER_LT => -1, |
16
|
|
|
|
|
|
|
PKG_VER_GT => 1, |
17
|
5
|
|
|
5
|
|
30
|
}; |
|
5
|
|
|
|
|
7
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 NAME |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
Slackware::Slackget::Package - This class is the internal representation of a package for slack-get 1.0 |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 VERSION |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
Version 1.0.3 |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=cut |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
our @ISA = qw( Slackware::Slackget::MD5 ); |
30
|
|
|
|
|
|
|
our $VERSION = '1.0.3'; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 SYNOPSIS |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
This module is used to represent a package for slack-get |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
use Slackware::Slackget::Package; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $package = Slackware::Slackget::Package->new('package-1.0.0-noarch-1'); |
39
|
|
|
|
|
|
|
$package->setValue('description',"This is a test of the Slackware::Slackget::Package object"); |
40
|
|
|
|
|
|
|
$package->fill_object_from_package_name(); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
This class inheritate from Slackware::Slackget::MD5, so you can use : |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
$sgo->installpkg($package) if($package->verify_md5); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Isn't it great ? |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head2 new |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
The constructor take two parameters : a package name, and an id (the namespace of the package like 'slackware' or 'linuxpackages') |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
my $package = new Slackware::Slackget::Package ('aaa_base-10.0.0-noarch-1','slackware'); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
The constructor automatically call the fill_object_from_package_name() method. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
You also can pass some extra arguments like that : |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
my $package = new Slackware::Slackget::Package ('aaa_base-10.0.0-noarch-1', 'package-object-version' => '1.0.0'); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
The constructor return undef if the id is not defined. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=cut |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub new |
67
|
|
|
|
|
|
|
{ |
68
|
4
|
|
|
4
|
1
|
1364
|
my ($class,$id,@args) = @_ ; |
69
|
4
|
50
|
|
|
|
10
|
return undef unless($id); |
70
|
4
|
|
|
|
|
8
|
my %args = (); |
71
|
4
|
|
|
|
|
5
|
my $self = {}; |
72
|
4
|
50
|
|
|
|
11
|
if(scalar(@args)%2 == 0){ |
73
|
0
|
|
|
|
|
0
|
%args = @args ; |
74
|
0
|
|
|
|
|
0
|
$self={%args} ; |
75
|
|
|
|
|
|
|
}else{ |
76
|
4
|
|
|
|
|
9
|
$self->{SOURCE} = $args[0]; |
77
|
|
|
|
|
|
|
} |
78
|
4
|
|
|
|
|
7
|
$self->{ROOT} = $id ; |
79
|
4
|
|
|
|
|
12
|
$self->{STATS} = {hw => [], dwc => 0}; |
80
|
4
|
|
|
|
|
6
|
bless($self,$class); |
81
|
4
|
|
|
|
|
10
|
$self->fill_object_from_package_name(); |
82
|
4
|
|
|
|
|
10
|
return $self; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head1 FUNCTIONS |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head2 merge |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
This method merge $another_package with $package. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
** WARNING ** : $another_package will be destroy in the operation (this is a collateral damage ;-), for some dark preocupation of memory. |
92
|
|
|
|
|
|
|
** WARNING 2 ** : the merge keep the id from $package, this mean that an inconsistency can be found between the id and the version number. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
This method overwrite existing value. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
$package->merge($another_package); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=cut |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub merge { |
101
|
2
|
|
|
2
|
1
|
4
|
my ($self,$package) = @_ ; |
102
|
2
|
50
|
|
|
|
9
|
return unless($package); |
103
|
2
|
|
|
|
|
3
|
foreach (keys(%{$package->{PACK}})){ |
|
2
|
|
|
|
|
10
|
|
104
|
10
|
|
|
|
|
16
|
$self->{PACK}->{$_} = $package->{PACK}->{$_} ; |
105
|
|
|
|
|
|
|
} |
106
|
2
|
|
|
|
|
3
|
$self->{STATS} = {hw => [@{ $package->{STATS}->{hw} }], dwc => $package->{STATS}->{dwc}} ; |
|
2
|
|
|
|
|
11
|
|
107
|
2
|
|
|
|
|
5
|
$package = undef; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head2 is_heavy_word |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
This method return true (1) if the first argument is an "heavy word" and return false (0) otherwise. |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
print "heavy word found !\n" if($package->is_heavy_word($request[$i])); |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=cut |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub is_heavy_word |
119
|
|
|
|
|
|
|
{ |
120
|
2
|
|
|
2
|
1
|
4
|
my ($self,$w) = @_ ; |
121
|
2
|
50
|
|
|
|
8
|
return undef unless($w); |
122
|
2
|
|
|
|
|
3
|
foreach my $hw (@{$self->{STATS}->{hw}}){ |
|
2
|
|
|
|
|
7
|
|
123
|
2
|
50
|
|
|
|
14
|
return 1 if($w eq $hw); |
124
|
|
|
|
|
|
|
} |
125
|
0
|
|
|
|
|
0
|
return 0; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head2 get_statistic |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Return a given statistic about the description of the package. Currently available are : dwc (description words count) and hw (heavy words, a list of important words). |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Those are for the optimisation of the search speed. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=cut |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub get_statistic |
137
|
|
|
|
|
|
|
{ |
138
|
0
|
|
|
0
|
1
|
0
|
my ($self,$w) = @_ ; |
139
|
0
|
|
|
|
|
0
|
return $self->{PACK}->{statistics}->{$w}; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=head2 compare_version |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
This method take another Slackware::Slackget::Package as argument and compare it's version to the current object. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
if( $package->compare_version( $another_package ) == -1 ) |
147
|
|
|
|
|
|
|
{ |
148
|
|
|
|
|
|
|
print $another_package->get_id," is newer than ",$package->get_id ,"\n"; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
Returned code : |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
-1 => $package version is lesser than $another_package's one |
154
|
|
|
|
|
|
|
0 => $package version is equal to $another_package's one |
155
|
|
|
|
|
|
|
1 => $package version is greater than $another_package's one |
156
|
|
|
|
|
|
|
undef => an error occured. |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=cut |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub compare_version |
161
|
|
|
|
|
|
|
{ |
162
|
24
|
|
|
24
|
1
|
538
|
my ($self,$o_pack) = @_ ; |
163
|
|
|
|
|
|
|
# warn "$o_pack is not a Slackware::Slackget::Package !" if(ref($o_pack) ne 'Slackware::Slackget::Package') ; |
164
|
24
|
50
|
|
|
|
82
|
if($o_pack->can('version')) |
165
|
|
|
|
|
|
|
{ |
166
|
|
|
|
|
|
|
# print "compare_version ",$self->get_id()," v. ",$self->version()," and ",$o_pack->get_id()," v. ",$o_pack->version(),"\n"; |
167
|
24
|
50
|
|
|
|
32
|
$o_pack->setValue('version','0.0.0') unless(defined($o_pack->version())); |
168
|
24
|
50
|
|
|
|
53
|
$self->setValue('version','0.0.0') unless(defined($self->version())); |
169
|
24
|
|
|
|
|
31
|
my @o_pack_version = split(/\./, $o_pack->version()) ; |
170
|
24
|
|
|
|
|
32
|
my @self_version = split(/\./, $self->version()) ; |
171
|
24
|
|
|
|
|
46
|
for(my $k=0; $k<=$#self_version; $k++) |
172
|
|
|
|
|
|
|
{ |
173
|
|
|
|
|
|
|
# print "\t cmp $self_version[$k] and $o_pack_version[$k]\n"; |
174
|
32
|
50
|
|
|
|
46
|
$self_version[$k] = 0 unless(defined($self_version[$k])); |
175
|
32
|
50
|
|
|
|
38
|
$o_pack_version[$k] = 0 unless(defined($o_pack_version[$k])); |
176
|
32
|
50
|
33
|
|
|
170
|
if($self_version[$k] =~ /^\d+$/ && $o_pack_version[$k] =~ /^\d+$/) |
177
|
|
|
|
|
|
|
{ |
178
|
32
|
100
|
|
|
|
86
|
if($self_version[$k] > $o_pack_version[$k]) |
|
|
100
|
|
|
|
|
|
179
|
|
|
|
|
|
|
{ |
180
|
8
|
50
|
|
|
|
18
|
print "\t",$self->get_id()," > ",$o_pack->get_id(),"\n" if($ENV{SG_DAEMON_DEBUG}); |
181
|
8
|
|
|
|
|
31
|
return 1; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
elsif($self_version[$k] < $o_pack_version[$k]) |
184
|
|
|
|
|
|
|
{ |
185
|
12
|
50
|
|
|
|
23
|
print "\t",$self->get_id()," < ",$o_pack->get_id(),"\n" if($ENV{SG_DAEMON_DEBUG}); |
186
|
12
|
|
|
|
|
46
|
return -1; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
else |
190
|
|
|
|
|
|
|
{ |
191
|
0
|
0
|
|
|
|
0
|
if($self_version[$k] gt $o_pack_version[$k]) |
|
|
0
|
|
|
|
|
|
192
|
|
|
|
|
|
|
{ |
193
|
0
|
0
|
|
|
|
0
|
print "\t",$self->get_id()," greater than ",$o_pack->get_id(),"\n" if($ENV{SG_DAEMON_DEBUG}); |
194
|
0
|
|
|
|
|
0
|
return 1; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
elsif($self_version[$k] lt $o_pack_version[$k]) |
197
|
|
|
|
|
|
|
{ |
198
|
0
|
0
|
|
|
|
0
|
print "\t",$self->get_id()," lesser than ",$o_pack->get_id(),"\n" if($ENV{SG_DAEMON_DEBUG}); |
199
|
0
|
|
|
|
|
0
|
return -1; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
} |
203
|
4
|
50
|
33
|
|
|
7
|
if( $self->getValue('package-version') && $o_pack->getValue('package-version') ){ |
204
|
4
|
50
|
|
|
|
7
|
if( $self->getValue('package-version') gt $o_pack->getValue('package-version') ){ |
|
|
50
|
|
|
|
|
|
205
|
0
|
0
|
|
|
|
0
|
print "\t",$self->get_id()," greater than ",$o_pack->get_id()," (package-version)\n" if($ENV{SG_DAEMON_DEBUG}); |
206
|
0
|
|
|
|
|
0
|
return 1; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
elsif( $self->getValue('package-version') lt $o_pack->getValue('package-version') ){ |
209
|
0
|
0
|
|
|
|
0
|
print "\t",$self->get_id()," lesser than ",$o_pack->get_id()," (package-version)\n" if($ENV{SG_DAEMON_DEBUG}); |
210
|
0
|
|
|
|
|
0
|
return -1 ; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
} |
213
|
4
|
50
|
|
|
|
10
|
print "\t",$self->get_id()," equal to ",$o_pack->get_id(),"\n" if($ENV{SG_DAEMON_DEBUG}); |
214
|
4
|
|
|
|
|
17
|
return 0; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
else |
217
|
|
|
|
|
|
|
{ |
218
|
0
|
|
|
|
|
0
|
return undef; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=head2 fill_object_from_package_name |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
Try to extract the maximum informations from the name of the package. The constructor automatically call this method. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
$package->fill_object_from_package_name(); |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=cut |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub fill_object_from_package_name{ |
231
|
4
|
|
|
4
|
1
|
6
|
my $self = shift; |
232
|
4
|
50
|
|
|
|
85
|
if($self->{ROOT}=~ /^(.*)-([0-9].*)-(i[0-9]86|noarch)-(\d{1,2})(\.tgz)?$/) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
233
|
|
|
|
|
|
|
{ |
234
|
4
|
|
|
|
|
11
|
$self->setValue('name',$1); |
235
|
4
|
|
|
|
|
6
|
$self->setValue('version',$2); |
236
|
4
|
|
|
|
|
6
|
$self->setValue('architecture',$3); |
237
|
4
|
|
|
|
|
7
|
$self->setValue('package-version',$4); |
238
|
4
|
50
|
33
|
|
|
33
|
$self->setValue('package-maintener','Slackware team') if(defined($self->{SOURCE}) && $self->{SOURCE}=~/^slackware$/i); |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
elsif($self->{ROOT}=~ /^(.*)-([0-9].*)-(i[0-9]86|noarch)-([^\-]+)(\.tgz)?$/) |
241
|
|
|
|
|
|
|
{ |
242
|
0
|
|
|
|
|
0
|
$self->setValue('name',$1); |
243
|
0
|
|
|
|
|
0
|
$self->setValue('version',$2); |
244
|
0
|
|
|
|
|
0
|
$self->setValue('architecture',$3); |
245
|
0
|
|
|
|
|
0
|
$self->setValue('package-version',$4); |
246
|
|
|
|
|
|
|
# $self->setValue('package-maintener',$5) if(!defined($self->getValue('package-maintener'))); |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
elsif($self->{ROOT}=~ /^(.*)-([0-9].*)-(i[0-9]86|noarch)-(\d{1,2})(\w*)(\.tgz)?$/) |
249
|
|
|
|
|
|
|
{ |
250
|
0
|
|
|
|
|
0
|
$self->setValue('name',$1); |
251
|
0
|
|
|
|
|
0
|
$self->setValue('version',$2); |
252
|
0
|
|
|
|
|
0
|
$self->setValue('architecture',$3); |
253
|
0
|
|
|
|
|
0
|
$self->setValue('package-version',$4); |
254
|
|
|
|
|
|
|
# $self->setValue('package-maintener',$5) if(!defined($self->getValue('package-maintener'))); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
elsif($self->{ROOT}=~ /^(.*)-([^-]+)-(i[0-9]86|noarch)-(\d{1,2})(\.tgz)?$/) |
257
|
|
|
|
|
|
|
{ |
258
|
0
|
|
|
|
|
0
|
$self->setValue('name',$1); |
259
|
0
|
|
|
|
|
0
|
$self->setValue('version',$2); |
260
|
0
|
|
|
|
|
0
|
$self->setValue('architecture',$3); |
261
|
0
|
|
|
|
|
0
|
$self->setValue('package-version',$4); |
262
|
0
|
0
|
0
|
|
|
0
|
$self->setValue('package-maintener','Slackware team') if(defined($self->{SOURCE}) && $self->{SOURCE}=~/^slackware$/i); |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
elsif($self->{ROOT}=~ /^(.*)-([^-]+)-(i[0-9]86|noarch)-(\d{1,2})(\w*)(\.tgz)?$/) |
265
|
|
|
|
|
|
|
{ |
266
|
0
|
|
|
|
|
0
|
$self->setValue('name',$1); |
267
|
0
|
|
|
|
|
0
|
$self->setValue('version',$2); |
268
|
0
|
|
|
|
|
0
|
$self->setValue('architecture',$3); |
269
|
0
|
|
|
|
|
0
|
$self->setValue('package-version',$4); |
270
|
|
|
|
|
|
|
# $self->setValue('package-maintener',$5) if(!defined($self->getValue('package-maintener'))); |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
else |
273
|
|
|
|
|
|
|
{ |
274
|
0
|
|
|
|
|
0
|
$self->setValue('name',$self->{ROOT}); |
275
|
|
|
|
|
|
|
} |
276
|
4
|
|
|
|
|
11
|
$self->{STATS}->{hw} = [split(/-/,$self->getValue('name'))]; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=head2 extract_informations |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
Extract informations about a package from a string. This string must be a line of the description of a package. |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
$package->extract_informations($data); |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
This method is designe to be called by the Slackware::Slackget::SpecialFiles::PACKAGES class, and automatically call the clean_description() method. |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=cut |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub extract_informations { |
290
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
291
|
0
|
|
|
|
|
0
|
my $raw_str = shift ; |
292
|
0
|
|
|
|
|
0
|
my $is_descr=0; |
293
|
0
|
|
|
|
|
0
|
my $have_sd=0; |
294
|
0
|
|
|
|
|
0
|
foreach (split(/\n/,$raw_str) ){ |
295
|
0
|
|
|
|
|
0
|
chomp ; |
296
|
0
|
0
|
|
|
|
0
|
if($_ =~ /^\s*PACKAGE NAME\s*:\s*(.*)\.tgz\s*/) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
297
|
|
|
|
|
|
|
{ |
298
|
0
|
|
|
|
|
0
|
$self->_setId($1); |
299
|
|
|
|
|
|
|
# print "[Slackware::Slackget::Package] (debug) package name: $1\n" if($ENV{SG_DAEMON_DEBUG}); |
300
|
0
|
|
|
|
|
0
|
$self->fill_object_from_package_name(); |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
elsif($_ =~ /^\s*(COMPRESSED PACKAGE SIZE|PACKAGE SIZE \(compressed\))\s*:\s*(.*) K/) |
304
|
|
|
|
|
|
|
{ |
305
|
|
|
|
|
|
|
# print "[Slackware::Slackget::Package] (debug) compressed size: $2\n" if($ENV{SG_DAEMON_DEBUG}); |
306
|
0
|
|
|
|
|
0
|
$self->setValue('compressed-size',$2); |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
elsif($_ =~ /^\s*(UNCOMPRESSED PACKAGE SIZE|PACKAGE SIZE \(uncompressed\))\s*:\s*(.*) K/) |
309
|
|
|
|
|
|
|
{ |
310
|
|
|
|
|
|
|
# print "[Slackware::Slackget::Package] (debug) uncompressed size: $2\n" if($ENV{SG_DAEMON_DEBUG}); |
311
|
0
|
|
|
|
|
0
|
$self->setValue('uncompressed-size',$2); |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
elsif($_ =~ /^\s*PACKAGE LOCATION\s*:\s*(.*)\s*/) |
314
|
|
|
|
|
|
|
{ |
315
|
|
|
|
|
|
|
# print "[Slackware::Slackget::Package] (debug) package location: $1\n" if($ENV{SG_DAEMON_DEBUG}); |
316
|
0
|
|
|
|
|
0
|
$self->setValue('package-location',$1); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
elsif($_ =~ /^\s*PACKAGE REQUIRED\s*:\s*(.*)\s*/) |
319
|
|
|
|
|
|
|
{ |
320
|
|
|
|
|
|
|
# print "[Slackware::Slackget::Package] (debug) required packages: $1\n" if($ENV{SG_DAEMON_DEBUG}); |
321
|
0
|
|
|
|
|
0
|
my $raw_deps = $1; |
322
|
0
|
|
|
|
|
0
|
my @dep=(); |
323
|
0
|
|
|
|
|
0
|
foreach my $d ( split(/\s*,|;\s*/,$raw_deps) ){ |
324
|
0
|
|
|
|
|
0
|
my $tmp_array = []; |
325
|
0
|
|
|
|
|
0
|
foreach my $i (split(/\s*\|\s*/,$d) ){ |
326
|
0
|
0
|
0
|
|
|
0
|
if($i=~ /^\s*([^><=\s]+)\s*([><=]+)\s*(.+)\s*$/){ |
|
|
0
|
|
|
|
|
|
327
|
0
|
|
|
|
|
0
|
my $ref = {pkg_name => $1, comparison_type => $2, required_version => $3}; |
328
|
0
|
0
|
|
|
|
0
|
$ref->{required_version} = $1 if($ref->{required_version} =~ /^(.+)-(.+)-(.+)$/); |
329
|
0
|
|
|
|
|
0
|
push @{$tmp_array}, $ref; |
|
0
|
|
|
|
|
0
|
|
330
|
|
|
|
|
|
|
}elsif(defined($i) && $i !~ /(,|;|\|)/ ){ |
331
|
0
|
|
|
|
|
0
|
push @{$tmp_array}, {pkg_name => $i}; |
|
0
|
|
|
|
|
0
|
|
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
# else{ |
334
|
|
|
|
|
|
|
# print STDERR "[Slackware::Slackget::Package] (error) $d is not a valid dependency token for package $self->{ROOT} (",$self->getValue('package-source'),").\n"; |
335
|
|
|
|
|
|
|
# } |
336
|
|
|
|
|
|
|
} |
337
|
0
|
|
|
|
|
0
|
push @dep, $tmp_array; |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
# print "==> dump for package $self->{ROOT} (",$self->getValue('package-source'),") <==\n",Dumper(@dep); <STDIN>; |
340
|
0
|
|
|
|
|
0
|
$self->setValue('required',[@dep]); |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
elsif($_ =~ /^\s*PACKAGE SUGGESTS\s*:\s*([^\n]*)\s*/) |
343
|
|
|
|
|
|
|
{ |
344
|
0
|
|
|
|
|
0
|
my $raw_deps = $1; |
345
|
0
|
|
|
|
|
0
|
my @dep=(); |
346
|
0
|
|
|
|
|
0
|
foreach my $d ( split(/,|;/,$raw_deps) ){ |
347
|
0
|
|
|
|
|
0
|
my $tmp_array = []; |
348
|
0
|
|
|
|
|
0
|
foreach my $i (split(/\|/,$d) ){ |
349
|
0
|
0
|
0
|
|
|
0
|
if($i=~ /^\s*([^><=]+)\s*([><=]+)\s*(.+)\s*$/){ |
|
|
0
|
|
|
|
|
|
350
|
0
|
|
|
|
|
0
|
my $ref = {pkg_name => $1, comparison_type => $2, required_version => $3}; |
351
|
0
|
0
|
|
|
|
0
|
$ref->{required_version} = $1 if($ref->{required_version} =~ /^(.+)-(.+)-(.+)$/); |
352
|
0
|
0
|
|
|
|
0
|
$ref->{comparison_type} = '=<' if($ref->{comparison_type} eq '<='); |
353
|
0
|
0
|
|
|
|
0
|
$ref->{comparison_type} = '>=' if($ref->{comparison_type} eq '=>'); |
354
|
0
|
|
|
|
|
0
|
push @{$tmp_array}, $ref; |
|
0
|
|
|
|
|
0
|
|
355
|
|
|
|
|
|
|
}elsif(defined($i) && $i !~ /(,|;|\|)/ ){ |
356
|
0
|
|
|
|
|
0
|
push @{$tmp_array}, {pkg_name => $i}; |
|
0
|
|
|
|
|
0
|
|
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
} |
359
|
0
|
|
|
|
|
0
|
push @dep, $tmp_array; |
360
|
|
|
|
|
|
|
} |
361
|
0
|
|
|
|
|
0
|
$self->setValue('suggested',[@dep]); |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
elsif($_=~/^\s*PACKAGE DESCRIPTION:\s*\n*(.*)/ms) |
365
|
|
|
|
|
|
|
{ |
366
|
|
|
|
|
|
|
# print "descr "; |
367
|
0
|
|
|
|
|
0
|
$self->setValue('description',$1); |
368
|
0
|
0
|
|
|
|
0
|
if(defined($1)){ |
369
|
0
|
|
|
|
|
0
|
$self->setValue('shortdescription',$1); |
370
|
|
|
|
|
|
|
} |
371
|
0
|
|
|
|
|
0
|
$is_descr=1; |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
# print "[DEBUG] Slackware::Slackget::Package -> package ",$self->get_id()," ($self) have $self->{STATS}->{dwc} words in its description.\n"; |
374
|
|
|
|
|
|
|
# print Dumper($self);<STDIN>; |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
elsif($is_descr){ |
377
|
0
|
0
|
|
|
|
0
|
if(/^\s*[^:]+\s*:\s*(.+)$/){ |
378
|
0
|
|
|
|
|
0
|
$self->setValue('description', $self->getValue('description')."$1\n" ); |
379
|
0
|
0
|
|
|
|
0
|
unless($have_sd){ |
380
|
0
|
|
|
|
|
0
|
$self->setValue('shortdescription',$1); |
381
|
0
|
|
|
|
|
0
|
$have_sd=1; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
} |
386
|
0
|
|
|
|
|
0
|
$self->clean_description ; |
387
|
0
|
|
|
|
|
0
|
my @t = split(/\s/,$self->getValue('description')); |
388
|
0
|
|
|
|
|
0
|
$self->{STATS}->{dwc} = scalar(@t); |
389
|
|
|
|
|
|
|
# print "[Slackware::Slackget::Package] (debug) description:\n",$self->getValue('description'),"\n" if($ENV{SG_DAEMON_DEBUG}); |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=head2 clean_description |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
remove the "<package_name>: " string in front of each line of the description. Remove extra tabulation (for identation). |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
$package->clean_description(); |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=cut |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
sub clean_description{ |
401
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
402
|
0
|
0
|
0
|
|
|
0
|
if($self->{PACK}->{name} && defined($self->{PACK}->{description}) && $self->{PACK}->{description}) |
|
|
|
0
|
|
|
|
|
403
|
|
|
|
|
|
|
{ |
404
|
0
|
|
|
|
|
0
|
$self->{PACK}->{description}=~ s/\s*\Q$self->{PACK}->{name}\E\s*:\s*/ /ig; |
405
|
|
|
|
|
|
|
# my @descr = split(/\s*\Q$self->{PACK}->{name}\E\s*:/,$self->{PACK}->{description}); |
406
|
|
|
|
|
|
|
# $self->{PACK}->{description} = join(' ',@descr); |
407
|
0
|
|
|
|
|
0
|
$self->{PACK}->{description}=~ s/\t{4,}/\t\t\t/g; |
408
|
0
|
|
|
|
|
0
|
$self->{PACK}->{description}=~ s/\n\s+\n/\n/g; |
409
|
|
|
|
|
|
|
} |
410
|
0
|
|
|
|
|
0
|
$self->{PACK}->{description}.="\n\t\t"; |
411
|
0
|
|
|
|
|
0
|
return 1; |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=head2 grab_info_from_description |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
Try to find some informations in the description. For example, packages from linuxpackages.net contain a line starting by Packager: ..., this method will extract this information and re-set the package-maintener tag. |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
The supported tags are: package-maintener, info-destination-slackware, info-packager-mail, info-homepage, info-packager-tool, info-packager-tool-version |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
$package->grab_info_from_description(); |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=cut |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
sub grab_info_from_description |
425
|
|
|
|
|
|
|
{ |
426
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
427
|
0
|
0
|
|
|
|
0
|
return unless( defined($self->{PACK}->{description}) ); |
428
|
|
|
|
|
|
|
# NOTE: je remplace ici tout les elsif() par des if() histoire de voir si l'extraction d'information est plus interressante. |
429
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /this\s+version\s+.*\s+was\s+comp(iled|lied)\s+for\s+([^\n]*)\s+(.|\n)*\s+by\s+([^\n\t]*)/i){ |
430
|
0
|
|
|
|
|
0
|
$self->setValue('info-destination-slackware',$2); |
431
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',$4); |
432
|
|
|
|
|
|
|
} |
433
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /\s*(http:\/\/[^\s]+)/i){ |
434
|
0
|
|
|
|
|
0
|
$self->setValue('info-homepage',$1); |
435
|
|
|
|
|
|
|
} |
436
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /\s*([\w\.\-]+\@[^\s]+\.[\w]+)/i){ |
437
|
0
|
|
|
|
|
0
|
$self->setValue('info-packager-mail',$1); |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
|
440
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /Package\s+created\s+by:\s+(.*)\s+<([^\n\t]*)>/i){ |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
441
|
0
|
|
|
|
|
0
|
$self->setValue('info-pacdatekager-mail',$2); |
442
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',$1); |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
elsif($self->{PACK}->{description}=~ /Packager:\s+(.*)\s+<(.*)>/i){ |
445
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',$1); |
446
|
0
|
|
|
|
|
0
|
$self->setValue('info-packager-mail',$2); |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
elsif($self->{PACK}->{description}=~ /Package\s+created\s+.*by\s+(.*)\s+\(([^\n\t]*)\)/i){ |
449
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',$1); |
450
|
0
|
|
|
|
|
0
|
$self->setValue('info-packager-mail',$2); |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
elsif ( $self->{PACK}->{description}=~ /Packaged by ([^\s]+) ([^\s]+) \((.*)\)/i) |
453
|
|
|
|
|
|
|
{ |
454
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',"$1 $2"); |
455
|
0
|
|
|
|
|
0
|
$self->setValue('info-packager-mail',$3); |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
elsif($self->{PACK}->{description}=~ /\s*Package\s+Maintainer:\s+(.*)\s+\(([^\n\t]*)\)/i){ |
458
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',$1); |
459
|
0
|
|
|
|
|
0
|
$self->setValue('info-packager-mail',$2); |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
elsif($self->{PACK}->{description}=~ /Packaged\s+by\s+(.*)\s+<([^\n\t]*)>/i){ |
462
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',$1); |
463
|
0
|
|
|
|
|
0
|
$self->setValue('info-packager-mail',$2); |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
0
|
0
|
|
|
|
0
|
if ( $self->{PACK}->{description}=~ /Package created by ([^\s]+) ([^\s]+)/i) |
467
|
|
|
|
|
|
|
{ |
468
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',"$1 $2"); |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
|
471
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /Packaged\s+by:?\s+(.*)(\s+(by|for|to|on))?/i){ |
472
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',$1); |
473
|
|
|
|
|
|
|
} |
474
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /Package\s+created\s+by:?\s+([^\n\t]*)/i){ |
475
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',$1); |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
|
478
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /Package\s+created\s+by\s+(.*)\s+\[([^\n\t]*)\]/i){ |
479
|
0
|
|
|
|
|
0
|
$self->setValue('info-homepage',$2);date |
|
0
|
|
|
|
|
0
|
|
480
|
|
|
|
|
|
|
$self->setValue('package-maintener',$1); |
481
|
|
|
|
|
|
|
} |
482
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /Packager:\s+([^\n\t]*)/i){ |
483
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',$1); |
484
|
|
|
|
|
|
|
} |
485
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /Packager\s+([^\n\t]*)/i){ |
486
|
0
|
|
|
|
|
0
|
$self->setValue('package-maintener',$1); |
487
|
|
|
|
|
|
|
} |
488
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /Home\s{0,1}page: ([^\n\t]*)/i){ |
489
|
0
|
|
|
|
|
0
|
$self->setValue('info-homepage',$1); |
490
|
|
|
|
|
|
|
} |
491
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /Package URL: ([^\n\t]*)/i){ |
492
|
0
|
|
|
|
|
0
|
$self->setValue('info-homepage',$1); |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
|
495
|
0
|
0
|
|
|
|
0
|
if($self->{PACK}->{description}=~ /Package creat(ed|e) with ([^\s]*) ([^\s]*)/i){ |
496
|
0
|
|
|
|
|
0
|
$self->setValue('info-packager-tool',$2); |
497
|
0
|
|
|
|
|
0
|
$self->setValue('info-packager-tool-version',$3); |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=head2 to_XML (deprecated) |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
Same as to_xml(), provided for backward compatibility. |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=cut |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
sub to_XML { |
509
|
1
|
|
|
1
|
1
|
4
|
return to_xml(@_); |
510
|
|
|
|
|
|
|
} |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=head2 to_xml |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
return the package as an XML encoded string. |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
$xml = $package->to_xml(); |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
=cut |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
sub to_xml |
521
|
|
|
|
|
|
|
{ |
522
|
4
|
|
|
4
|
1
|
4
|
my $self = shift; |
523
|
|
|
|
|
|
|
|
524
|
4
|
|
|
|
|
10
|
my $xml = "\t<package id=\"$self->{ROOT}\">\n"; |
525
|
4
|
50
|
33
|
|
|
21
|
if(defined($self->{STATUS}) && ref($self->{STATUS}) eq 'Slackware::Slackget::Status') |
526
|
|
|
|
|
|
|
{ |
527
|
0
|
|
|
|
|
0
|
$xml .= "\t\t".$self->{STATUS}->to_xml()."\n"; |
528
|
|
|
|
|
|
|
} |
529
|
4
|
50
|
|
|
|
8
|
if($self->{PACK}->{'package-date'}){ |
530
|
0
|
|
|
|
|
0
|
$xml .= "\t\t".$self->{PACK}->{'package-date'}->to_xml(); |
531
|
0
|
|
|
|
|
0
|
$self->{TMP}->{'package-date'}=$self->{PACK}->{'package-date'}; |
532
|
0
|
|
|
|
|
0
|
delete($self->{PACK}->{'package-date'}); |
533
|
|
|
|
|
|
|
} |
534
|
4
|
50
|
|
|
|
12
|
if($self->{PACK}->{'date'}){ |
535
|
0
|
|
|
|
|
0
|
$xml .= "\t\t".$self->{PACK}->{'date'}->to_xml(); |
536
|
0
|
|
|
|
|
0
|
$self->{TMP}->{'date'}=$self->{PACK}->{'date'}; |
537
|
0
|
|
|
|
|
0
|
delete($self->{PACK}->{'date'}); |
538
|
|
|
|
|
|
|
} |
539
|
4
|
50
|
|
|
|
8
|
if($self->{STATS}){ |
540
|
4
|
50
|
66
|
|
|
12
|
if($self->{STATS}->{dwc} == 0 && scalar(@{$self->{STATS}->{hw}}) > 0 && defined($self->getValue('description')) ){ |
|
2
|
|
66
|
|
|
13
|
|
541
|
2
|
|
|
|
|
5
|
my @t = split(/\s/,$self->getValue('description')); |
542
|
2
|
|
|
|
|
4
|
$self->{STATS}->{dwc} = scalar(@t); |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
# print "[Slackware::Slackget::Package->to_xml] $self->{ROOT} ($self) : <statistics dwc=\"".$self->{STATS}->{dwc}."\" hw=\":".join(':',@{$self->{STATS}->{hw}}).":\" />\n"; |
545
|
|
|
|
|
|
|
# print Dumper($self);<STDIN>; |
546
|
|
|
|
|
|
|
|
547
|
4
|
|
|
|
|
10
|
$xml .= "\t\t<statistics dwc=\"".$self->{STATS}->{dwc}."\" hw=\":".join(':',@{$self->{STATS}->{hw}}).":\" />\n"; |
|
4
|
|
|
|
|
13
|
|
548
|
|
|
|
|
|
|
} |
549
|
4
|
50
|
|
|
|
21
|
if($self->{PACK}->{'required'}){ |
550
|
0
|
|
|
|
|
0
|
$xml .= "\t\t<required>\n"; |
551
|
0
|
|
|
|
|
0
|
foreach my $dep ( @{$self->{PACK}->{'required'}} ){ |
|
0
|
|
|
|
|
0
|
|
552
|
0
|
0
|
|
|
|
0
|
next if(ref($dep) ne 'ARRAY'); |
553
|
0
|
|
|
|
|
0
|
$xml .= "\t\t\t<dependencies>\n"; |
554
|
0
|
|
|
|
|
0
|
foreach my $ad (@{$dep}){ |
|
0
|
|
|
|
|
0
|
|
555
|
0
|
|
|
|
|
0
|
$xml .= "\t\t\t\t<dependency name=\"$ad->{pkg_name}\""; |
556
|
0
|
0
|
|
|
|
0
|
$xml .= " required_version=\"$ad->{required_version}\"" if($ad->{required_version}); |
557
|
0
|
0
|
|
|
|
0
|
$xml .= " comparison_type=\"$ad->{comparison_type}\"" if($ad->{comparison_type}); |
558
|
0
|
|
|
|
|
0
|
$xml .= "/>\n"; |
559
|
|
|
|
|
|
|
} |
560
|
0
|
|
|
|
|
0
|
$xml .= "\t\t\t</dependencies>\n"; |
561
|
|
|
|
|
|
|
} |
562
|
0
|
|
|
|
|
0
|
$xml .= "\t\t</required>\n"; |
563
|
0
|
|
|
|
|
0
|
$self->{TMP}->{'required'}=$self->{PACK}->{'required'}; |
564
|
0
|
|
|
|
|
0
|
delete($self->{PACK}->{'required'}); |
565
|
|
|
|
|
|
|
} |
566
|
4
|
50
|
|
|
|
12
|
if($self->{PACK}->{'suggested'}){ |
567
|
0
|
|
|
|
|
0
|
$xml .= "\t\t<suggested>\n"; |
568
|
0
|
|
|
|
|
0
|
foreach my $dep ( @{$self->{PACK}->{'suggested'}} ){ |
|
0
|
|
|
|
|
0
|
|
569
|
0
|
0
|
|
|
|
0
|
next if(ref($dep) ne 'ARRAY'); |
570
|
0
|
|
|
|
|
0
|
$xml .= "\t\t\t<dependencies>\n"; |
571
|
0
|
|
|
|
|
0
|
foreach my $ad (@{$dep}){ |
|
0
|
|
|
|
|
0
|
|
572
|
0
|
|
|
|
|
0
|
$xml .= "\t\t\t\t<dependency name=\"$ad->{pkg_name}\""; |
573
|
0
|
0
|
|
|
|
0
|
$xml .= " required_version=\"$ad->{required_version}\"" if($ad->{required_version}); |
574
|
0
|
0
|
|
|
|
0
|
$xml .= " comparison_type=\"$ad->{comparison_type}\"" if($ad->{comparison_type}); |
575
|
0
|
|
|
|
|
0
|
$xml .= "/>\n"; |
576
|
|
|
|
|
|
|
} |
577
|
0
|
|
|
|
|
0
|
$xml .= "\t\t\t</dependencies>\n"; |
578
|
|
|
|
|
|
|
} |
579
|
0
|
|
|
|
|
0
|
$xml .= "\t\t</suggested>\n"; |
580
|
0
|
|
|
|
|
0
|
$self->{TMP}->{'suggested'}=$self->{PACK}->{'suggested'}; |
581
|
0
|
|
|
|
|
0
|
delete($self->{PACK}->{'suggested'}); |
582
|
|
|
|
|
|
|
} |
583
|
4
|
|
|
|
|
4
|
foreach (keys(%{$self->{PACK}})){ |
|
4
|
|
|
|
|
10
|
|
584
|
26
|
50
|
|
|
|
39
|
next if(/^_[A-Z_]+$/); |
585
|
26
|
100
|
|
|
|
67
|
$xml .= "\t\t<$_><![CDATA[$self->{PACK}->{$_}]]></$_>\n" if(defined($self->{PACK}->{$_})); |
586
|
|
|
|
|
|
|
} |
587
|
4
|
|
|
|
|
11
|
$self->{PACK}->{'package-date'}=$self->{TMP}->{'package-date'}; |
588
|
4
|
|
|
|
|
6
|
delete($self->{TMP}); |
589
|
4
|
|
|
|
|
4
|
$xml .= "\t</package>\n"; |
590
|
4
|
|
|
|
|
12
|
return $xml; |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=head2 to_string |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
Alias for to_xml() |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
=cut |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
sub to_string{ |
600
|
2
|
|
|
2
|
1
|
4
|
my $self = shift; |
601
|
2
|
|
|
|
|
6
|
$self->to_xml(); |
602
|
|
|
|
|
|
|
} |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
=head2 to_HTML (deprecated) |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
Same as to_html(), provided for backward compatibility. |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
=cut |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
sub to_HTML { |
611
|
1
|
|
|
1
|
1
|
3
|
return to_html(@_); |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
=head2 to_html |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
return the package as an HTML string |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
my $html = $package->to_html ; |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
Note: I have design this method for 2 reasons. First for an easy integration of the search result in a GUI, second for my website search engine. So this HTML may not satisfy you. In this case just generate new HTML from accessors ;-) |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
=cut |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
sub to_html |
625
|
|
|
|
|
|
|
{ |
626
|
2
|
|
|
2
|
1
|
4
|
my $self = shift; |
627
|
2
|
|
|
|
|
8
|
my $html = "\t<h3>$self->{ROOT}</h3>\n<p>"; |
628
|
2
|
50
|
33
|
|
|
10
|
if(defined($self->{STATUS}) && ref($self->{STATUS}) eq 'Slackware::Slackget::Status') |
629
|
|
|
|
|
|
|
{ |
630
|
0
|
|
|
|
|
0
|
$html .= "\t\t".$self->{STATUS}->to_html()."\n"; |
631
|
|
|
|
|
|
|
} |
632
|
2
|
50
|
|
|
|
7
|
if($self->{PACK}->{'package-date'}){ |
633
|
0
|
|
|
|
|
0
|
$html .= "\t\t".$self->{PACK}->{'package-date'}->to_html(); |
634
|
0
|
|
|
|
|
0
|
$self->{TMP}->{'package-date'}=$self->{PACK}->{'package-date'}; |
635
|
0
|
|
|
|
|
0
|
delete($self->{PACK}->{'package-date'}); |
636
|
|
|
|
|
|
|
} |
637
|
2
|
50
|
|
|
|
6
|
if($self->{PACK}->{'date'}){ |
638
|
0
|
|
|
|
|
0
|
$html .= "\t\t".$self->{PACK}->{'date'}->to_html(); |
639
|
0
|
|
|
|
|
0
|
$self->{TMP}->{'date'}=$self->{PACK}->{'date'}; |
640
|
0
|
|
|
|
|
0
|
delete($self->{PACK}->{'date'}); |
641
|
|
|
|
|
|
|
} |
642
|
2
|
|
|
|
|
4
|
foreach (keys(%{$self->{PACK}})){ |
|
2
|
|
|
|
|
7
|
|
643
|
14
|
50
|
|
|
|
20
|
if($_ eq 'package-source') |
644
|
|
|
|
|
|
|
{ |
645
|
0
|
0
|
|
|
|
0
|
$html .= "<strong>$_ :</strong> <b style=\"color:white;background-color:#6495ed\">$self->{PACK}->{$_}</b><br/>\n" if(defined($self->{PACK}->{$_})); |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
else |
648
|
|
|
|
|
|
|
{ |
649
|
14
|
100
|
|
|
|
33
|
$html .= "<strong>$_ :</strong> $self->{PACK}->{$_}<br/>\n" if(defined($self->{PACK}->{$_})); |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
} |
652
|
2
|
|
|
|
|
6
|
$self->{PACK}->{'package-date'}=$self->{TMP}->{'package-date'}; |
653
|
2
|
|
|
|
|
4
|
delete($self->{TMP}); |
654
|
2
|
|
|
|
|
7
|
$html .="\n</p>"; |
655
|
2
|
|
|
|
|
6
|
return $html; |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
=head1 PRINTING METHODS |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
=head2 print_restricted_info |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
Print a part of package information. |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
$package->print_restricted_info(); |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=cut |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
sub print_restricted_info { |
669
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
670
|
0
|
|
|
|
|
0
|
print "Information on package ".$self->get_id." :\n". |
671
|
|
|
|
|
|
|
"\tshort name : ".$self->name()." \n". |
672
|
|
|
|
|
|
|
"\tArchitecture : ".$self->architecture()." \n". |
673
|
|
|
|
|
|
|
"\tDownload size : ".$self->compressed_size()." KB \n". |
674
|
|
|
|
|
|
|
"\tSource : ".$self->getValue('package-source')."\n". |
675
|
|
|
|
|
|
|
"\tPackage version : ".$self->version()." \n"; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=head2 print_full_info |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
Print all informations found in the package. |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
$package->print_full_info(); |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
=cut |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
sub print_full_info { |
687
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
688
|
0
|
|
|
|
|
0
|
print "Information on package ".$self->get_id." :\n"; |
689
|
0
|
|
|
|
|
0
|
foreach (keys(%{$self->{PACK}})) { |
|
0
|
|
|
|
|
0
|
|
690
|
0
|
|
|
|
|
0
|
print "\t$_ : $self->{PACK}->{$_}\n"; |
691
|
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
=head2 fprint_restricted_info |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
Same as print_restricted_info, but output in HTML |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
$package->fprint_restricted_info(); |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=cut |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
sub fprint_restricted_info { |
703
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
704
|
0
|
|
|
|
|
0
|
print "<u><li>Information on package ".$self->get_id." :</li></u><br/>\n". |
705
|
|
|
|
|
|
|
" <strong>short name : </strong> ".$self->name()." <br/>\n". |
706
|
|
|
|
|
|
|
" <strong>Architecture : </strong> ".$self->architecture()." <br/>\n". |
707
|
|
|
|
|
|
|
" <strong>Download size : </strong> ".$self->compressed_size()." KB <br/>\n". |
708
|
|
|
|
|
|
|
" <strong>Source : </strong> ".$self->getValue('package-source')."<br/>\n". |
709
|
|
|
|
|
|
|
" <strong>Package version : </strong> ".$self->version()." <br/>\n"; |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
=head2 fprint_full_info |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
Same as print_full_info, but output in HTML |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
$package->fprint_full_info(); |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=cut |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
sub fprint_full_info { |
721
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
722
|
0
|
|
|
|
|
0
|
print "<u><li>Information on package ".$self->get_id." :</li></u><br/>\n"; |
723
|
0
|
|
|
|
|
0
|
foreach (keys(%{$self->{PACK}})){ |
|
0
|
|
|
|
|
0
|
|
724
|
0
|
|
|
|
|
0
|
print " <strong>$_ : </strong> $self->{PACK}->{$_}<br/>\n"; |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
=head1 ACCESSORS |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
=head2 set_value |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
Set the value of a named key to the value passed in argument. |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
$package->set_value($key,$value); |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
Return $value (for integrity check). |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
=cut |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
sub set_value { |
741
|
24
|
|
|
24
|
1
|
36
|
my ($self,$key,$value) = @_ ; |
742
|
|
|
|
|
|
|
# print "Setting $key=$value for $self\n"; |
743
|
24
|
|
|
|
|
33
|
$self->{PACK}->{$key} = $value ; |
744
|
24
|
|
|
|
|
30
|
return $self->{PACK}->{$key}; |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
=head2 setValue (deprecated) |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
Same as set_value(), provided for backward compatibility. |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
=cut |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
sub setValue { |
754
|
22
|
|
|
22
|
1
|
25
|
return set_value(@_); |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
=head2 getValue (deprecated) |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
Same as get_value(), provided for backward compatibility. |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=cut |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
sub getValue { |
764
|
34
|
|
|
34
|
1
|
41
|
return get_value(@_); |
765
|
|
|
|
|
|
|
} |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=head2 get_value |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
Return the value of a key : |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
$string = $package->get_value($key); |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
=cut |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
sub get_value { |
776
|
36
|
|
|
36
|
1
|
34
|
my ($self,$key) = @_ ; |
777
|
36
|
|
|
|
|
102
|
return $self->{PACK}->{$key}; |
778
|
|
|
|
|
|
|
} |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
=head2 status |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
Return the current status of the package object as a Slackware::Slackget::Status object. This object is set by other class, and in most case you don't have to set it by yourself. |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
print "The current status for ",$package->name," is ",$package->status()->to_string,"\n"; |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
You also can set the status, by passing a Slackware::Slackget::Status object, to this method. |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
$package->status($status_object); |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
This method return 1 if all goes well and undef else. |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
=cut |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
sub status { |
795
|
0
|
|
|
0
|
1
|
0
|
my ($self,$status) = @_ ; |
796
|
0
|
0
|
|
|
|
0
|
if(defined($status)) |
797
|
|
|
|
|
|
|
{ |
798
|
0
|
0
|
|
|
|
0
|
return undef if(ref($status) ne 'Slackware::Slackget::Status'); |
799
|
0
|
|
|
|
|
0
|
$self->{STATUS} = $status ; |
800
|
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
else |
802
|
|
|
|
|
|
|
{ |
803
|
0
|
|
|
|
|
0
|
return $self->{STATUS} ; |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
|
806
|
0
|
|
|
|
|
0
|
return 1; |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
=head2 _setId [PRIVATE] |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
set the package ID (normally the package complete name, like aaa_base-10.0.0-noarch-1). In normal use you don't need to use this method |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
$package->_setId('aaa_base-10.0.0-noarch-1'); |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=cut |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
sub _setId{ |
820
|
0
|
|
|
0
|
|
0
|
my ($self,$id)=@_; |
821
|
0
|
|
|
|
|
0
|
$self->{ROOT} = $id; |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
=head2 get_id |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
return the package id (full name, like aaa_base-10.0.0-noarch-1). |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
$string = $package->get_id(); |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
=cut |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
sub get_id { |
833
|
2
|
|
|
2
|
1
|
4
|
my $self= shift; |
834
|
2
|
|
|
|
|
7
|
return $self->{ROOT}; |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=head2 description |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
return the description of the package. |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
$string = $package->description(); |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=cut |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
sub description{ |
846
|
4
|
|
|
4
|
1
|
5
|
my $self = shift; |
847
|
4
|
|
|
|
|
20
|
return $self->{PACK}->{description}; |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
=head2 filelist |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
return the list of files in the package. WARNING: by default this list is not included ! |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
$string = $package->filelist(); |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
=cut |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
sub filelist{ |
859
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
860
|
0
|
|
|
|
|
0
|
return $self->{PACK}->{'file-list'}; |
861
|
|
|
|
|
|
|
} |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
=head2 name |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
return the name of the package. |
866
|
|
|
|
|
|
|
Ex: for the package aaa_base-10.0.0-noarch-1 name() will return aaa_base |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
my $string = $package->name(); |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
=cut |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
sub name{ |
873
|
2
|
|
|
2
|
1
|
4
|
my $self = shift; |
874
|
2
|
|
|
|
|
7
|
return $self->{PACK}->{name}; |
875
|
|
|
|
|
|
|
} |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
=head2 compressed_size |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
return the compressed size of the package |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
$number = $package->compressed_size(); |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=cut |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
sub compressed_size{ |
886
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
887
|
0
|
|
|
|
|
0
|
return $self->{PACK}->{'compressed-size'}; |
888
|
|
|
|
|
|
|
} |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
=head2 uncompressed_size |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
return the uncompressed size of the package |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
$number = $package->uncompressed_size(); |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=cut |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
sub uncompressed_size{ |
899
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
900
|
0
|
|
|
|
|
0
|
return $self->{PACK}->{'uncompressed-size'}; |
901
|
|
|
|
|
|
|
} |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
=head2 location |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
return the location of the installed package. |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
$string = $package->location(); |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=cut |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
sub location{ |
912
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
913
|
0
|
0
|
0
|
|
|
0
|
if(exists($self->{PACK}->{'package-location'}) && defined($self->{PACK}->{'package-location'})) |
914
|
|
|
|
|
|
|
{ |
915
|
0
|
|
|
|
|
0
|
return $self->{PACK}->{'package-location'}; |
916
|
|
|
|
|
|
|
} |
917
|
|
|
|
|
|
|
else |
918
|
|
|
|
|
|
|
{ |
919
|
0
|
|
|
|
|
0
|
return $self->{PACK}->{location}; |
920
|
|
|
|
|
|
|
} |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
} |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=head2 conflicts |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
return the list of conflicting pakage. |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
$string = $package->conflict(); |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=cut |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
sub conflicts{ |
933
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
934
|
0
|
|
|
|
|
0
|
return $self->{PACK}->{conflicts}; |
935
|
|
|
|
|
|
|
} |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
=head2 suggested |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
return the suggested package related to the current package. |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
$string = $package->suggested(); |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
=cut |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
sub suggested{ |
946
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
947
|
0
|
|
|
|
|
0
|
return $self->{PACK}->{suggested}; |
948
|
|
|
|
|
|
|
} |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
=head2 required |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
return the required packages for installing the current package |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
$string = $package->required(); |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
=cut |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
sub required{ |
959
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
960
|
0
|
|
|
|
|
0
|
return $self->{PACK}->{required}; |
961
|
|
|
|
|
|
|
} |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
=head2 architecture |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
return the architecture the package is compiled for. |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
$string = $package->architecture(); |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
=cut |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
sub architecture { |
972
|
2
|
|
|
2
|
1
|
5
|
my $self = shift; |
973
|
2
|
|
|
|
|
9
|
return $self->{PACK}->{architecture}; |
974
|
|
|
|
|
|
|
} |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=head2 version |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
return the package version. |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
$string = $package->version(); |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=cut |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
sub version { |
985
|
100
|
|
|
100
|
1
|
62
|
my $self = shift; |
986
|
100
|
|
|
|
|
207
|
return $self->{PACK}->{version}; |
987
|
|
|
|
|
|
|
} |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
=head2 get_fields_list |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
return a list of all fields of the package. This method is suitable for example in GUI for displaying informations on packages. |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
foreach my $field ( $package->get_fields_list ) |
994
|
|
|
|
|
|
|
{ |
995
|
|
|
|
|
|
|
qt_textbrowser->append( "<b>$field</b> : ".$package->getValue( $field )."<br/>\n" ) ; |
996
|
|
|
|
|
|
|
} |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
=cut |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
sub get_fields_list |
1001
|
|
|
|
|
|
|
{ |
1002
|
2
|
|
|
2
|
1
|
3
|
my $self = shift ; |
1003
|
2
|
|
|
|
|
3
|
return keys(%{$self->{PACK}}) ; |
|
2
|
|
|
|
|
14
|
|
1004
|
|
|
|
|
|
|
} |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
# |
1007
|
|
|
|
|
|
|
# =head2 |
1008
|
|
|
|
|
|
|
# |
1009
|
|
|
|
|
|
|
# return the |
1010
|
|
|
|
|
|
|
# |
1011
|
|
|
|
|
|
|
# =cut |
1012
|
|
|
|
|
|
|
# |
1013
|
|
|
|
|
|
|
# sub { |
1014
|
|
|
|
|
|
|
# my $self = shift; |
1015
|
|
|
|
|
|
|
# return $self->{PACK}->{}; |
1016
|
|
|
|
|
|
|
# } |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
=head1 AUTHOR |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
DUPUIS Arnaud, C<< <a.dupuis@infinityperl.org> >> |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
=head1 BUGS |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
1025
|
|
|
|
|
|
|
C<bug-Slackware-Slackget@rt.cpan.org>, or through the web interface at |
1026
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Slackware-Slackget>. |
1027
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
1028
|
|
|
|
|
|
|
your bug as I make changes. |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
=head1 SUPPORT |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
perldoc Slackware::Slackget::Package |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
You can also look for information at: |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
=over 4 |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
=item * Infinity Perl website |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
L<http://www.infinityperl.org/category/slack-get> |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=item * slack-get specific website |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
L<http://slackget.infinityperl.org> |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Slackware-Slackget> |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Slackware-Slackget> |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
=item * CPAN Ratings |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Slackware-Slackget> |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
=item * Search CPAN |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/Slackware-Slackget> |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
=back |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
Thanks to Bertrand Dupuis (yes my brother) for his contribution to the documentation. |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
=head1 SEE ALSO |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
Copyright 2005 DUPUIS Arnaud, All Rights Reserved. |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
1078
|
|
|
|
|
|
|
under the same terms as Perl itself. |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
=cut |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
1; # End of Slackware::Slackget::Package |