line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Slackware::Slackget::PkgTools; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
6
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
52
|
|
4
|
2
|
|
|
2
|
|
6
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
46
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
require Slackware::Slackget::Status ; |
7
|
2
|
|
|
2
|
|
808
|
use File::Copy ; |
|
2
|
|
|
|
|
3394
|
|
|
2
|
|
|
|
|
114
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use constant { |
10
|
2
|
|
|
|
|
2072
|
PKG_INSTALL_OK => 0x43001, |
11
|
|
|
|
|
|
|
PKG_UPGRADE_OK => 0x43003, |
12
|
|
|
|
|
|
|
PKG_REMOVE_OK => 0x43005, |
13
|
|
|
|
|
|
|
PKG_INSTALL_FAIL => 0x43002, |
14
|
|
|
|
|
|
|
PKG_UPGRADE_FAIL => 0x43004, |
15
|
|
|
|
|
|
|
PKG_REMOVE_FAIL => 0x43006, |
16
|
|
|
|
|
|
|
PKG_NOT_FOUND_INSTALL_FAIL => 0x43007, |
17
|
|
|
|
|
|
|
PKG_NOT_FOUND_UPGRADE_FAIL => 0x43008, |
18
|
|
|
|
|
|
|
PKG_NOT_FOUND_REMOVE_FAIL => 0x43009, |
19
|
|
|
|
|
|
|
PKG_UNKNOWN_FAIL => 0x43010, |
20
|
2
|
|
|
2
|
|
10
|
}; |
|
2
|
|
|
|
|
2
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 NAME |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Slackware::Slackget::PkgTools - A wrapper for the pkgtools action(installpkg, upgradepkg and removepkg) |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 VERSION |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Version 1.0.1 |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=cut |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our $VERSION = '1.0.1'; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 SYNOPSIS |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
This class is anoter wrapper for slack-get. It encapsulates the pkgtools system call. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
use Slackware::Slackget::PkgTools; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my $pkgtool = Slackware::Slackget::PkgTools->new($config); |
41
|
|
|
|
|
|
|
$pkgtool->install($package1); |
42
|
|
|
|
|
|
|
$pkgtool->remove($package_list); |
43
|
|
|
|
|
|
|
foreach (@{$packagelist->get_all}) |
44
|
|
|
|
|
|
|
{ |
45
|
|
|
|
|
|
|
print "Status for ",$_->name," : ",$_->status()->to_string,"\n"; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
$pkgtool->upgrade($package_list); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=cut |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub new |
52
|
|
|
|
|
|
|
{ |
53
|
0
|
|
|
0
|
1
|
|
my ($class,$config,%args) = @_ ; |
54
|
0
|
0
|
0
|
|
|
|
return undef if(!defined($config) && ref($config) ne 'Slackware::Slackget::Config') ; |
55
|
0
|
|
|
|
|
|
my $self={}; |
56
|
0
|
|
|
|
|
|
$self->{CONF} = $config ; |
57
|
|
|
|
|
|
|
$self->{SUCCESS_STATUS} = { |
58
|
0
|
|
|
|
|
|
PKG_INSTALL_OK => "Package have been installed successfully.\n", |
59
|
|
|
|
|
|
|
PKG_UPGRADE_OK => "Package have been upgraded successfully.\n", |
60
|
|
|
|
|
|
|
PKG_REMOVE_OK => "Package have been removed successfully.\n", |
61
|
|
|
|
|
|
|
}; |
62
|
|
|
|
|
|
|
$self->{ERROR_STATUS}={ |
63
|
0
|
|
|
|
|
|
PKG_NOT_FOUND_INSTALL_FAIL => "Can't install package : new package not found in the cache.\n", |
64
|
|
|
|
|
|
|
PKG_NOT_FOUND_REMOVE_FAIL => "Can't remove package : no such package installed.\n", |
65
|
|
|
|
|
|
|
PKG_NOT_FOUND_UPGRADE_FAIL => "Can't upgrade package : new package not found in the cache.\n", |
66
|
|
|
|
|
|
|
PKG_INSTALL_FAIL => "Can't install package : an error occured during $self->{CONF}->{common}->{pkgtools}->{'installpkg-binary'} system call\n", |
67
|
|
|
|
|
|
|
PKG_REMOVE_FAIL => "Can't remove package : an error occured during $self->{CONF}->{common}->{pkgtools}->{'removepkg-binary'} system call\n", |
68
|
|
|
|
|
|
|
PKG_UPGRADE_FAIL => "Can't upgrade package : an error occured during $self->{CONF}->{common}->{pkgtools}->{'upgradepkg-binary'} system call\n", |
69
|
|
|
|
|
|
|
PKG_UNKNOWN_FAIL => "An error occured in the Slackware::Slackget::PkgTool class (during installpkg, upgradepkg or removepkg) but the class is unable to understand the error.\n", |
70
|
|
|
|
|
|
|
}; |
71
|
|
|
|
|
|
|
$self->{DATA} = { |
72
|
0
|
|
|
|
|
|
'info-output' => undef, |
73
|
|
|
|
|
|
|
'connection-id' => 0, |
74
|
|
|
|
|
|
|
'fake_mode' => 0, |
75
|
|
|
|
|
|
|
}; |
76
|
0
|
0
|
|
|
|
|
$self->{DATA}->{'fake_mode'} = $args{'fake_mode'} if(defined($args{'fake_mode'})); |
77
|
0
|
|
|
|
|
|
bless($self,$class); |
78
|
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
|
return $self; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 new |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Take a Slackware::Slackget::Config object as argument : |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
my $pkgtool = new Slackware::Slackget::PkgTool ($config); |
89
|
|
|
|
|
|
|
=cut |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub _send_info |
92
|
|
|
|
|
|
|
{ |
93
|
0
|
|
|
0
|
|
|
my ($self,$action,$pkg) = @_; |
94
|
0
|
|
|
|
|
|
my $client=0; |
95
|
0
|
0
|
0
|
|
|
|
return 0 unless(defined($self->{DATA}->{'info-output'}) && $self->{DATA}->{'info-output'}); |
96
|
0
|
0
|
0
|
|
|
|
$client = $self->{DATA}->{'info-output'} if(defined($self->{DATA}->{'info-output'}) && $self->{DATA}->{'info-output'}); |
97
|
|
|
|
|
|
|
#print for debug purpose |
98
|
0
|
|
|
|
|
|
print "[Slackware::Slackget::PkgTools::DEBUG] info:$self->{DATA}->{'connection-id'}:2:progress:file=$pkg;state=now$action\n"; |
99
|
|
|
|
|
|
|
|
100
|
0
|
0
|
0
|
|
|
|
print $client->put("info:$self->{DATA}->{'connection-id'}:2:progress:file=$pkg;state=now$action\n") if($client && defined($self->{DATA}->{'connection-id'}) && $self->{DATA}->{'connection-id'}); |
|
|
|
0
|
|
|
|
|
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head1 FUNCTIONS |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Slackware::Slackget::PkgTools methods used the followings status : |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
0 : Package have been installed successfully. |
108
|
|
|
|
|
|
|
1 : Package have been upgraded successfully. |
109
|
|
|
|
|
|
|
2 : Package have been removed successfully. |
110
|
|
|
|
|
|
|
3 : Can't install package : new package not found in the cache. |
111
|
|
|
|
|
|
|
4 : Can't remove package : no such package installed. |
112
|
|
|
|
|
|
|
5 : Can't upgrade package : new package not found in the cache. |
113
|
|
|
|
|
|
|
6 : Can't install package : an error occured during <installpkg-binary /> system call |
114
|
|
|
|
|
|
|
7 : Can't remove package : an error occured during <removepkg-binary /> system call |
115
|
|
|
|
|
|
|
8 : Can't upgrade package : an error occured during <upgradepkg-binary /> system call |
116
|
|
|
|
|
|
|
9 : Package scheduled for install on next reboot. |
117
|
|
|
|
|
|
|
10 : An error occured in the Slackware::Slackget::PkgTool class (during installpkg, upgradepkg or removepkg) but the class is unable to understand the error. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=head2 install |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
Take a single Slackware::Slackget::Package object or a single Slackware::Slackget::PackageList as argument and call installpkg on all this packages. |
122
|
|
|
|
|
|
|
Return 1 or undef if an error occured. But methods from the Slackware::Slackget::PkgTools class don't return on the first error, it will try to install all packages. Additionnally, for each package, set a status. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
$pkgtool->install($package_list); |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=cut |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub install { |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub _install_package |
131
|
|
|
|
|
|
|
{ |
132
|
0
|
|
|
0
|
|
|
my ($self,$pkg) = @_; |
133
|
0
|
|
|
|
|
|
my $status = new Slackware::Slackget::Status (success_codes => $self->{SUCCESS_STATUS}, error_codes => $self->{ERROR_STATUS}); |
134
|
|
|
|
|
|
|
#$self->{CONF}->{common}->{'update-directory'}/".$server->shortname."/cache/ |
135
|
|
|
|
|
|
|
# print "[Slackware::Slackget::PkgTools::_install_package DEBUG] try to install package ",$pkg->get_id,"\n"; |
136
|
0
|
0
|
|
|
|
|
if($pkg->getValue('install_later')) |
|
|
0
|
|
|
|
|
|
137
|
|
|
|
|
|
|
{ |
138
|
|
|
|
|
|
|
# print "[Slackware::Slackget::PkgTools::_install_package DEBUG] package ",$pkg->get_id," will be installed later.\n"; |
139
|
0
|
0
|
|
|
|
|
mkdir "/tmp/slack_get_boot_install" unless( -e "/tmp/slack_get_boot_install") ; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
elsif( -e "$self->{CONF}->{common}->{'update-directory'}/package-cache/".$pkg->get_id.".tgz") |
142
|
|
|
|
|
|
|
{ |
143
|
0
|
|
|
|
|
|
$self->_send_info('install',$pkg->get_id()); |
144
|
|
|
|
|
|
|
# print "[Slackware::Slackget::PkgTools::_install_package DEBUG] log file : $self->{CONF}->{common}->{'log'}->{'log-file'}\n"; |
145
|
0
|
0
|
|
|
|
|
if(system("2>>$self->{CONF}->{common}->{'log'}->{'log-file'} $self->{CONF}->{common}->{pkgtools}->{'installpkg-binary'} $self->{CONF}->{common}->{'update-directory'}/package-cache/".$pkg->get_id.".tgz")==0) |
146
|
|
|
|
|
|
|
{ |
147
|
|
|
|
|
|
|
# print "[Slackware::Slackget::PkgTools::_install_package DEBUG] package ",$pkg->get_id," have been correctly installed\n"; |
148
|
0
|
|
|
|
|
|
$status->current(PKG_INSTALL_OK); |
149
|
0
|
|
|
|
|
|
return $status ; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
else |
152
|
|
|
|
|
|
|
{ |
153
|
|
|
|
|
|
|
# print "[Slackware::Slackget::PkgTools::_install_package DEBUG] package ",$pkg->get_id," have NOT been correctly installed\n"; |
154
|
0
|
|
|
|
|
|
$status->current(PKG_INSTALL_FAIL); |
155
|
0
|
|
|
|
|
|
return $status ; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
else |
160
|
|
|
|
|
|
|
{ |
161
|
|
|
|
|
|
|
# print "[Slackware::Slackget::PkgTools::_install_package DEBUG] package ",$pkg->get_id," can't be installed.\n"; |
162
|
0
|
|
|
|
|
|
$status->current(PKG_NOT_FOUND_INSTALL_FAIL); |
163
|
0
|
|
|
|
|
|
return $status ; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
} |
166
|
0
|
|
|
0
|
1
|
|
my ($self,$object) = @_; |
167
|
0
|
0
|
|
|
|
|
if(ref($object) eq 'Slackware::Slackget::PackageList') |
|
|
0
|
|
|
|
|
|
168
|
|
|
|
|
|
|
{ |
169
|
|
|
|
|
|
|
# print "[install] Do the job for a Slackware::Slackget::PackageList\n"; |
170
|
0
|
|
|
|
|
|
foreach my $pack ( @{ $object->get_all() }) |
|
0
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
{ |
172
|
|
|
|
|
|
|
# print "[install] sending ",$pack->get_id," to _install_package.\n"; |
173
|
0
|
|
|
|
|
|
$pack->status($self->_install_package($pack)); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
# print "[install] end of the install loop.\n"; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
elsif(ref($object) eq 'Slackware::Slackget::Package') |
178
|
|
|
|
|
|
|
{ |
179
|
|
|
|
|
|
|
# print "[install] Do the job for a Slackware::Slackget::Package '$object'\n"; |
180
|
0
|
|
|
|
|
|
$object->status($self->_install_package($object)); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
else |
183
|
|
|
|
|
|
|
{ |
184
|
0
|
|
|
|
|
|
return undef; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
# print "[Slackware::Slackget::PkgTools DEBUG] all job processed.\n"; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=head2 upgrade |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Take a single Slackware::Slackget::Package object or a single Slackware::Slackget::PackageList as argument and call upgradepkg on all this packages. |
192
|
|
|
|
|
|
|
Return 1 or undef if an error occured. But methods from the Slackware::Slackget::PkgTools class don't return on the first error, it will try to install all packages. Additionnally, for each package, set a status. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
$pkgtool->install($package_list) ; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=cut |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub upgrade { |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub _upgrade_package |
201
|
|
|
|
|
|
|
{ |
202
|
0
|
|
|
0
|
|
|
my ($self,$pkg) = @_; |
203
|
0
|
|
|
|
|
|
my $status = new Slackware::Slackget::Status (success_codes => $self->{SUCCESS_STATUS}, error_codes => $self->{ERROR_STATUS}); |
204
|
|
|
|
|
|
|
#$self->{CONF}->{common}->{'update-directory'}/".$server->shortname."/cache/ |
205
|
0
|
0
|
|
|
|
|
if( -e "$self->{CONF}->{common}->{'update-directory'}/package-cache/".$pkg->get_id.".tgz") |
206
|
|
|
|
|
|
|
{ |
207
|
0
|
|
|
|
|
|
$self->_send_info('upgrade',$pkg->get_id()); |
208
|
|
|
|
|
|
|
# print "\tTrying to upgrade package: $self->{CONF}->{common}->{'update-directory'}/package-cache/".$pkg->get_id.".tgz\n"; |
209
|
0
|
0
|
|
|
|
|
if(system("2>>$self->{CONF}->{common}->{'log'}->{'log-file'} $self->{CONF}->{common}->{pkgtools}->{'upgradepkg-binary'} $self->{CONF}->{common}->{'update-directory'}/package-cache/".$pkg->get_id.".tgz")==0) |
210
|
|
|
|
|
|
|
{ |
211
|
0
|
|
|
|
|
|
$status->current(PKG_UPGRADE_OK); |
212
|
0
|
|
|
|
|
|
return $status ; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
else |
215
|
|
|
|
|
|
|
{ |
216
|
0
|
|
|
|
|
|
$status->current(PKG_UPGRADE_FAIL); |
217
|
0
|
|
|
|
|
|
return $status ; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
else |
221
|
|
|
|
|
|
|
{ |
222
|
0
|
|
|
|
|
|
$status->current(PKG_NOT_FOUND_UPGRADE_FAIL); |
223
|
0
|
|
|
|
|
|
return $status ; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
} |
226
|
0
|
|
|
0
|
1
|
|
my ($self,$object) = @_; |
227
|
0
|
0
|
|
|
|
|
if(ref($object) eq 'Slackware::Slackget::PackageList') |
|
|
0
|
|
|
|
|
|
228
|
|
|
|
|
|
|
{ |
229
|
|
|
|
|
|
|
# print "Do the job for a Slackware::Slackget::PackageList\n"; |
230
|
0
|
|
|
|
|
|
foreach my $pack ( @{ $object->get_all() }) |
|
0
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
{ |
232
|
0
|
|
|
|
|
|
$pack->status($self->_upgrade_package($pack)); |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
elsif(ref($object) eq 'Slackware::Slackget::Package') |
236
|
|
|
|
|
|
|
{ |
237
|
|
|
|
|
|
|
# print "Do the job for a Slackware::Slackget::Package\n"; |
238
|
0
|
|
|
|
|
|
$object->status($self->_upgrade_package($object)); |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
else |
241
|
|
|
|
|
|
|
{ |
242
|
0
|
|
|
|
|
|
return undef; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=head2 remove |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
Take a single Slackware::Slackget::Package object or a single Slackware::Slackget::PackageList as argument and call installpkg on all this packages. |
249
|
|
|
|
|
|
|
Return 1 or undef if an error occured. But methods from the Slackware::Slackget::PkgTools class don't return on the first error, it will try to install all packages. Additionnally, for each package, set a status. |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
$pkgtool->remove($package_list); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=cut |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub remove { |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
sub _remove_package |
258
|
|
|
|
|
|
|
{ |
259
|
0
|
|
|
0
|
|
|
my ($self,$pkg) = @_; |
260
|
0
|
|
|
|
|
|
my $status = new Slackware::Slackget::Status (success_codes => $self->{SUCCESS_STATUS}, error_codes => $self->{ERROR_STATUS}); |
261
|
|
|
|
|
|
|
#$self->{CONF}->{common}->{'update-directory'}/".$server->shortname."/cache/ |
262
|
0
|
0
|
|
|
|
|
if( -e "$self->{CONF}->{common}->{'packages-history-dir'}/".$pkg->get_id) |
263
|
|
|
|
|
|
|
{ |
264
|
0
|
|
|
|
|
|
$self->_send_info('remove',$pkg->get_id()); |
265
|
|
|
|
|
|
|
# print "\tTrying to remove package: ".$pkg->get_id."\n"; |
266
|
|
|
|
|
|
|
# TODO: the error output is not logged anymore in the PkgTools calls. It must be fixed. |
267
|
0
|
0
|
|
|
|
|
if(system("$self->{CONF}->{common}->{pkgtools}->{'removepkg-binary'} ".$pkg->get_id)==0) |
268
|
|
|
|
|
|
|
{ |
269
|
0
|
|
|
|
|
|
print "[Slackware::Slackget::PkgTools] (removepkg) setting (success) status ",PKG_REMOVE_OK,"\n"; |
270
|
0
|
|
|
|
|
|
$status->current(PKG_REMOVE_OK); |
271
|
0
|
|
|
|
|
|
return $status ; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
else |
274
|
|
|
|
|
|
|
{ |
275
|
0
|
|
|
|
|
|
print "[Slackware::Slackget::PkgTools] (removepkg) setting (failed) status ",PKG_REMOVE_FAIL,"\n"; |
276
|
0
|
|
|
|
|
|
$status->current(PKG_REMOVE_FAIL); |
277
|
0
|
|
|
|
|
|
return $status ; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
else |
281
|
|
|
|
|
|
|
{ |
282
|
0
|
|
|
|
|
|
print "[Slackware::Slackget::PkgTools] (removepkg) setting (fail) status ",PKG_NOT_FOUND_REMOVE_FAIL,"\n"; |
283
|
0
|
|
|
|
|
|
$status->current(PKG_NOT_FOUND_REMOVE_FAIL); |
284
|
0
|
|
|
|
|
|
return $status ; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
} |
287
|
0
|
|
|
0
|
1
|
|
my ($self,$object) = @_; |
288
|
0
|
0
|
|
|
|
|
if(ref($object) eq 'Slackware::Slackget::PackageList') |
|
|
0
|
|
|
|
|
|
289
|
|
|
|
|
|
|
{ |
290
|
|
|
|
|
|
|
# print "Do the job for a Slackware::Slackget::PackageList\n"; |
291
|
0
|
|
|
|
|
|
foreach my $pack ( @{ $object->get_all() }) |
|
0
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
{ |
293
|
0
|
|
|
|
|
|
$pack->status($self->_remove_package($pack)); |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
elsif(ref($object) eq 'Slackware::Slackget::Package') |
297
|
|
|
|
|
|
|
{ |
298
|
|
|
|
|
|
|
# print "Do the job for a Slackware::Slackget::Package\n"; |
299
|
0
|
|
|
|
|
|
$object->status($self->_remove_package($object)); |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
else |
302
|
|
|
|
|
|
|
{ |
303
|
0
|
|
|
|
|
|
return undef; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=head1 AUTHOR |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
DUPUIS Arnaud, C<< <a.dupuis@infinityperl.org> >> |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=head1 BUGS |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
314
|
|
|
|
|
|
|
C<bug-Slackware-Slackget@rt.cpan.org>, or through the web interface at |
315
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Slackware-Slackget>. |
316
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
317
|
|
|
|
|
|
|
your bug as I make changes. |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=head1 SUPPORT |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
perldoc Slackware::Slackget |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
You can also look for information at: |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=over 4 |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=item * Infinity Perl website |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
L<http://www.infinityperl.org/category/slack-get> |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=item * slack-get specific website |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
L<http://slackget.infinityperl.org> |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Slackware-Slackget> |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Slackware-Slackget> |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
=item * CPAN Ratings |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Slackware-Slackget> |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=item * Search CPAN |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/Slackware-Slackget> |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=back |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
Thanks to Bertrand Dupuis (yes my brother) for his contribution to the documentation. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=head1 SEE ALSO |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
Copyright 2005 DUPUIS Arnaud, All Rights Reserved. |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
367
|
|
|
|
|
|
|
under the same terms as Perl itself. |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
=cut |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
1; # End of Slackware::Slackget::PkgTools |