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;