The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::Siebel::Srvrmgr::Daemon::Heavy;

use Cwd;
use Test::Most;
use File::Spec;
use Test::Moose 'has_attribute_ok';
use Siebel::Srvrmgr::Daemon::Heavy;
use Config;
use parent 'Test::Siebel::Srvrmgr::Daemon';
use Siebel::Srvrmgr;

sub class_methods : Test(+1) {

    my $test = shift;

    $test->SUPER::class_methods();

    can_ok(
        $test->{daemon},
        (
            'get_commands',     'set_commands',
            'get_bin',          'set_bin',
            'get_write',        'get_read',
            'get_last_cmd',     'get_cmd_stack',
            'get_params_stack', 'get_buffer_size',
            'set_buffer_size',  'get_prompt',
            '_set_prompt',      '_create_child',
            '_process_stderr',  '_process_stdout',
            '_check_error',     '_check_child',
            '_submit_cmd',      'close_child',
            'has_pid',          'clear_pid',
            '_manage_handlers'
        )
    );

}

sub class_attributes : Tests(no_plan) {

    my $test = shift;

    my @attribs = (
        'write_fh',       'read_fh',
        'child_pid',      'last_exec_cmd',
        'cmd_stack',      'params_stack',
        'action_stack',   'ipc_buffer_size',
        'srvrmgr_prompt', 'read_timeout',
        'child_pid'
    );

    $test->SUPER::class_attributes( \@attribs );

}

sub runs : Tests(+10) {

    my $test = shift;

    $test->SUPER::runs();

    ok( $test->{daemon}->run(), 'run method executes successfuly' );

    my $lock_file = $test->{daemon}->get_lock_file;
    $test->{lock_file} = $lock_file;    # see the_last_run

    is( $test->{daemon}->get_child_runs(),
        1, 'get_child_runs returns the expected number' );

    my $shifted_cmd;
    ok( $shifted_cmd = $test->{daemon}->shift_commands(),
        'shift_command works' );
    isa_ok( $shifted_cmd, 'Siebel::Srvrmgr::Daemon::Command' );
    ok( $test->{daemon}->shift_commands(), 'shift_command works' );
    ok( $test->{daemon}->shift_commands(), 'shift_command works' );

    ok( $test->{daemon}->run(), 'run method executes successfuly (2)' );
    is( $test->{daemon}->get_child_runs(),
        2, 'get_child_runs returns the expected number' );
    ok( $test->{daemon}->run(), 'run method executes successfuly (3)' );
    is( $test->{daemon}->get_child_runs(),
        3, 'get_child_runs returns the expected number' );

}

sub runs_much_more : Tests(60) {

    my $test = shift;

  SKIP: {

        skip 'Not a developer machine', 60
          unless ( $ENV{SIEBEL_SRVRMGR_DEVEL} );

        $test->{daemon}->set_commands(
            [
                Siebel::Srvrmgr::Daemon::Command->new(
                    command => 'load preferences',
                    action  => 'LoadPreferences'
                ),
                Siebel::Srvrmgr::Daemon::Command->new(
                    command => 'list comp type',
                    action  => 'ListCompTypes',
                    params  => ['dump1']
                ),
                Siebel::Srvrmgr::Daemon::Command->new(
                    command => 'list comp',
                    action  => 'ListComps',
                    params  => ['dump2']
                ),
                Siebel::Srvrmgr::Daemon::Command->new(
                    command => 'list comp def',
                    action  => 'ListCompDef',
                    params  => ['dump3']
                )
            ]
        );

        for ( 1 .. 60 ) {

            ok( $test->{daemon}->run(), 'run method executes successfuly' );

        }

    }

}

sub runs_with_stderr : Test(4) {

    my $test = shift;

    $test->{daemon}->set_commands(
        [
            Siebel::Srvrmgr::Daemon::Command->new(
                command => 'list complexquery',
                action  => 'Dummy'
            ),
        ]
    );

    ok( $test->{daemon}->run(), 'run executes OK' );
    ok(
        $test->_search_log_msg(qr/oh\sgod\,\snot\stoday/),
        'can find warn message in the log file'
    );

    $test->{daemon}->set_commands(
        [
            Siebel::Srvrmgr::Daemon::Command->new(
                command => 'list frag',
                action  => 'Dummy'
            ),
        ]
    );

    dies_ok { $test->{daemon}->run() } 'run dies due fatal error';
    ok(
        $test->_search_log_msg(
            qr/FATAL.*Could\snot\sfind\sthe\sSiebel\sServer/),
        'can find fatal message in the log file'
    );

}

sub _poke_child {

    my $test = shift;

    if (    ( defined( $test->{daemon}->get_pid() ) )
        and ( $test->{daemon}->get_pid() =~ /\d+/ ) )
    {

        unless ( kill 0, $test->{daemon}->get_pid() ) {

            return 0;

        }
        else {

            return 1;

        }

    }
    else {

        return 0;

    }

}

sub the_termination : Tests(4) {

    my $test   = shift;
    my $logger = Siebel::Srvrmgr->gimme_logger( $test->class() );

    ok( $test->{daemon}->close_child($logger),
        'close_child returns true (termined child process)' );
    is( $test->{daemon}->close_child($logger),
        0, 'close_child returns false since there is no PID anymore' );
    is( $test->{daemon}->has_pid(), '', 'has_pid returns false' );
    is( $test->_poke_child(),       0,  'child PID is no more' );

    $test->{daemon} = undef;

}

sub _search_log_msg {

    my $test      = shift;
    my $msg_regex = shift;
    my $found     = 0;

    open( my $in, '<', $test->{log_file} )
      or die 'Cannot read ' . $test->{log_file} . ': ' . $! . "\n";

    while (<$in>) {

        chomp();
        if (/$msg_regex/) {

            $found = 1;
            last;

        }

    }

    close($in) or die 'Cannot close ' . $test->{log_file} . ': ' . $! . "\n";

    return $found;

}

1;