File Coverage

blib/lib/Test/Script/Shebang.pm

Criterion	Covered	Total	%
statement	60	60	100.0
branch	12	16	75.0
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	83	87	95.4

package Test::Script::Shebang;

use strict;
use warnings;
use 5.006_002;
our $VERSION = '0.02';

use File::Spec;
use Test::Builder;

my $tb = Test::Builder->new;
my $ok = 1;

sub import {
    my $self = shift;
    my $caller = caller;

    for my $func (qw/check_shebang check_shebang_from_dir/) {
        no strict 'refs';
        *{$caller."::".$func} = \&$func;
    }

    $tb->exported_to($caller);
    $tb->plan(@_);
}

sub check_shebang {
    my @files = @_;

    for my $file (@files) {
        unless (-f $file) {
            $tb->ok(0, $file);
            $tb->diag("$file dose not exists");
            next;
        }

        open my $fh, '<', $file or die "$file: $!";
        local $/ = "\n";
        chomp(my $line = <$fh>);
        close $fh or die "$file: $!";

        unless ($line =~ s/^\s*\#!\s*//) {
            $tb->ok(0, $file);
            $tb->diag("Not a shebang file: $file");
            next;
        }

        my ($cmd, $arg) = split ' ', $line, 2;
        $cmd =~ s|^.*/||;
        unless ($cmd =~ m{^perl(?:\z|[^a-z])}) {
            $tb->ok(0, $file);
            $tb->diag("$file is not perl script");
            next;
        }
        $tb->ok(1, $file);
    }

    return $ok;
}

sub check_shebang_from_dir {
    my @dirs = @_;

    for my $dir (sort @dirs) {
        unless (-d $dir) {
            $tb->ok(0, $dir);
            $tb->diag("$dir dose not exists");
            next;
        }

        opendir my $dh, $dir or die "$dir: $!";
        my @files = map { File::Spec->catfile($dir, $_) } grep !/^\.{1,2}$/, sort readdir $dh;
        closedir $dh or die "$dir: $!";

        local $Test::Builder::Level = $Test::Builder::Level + 1;
        $tb->ok(check_shebang(@files), $dir);
    }

    return $ok;
}

1;
__END__