Zabbix

#!/usr/bin/env perl

​

use strict;

use warnings;

​

use YAML::XS qw(LoadFile Dump);

use Path::Tiny qw(path);

use IPC::Run3 qw(run3);

use Time::HiRes qw(time);

use File::Basename qw(dirname);

use Getopt::Long qw(GetOptions);

use Cwd qw(getcwd);

use Pod::Usage;

​

use constant TEST_SUITE_ATTRIBUTES  => ('name', 'tests', 'skipped', 'errors', 'failures', 'time');

use constant TEST_CASE_ATTRIBUTES   => ('name', 'assertions', 'time');

​

use constant TEST_CASE_HEADER_FORMAT    => " %*s │ %-7s │ %s\n";

use constant TEST_CASE_FORMAT       => " %*d │ %-7s │ %s\n";

use constant TEST_SUITE_HEADER_FORMAT   => " %-*s │ %9s │ %7s │ %6s │ %8s │ %5s\n";

use constant TEST_SUITE_FORMAT      => " %-*s │ %9d │ %7d │ %6d │ %8d │ %5.2f\n";

use constant TEST_SUITE_PATTERN     => qr/^( [a-zA-Z0-9_:]+\b\D*)(\d+)(\D*)(\d+)(\D*)(\d+)(\D*)(\d+)(.*)$/;

​

sub escape_xml_entity($)

{

    my $entity = shift;

​

    $entity =~ s/&/&/g;

    $entity =~ s/</&lt;/g;

    $entity =~ s/>/>/g;

​

    return $entity;

}

​

sub escape_xml_attribute($)

{

    my $attribute = escape_xml_entity(shift);

​

    $attribute =~ s/'/'/g;

    $attribute =~ s/"/"/g;

​

    return $attribute;

}

my $valgrind = 0;

sub launch($$$)

{

    my $test_suite = shift;

    my $test_exec = shift;

    my $test_data = shift;

​

    my $start = time();

​

    $test_suite->{'tests'}++;

​

    my $test_case = {

        'name'      => $test_data->{'test case'} // "N/A",

        'assertions'    => 0

    };

​

    utf8::encode($test_case->{'name'});

​

    if (path($test_exec)->is_file)

    {

        my $in = Dump($test_data);

        my $out;

        my $err;

​

        my($path, $filename) = $test_exec =~ m{(.+)/([^/]+)$};

​

        if ($path ne '.')

        {

            my $current_dir = getcwd();

            chdir $path;

            if ($valgrind)

            {

                print $test_case->{'name'} . "\n";

                eval {run3('valgrind --track-origins=yes --leak-check=yes --read-var-info=yes --leak-resolution=high ./' . $filename, \$in, \$out, \$err)};

                print $err;

            }

            else

            {

                eval {run3('./' . $filename, \$in, \$out, \$err)};

            }

​

            chdir $current_dir;

        }

        else

        {

            eval {run3($test_exec, \$in, \$out, \$err)};

        }

​