line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Slackware::Slackget::SpecialFiles::CHECKSUMS; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
24
|
|
4
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
5
|
use Slackware::Slackget::File; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
17
|
|
7
|
1
|
|
|
1
|
|
5
|
use Slackware::Slackget::Package; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
699
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 NAME |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Slackware::Slackget::SpecialFiles::CHECKSUMS - An interface for the special file CHECKSUMS.md5 |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 VERSION |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
Version 1.0.0 |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=cut |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
our $VERSION = '1.0.0'; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 SYNOPSIS |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
This class contain all methods for the treatment of the CHECKSMUMS.md5 file |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
use Slackware::Slackget::SpecialFiles::CHECKSUMS; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $spec_chk = Slackware::Slackget::SpecialFiles::CHECKSUMS->new('CHECKSUMS.md5','slackware'); |
28
|
|
|
|
|
|
|
$spec_chk->compile(); |
29
|
|
|
|
|
|
|
my $ref = $spec_chk->get_checksums('glibc-profile-2.3.4-i486-1'); |
30
|
|
|
|
|
|
|
print "Checksum for glibc-profile-2.3.4-i486-1.tgz : $ref->{checksum}\n"; |
31
|
|
|
|
|
|
|
print "Checksum for glibc-profile-2.3.4-i486-1.tgz.asc : $ref->{'signature-checksum'}\n"; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 WARNINGS |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
All classes from the Slackware::Slackget::SpecialFiles:: namespace need the followings methods : |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
- a contructor new() |
38
|
|
|
|
|
|
|
- a method compil() |
39
|
|
|
|
|
|
|
- a method get_result(), which one can be an alias on another method of the class. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
Moreover, the get_result() methode need to return a hashref. Keys of this hashref are the filenames. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
Classes from ths namespace represent an abstraction of the special file they can manage so informations stored in the returned hashref must have a direct link with this special file. |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head2 new |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
The constructor take three argument : the file CHECKSUMS.md5 with his all path, a Slackware::Slackget::Config object and an id name. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
my $spec_chk = Slackware::Slackget::SpecialFiles::CHECKSUMS->new('/home/packages/CHECKSUMS.md5',$config,'slackware'); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
The constructor return undef if the file does not exist. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=cut |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub new |
58
|
|
|
|
|
|
|
{ |
59
|
0
|
|
|
0
|
1
|
|
my ($class,$file,$config,$root) = @_ ; |
60
|
0
|
0
|
0
|
|
|
|
return undef if(!defined($config) && ref($config) ne 'Slackware::Slackget::Config') ; |
61
|
0
|
|
|
|
|
|
my $self={}; |
62
|
0
|
|
|
|
|
|
$self->{ROOT} = $root; |
63
|
0
|
|
|
|
|
|
$self->{config}=$config; |
64
|
0
|
0
|
0
|
|
|
|
return undef unless(defined($file) && -e $file); |
65
|
|
|
|
|
|
|
# print "[debug CHECKSUMS] Loading $file as CHECKSUMS\n"; |
66
|
0
|
|
|
|
|
|
$self->{FILE} = new Slackware::Slackget::File ($file,'file-encoding' => $config->{common}->{'file-encoding'}); |
67
|
0
|
|
|
|
|
|
$self->{DATA} = {}; |
68
|
0
|
|
|
|
|
|
bless($self,$class); |
69
|
0
|
|
|
|
|
|
return $self; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head1 FUNCTIONS |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head2 compile |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
This method take no arguments, and extract the list of couple (file/checksum). Those couple are store into an internal data structure. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
$spec_chk->compile(); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=cut |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub compile { |
83
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
84
|
0
|
|
|
|
|
|
foreach ($self->{FILE}->Get_file()){ |
85
|
0
|
0
|
|
|
|
|
if($_=~/^([0-9a-f]*)\s+\.\/(.*)\/([^\/\s\n]*)\.tgz\.asc$/i){ |
|
|
0
|
|
|
|
|
|
86
|
0
|
0
|
|
|
|
|
next if ($2=~ /source\//); |
87
|
0
|
0
|
|
|
|
|
unless(defined($self->{DATA}->{$3})){ |
88
|
0
|
|
|
|
|
|
$self->{DATA}->{$3} = new Slackware::Slackget::Package ($3) ; |
89
|
0
|
0
|
|
|
|
|
$self->{DATA}->{$3}->setValue('package-source',$self->{ROOT}) if($self->{ROOT}); |
90
|
0
|
|
|
|
|
|
$self->{DATA}->{$3}->setValue('package-location',$2); |
91
|
|
|
|
|
|
|
} |
92
|
0
|
|
|
|
|
|
$self->{DATA}->{$3}->setValue('signature-checksum',$1); |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
elsif($_=~/^([0-9a-f]*)\s+\.\/(.*)\/([^\/\s\n]*)\.tgz$/i){ |
95
|
0
|
0
|
|
|
|
|
next if ($2=~ /source\//); |
96
|
0
|
0
|
|
|
|
|
unless(defined($self->{DATA}->{$3})){ |
97
|
0
|
|
|
|
|
|
$self->{DATA}->{$3} = new Slackware::Slackget::Package ($3) ; |
98
|
0
|
0
|
|
|
|
|
$self->{DATA}->{$3}->setValue('package-source',$self->{ROOT}) if($self->{ROOT}); |
99
|
0
|
|
|
|
|
|
$self->{DATA}->{$3}->setValue('package-location',$2); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
# $self->{DATA}->{$3}->{checksum} = $1; |
102
|
0
|
|
|
|
|
|
$self->{DATA}->{$3}->setValue('checksum',$1); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
} |
105
|
0
|
|
|
|
|
|
$self->{FILE}->Close(); |
106
|
|
|
|
|
|
|
### DEBUG ONLY |
107
|
|
|
|
|
|
|
# $self->{FILE}->Write("debug/checksums_$self->{ROOT}.xml",$self->to_XML); |
108
|
|
|
|
|
|
|
# $self->{FILE}->Close ; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head2 get_checksums |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
This method return a Slackware::Slackget::Package object containing 2 keys : checksum and signature-checksum, wich are respectively the file checksum and the GnuPG signature (.asc) checksum. The object can contain more inforations (like the package-source and package-location). This method is the same that get_package(). |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
my $ref = $spec_chk->get_checksums($package_name) ; |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
This method return undef if $package_name doesn't exist in the data structure. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=cut |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub get_checksums { |
122
|
0
|
|
|
0
|
1
|
|
my ($self,$package) = @_; |
123
|
0
|
|
|
|
|
|
return $self->{DATA}->{$package}; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head2 get_package |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Return informations relative to a packages as a Slackware::Slackget::Package object. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
my $package_object = $spec_chk->get_package($package_name) ; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=cut |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub get_package { |
135
|
0
|
|
|
0
|
1
|
|
my ($self,$pack_name) = @_ ; |
136
|
0
|
|
|
|
|
|
return $self->{DATA}->{$pack_name} ; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head2 get_result |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
Alias for get_checksums() |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=cut |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub get_result { |
146
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
147
|
0
|
|
|
|
|
|
return $self->get_checksums(@_); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=head2 to_XML (deprecated) |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
Same as to_xml(), provided for backward compatibility. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=cut |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub to_XML { |
157
|
0
|
|
|
0
|
1
|
|
return to_xml(@_); |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head2 to_xml |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Translate the internale data structure into a single XML string. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
WARNING: this method is for debug ONLY, YOU NEVER HAVE TO CALL IT IN NORMAL USE. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=cut |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub to_xml { |
169
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
170
|
0
|
|
|
|
|
|
my $xml = "\n"; |
171
|
0
|
|
|
|
|
|
foreach (keys(%{$self->{DATA}})){ |
|
0
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
$xml.=$self->{DATA}->{$_}->to_xml ; |
173
|
|
|
|
|
|
|
} |
174
|
0
|
|
|
|
|
|
$xml .= "\n"; |
175
|
0
|
|
|
|
|
|
return $xml; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 AUTHOR |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
DUPUIS Arnaud, C<< >> |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head1 BUGS |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
185
|
|
|
|
|
|
|
C, or through the web interface at |
186
|
|
|
|
|
|
|
L. |
187
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
188
|
|
|
|
|
|
|
your bug as I make changes. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=head1 SUPPORT |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
perldoc Slackware::Slackget |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
You can also look for information at: |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=over 4 |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=item * Infinity Perl website |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
L |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=item * slack-get specific website |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
L |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
L |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
L |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=item * CPAN Ratings |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
L |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=item * Search CPAN |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
L |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=back |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
Thanks to Bertrand Dupuis (yes my brother) for his contribution to the documentation. |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
Copyright 2005 DUPUIS Arnaud, All Rights Reserved. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
237
|
|
|
|
|
|
|
under the same terms as Perl itself. |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=cut |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
1; # End of Slackware::Slackget::SpecialFiles::CHECKSUMS |