contrib-munin/t/test.t

# -*- perl -*-

use strict;
use warnings;

use Test::More;
use File::Find ();
use Capture::Tiny ':all';

use vars qw/*name *dir *prune/;
*name  = *File::Find::name;
*dir   = *File::Find::dir;
*prune = *File::Find::prune;
my $num_plugins = 0;

sub wanted {
    my ( $dev, $ino, $mode, $nlink, $uid, $gid, $interpreter, $arguments );

    ( ( $dev, $ino, $mode, $nlink, $uid, $gid ) = lstat($_) )
        && -f _
        && ( ( $interpreter, $arguments ) = hashbang("$_") )
        && ($interpreter)
        && ++$num_plugins
        && process_file( $_, $name, $interpreter, $arguments );
}

File::Find::find( { wanted => \&wanted }, 'plugins' );

sub hashbang {
    my ($filename) = @_;
    open my $file, '<', $filename;
    my $firstline = <$file>;
    close $file;

    $firstline =~ m{ ^\#!                    # hashbang
                     \s*                     # optional space
                     (?:/usr/bin/env\s+)?    # optional /usr/bin/env
                     (?<interpreter>\S+)     # interpreter
                     (?:\s+
                         (?<arguments>[^\n]*)   # optional interpreter arguments
                     )?
               }xms;

    return ( $+{interpreter}, $+{arguments} );
}

sub process_file {
    my ( $file, $filename, $interpreter, $arguments ) = @_;
    use v5.10.1;

    if ( ! -x $file ) {
        # missing executable flag
        diag(
            sprintf("\nFile '%s' lacks executable permission bits. Maybe try 'chmod +x $file'?\n",
                    $file)
        );
    }
    elsif ( $interpreter =~ m{/bin/sh} ) {
        subtest $filename => sub {
            plan tests => 2;
            run_check(
                {   command     => [ 'sh', '-n', $file ],
                    description => 'sh syntax check'
                }
            );
            my $checkbashisms_location = `command -v checkbashisms 2>/dev/null`;
            chomp($checkbashisms_location);
            my $command;
            if ($checkbashisms_location ne "") {
                # monkey-patch "checkbashisms" in order to allow "command -v"
                # see https://unix.stackexchange.com/a/85250: "command -v" vs. which/hash/...
                # see https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=733511
                my $run_modified_checkbashisms = q/sed 's#command\\\s+-\[\^p\]#command\s+-[^pvV]#'/
                    . " '$checkbashisms_location' | perl - '$file'";
                $command = [ 'sh', '-c', $run_modified_checkbashisms ];
            } else {
                # make sure that the non-confusing "checkbashisms not found" message is displayed
                $command = [ 'checkbashisms', $file ];
            }
            run_check(
                {   command     => $command,
                    description => 'checkbashisms'
                }
            );
        };
    }
    elsif ( $interpreter =~ m{/bin/ksh} ) {
        subtest $filename => sub {
            plan tests => 2;
            run_check(
                {   command     => [ 'ksh', '-n', $file ],
                    description => 'ksh syntax check',
                    filename    => $filename
                }
            );
            run_check(
                {   command     => [ 'shellcheck', $file ],
                    description => 'shellcheck'
                }
            );
        }
    }
    elsif ( $interpreter =~ m{bash} ) {
        run_check(
            {   command     => [ 'bash', '-n', $file ],
                description => 'bash syntax check',
                filename    => $filename
            }
        );
    }
    elsif ( $interpreter =~ m{/bin/zsh} ) {
        run_check(
            {   command     => [ 'zsh', '-n', $file ],
                description => 'zsh syntax check',
                filename    => $filename
            }
        );
    }
    elsif ( $interpreter =~ m{perl} ) {
        my $command;
        if ( $arguments =~ m{-.*T}mx ) {
            $command = [ 'perl', '-cwT', $file ];
        }
        else {
            $command = [ 'perl', '-cw', $file ];
        }
        run_check(
            {   command     => $command,
                description => 'perl syntax check',
                filename    => $filename
            }
        );
    }
    elsif ( $interpreter =~ m{python3} ) {
        run_check(
            {   command     => [ 'python3', '-m', 'py_compile', $file ],
                description => 'python3 compile',
                filename    => $filename
            }
        );
    }
    elsif ( $interpreter =~ m{python} ) {
        run_check(
            {   command     => [ 'python', '-m', 'py_compile', $file ],
                description => 'python compile',
                filename    => $filename
            }
        );
    }
    elsif ( $interpreter =~ m{php} ) {
        run_check(
            {   command     => [ 'php', '-l', $file ],
                description => 'php syntax check',
                filename    => $filename
            }
        );
    }
    elsif ( $interpreter =~ m{j?ruby} ) {
        run_check(
            {   command     => [ 'ruby', '-cw', $file ],
                description => 'ruby syntax check',
                filename    => $filename
            }
        );
    }
    elsif ( $interpreter =~ m{gawk} ) {
        run_check(
            {   command => [
                    'gawk', '--source', 'BEGIN { exit(0) } END { exit(0) }',
                    '--file', $file
                ],
                description => 'gawk syntax check',
                filename    => $filename
            }
        );
    }
    elsif ( $interpreter =~ m{expect} ) {
    SKIP: {
            skip 'no idea how to check expect scripts', 1;
            pass("No pretending everything is ok");
        }
    }
    else {
        fail( $filename . " unknown interpreter " . $interpreter );
    }
}

sub run_check {
    my ($args)        = @_;
    my $check_command = $args->{command};
    my $description   = $args->{description};
    my $filename      = $args->{filename};

    my $message;

    if ($filename) {
        $message = sprintf( '%s: %s', $filename, $description );
    }
    else {
        $message = $description;
    }

    my ( $stdout, $stderr, $exit ) = capture {
        system( @{$check_command} );
    };

    ok( ( $exit == 0 ), $message );

    if ($exit) {
        diag(
            sprintf(
                "\nCommand: %s\n\nSTDOUT:\n\n%s\n\nSTDERR:\n\n%s\n\n",
                join( " ", @{$check_command} ),
                $stdout, $stderr
            )
        );
    }
}

done_testing($num_plugins);