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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
package Module::CPANTS::Kwalitee::Distros;
use warnings;
use strict;
#use File::Spec::Functions qw(catfile);
#use List::MoreUtils qw(all any);
use LWP::Simple qw(mirror);
use Data::Dumper qw(Dumper);
use Text::CSV_XS 0.45;
sub order { 800 }
##################################################################
# Analyse
##################################################################
my $debian;
sub analyse {
my $class=shift;
my $me=shift;
return if $ENV{CPANTS_LINT};
if (not $debian) {
$debian = _get_debian_data();
}
return;
}
sub _get_debian_data {
my $local_file = 'Debian_CPANTS.txt';
mirror('http://pkg-perl.alioth.debian.org/CPANTS.txt', $local_file);
my %debian;
return {} if not open my $fh ,'<', $local_file;
# TODO other error reporting in this case?
my $csv = Text::CSV_XS->new({ allow_whitespace => 1 });
# header looks like the following though we don't rely on this order
# TODO: maybe we should check if the file really contains the expected columns and if
# all the rows are well formatted so we have some alert if the Debian people
# break this format.
# We should also alert if the file is not new enough...
# debian_pkg, CPAN_dist, CPAN_vers, N_bugs, N_patches
my $header = <$fh>;
$header=~s/\s+$//s;
#chomp $header;
$csv->parse($header) or die "Could not parse header:\n$header\n";
my @header = $csv->fields;
#die Dumper \@header;
while (my $row = <$fh>) {
$row=~s/\s+$//s;
#chomp $row;
if ($csv->parse($row)) {
my @values = $csv->fields;
my %h;
#die Dumper \@values;
@h{@header} = @values;
#(my $dist = $h{CPAN_dist}) =~ s/-/::/g;
#$debian{$dist} = \%h;
$debian{ $h{CPAN_dist} } = \%h;
#} else {
# warn "Invalid row in Debian file:\n$row\n";
}
}
return \%debian;
}
##################################################################
# Kwalitee Indicators
##################################################################
sub kwalitee_indicators{
return [] if $ENV{CPANTS_LINT};
return [
{
name=>'distributed_by_debian',
error=>qq{The module is not distributed by Debian},
remedy=>q{Make your package easily repackagable by Debian and convince the Debian-Perl team to package your module},
is_experimental=>1,
code=> sub {
my $d = shift;
my $metric=shift;
return $debian->{ $d->{dist} } ? 1 : 0;
},
},
{
name=>'latest_version_distributed_by_debian',
error=>qq{The version distributed by Debian is NOT the latest from CPAN},
remedy=>q{Give the Debian-Perl people some time to repackage your module. After that talk to the to see if
there is a problem with the latest version?},
is_experimental=>1,
code=> sub {
my $d = shift;
my $metric=shift;
my $deb = $debian->{ $d->{dist} };
return 1 if $deb && $deb->{CPAN_vers} eq $d->{version};
if ($deb) {
my $error = "Seen on CPAN: '$d->{version}'. Reported by Debian: '$deb->{CPAN_vers}'";
$error .= " See: <a href=http://packages.debian.org/src:$deb->{debian_pkg}>Basic homepage</a>";
$d->{error}{ $metric->{name} } = $error;
} else {
#$d->{error}{ $metric->{name} } = 'First get your module in Debian';
}
return 0;
},
},
{
name=>'has_no_bugs_reported_in_debian',
error=>qq{There is a bug reported in Debian},
remedy=>q{Give the Debian-Perl people some time to repackage your module. After that talk to the to see if
there is a problem with the latest version?},
is_experimental=>1,
code=> sub {
my $d = shift;
my $metric=shift;
my $deb = $debian->{ $d->{dist} };
return 1 if $deb && !$deb->{N_bugs};
if ($deb) {
my $error = "Number of bugs reported: $deb->{N_bugs}.";
$error .= " See: <a href=http://packages.debian.org/src:$deb->{debian_pkg}>Basic homepage</a>";
$d->{error}{ $metric->{name} } = $error;
} else {
#$d->{error}{ $metric->{name} } = 'First get your module in Debian';
}
return 0;
},
},
{
name=>'has_no_patches_in_debian',
error=>qq{There is a patch in Debian},
remedy=>q{Go to the Debian repository apply their patch to the version maintained on CPAN and ask the Debian
team to upgrde.},
is_experimental=>1,
code=> sub {
my $d = shift;
my $metric=shift;
my $deb = $debian->{ $d->{dist} };
return 1 if $deb && !$deb->{N_patches};
if ($deb) {
my $error = qq(Number of patches reported: $deb->{N_patches}.);
$error .= qq( See: <a href="http://packages.debian.org/src:$deb->{debian_pkg}">Basic homepage</a>);
$error .= sprintf(' <a href="http://svn.debian.org/wsvn/pkg-perl/trunk/%s/debian/patches/">svn</a>',
$deb->{debian_pkg});
$d->{error}{ $metric->{name} } = $error;
} else {
#$d->{error}{ $metric->{name} } = 'First get your module in Debian';
}
return 0;
},
},
];
}
q{Favourite record of the moment:
Lili Allen - Allright, still};
__END__
=encoding UTF-8
=head1 NAME
Module::CPANTS::Kwalitee::Distros - Information retrieved from the various Linux and other distributions
=head1 SYNOPSIS
The metrics here are based on data provided by the various downstream packaging systems.
=head1 DESCRIPTION
=head2 Methods
=head3 order
Defines the order in which Kwalitee tests should be run.
=head3 analyse
=head3 kwalitee_indicators
Returns the Kwalitee Indicators datastructure.
=over
=item * distributed_by_debian
True if the module (package) is repackaged by the Debian-Perl team and
you can install it using the package management system of Debian.
=item * latest_version_distributed_by_debian
True if the latest version of the module (package) is repackaged by Debian
=item * has_no_bugs_reported_in_debian
True for if the module is distributed by Debian and no bugs were reported.
=item * has_no_patches_in_debian
True for if the module is distributed by Debian and no patches applied.
=back
=head1 Caveats
CPAN_dist, the name of CPAN distribution is inferred from the download location,
for Debian packages. It works 99% of the time, but it is not completely reliable.
If it fails to detect something, it will spit out the known download location.
CPAN_vers, the version number reported by Debian is inferred from the debian version.
This fails a lot, since Debian has a mechanism for "unmangling" upstream versions which
is non-reversible. We have to use that many times to fix versioning problems,
and those packages will show a different version (e.g. 1.080 vs 1.80)
The first problem is something the Debian people like to solve by adding
metadata to the packages, for many other useful stuff
(like automatic upstream bug tracking and handling). About the second... well,
it's a difficult one.
CPANTS does not yet handle the second issue.
=head1 LINKS
Basic homepage: http://packages.debian.org/src:$pkgname
Detalied homepage: http://packages.qa.debian.org/$pkgname
Bugs report: http://bugs.debian.org/src:$pkgname
Public SVN repository: http://svn.debian.org/wsvn/pkg-perl/trunk/$pkg
From that last URL, you might be interested in the debian/ and
debian/patches subdirectories.
=head1 SEE ALSO
L<Module::CPANTS::Analyse>
=head1 AUTHOR
L<Thomas Klausner|https://metacpan.org/author/domm>
and L<Gábor Szabó|https://metacpan.org/author/szabgab>
with the help of Martín Ferrari and the
L<Debian Perl packaging team|http://pkg-perl.alioth.debian.org/>.
=head1 COPYRIGHT AND LICENSE
Copyright © 2003–2009 L<Thomas Klausner|https://metacpan.org/author/domm>
Copyright © 2006–2008 L<Gábor Szabó|https://metacpan.org/author/szabgab>
You may use and distribute this module according to the same terms
that Perl is distributed under.
|
