App-Cme
view release on metacpan or search on metacpan
A sample of a C<.log4config-model> is provided in contrib directory in C<Config::Model>
distribution of on L<github|https://github.com/dod38fr/config-model/blob/master/contrib/log4config-model>
Without these files, the following Log4perl config is used:
log4perl.rootLogger=WARN, Screen
log4perl.logger.Model.Legacy = INFO, SimpleScreen
log4perl.additivity.Model.Legacy = 0
log4perl.appender.Screen = Log::Log4perl::Appender::Screen
log4perl.appender.Screen.stderr = 0
log4perl.appender.Screen.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.Screen.layout.ConversionPattern = %M %m (line %L)%n
log4perl.appender.SimpleScreen = Log::Log4perl::Appender::Screen
log4perl.appender.SimpleScreen.stderr = 0
log4perl.appender.SimpleScreen.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.SimpleScreen.layout.ConversionPattern = %p: %m%n
log4perl.oneMessagePerAppender = 1
Log4perl uses the following categories:
=over
=item Anything
t/cme-command.t view on Meta::CPAN
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 containt 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;
t/cme-command.t view on Meta::CPAN
# 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";
# with perl 5.14 5.16, IO::Handle writes an extra \n with print.
my $re = $^V lt 5.18.1 ? qr/yes"\n+MY/ : qr/yes"\nMY/;
file_contents_like $conf_file->stringify, $re, "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");
t/cme-command.t view on Meta::CPAN
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" );
t/cme-command.t view on Meta::CPAN
Changes applied to popcon configuration:
- MY_HOSTID: 'aaaaaaaaaaaaaaaaaaaa' -> '$namefoobar'
EOF
my @script_tests = (
{
label => __LINE__.": modification with a script and args",
script => [ "app: popcon", 'load ! MY_HOSTID=\$name$name'],
args => [qw!--arg name=foobar!],
test => qr/"\$namefoobar"/,
stderr => $expect_namefoobar,
},
{
label => __LINE__.": modification with a script and args",
script => [ "# Format: YAML", "---", "app: popcon", 'load: |-', ' ! MY_HOSTID=\$name$name'],
args => [qw!--arg name=foobar!],
test => qr/"\$namefoobar"/,
stderr => $expect_namefoobar,
},
{
label => "line ".__LINE__.": modification with a script and a default value",
script => [ "app: popcon", "default: name foobar", 'load ! MY_HOSTID=\$name$name'],
test => qr/"\$namefoobar"/,
stderr => $expect_namefoobar,
},
{
label => "line ".__LINE__.": modification with a script and a var that uses a default value",
script => [ "app: popcon",
"default: defname foobar",
'var: $var{name} = $args{defname}',
'load ! MY_HOSTID=\$name$name'
],
test => qr/"\$namefoobar"/,
stderr => $expect_namefoobar,
},
{
label => "line ".__LINE__.": modification with a YAML script and a var that uses a default value",
script => [
"# Format: YAML",
"---",
"app: popcon",
"default: ",
" defname: foobar",
'var: "$var{name} = $args{defname}"',
'load: "! MY_HOSTID=\\\\$name$name"'
],
test => qr/"\$namefoobar"/,
stderr => $expect_namefoobar
},
{
label => "line ".__LINE__.": quiet modification with a script and var section",
script => [ "app: popcon", 'var: $var{name}="foobar2"','load ! MY_HOSTID=\$name$name'],
test => qr/"\$namefoobar2"/,
args => ['-quiet'],
},
{
label => "line ".__LINE__.": modification with a script and var section which uses args",
script => [ "app: popcon", 'var: $var{name}=$args{fooname}."bar2"','load ! MY_HOSTID=\$name$name'],
args => [qw/--arg fooname=foo/],
test => qr/"\$namefoobar2"/,
stderr => q(
Changes applied to popcon configuration:
- MY_HOSTID: 'aaaaaaaaaaaaaaaaaaaa' -> '$namefoobar2'
)
},
{
label => "line ".__LINE__.": modification with a script with load =~ regex and quotes and \\s",
script => [
"app: popcon",
'---var',
'$var{change_it} = qq{',
'( s/^(a)a+/', # comment
'\$1.\\"$args{fooname}\\" x2',
'/xe )}',
'---',
'load: ! MY_HOSTID=~"$change_it"',
],
args => [qw/--arg fooname=foo/],
test => qr/MY_HOSTID="afoofoo"/,
stderr => q(
Changes applied to popcon configuration:
- MY_HOSTID: 'aaaaaaaaaaaaaaaaaaaa' -> 'afoofoo'
)
},
{
label =>"line ". __LINE__.": modification with a Perl script run by cme run with args",
script => [
"#!/usr/bin/env perl",
"use Config::Model qw(cme);",
'my ($opt,$val,$name) = @ARGV;',
'cme(application => "popcon", root_dir => $val)->modify("! MY_HOSTID=\$name$name");'
],
args => ['foobar3'],
test => qr/"\$namefoobar3"/,
exec_mode => 1,
stderr => q(
Changes applied to popcon configuration:
- MY_HOSTID: 'aaaaaaaaaaaaaaaaaaaa' -> '$namefoobar3'
)
},
{
label => "line ".__LINE__.": modification with a script and var section which uses regexp and capture",
script => [
"app: popcon",
'load: ! MY_HOSTID=aaaaab MY_HOSTID=~s/(a{$times})/$1x$times/',
],
args => [qw/--arg times=4 --verbose/],
test => qr/aaaax4ab/,
stderr => q[command '!': Going from root node to root node
command 'MY_HOSTID=aaaaab': Setting leaf 'MY_HOSTID' uniline to 'aaaaab'.
command 'MY_HOSTID=~s/(a{4})/$1x4/': Applying regexp 's/(a{4})/$1x4/' to leaf 'MY_HOSTID' uniline. Result is 'aaaax4ab'.
Changes applied to popcon configuration:
- MY_HOSTID: 'aaaaaaaaaaaaaaaaaaaa' -> 'aaaaab'
- MY_HOSTID: 'aaaaab' -> 'aaaax4ab'
],
},
{
label => "line ".__LINE__.": modification with a script with code",
script => [
"app: popcon",
'---code',
q!$root->fetch_element('MY_HOSTID')->store($to_store);!,
'---',
],
args => [qw/--arg to_store=with_code/],
test => qr/MY_HOSTID="with_code"/,
stderr => q(
Changes applied to popcon configuration:
- MY_HOSTID: 'aaaaaaaaaaaaaaaaaaaa' -> 'with_code'
)
},
{
label => "line ".__LINE__.": modification with a script with Perl format",
script => [
<<'EOS'
# Format:perl
{
app => 'popcon',
sub => sub ($root, $arg ) { $root->fetch_element('MY_HOSTID')->store($arg->{to_store}); },
};
EOS
],
args => [qw/--arg to_store=with_code/],
test => qr/MY_HOSTID="with_code"/,
stderr => q(
Changes applied to popcon configuration:
- MY_HOSTID: 'aaaaaaaaaaaaaaaaaaaa' -> 'with_code'
)
},
);
# test cme run real script with arguments
my $i=0;
foreach my $test ( @script_tests) {
t/cme-command.t view on Meta::CPAN
'-root-dir' => $wr_dir->stringify,
@{$test->{args} // []}
];
note("cme command: cme @$cmd");
my $ok = test_app('App::Cme' => $cmd);
is( $ok->error, undef, 'threw no exceptions');
is( $ok->exit_code, 0, "all went well" ) or diag("Failed command: @$cmd");
file_contents_like $conf_file->stringify, $test->{test},
"updated MY_HOSTID with script" ,{ encoding => 'UTF-8' };
is(colorstrip($ok->stderr), $test->{stderr} || '', 'run "'.$test->{label}.'" stderr content' );
is(colorstrip($ok->stdout.''), $test->{stdout} || '', 'run "'.$test->{label}.'": stdout content' );
};
}
# test failure case for run script
my @bad_script_tests = (
{
label => "line ".__LINE__.": missing app",
script => [ 'load ! MY_HOSTID=dontcare'],
args => [],
( run in 0.530 second using v1.01-cache-2.11-cpan-49f99fa48dc )