more pg test cleanup
[dbsrgits/DBIx-Class-Historic.git] / t / 03podcoverage.t
1 use Test::More;
2 use List::Util ();
3
4 eval "use Pod::Coverage 0.19";
5 plan skip_all => 'Pod::Coverage 0.19 required' if $@;
6 eval "use Test::Pod::Coverage 1.04";
7 plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
8
9 plan skip_all => 'set TEST_POD to enable this test'
10   unless ($ENV{TEST_POD} || -e 'MANIFEST.SKIP');
11
12
13 # Since this is about checking documentation, a little documentation
14 # of what this is doing might be in order.
15 # The exceptions structure below is a hash keyed by the module
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
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.
26 my $exceptions = {
27     'DBIx::Class' => {
28         ignore => [qw/
29             MODIFY_CODE_ATTRIBUTES
30             component_base_class
31             mk_classdata
32             mk_classaccessor
33         /]
34     },
35     'DBIx::Class::Row' => {
36         ignore => [qw/
37             MULTICREATE_DEBUG
38         /],
39     },
40     'DBIx::Class::ResultSource' => {
41         ignore => [qw/
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
53         /],
54     },
55     'DBIx::Class::Storage' => {
56         ignore => [qw/
57             schema
58             cursor
59         /]
60     },
61     'DBIx::Class::Schema' => {
62         ignore => [qw/
63             setup_connection_class
64         /]
65     },
66
67     'DBIx::Class::Schema::Versioned' => {
68         ignore => [ qw/
69             connection
70         /]
71     },
72
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 },
79
80 # test some specific components whose parents are exempt below
81     'DBIx::Class::Storage::DBI::Replicated*'        => {},
82     'DBIx::Class::Relationship::Base'               => {},
83
84 # internals
85     'DBIx::Class::SQLAHacks*'                       => { skip => 1 },
86     'DBIx::Class::Storage::DBI*'                    => { skip => 1 },
87     'SQL::Translator::*'                            => { skip => 1 },
88
89 # deprecated / backcompat stuff
90     'DBIx::Class::CDBICompat*'                      => { skip => 1 },
91     'DBIx::Class::ResultSetManager'                 => { skip => 1 },
92     'DBIx::Class::DB'                               => { skip => 1 },
93
94 # skipped because the synopsis covers it clearly
95     'DBIx::Class::InflateColumn::File'              => { skip => 1 },
96 };
97
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
108 foreach my $module (@modules) {
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   }
129 }
130
131 done_testing;