Commit | Line | Data |
0fe5201a |
1 | use Test::More; |
32978f6e |
2 | use List::Util (); |
0fe5201a |
3 | |
f09cd1d4 |
4 | eval "use Pod::Coverage 0.19"; |
5 | plan skip_all => 'Pod::Coverage 0.19 required' if $@; |
0fe5201a |
6 | eval "use Test::Pod::Coverage 1.04"; |
7 | plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@; |
f09cd1d4 |
8 | |
b20edc27 |
9 | plan skip_all => 'set TEST_POD to enable this test' |
10 | unless ($ENV{TEST_POD} || -e 'MANIFEST.SKIP'); |
0fe5201a |
11 | |
7eb4ecc8 |
12 | |
9b83fccd |
13 | # Since this is about checking documentation, a little documentation |
32978f6e |
14 | # of what this is doing might be in order. |
9b83fccd |
15 | # The exceptions structure below is a hash keyed by the module |
32978f6e |
16 | # name. Any * in a name is treated like a wildcard and will behave |
17 | # as expected. Modules are matched by longest string first, so |
18 | # A::B::C will match even if there is A::B* |
19 | |
20 | # The value for each is a hash, which contains one or more |
9b83fccd |
21 | # (although currently more than one makes no sense) of the following |
22 | # things:- |
23 | # skip => a true value means this module is not checked |
24 | # ignore => array ref containing list of methods which |
25 | # do not need to be documented. |
7eb4ecc8 |
26 | my $exceptions = { |
27 | 'DBIx::Class' => { |
517ba890 |
28 | ignore => [qw/ |
29 | MODIFY_CODE_ATTRIBUTES |
30 | component_base_class |
31 | mk_classdata |
32 | mk_classaccessor |
33 | /] |
b20edc27 |
34 | }, |
0c62fa59 |
35 | 'DBIx::Class::Row' => { |
517ba890 |
36 | ignore => [qw/ |
37 | MULTICREATE_DEBUG |
38 | /], |
0c62fa59 |
39 | }, |
bc984450 |
40 | 'DBIx::Class::ResultSource' => { |
41 | ignore => [qw/ |
517ba890 |
42 | compare_relationship_keys |
43 | pk_depends_on |
44 | resolve_condition |
45 | resolve_join |
46 | resolve_prefetch |
47 | /], |
48 | }, |
49 | 'DBIx::Class::ResultSourceHandle' => { |
50 | ignore => [qw/ |
51 | schema |
52 | source_moniker |
bc984450 |
53 | /], |
54 | }, |
b20edc27 |
55 | 'DBIx::Class::Storage' => { |
517ba890 |
56 | ignore => [qw/ |
57 | schema |
58 | cursor |
59 | /] |
7eb4ecc8 |
60 | }, |
249963d4 |
61 | 'DBIx::Class::Schema' => { |
517ba890 |
62 | ignore => [qw/ |
63 | setup_connection_class |
64 | /] |
249963d4 |
65 | }, |
32978f6e |
66 | |
67 | 'DBIx::Class::Schema::Versioned' => { |
68 | ignore => [ qw/ |
69 | connection |
517ba890 |
70 | /] |
00c937a2 |
71 | }, |
737416a4 |
72 | |
32978f6e |
73 | 'DBIx::Class::ClassResolver::PassThrough' => { skip => 1 }, |
74 | 'DBIx::Class::Componentised' => { skip => 1 }, |
75 | 'DBIx::Class::Relationship::*' => { skip => 1 }, |
76 | 'DBIx::Class::ResultSetProxy' => { skip => 1 }, |
77 | 'DBIx::Class::ResultSourceProxy' => { skip => 1 }, |
78 | 'DBIx::Class::Storage::Statistics' => { skip => 1 }, |
737416a4 |
79 | |
32978f6e |
80 | # test some specific components whose parents are exempt below |
81 | 'DBIx::Class::Storage::DBI::Replicated*' => {}, |
82 | 'DBIx::Class::Relationship::Base' => {}, |
737416a4 |
83 | |
32978f6e |
84 | # internals |
85 | 'DBIx::Class::SQLAHacks*' => { skip => 1 }, |
86 | 'DBIx::Class::Storage::DBI*' => { skip => 1 }, |
87 | 'SQL::Translator::*' => { skip => 1 }, |
737416a4 |
88 | |
32978f6e |
89 | # deprecated / backcompat stuff |
90 | 'DBIx::Class::CDBICompat*' => { skip => 1 }, |
91 | 'DBIx::Class::ResultSetManager' => { skip => 1 }, |
92 | 'DBIx::Class::DB' => { skip => 1 }, |
737416a4 |
93 | |
32978f6e |
94 | # skipped because the synopsis covers it clearly |
95 | 'DBIx::Class::InflateColumn::File' => { skip => 1 }, |
7eb4ecc8 |
96 | }; |
97 | |
32978f6e |
98 | my $ex_lookup = {}; |
99 | for my $string (keys %$exceptions) { |
100 | my $ex = $exceptions->{$string}; |
101 | $string =~ s/\*/'.*?'/ge; |
102 | my $re = qr/^$string$/; |
103 | $ex_lookup->{$re} = $ex; |
104 | } |
105 | |
106 | my @modules = sort { $a cmp $b } (Test::Pod::Coverage::all_modules()); |
107 | |
7eb4ecc8 |
108 | foreach my $module (@modules) { |
32978f6e |
109 | SKIP: { |
110 | |
111 | my ($match) = List::Util::first |
112 | { $module =~ $_ } |
113 | (sort { length $b <=> length $a || $b cmp $a } (keys %$ex_lookup) ) |
114 | ; |
115 | |
116 | my $ex = $ex_lookup->{$match} if $match; |
117 | |
118 | skip ("$module exempt", 1) if ($ex->{skip}); |
119 | |
120 | # build parms up from ignore list |
121 | my $parms = {}; |
122 | $parms->{trustme} = |
123 | [ map { qr/^$_$/ } @{ $ex->{ignore} } ] |
124 | if exists($ex->{ignore}); |
125 | |
126 | # run the test with the potentially modified parm set |
127 | pod_coverage_ok($module, $parms, "$module POD coverage"); |
128 | } |
7eb4ecc8 |
129 | } |
32978f6e |
130 | |
131 | done_testing; |