File Coverage

bin/aep

Criterion	Covered	Total	%
statement	144	152	94.7
branch	24	38	63.1
condition	19	41	46.3
subroutine	20	20	100.0
pod			n/a
total	207	251	82.4

#!/usr/bin/env perl

# Core
use warnings;
use strict;
use utf8;
use v5.28;

# Experimental (stable)
use experimental 'signatures';

# External modules
use YAML::XS;
use Getopt::Long::Descriptive;
use POE qw(Session::PlainCall);

# Our modules
use App::aep;

# Debug
use Data::Dumper;
use Carp qw(cluck longmess shortmess);

STDOUT->autoflush(1);
STDERR->autoflush(1);

# Version of this software
our $VERSION = '0.013';

# Config defaults
my $opt_conf_def = { 'AEP_SOCKETPATH' => '/tmp/aep.sock', };

# Option specs
my @opt_desc = (
    'aep %o ',
    [
        'config-env',
        'Read config values from the environment only.',
        {
            'default' => 0,
        },
    ],
    [
        'config-file=s',
        'Read config from a config file only.',
        {
            'default'   => '$unset',
            'callbacks' => {
                'exists' => sub { _check_exists( shift ) },
            },
        },
    ],
    [
        'config-args',
        'Read config values from arguments only.',
        {
            'default' => 0,
        },
    ],
    [
        'config-merge',
        'Merge together env, file and args to generate a config.',
        {
            'default' => 1,
        },
    ],
    [
        'config-order=s',
        'The order to merge options together, comma separated, default is: env,file,args',
        {
            'default' => 'env,file,args',
        },
    ],
    [],
    [
        'env-prefix=s',
        'What prefix to look for aep config environmentals, default is AEP_',
        {
            'default' => 'AEP_',
        },
    ],
    [],
    [
        'command=s',
        'What to actually run within the container, default is print aes help.',
        {
            'default' => 'aep --help',
        }
    ],
    [
        'command-args=s',
        'The arguments to add to the command comma separated, default is nothing.',
        {
            'default' => "",
        },
    ],
    [ 'command-norestart', 'If the command exits then do not attempt to restart it.', ],
    [
        'command-restart=i',
        'If the command exits how many times to retry it, default 0. Set to -1 for infinite.',
        {
            'default'   => 0,
            'callbacks' => {
                'is_positive' => sub { _check_positive_number( shift ) },
            },
        },
    ],
    [
        'command-restart-delay=i',
        'The time in milliseconds to wait before retrying the command, default 1000',
        {
            'default' => 1000,
        },
    ],
    [],
    [
        'lock-server',
        'Act like a lock server, this means we will expect other apps to '
        . 'connect to us, we in turn will say when they should actually start, '
        . 'this is to counter-act race issues when starting multi image '
        . 'containers such as docker-compose, default: no',
        {
            'default' => 0,
        },
    ],
    [
        'lock-server-host=s',
        'What host to bind to, defaults to 0.0.0.0',
        {
            'default' => '0.0.0.0',
        },
    ],
    [
        'lock-server-port=i',
        'What port to bind to, defaults to 60000',
        {
            'default' => 60000,
        },
    ],
    [
        'lock-server-default=s',
        'If we get sent an ID we do not know, the default action to take. '
        . 'Valid options are: "ignore", "run" or "runlast" the default is ignore.',
        {
            'default' => 'ignore',
        },
    ],
    [
        'lock-server-order=s',
        'The list of ids and the order to allow them to run, '
        . 'comma separated. Use || for parallel groups, e.g.: db,redis1||redis2,nginx',
        {
            'default' => '',
        },
    ],
    [
        'lock-server-exhaust-action=s',
        'What to do when all clients in the order have started. '
        . 'Valid options: "exit", "idle", "restart", "execute". Default is idle.',
        {
            'default' => 'idle',
        },
    ],
    [],
    [
        'lock-client',
        'Become a lock client, this will mean your aep will connect to '
        . 'another aep to learn when it should run its command.',
        {
            'default' => 0,
        },
    ],
    [ 'lock-client-noretry', 'If the connection to a master fails, do not retry - overrides lock-client-retry', ],
    [
        'lock-client-retry=i',
        'If the connection to a master fails, do not fail retry n many times, '
        . 'if this is set to 0 it will retry infinately, defaults to: 3 (seconds)',
        {
            'default' => 3,
        },
    ],
    [
        'lock-client-retry-delay=i',
        'How long to wait before retrying, default 5 (seconds)',
        {
            'default' => 5,
        },
    ],
    [
        'lock-client-timeout=i',
        'Maximum seconds to wait for the lock server to send run. 0 = wait forever. Default 0.',
        {
            'default' => 0,
        },
    ],
    [
        'lock-transport=s',
        'Transport to use for lock client: tcp, unix, or auto (try TCP then Unix). Default auto.',
        {
            'default' => 'auto',
        },
    ],
    [],
    [
        'lock-client-host=s',
        'What host to connect to, defaults to: aep-master',
        {
            'default' => 'aep-master'
        },
    ],
    [
        'lock-client-port=i',
        'What port to connect to, defaults to 60000',
        {
            'default' => 60000,
        },
    ],
    [
        'lock-trigger=s',
        'Please read --help-config lock-trigger, default is: none:time:10000 (milliseconds)',
        {
            'default' => 'none:time:10000'
        },
    ],
    [
        'lock-id=s',
        'What ID we should say we are, mandatory when acting as a lock-client',
        {
            'default' => $$,
        },
    ],
    [],
    [
        'quiet',
        'Suppress informational output, only show errors.',
        {
            'default' => 0,
        },
    ],
    [
        'verbose',
        'Show detailed debug output including packet contents.',
        {
            'default' => 0,
        },
    ],
    [],
    [
        'help',
        'print usage message and exit',
        {
            'shortcircuit' => 1,
        },
    ],
    [
        'help-config=s',
        'print configuration examples for: config-env, config-files, '
        . 'config-arg, config-merge or lock-trigger eg: help-config config-env',
        {
            'shortcircuit' => 1,
        },
    ],
    [
        'docker-health-check',
        'Call this from docker-compose for a health report, returns an exit of 0(success) or 1(failure)',
        {
            'default' => 0,
        },
    ],
);
# Read in our options
my ( $opt, $usage ) = describe_options( @opt_desc );

if ( $opt->help )
{
    say $usage->text;
    exit 0;
}

# Define our main function that starts out perl POE kernel
sub main ( @args )
{
    my $options = {};

    # Default exit code of error
    my $exit_code   = 1;
    my $exit_reason = 'Unknown';

    # Create a function to handle setting exit
    my $exit_func = sub {
        my ( $code, $reason ) = @_;
        if   ( defined $code && $code =~ m#^\d+$# ) { $exit_code = $code }
        else                                        { $exit_code = 1 }
        if   ( defined $reason ) { $exit_reason = $reason }
        else                     { $reason      = 'Unknown' }
    };

    # Create an appropriate heap for our session
    my $func_map = _create_heap( $args[ 0 ], $args[ 1 ] );

    my $log_level = $opt->quiet ? 'quiet' : ( $opt->verbose ? 'verbose' : 'info' );
    $func_map->{ '_' }->{ 'log_level' } = $log_level;
    $func_map->{ '_' }->{ 'debug' }     = sub { _func_debug( $log_level, @_ ) };
    $func_map->{ '_' }->{ 'set_exit' }  = $exit_func;

    my $session = POE::Session::PlainCall->create(
        'package'   => 'App::aep',
        'ctor_args' => [ $options ],
        'heap'      => $func_map,
        'states'    => [
            qw(
                _start sig_int sig_term sig_chld sig_usr scheduler
                command_start command_stdout command_stderr command_close command_error
                lock_trigger_fire lock_trigger_connect lock_trigger_script
                lock_client_timeout_fire lock_client_timeout_cancel
            )
        ],
    );

    $poe_kernel->run();

    # Return an appropriate code and reason
    return ( $exit_code, $exit_reason );
}

sub _create_heap ( $opt, $usage )
{
    my $map = { '_' => {}, };
    $map->{ '_' }->{ 'opt' }     = $opt;
    $map->{ '_' }->{ 'usage' }   = $usage;
    $map->{ '_' }->{ 'default' } = $opt_conf_def;
    $map->{ '_' }->{ 'config' }  = {};

    # As it will be accessed a lot, keep a copy here
    my $env_prefix = $opt->env_prefix;

    # Collect appropriate environmental variables and stash them in the funcmap/heap
    foreach my $env_key ( keys %ENV )
    {
        my $env_val = $ENV{ $env_key };
        if ( $env_key =~ m{^\Q$env_prefix\E} )
        {
            $map->{ '_' }->{ 'aep' }->{ $env_key } = $env_val;
        }
        else
        {
            $map->{ '_' }->{ 'env' }->{ $env_key } = $env_val;
        }
    }

    # Process the resultant config by merging sources in the specified order
    my $merged = { %{ $opt_conf_def } };

    # Read config file if specified
    my $file_config = {};
    my $config_file = $opt->config_file;
    if ( defined $config_file && $config_file ne '$unset' && -e $config_file )
    {
        my $yaml_content = do {
            open my $fh, '<', $config_file or die "Cannot open config file '$config_file': $!";
            local $/;
            <$fh>;
        };
        $file_config = YAML::XS::Load( $yaml_content ) || {};
    }

    # Build source maps for merging
    my $sources = {
        'env'  => $map->{ '_' }->{ 'aep' } || {},
        'file' => $file_config,
        'args' => {},
    };

    # Use AEP_ prefixed env vars as config keys directly (preserve full key name)
    my $env_config = {};
    for my $key ( keys %{ $sources->{ 'env' } } )
    {
        $env_config->{ $key } = $sources->{ 'env' }->{ $key };
    }
    $sources->{ 'env' } = $env_config;

    # Determine merge order
    my $order_str = $opt->config_order || 'env,file,args';
    my @order = split( /,/, $order_str );

    # Apply sources in order (later overrides earlier)
    for my $source_name ( @order )
    {
        $source_name =~ s{^\s+|\s+$}{}g;
        my $source_data = $sources->{ $source_name } || {};
        for my $key ( keys %{ $source_data } )
        {
            $merged->{ $key } = $source_data->{ $key };
        }
    }

    $map->{ '_' }->{ 'config' } = $merged;

    return $map;
}

sub _check_exists ( $val )
{
    if ( $val ne '$unset' ) { return $val ? -e $val : undef }
    else                    { return 1 }
}

sub _check_positive_number ( $val )
{
    return ( $val >= 0 || $val == -1 ) ? 1 : undef;
}

# Show debug messages
# $log_level: 'quiet', 'info', or 'verbose' (global setting from --quiet/--verbose)
# $level: 'error', 'info', or 'debug' (per-message level, defaults to 'info')
sub _func_debug ( $log_level, $pipe, $line, $message, $level = 'info' )
{
    # Filter messages based on log level
    if ( $log_level eq 'quiet' && $level ne 'error' )
    {
        return;
    }
    if ( $log_level eq 'info' && $level eq 'debug' )
    {
        return;
    }
    # 'verbose' shows everything

    my @buffer;

    if ( $message && ref( $message ) eq 'HASH' )
    {

        # Fancy message - Add a default for lefttab (add more later)
        if ( $message->{ 'lines' } && ref( $message->{ 'lines' } ) eq 'ARRAY' )
        {

            # nothing to do, makes sense
            @buffer = @{ $message->{ 'lines' } };
        }
        else
        {
            # No idea what to do, re-pop it as dumper
            push @buffer, 'Unexpected multiline format log packet, using data::dumper';
            push @buffer, split( /\n/, Dumper( $message->{ 'lines' } ) );
        }
    }
    else
    {
        push @buffer, $message;
    }

    my $msg_first        = 1;
    my $left_buffer_size = 0;
    foreach my $out_msg ( @buffer )
    {
        if ( $msg_first++ == 1 )
        {
            my $msg_prefix = "AEP($pipe:$line) ";
            $left_buffer_size = length( $msg_prefix );
            say STDERR "\r$msg_prefix$out_msg";
        }
        else
        {
            say STDERR ' ' x $left_buffer_size, $out_msg;
        }
    }

    return;
}

# Call the main function with selected options
exit do
{
    my ( $exit_code, $exit_reason ) = main( $opt, $usage );

    if ( ( !defined $exit_code ) || ( $exit_code !~ m#^\d+$# ) || ( $exit_code > 255 ) || ( $exit_code < 0 ) )
    {
        $exit_code = 255;
    }

    my $final_log_level = $opt->quiet ? 'quiet' : ( $opt->verbose ? 'verbose' : 'info' );
    _func_debug(
        $final_log_level, 'STDERR', __LINE__,
        {
            'lines' => [ "Child exiting with: $exit_code", "Status: $exit_reason", 'Perl exception: ' . $!, ]
        }
    );

    $exit_code;
};

__END__