File Coverage

blib/lib/Test/NaiveStubs.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	12	14	85.7
condition			n/a
subroutine	9	9	100.0
pod	3	3	100.0
total	75	77	97.4

package Test::NaiveStubs;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Generate test stubs for methods and functions

our $VERSION = '0.0701';

use Moo;
use strictures 2;
use namespace::clean;

use Package::Stash;
use Sub::Identify 'stash_name';


has module => (
    is       => 'ro',
    required => 1,
);


has name => (
    is      => 'ro',
    builder => 1,
);

sub _build_name {
    my ($self) = @_;
    ( my $name = $self->module ) =~ s/::/-/g;
    $name = lc $name;
    return "$name.t";
}


has subs => (
    is       => 'rw',
    init_arg => undef,
);


has is_oo => (
    is       => 'rw',
    init_arg => undef,
    default  => sub { 0 },
);


sub gather_subs {
    my ($self) = @_;

    my $subs = Package::Stash->new($self->module)->get_all_symbols('CODE');

    my @subs;
    for my $sub ( keys %$subs ) {
        my $packagename = stash_name($subs->{$sub});
        push @subs, $sub if $packagename eq $self->module;
    }

    my %subs;
    @subs{@subs} = undef;

    $self->subs( \%subs );
}


sub unit_test {
    my ($self, $subroutine) = @_;

    my $test = '';

    if ( $subroutine eq 'new' ) {
        $test = 'use_ok "' . $self->module . '";'
            . "\n\n"
            . 'my $obj = ' . $self->module . '->new;'
            . "\n"
            . 'isa_ok $obj, "' . $self->module . '";';
    }
    elsif ( $self->is_oo ) {
        $test = 'ok $obj->can("' . $subroutine . '"), "' . $subroutine . '";';
    }
    else {
        $test = "ok $subroutine(), " . '"' . $subroutine . '";';
    }

    return $test;
}


sub create_test {
    my ($self) = @_;

    open my $fh, '>', $self->name or die "Can't write " . $self->name . ": $!";

    my $text =<<'END';
use strict;
use warnings;

use Test::More;

END

    # Set the subs attribute
    $self->gather_subs;

    if ( exists $self->subs->{new} ) {
        $self->is_oo(1);

        my $test = $self->unit_test('new');

        $text .= "$test\n\n";
    }

    for my $sub ( sort keys %{ $self->subs } ) {
        next if $sub =~ /^_/;
        next if $sub eq 'new';

        my $test = $self->unit_test($sub);

        $text .= "$test\n\n";
    }

    $text .= 'done_testing();
';

    print $fh $text;
}

1;

__END__