Pod::Coverage::Moose - L<Pod::Coverage> extension for L<Moose>

Pod-Coverage-Moose documentation Contained in the Pod-Coverage-Moose distribution.

Index

Code Index:

NAME

Top

Pod::Coverage::Moose - Pod::Coverage extension for Moose

SYNOPSIS

Top

  use Pod::Coverage::Moose;

  my $pcm = Pod::Coverage::Moose->new(package => 'MoosePackage');
  print 'Coverage: ', $pcm->coverage, "\n";

DESCRIPTION

Top

When using Pod::Coverage in combination with Moose, it will report any method imported from a Role. This is especially bad when used in combination with Test::Pod::Coverage, since it takes away its ease of use.

To use this module in combination with Test::Pod::Coverage, use something like this:

  use Test::Pod::Coverage;
  all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::Moose'});

ATTRIBUTES

Top

package

This is the package used for inspection.

METHODS

Top

meta

Moose meta object.

BUILD

Initialises the internal Pod::Coverage object. It uses the meta object to find all methods and attribute methods imported via roles.

DELEGATED METHODS

Top

Delegated to the traditional Pod::Coverage object are

coverage
covered
naked
uncovered
why_unrated

EXTENDED METHODS

Top

new

The constructor will only return a Pod::Coverage::Moose object if it is invoked on a class that can a meta method. Otherwise, a traditional Pod::Coverage object will be returned. This is done so you don't get in trouble for mixing Moose with non Moose classes in your project.

SEE ALSO

Top

Moose, Pod::Coverage, Test::Pod::Coverage

AUTHOR

Top

Robert 'phaylon' Sedlacek <rs@474.at>

COPYRIGHT AND LICENSE

Top

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Pod-Coverage-Moose documentation Contained in the Pod-Coverage-Moose distribution. 
package Pod::Coverage::Moose;
use Moose;

use Pod::Coverage;
use Carp            qw( croak );
use Perl6::Junction qw( any );
use Class::MOP;

use namespace::clean -except => 'meta';

our $VERSION = '0.02';


has package => (
    is          => 'rw',
    isa         => 'Str',
    required    => 1,
);

#
#   original pod_coverage object
#

has _pod_coverage => (
    is          => 'rw',
    isa         => 'Pod::Coverage',
    handles     => [qw( coverage why_unrated naked uncovered covered )],
);


sub BUILD {
    my ($self, $args) = @_;

    my $meta    = $self->package->meta;
    my @trustme = @{ $args->{trustme} || [] };

    push @trustme, qr/^meta$/;
    push @trustme,                                          # MooseX-AttributeHelpers hack
        map  { qr/^$_$/ }
        map  { $_->name }
        grep { $_->isa('MooseX::AttributeHelpers::Meta::Method::Provided') }
        $meta->get_all_methods
            unless $meta->isa('Moose::Meta::Role');
    push @trustme, 
        map { qr/^$_$/ }                                    # turn value into a regex
        map {                                               # iterate over all roles of the class
            my $role = $_;
            $role->get_method_list,
            map {                                           # iterate over attributes
                my $attr = $role->get_attribute($_);
                ($attr->{is} && $attr->{is} eq any(qw( rw ro wo )) ? $_ : ()),  # accessors
                grep defined, map { $attr->{ $_ } }                             # other attribute methods
                    qw( clearer predicate reader writer accessor );
            } $role->get_attribute_list,
        } 
        $meta->calculate_all_roles;

    $args->{trustme} = \@trustme;

    $self->_pod_coverage(Pod::Coverage->new(%$args));
}


around new => sub {
    my $next = shift;
    my ($self, @args) = @_;

    my %args  = (@args == 1 && ref $args[0] eq 'HASH' ? %{ $args[0] } : @args);
    my $class = $args{package}
        or croak 'You need to specify a package in the constructor arguments';

    Class::MOP::load_class($class);
    return Pod::Coverage->new(%args) unless $class->can('meta');

    return $self->$next(@args);
};

1;