more pg test cleanup
[dbsrgits/DBIx-Class-Historic.git] / t / 03podcoverage.t
CommitLineData
0fe5201a 1use Test::More;
32978f6e 2use List::Util ();
0fe5201a 3
f09cd1d4 4eval "use Pod::Coverage 0.19";
5plan skip_all => 'Pod::Coverage 0.19 required' if $@;
0fe5201a 6eval "use Test::Pod::Coverage 1.04";
7plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
f09cd1d4 8
b20edc27 9plan 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 26my $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 98my $ex_lookup = {};
99for 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
106my @modules = sort { $a cmp $b } (Test::Pod::Coverage::all_modules());
107
7eb4ecc8 108foreach 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
131done_testing;