—package
Pod::Coverage::CountParents;
use
strict;
use
Pod::Coverage ();
# this code considered lightly fugly :)
sub
_get_pods {
my
$self
=
shift
;
my
$package
=
$self
->{
package
};
eval
qq{ require $package }
;
if
($@) {
$self
->{why_unrated} =
"Couldn't compile '$package' to inspect: $@"
;
return
;
}
my
%pods
;
$pods
{
$package
} =
$self
->SUPER::_get_pods;
__walk_up(
$package
, \
%pods
);
my
%flat
=
map
{
$_
=> 1 }
map
{ @{
$_
|| [] } }
values
%pods
;
return
[
keys
%flat
];
}
sub
__walk_up {
my
$package
=
shift
;
my
$pods
=
shift
;
$pods
->{
$package
} = Pod::Coverage->new(
package
=>
$package
)->_get_pods();
my
@parents
;
{
no
strict
'refs'
;
@parents
= @{
"$package\::ISA"
};
}
do
{
$pods
->{
$_
} || __walk_up(
$_
,
$pods
) }
for
@parents
;
}
1;
__END__
=head1 NAME
Pod::Coverage::CountParents - subclass of Pod::Coverage that examines the inheritance tree
=head1 SYNOPSIS
# all in one invocation
use Pod::Coverage::CountParents package => 'Fishy';
# straight OO
use Pod::Coverage::CountParents;
my $pc = new Pod::Coverage::CountParents package => 'Pod::Coverage';
print "We rock!" if $pc->coverage == 1;
=head1 DESCRIPTION
This module extends Pod::Coverage to include the documentation from
parent classes when identifying the coverage of the code.
If you want full documentation we suggest you check the
L<Pod::Coverage> documentation.
=head1 SEE ALSO
L<Pod::Coverage>, L<base>
=head1 AUTHOR
Copyright (c) 2002 Richard Clamp. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.
=cut