git.maemo.org Git - dh-make-perl/blob - dev/arm/libpod-coverage-perl/libpod-coverage-perl-0.19/lib/Pod/Coverage/CountParents.pm

   1 package Pod::Coverage::CountParents;
   2 use strict;
   3 use Pod::Coverage ();
   4 use base 'Pod::Coverage';
   5
   6 # this code considered lightly fugly :)
   7
   8 sub _get_pods {
   9     my $self = shift;
  10     my $package = $self->{package};
  11
  12     eval qq{ require $package };
  13     if ($@) {
  14         $self->{why_unrated} = "Couldn't compile '$package' to inspect: $@";
  15         return;
  16     }
  17
  18     my %pods;
  19     $pods{$package} = $self->SUPER::_get_pods;
  20
  21     __walk_up($package, \%pods);
  22     my %flat = map { $_ => 1 }  map { @{ $_ || [] } } values %pods;
  23     return [ keys %flat ];
  24 }
  25
  26 sub __walk_up {
  27     my $package = shift;
  28     my $pods    = shift;
  29
  30     $pods->{$package} = Pod::Coverage->new(package => $package)->_get_pods();
  31
  32     my @parents;
  33     {
  34         no strict 'refs';
  35         @parents = @{"$package\::ISA"};
  36     }
  37
  38     do { $pods->{$_} || __walk_up($_, $pods) } for @parents;
  39 }
  40
  41 1;
  42 __END__
  43
  44
  45 =head1 NAME
  46
  47 Pod::Coverage::CountParents - subclass of Pod::Coverage that examines the inheritance tree
  48
  49 =head1 SYNOPSIS
  50
  51   # all in one invocation
  52   use Pod::Coverage::CountParents package => 'Fishy';
  53
  54   # straight OO
  55   use Pod::Coverage::CountParents;
  56   my $pc = new Pod::Coverage::CountParents package => 'Pod::Coverage';
  57   print "We rock!" if $pc->coverage == 1;
  58
  59 =head1 DESCRIPTION
  60
  61 This module extends Pod::Coverage to include the documentation from
  62 parent classes when identifying the coverage of the code.
  63
  64 If you want full documentation we suggest you check the
  65 L<Pod::Coverage> documentation.
  66
  67 =head1 SEE ALSO
  68
  69 L<Pod::Coverage>, L<base>
  70
  71 =head1 AUTHOR
  72
  73 Copyright (c) 2002 Richard Clamp. All rights reserved.  This program
  74 is free software; you can redistribute it and/or modify it under the
  75 same terms as Perl itself.
  76
  77 =cut