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

package Syntax::Check;

use warnings;
use strict;
use feature 'say';

use Carp qw(croak confess);
use Data::Dumper;
use Exporter qw(import);
use File::Path qw(make_path);
use File::Temp qw(tempdir);
use PPI;

our $VERSION = '1.04';

my $SEPARATOR;

BEGIN {
    if ($^O =~ /^(dos|os2)/i) {
        $SEPARATOR = '\\';
    } elsif ($^O =~ /^MacOS/i) {
        $SEPARATOR = ':';
    } else {
        $SEPARATOR = '/';
    }
}

sub new {
    my ($class, %p) = @_;

    if (! exists $p{file} || ! -f $p{file}) {
        croak "new() requires a file name as its first parameter";
    }

    my $self = bless {%p}, $class;

    return $self;
}
sub check {
    my ($self) = @_;

    my $doc = PPI::Document->new($self->{file});

    my $includes = $doc->find('PPI::Statement::Include');

    for my $include (@$includes) {

        my $module = $include->module;
        my $package = $module;

        if ($module eq lc $module) {
            # Skip pragmas
            say "Skipping assumed pragma '$module'" if $self->{verbose};
            next;
        }

        next if $module =~ /^Carp/;

        $module =~ s|::|/|g;

        if (my ($dir, $file) = $module =~ m|^(.*)/(.*)$|) {
            $file .= '.pm';
            my $path = "$dir/$file";

            if (_module_installed($package)) {
                # Skip includes that are actually installed
                say "Skipping available module '$package'" if $self->{verbose};
                next;
            }
            else {
                $self->_create_lib_dir;

                if (! -d "$self->{lib}/$dir") {
                    # Create the module directory structure
                    make_path("$self->{lib}/$dir") or die $!;
                }

                if (! -f "$self->{lib}/$path") {
                    # Create the module file
                    open my $wfh, '>', "$self->{lib}/$path" or die $!;
                    print $wfh '1;';
                    close $wfh or die $!;
                }
            }
        }
        else {
            # Single-word module, ie. no directory structure
            $self->_create_lib_dir;

            my $module_file = "$module.pm";
            if (! -f "$self->{lib}/$module_file") {
                # Create the module file
                open my $wfh, '>', "$self->{lib}/$module_file" or die $!;
                print $wfh '1;';
                close $wfh or die $!;
            }
        }
    }

    if (! $self->{lib}) {
        `perl -c $self->{file}`;
    }
    else {
        `perl -I$self->{lib} -c $self->{file}`;
    }
}
sub _create_lib_dir {
    my ($self) = @_;
    if (! exists $self->{lib} || ! -d $self->{lib}) {
        $self->{cleanup} = exists $self->{keep} ? ! $self->{keep} : 1;
        $self->{lib} = tempdir(CLEANUP => $self->{cleanup});
        say "Created temp lib dir '$self->{lib}'" if $self->{verbose};
    }
}
sub _module_installed {
    my ($name) = @_;

    my $name_pm;

    if ($name =~ /\A\w+(?:::\w+)*\z/) {
        ($name_pm = "$name.pm") =~ s!::!$SEPARATOR!g;
    } else {
        $name_pm = $name;
    }

    return 1 if exists $INC{$name_pm};
}
sub __placeholder {}

1;
__END__