view release on metacpan or  search on metacpan

t/cme-command.t  view on Meta::CPAN

use strict;
use warnings;
use utf8;
use v5.20;
use open ':std', ':encoding(utf8)';

use Encode;

use Path::Tiny 0.125;
use Term::ANSIColor 2.01 qw(colorstrip);

use Test::More;
use Test::File::Contents;

# used by "foreach loop" test to find test script
use lib 't/lib';

use App::Cmd::Tester;
use App::Cme ;
use Config::Model 2.148 qw/initialize_log4perl/;

# WARNING: these tests check the output of cme command. This output is
# created with Log4Perl to User class with INFO level.
# if present, ~/.log4config-model must contain the lines:
#     log4perl.logger.User = INFO, PlainMsgOnScreen
#     log4perl.additivity.User = 0

# work around a problem in IO::TieCombine (used by App::Cmd::Tester)
# to avoid messing up output of stderr of tested command (See
# ACHTUNG!! notes in IO::TieCombine doc)
$\ = '';

if ( $^O !~ /linux|bsd|solaris|sunos/ ) {
    plan skip_all => "Test with system() in build systems don't work well on this OS ($^O)";
}

my $arg = shift || '';
my ( $log, $show ) = (0) x 2;

my $trace = $arg =~ /t/ ? 1 : 0;

Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;

## testing exit status

# pseudo root where config files are written by config-model
my $wr_root = path('wr_root');

# cleanup before tests
$wr_root -> remove_tree;

my $test1     = 'popcon1';
my $wr_dir    = $wr_root->child($test1);

my $conf_dir = $wr_dir->child('/etc');
$conf_dir->mkpath;

my $conf_file = $conf_dir->child("popularity-contest.conf");
# created with -backup option
my $backup_file = $conf_dir->child("popularity-contest.conf.old");

subtest "list command" => sub {
    my @test_cmd = qw/list/;
    my $result = test_app( 'App::Cme' => \@test_cmd );
    say "-- stdout --\n", $result->stdout,"-----"  if $trace;
    is($result->error, undef, 'threw no exceptions');
};

subtest "foreach option" => sub {
    my @t_dirs = map {$wr_root->child($_)} qw/for1 for2 for3/;
    foreach my $d (@t_dirs) {
        $d->remove_tree;
        $d->mkdir;
    }
    my @test_cmd = (qw!run t/lib/Config/Model/scripts/cme-test!,
                    '--model-dir' => path("t/lib/Config/Model/models/")->absolute->stringify,
                    '--foreach' => join(' ', @t_dirs));
    my $ok = test_app( 'App::Cme' => \@test_cmd );
    is( $ok->error, undef, 'threw no exceptions');
    print $ok->stdout if $trace;
    is( $ok->exit_code, 0, 'all went well' ) or diag("Failed command @test_cmd");

    foreach my $d (@t_dirs) {
        my $t_file = $d->child('cme-test.yml');
        file_contents_like $t_file->stringify,   qr/test ok/, "check $t_file" ;
    }
};

subtest "modification without config file" => sub {
    my $test_cmd = [
        qw/modify popcon/,
        '-root-dir' => $wr_dir->stringify,
        "PARTICIPATE=yes"
    ];

    my $oops = test_app( 'App::Cme' => $test_cmd );
    is ($oops->exit_code, 2, 'error detected' );
    like($oops->error, qr/cannot find configuration file/, 'missing config file detected' );
};

# put popcon data in place
my @orig = <DATA>;

$conf_file->spew_utf8(@orig);

subtest "check" => sub {
    # use -save to force a file save to update file header
    my @test_cmd = (qw/check popcon -root-dir/, $wr_dir->stringify);
    my $ok = test_app( 'App::Cme' => \@test_cmd );
    is( $ok->exit_code, 0, 'all went well' ) or diag("Failed command @test_cmd");
    is($ok->stderr.'', '', 'check: no log on stderr' );
    is($ok->stdout.'', '', 'check: no message on stdout' );
};

subtest "check verbose mode" => sub {
    # use -save to force a file save to update file header
    my @test_cmd = (qw/check popcon --verbose -root-dir/, $wr_dir->stringify);
    my $ok = test_app( 'App::Cme' => \@test_cmd );
    is( $ok->exit_code, 0, 'all went well' ) or diag("Failed command @test_cmd");
    is($ok->stderr.'', '', 'check: no log on stderr' );
    is($ok->stdout.'', "Loading data...\nChecking data..\nCheck done.\n" ,
       'check: got messages on stdout' );
};

subtest "minimal modification" => sub {
    $conf_file->spew_utf8(@orig);
    # test minimal modif (re-order)
    my @test_cmd = (qw/modify popcon -save -backup -canonical -root-dir/, $wr_dir->stringify);
    my $ok = test_app( 'App::Cme' => \@test_cmd );
    is ($ok->exit_code, 0, 'all went well' ) or diag("Failed command cme @test_cmd");
    is($ok->error, undef, 'threw no exceptions');
    is($ok->stderr.'', '', 'modify: no log on stderr' );
    is($ok->stdout.'', '', 'modify: no message on stdout' );

    file_contents_like $conf_file->stringify,   qr/cme/,       "updated header";
    file_contents_like $conf_file->stringify, qr/yes"\nMY/, "reordered file";
    file_contents_unlike $conf_file->stringify, qr/removed/,   "double comment is removed";

    # check backup
    ok($backup_file->is_file, "backup file was created");
    file_contents_like $backup_file->stringify, qr/should be removed/, "backup file contains original comment";
};

subtest "modification with wrong parameter" => sub {
    $conf_file->spew_utf8(@orig);
    my @test_cmd = (qw/modify popcon -root-dir/, $wr_dir->stringify, qq/PARITICIPATE=yes/);
    my $oops = test_app( 'App::Cme' => \@test_cmd );
    isnt ($oops->exit_code, 0, 'error detected' );
    like($oops->error.'' , qr/object/, 'check unknown element' );
    isnt( $oops->exit_code, 0, 'wrong parameter detected' );

};

subtest "modification with good parameter" => sub {
    $conf_file->spew_utf8(@orig);
    # use -save to force a file save to update file header
    my @test_cmd = (qw/modify popcon -save -root-dir/, $wr_dir->stringify, qq/PARTICIPATE=yes/);
    my $ok = test_app( 'App::Cme' => \@test_cmd );
    is( $ok->exit_code, 0, 'all went well' ) or diag("Failed command @test_cmd");
    is($ok->stderr.'', '', 'modify: no log on stderr' );
    is($ok->stdout.'', '', 'modify: no message on stdout' );
    file_contents_like $conf_file->stringify,   qr/cme/,      "updated header";
    file_contents_unlike $conf_file->stringify, qr/removed`/, "double comment is removed";
};

subtest "modification with verbose option" => sub {
    $conf_file->spew_utf8(@orig);
    my @test_cmd = (qw/modify popcon -verbose -root-dir/, $wr_dir->stringify, qq/PARTICIPATE=yes/);
    my $ok = test_app( 'App::Cme' => \@test_cmd );
    is ($ok->exit_code, 0, 'no error detected' ) or diag("Failed command @test_cmd");
    is(colorstrip($ok->stderr), qq!command 'PARTICIPATE=yes': Setting leaf 'PARTICIPATE' boolean to 'yes'.\n!,
       'check log content' );
};

subtest "search" => sub {
    my @test_cmd = (qw/search popcon -root-dir/, $wr_dir->stringify, qw/-search y -narrow value/);
    my $search = test_app( 'App::Cme' => \@test_cmd );
    is( $search->error, undef, 'threw no exceptions');
    is( $search->exit_code, 0, 'search went well' ) or diag("Failed command @test_cmd");
    like( $search->stdout, qr/PARTICIPATE/, "got PARTICIPATE" );
    like( $search->stdout, qr/USEHTTP/,     "got USEHTTP" );
};

subtest "modification with utf8 parameter" => sub {
    $conf_file->spew_utf8(@orig);
    my $utf8_name = "héhôßœ";
    my @test_cmd = ((qw/modify popcon -root-dir/, $wr_dir->stringify),
        encode('UTF-8',qq/MY_HOSTID="$utf8_name"/) );
    my $ok = test_app( 'App::Cme' => \@test_cmd );
    is( $ok->error, undef, 'threw no exceptions');
    is( $ok->exit_code, 0, 'all went well' ) or diag("Failed command @test_cmd");

    file_contents_like $conf_file->stringify,   qr/$utf8_name/,
        "updated MY_HOSTID with weird utf8 hostname" ,{ encoding => 'UTF-8' };
};

subtest "migrate" => sub {
    $conf_file->spew_utf8(@orig);
    my @test_cmd = (qw/migrate popcon -root-dir/, $wr_dir->stringify );
    my $ok = test_app( 'App::Cme' => \@test_cmd );
    is( $ok->error, undef, 'threw no exceptions');