File Coverage

blib/lib/Syntax/Check.pm
Criterion Covered Total %
statement 76 80 95.0
branch 33 46 71.7
condition 4 6 66.6
subroutine 14 15 93.3
pod 2 2 100.0
total 129 149 86.5


line stmt bran cond sub pod time code
1             package Syntax::Check;
2              
3 3     3   283356 use warnings;
  3         27  
  3         105  
4 3     3   16 use strict;
  3         5  
  3         68  
5 3     3   14 use feature 'say';
  3         5  
  3         313  
6              
7 3     3   21 use Carp qw(croak confess);
  3         6  
  3         172  
8 3     3   648 use Data::Dumper;
  3         6978  
  3         179  
9 3     3   22 use Exporter qw(import);
  3         5  
  3         108  
10 3     3   21 use File::Path qw(make_path);
  3         6  
  3         175  
11 3     3   756 use File::Temp qw(tempdir);
  3         22111  
  3         174  
12 3     3   1721 use PPI;
  3         336818  
  3         406  
13              
14             our $VERSION = '1.04';
15              
16             my $SEPARATOR;
17              
18             BEGIN {
19 3 50   3   38 if ($^O =~ /^(dos|os2)/i) {
    50          
20 0         0 $SEPARATOR = '\\';
21             } elsif ($^O =~ /^MacOS/i) {
22 0         0 $SEPARATOR = ':';
23             } else {
24 3         2685 $SEPARATOR = '/';
25             }
26             }
27              
28             sub new {
29 7     7 1 35266 my ($class, %p) = @_;
30              
31 7 100 66     204 if (! exists $p{file} || ! -f $p{file}) {
32 1         197 croak "new() requires a file name as its first parameter";
33             }
34              
35 6         55 my $self = bless {%p}, $class;
36              
37 6         42 return $self;
38             }
39             sub check {
40 6     6 1 41 my ($self) = @_;
41              
42 6         183 my $doc = PPI::Document->new($self->{file});
43              
44 6         36918 my $includes = $doc->find('PPI::Statement::Include');
45              
46 6         7642 for my $include (@$includes) {
47              
48 34         202 my $module = $include->module;
49 34         989 my $package = $module;
50              
51 34 100       101 if ($module eq lc $module) {
52             # Skip pragmas
53 12 100       479 say "Skipping assumed pragma '$module'" if $self->{verbose};
54 12         38 next;
55             }
56              
57 22 50       87 next if $module =~ /^Carp/;
58              
59 22         93 $module =~ s|::|/|g;
60              
61 22 100       148 if (my ($dir, $file) = $module =~ m|^(.*)/(.*)$|) {
62 20         47 $file .= '.pm';
63 20         47 my $path = "$dir/$file";
64              
65 20 100       48 if (_module_installed($package)) {
66             # Skip includes that are actually installed
67 5 100       44 say "Skipping available module '$package'" if $self->{verbose};
68 5         17 next;
69             }
70             else {
71 15         43 $self->_create_lib_dir;
72              
73 15 50       292 if (! -d "$self->{lib}/$dir") {
74             # Create the module directory structure
75 15 50       2944 make_path("$self->{lib}/$dir") or die $!;
76             }
77              
78 15 50       397 if (! -f "$self->{lib}/$path") {
79             # Create the module file
80 15 50       915 open my $wfh, '>', "$self->{lib}/$path" or die $!;
81 15         135 print $wfh '1;';
82 15 50       521 close $wfh or die $!;
83             }
84             }
85             }
86             else {
87             # Single-word module, ie. no directory structure
88 2         8 $self->_create_lib_dir;
89              
90 2         8 my $module_file = "$module.pm";
91 2 50       42 if (! -f "$self->{lib}/$module_file") {
92             # Create the module file
93 2 50       110 open my $wfh, '>', "$self->{lib}/$module_file" or die $!;
94 2         23 print $wfh '1;';
95 2 50       64 close $wfh or die $!;
96             }
97             }
98             }
99              
100 6 50       38 if (! $self->{lib}) {
101 0         0 `perl -c $self->{file}`;
102             }
103             else {
104 6         154644 `perl -I$self->{lib} -c $self->{file}`;
105             }
106             }
107             sub _create_lib_dir {
108 17     17   34 my ($self) = @_;
109 17 100 66     266 if (! exists $self->{lib} || ! -d $self->{lib}) {
110 6 100       26 $self->{cleanup} = exists $self->{keep} ? ! $self->{keep} : 1;
111 6         60 $self->{lib} = tempdir(CLEANUP => $self->{cleanup});
112 6 100       2983 say "Created temp lib dir '$self->{lib}'" if $self->{verbose};
113             }
114             }
115             sub _module_installed {
116 20     20   36 my ($name) = @_;
117              
118 20         48 my $name_pm;
119              
120 20 50       97 if ($name =~ /\A\w+(?:::\w+)*\z/) {
121 20         87 ($name_pm = "$name.pm") =~ s!::!$SEPARATOR!g;
122             } else {
123 0         0 $name_pm = $name;
124             }
125              
126 20 100       95 return 1 if exists $INC{$name_pm};
127             }
128       0     sub __placeholder {}
129              
130             1;
131             __END__