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     'DBIx::Class::Storage::DBI::Replicated::Types'  => { skip => 1 },
  80
  81 # test some specific components whose parents are exempt below
  82     'DBIx::Class::Storage::DBI::Replicated*'        => {},
  83     'DBIx::Class::Relationship::Base'               => {},
  84
  85 # internals
  86     'DBIx::Class::SQLAHacks*'                       => { skip => 1 },
  87     'DBIx::Class::Storage::DBI*'                    => { skip => 1 },
  88     'SQL::Translator::*'                            => { skip => 1 },
  89
  90 # deprecated / backcompat stuff
  91     'DBIx::Class::CDBICompat*'                      => { skip => 1 },
  92     'DBIx::Class::ResultSetManager'                 => { skip => 1 },
  93     'DBIx::Class::DB'                               => { skip => 1 },
  94
  95 # skipped because the synopsis covers it clearly
  96     'DBIx::Class::InflateColumn::File'              => { skip => 1 },
  97 };
  98
  99 my $ex_lookup = {};
 100 for my $string (keys %$exceptions) {
 101   my $ex = $exceptions->{$string};
 102   $string =~ s/\*/'.*?'/ge;
 103   my $re = qr/^$string$/;
 104   $ex_lookup->{$re} = $ex;
 105 }
 106
 107 my @modules = sort { $a cmp $b } (Test::Pod::Coverage::all_modules());
 108
 109 foreach my $module (@modules) {
 110   SKIP: {
 111
 112     my ($match) = List::Util::first
 113       { $module =~ $_ }
 114       (sort { length $b <=> length $a || $b cmp $a } (keys %$ex_lookup) )
 115     ;
 116
 117     my $ex = $ex_lookup->{$match} if $match;
 118
 119     skip ("$module exempt", 1) if ($ex->{skip});
 120
 121     # build parms up from ignore list
 122     my $parms = {};
 123     $parms->{trustme} =
 124       [ map { qr/^$_$/ } @{ $ex->{ignore} } ]
 125         if exists($ex->{ignore});
 126
 127     # run the test with the potentially modified parm set
 128     pod_coverage_ok($module, $parms, "$module POD coverage");
 129   }
 130 }
 131
 132 done_testing;