File Coverage

blib/lib/App/Midgen/Role/InDistribution.pm
Criterion Covered Total %
statement 12 37 32.4
branch 0 22 0.0
condition 0 3 0.0
subroutine 4 6 66.6
pod 1 1 100.0
total 17 69 24.6


line stmt bran cond sub pod time code
1             package App::Midgen::Role::InDistribution;
2              
3 2     2   1066 use constant {TWO => 2, TRUE => 1, FALSE => 0,};
  2         3  
  2         172  
4              
5 2     2   9 use Types::Standard qw( Bool );
  2         4  
  2         18  
6 2     2   794 use Moo::Role;
  2         4  
  2         18  
7             requires qw( ppi_document debug );
8              
9             our $VERSION = '0.33_05';
10             $VERSION = eval $VERSION; ## no critic
11              
12              
13             ########
14             # is this a perl file
15             # more files found than File-Find-Rule-Perl (!psgi)
16             ########
17             sub is_perlfile {
18 0     0 1   my $self = shift;
19 0           my $filename = $_;
20              
21 0           for (qw(pm t psgi pl)) {
22 0 0         if ($filename =~ m/[.]$_$/) {
23 0 0         print "looking for requires in (.$_)-> $filename\n"
24             if $self->verbose >= TWO;
25 0           return TRUE;
26             }
27             }
28 0 0         if ($filename =~ m/[.]\w{2,4}$/) {
29 0 0         print "rejecting $filename\n" if $self->verbose >= TWO;
30 0           return FALSE;
31             }
32             else {
33 0           return $self->_confirm_perlfile($filename);
34             }
35             }
36              
37             ########
38             # confirm if this a perl file
39             #######
40             sub _confirm_perlfile {
41 0     0     my $self = shift;
42 0           my $filename = shift;
43              
44             # ignore dirs - bug found by farabi, azawawi++
45 0 0         return FALSE if -d $filename;
46              
47 0           $self->_set_ppi_document(PPI::Document->new($filename));
48              
49 0           my $ppi_tc = $self->ppi_document->find('PPI::Token::Comment');
50              
51 0           my $a_pl_file = 0;
52              
53 0 0         if ($ppi_tc) {
54              
55             # check first token-comment for a she-bang
56 0 0         $a_pl_file = 1 if $ppi_tc->[0]->content =~ m/^#!.*perl.*$/;
57             }
58              
59              
60 0 0 0       if ($self->ppi_document->find('PPI::Statement::Package') || $a_pl_file) {
61 0 0         if ($self->verbose >= TWO) {
62              
63 0 0         print "looking for requires in (package) -> "
64             if $self->ppi_document->find('PPI::Statement::Package');
65 0 0         print "looking for requires in (shebang) -> "
66             if $ppi_tc->[0]->content =~ /perl/;
67 0           print "$filename\n";
68             }
69 0           return TRUE;
70             }
71             else {
72 0           return FALSE;
73             }
74              
75             }
76              
77 2     2   4377 no Moo::Role;
  2         4  
  2         16  
78              
79             1;
80              
81             __END__
82              
83             =pod
84              
85             =encoding UTF-8
86              
87             =head1 NAME
88              
89             App::Midgen::Roles::InDistribution - used by L<App::Midgen>
90              
91             =head1 VERSION
92              
93             version: 0.33_05
94              
95             =head1 METHODS
96              
97             =over 4
98              
99             =item * is_perlfile
100              
101             Used to find perl files in your distribution to scan.
102              
103             =back
104              
105             =head1 AUTHOR
106              
107             See L<App::Midgen>
108              
109             =head2 CONTRIBUTORS
110              
111             See L<App::Midgen>
112              
113             =head1 COPYRIGHT
114              
115             See L<App::Midgen>
116              
117             =head1 LICENSE
118              
119             This library is free software; you can redistribute it and/or modify
120             it under the same terms as Perl itself.
121              
122             =cut
123              
124              
125              
126              
127              
128              
129              
130              
131              
132