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
|
use warnings;
use strict;
use Test::More;
use lib qw(t/lib maint/.Generated_Pod/lib);
use DBICTest;
plan skip_all => "Skipping finicky test on older perl"
if "$]" < 5.008005;
require DBIx::Class;
unless ( DBIx::Class::Optional::Dependencies->req_ok_for ('test_podcoverage') ) {
my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('test_podcoverage');
$ENV{RELEASE_TESTING}
? die ("Failed to load release-testing module requirements: $missing")
: plan skip_all => "Test needs: $missing"
}
# this has already been required but leave it here for CPANTS static analysis
require Test::Pod::Coverage;
# Since this is about checking documentation, a little documentation
# of what this is doing might be in order.
# The exceptions structure below is a hash keyed by the module
# name. Any * in a name is treated like a wildcard and will behave
# as expected. Modules are matched by longest string first, so
# A::B::C will match even if there is A::B*
# The value for each is a hash, which contains one or more
# (although currently more than one makes no sense) of the following
# things:-
# skip => a true value means this module is not checked
# ignore => array ref containing list of methods which
# do not need to be documented.
my $exceptions = {
'DBIx::Class' => {
ignore => [qw/
MODIFY_CODE_ATTRIBUTES
component_base_class
mk_classdata
mk_classaccessor
/]
},
'DBIx::Class::Carp' => {
ignore => [qw/
unimport
/]
},
'DBIx::Class::Row' => {
ignore => [qw/
MULTICREATE_DEBUG
/],
},
'DBIx::Class::FilterColumn' => {
ignore => [qw/
new
update
store_column
get_column
get_columns
get_dirty_columns
has_column_loaded
/],
},
'DBIx::Class::ResultSource' => {
ignore => [qw/
compare_relationship_keys
pk_depends_on
resolve_condition
resolve_join
resolve_prefetch
STORABLE_freeze
STORABLE_thaw
/],
},
'DBIx::Class::ResultSet' => {
ignore => [qw/
STORABLE_freeze
STORABLE_thaw
/],
},
'DBIx::Class::ResultSourceHandle' => {
ignore => [qw/
schema
source_moniker
/],
},
'DBIx::Class::Storage' => {
ignore => [qw/
schema
cursor
/]
},
'DBIx::Class::Schema' => {
ignore => [qw/
setup_connection_class
/]
},
'DBIx::Class::Schema::Versioned' => {
ignore => [ qw/
connection
/]
},
'DBIx::Class::Admin' => {
ignore => [ qw/
BUILD
/]
},
'DBIx::Class::Storage::DBI::Replicated*' => {
ignore => [ qw/
connect_call_do_sql
disconnect_call_do_sql
/]
},
'DBIx::Class::Storage::Debug::PrettyTrace' => {
ignore => [ qw/
print
query_start
query_end
/]
},
'DBIx::Class::Admin::*' => { skip => 1 },
'DBIx::Class::Optional::Dependencies' => { skip => 1 },
'DBIx::Class::ClassResolver::PassThrough' => { skip => 1 },
'DBIx::Class::Componentised' => { skip => 1 },
'DBIx::Class::AccessorGroup' => { skip => 1 },
'DBIx::Class::Relationship::*' => { skip => 1 },
'DBIx::Class::ResultSetProxy' => { skip => 1 },
'DBIx::Class::ResultSourceProxy' => { skip => 1 },
'DBIx::Class::ResultSource::*' => { skip => 1 },
'DBIx::Class::Storage::Statistics' => { skip => 1 },
'DBIx::Class::Storage::DBI::Replicated::Types' => { skip => 1 },
'DBIx::Class::GlobalDestruction' => { skip => 1 },
'DBIx::Class::Storage::BlockRunner' => { skip => 1 }, # temporary
# test some specific components whose parents are exempt below
'DBIx::Class::Relationship::Base' => {},
# internals
'DBIx::Class::_Util' => { skip => 1 },
'DBIx::Class::SQLMaker*' => { skip => 1 },
'DBIx::Class::SQLAHacks*' => { skip => 1 },
'DBIx::Class::Storage::DBI*' => { skip => 1 },
'SQL::Translator::*' => { skip => 1 },
# deprecated / backcompat stuff
'DBIx::Class::Serialize::Storable' => { skip => 1 },
'DBIx::Class::CDBICompat*' => { skip => 1 },
'DBIx::Class::ResultSetManager' => { skip => 1 },
'DBIx::Class::DB' => { skip => 1 },
# skipped because the synopsis covers it clearly
'DBIx::Class::InflateColumn::File' => { skip => 1 },
};
my $ex_lookup = {};
for my $string (keys %$exceptions) {
my $ex = $exceptions->{$string};
$string =~ s/\*/'.*?'/ge;
my $re = qr/^$string$/;
$ex_lookup->{$re} = $ex;
}
my @modules = sort { $a cmp $b } Test::Pod::Coverage::all_modules('lib');
foreach my $module (@modules) {
SKIP: {
my ($match) =
grep { $module =~ $_ }
(sort { length $b <=> length $a || $b cmp $a } (keys %$ex_lookup) )
;
my $ex = $ex_lookup->{$match} if $match;
skip ("$module exempt", 1) if ($ex->{skip});
skip ("$module not loadable", 1) unless eval "require $module";
# build parms up from ignore list
my $parms = {};
$parms->{trustme} =
[ map { qr/^$_$/ } @{ $ex->{ignore} } ]
if exists($ex->{ignore});
# run the test with the potentially modified parm set
Test::Pod::Coverage::pod_coverage_ok($module, $parms, "$module POD coverage");
}
}
done_testing;
|
