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


line stmt bran cond sub pod time code
1             package Test::NaiveStubs;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Generate test stubs for methods and functions
5              
6             our $VERSION = '0.0701';
7              
8 1     1   1217 use Moo;
  1         11098  
  1         5  
9 1     1   1987 use strictures 2;
  1         1583  
  1         39  
10 1     1   630 use namespace::clean;
  1         10978  
  1         6  
11              
12 1     1   294 use Package::Stash;
  1         2  
  1         24  
13 1     1   425 use Sub::Identify 'stash_name';
  1         988  
  1         686  
14              
15              
16             has module => (
17             is => 'ro',
18             required => 1,
19             );
20              
21              
22             has name => (
23             is => 'ro',
24             builder => 1,
25             );
26              
27             sub _build_name {
28 1     1   6 my ($self) = @_;
29 1         6 ( my $name = $self->module ) =~ s/::/-/g;
30 1         4 $name = lc $name;
31 1         5 return "$name.t";
32             }
33              
34              
35             has subs => (
36             is => 'rw',
37             init_arg => undef,
38             );
39              
40              
41             has is_oo => (
42             is => 'rw',
43             init_arg => undef,
44             default => sub { 0 },
45             );
46              
47              
48             sub gather_subs {
49 2     2 1 988 my ($self) = @_;
50              
51 2         55 my $subs = Package::Stash->new($self->module)->get_all_symbols('CODE');
52              
53 2         8 my @subs;
54 2         9 for my $sub ( keys %$subs ) {
55 20         43 my $packagename = stash_name($subs->{$sub});
56 20 100       103 push @subs, $sub if $packagename eq $self->module;
57             }
58              
59 2         4 my %subs;
60 2         10 @subs{@subs} = undef;
61              
62 2         19 $self->subs( \%subs );
63             }
64              
65              
66             sub unit_test {
67 11     11 1 1776 my ($self, $subroutine) = @_;
68              
69 11         23 my $test = '';
70              
71 11 100       31 if ( $subroutine eq 'new' ) {
    100          
72 2         13 $test = 'use_ok "' . $self->module . '";'
73             . "\n\n"
74             . 'my $obj = ' . $self->module . '->new;'
75             . "\n"
76             . 'isa_ok $obj, "' . $self->module . '";';
77             }
78             elsif ( $self->is_oo ) {
79 7         12 $test = 'ok $obj->can("' . $subroutine . '"), "' . $subroutine . '";';
80             }
81             else {
82 2         7 $test = "ok $subroutine(), " . '"' . $subroutine . '";';
83             }
84              
85 11         22 return $test;
86             }
87              
88              
89             sub create_test {
90 1     1 1 576 my ($self) = @_;
91              
92 1 50       86 open my $fh, '>', $self->name or die "Can't write " . $self->name . ": $!";
93              
94 1         5 my $text =<<'END';
95             use strict;
96             use warnings;
97              
98             use Test::More;
99              
100             END
101              
102             # Set the subs attribute
103 1         4 $self->gather_subs;
104              
105 1 50       5 if ( exists $self->subs->{new} ) {
106 1         4 $self->is_oo(1);
107              
108 1         3 my $test = $self->unit_test('new');
109              
110 1         4 $text .= "$test\n\n";
111             }
112              
113 1         2 for my $sub ( sort keys %{ $self->subs } ) {
  1         8  
114 9 100       21 next if $sub =~ /^_/;
115 8 100       16 next if $sub eq 'new';
116              
117 7         11 my $test = $self->unit_test($sub);
118              
119 7         14 $text .= "$test\n\n";
120             }
121              
122 1         2 $text .= 'done_testing();
123             ';
124              
125 1         49 print $fh $text;
126             }
127              
128             1;
129              
130             __END__