File Coverage

blib/lib/Amon2/Plugin/CLI.pm

Criterion	Covered	Total	%
statement	52	57	91.2
branch	9	14	64.2
condition	4	9	44.4
subroutine	11	13	84.6
pod	1	1	100.0
total	77	94	81.9

package Amon2::Plugin::CLI;
use strict;
use warnings;

use Plack::Util;
use Amon2::Util qw/add_method/;

my $CLI_OPT_KEY = '.'. __PACKAGE__;

sub init {
    my ($self, $c, $code_conf) = @_;

    if ($code_conf->{cli_opt_key}) {
        $CLI_OPT_KEY = $code_conf->{cli_opt_key};
    }

    my $run_method = $code_conf->{run_method} || 'run';

    my $getopt = $code_conf->{getopt} || [qw/:config posix_default no_ignore_case gnu_compat/];
    require Getopt::Long;
    Getopt::Long->import(@{$getopt});

    add_method($c => $run_method, sub {
        my ($c, $arg) = @_;

        eval {
            if (ref $arg eq 'CODE') {
                $arg->($c);
            }
            else {
                my $klass  = $arg;
                my $runner = Plack::Util::load_class($klass, $code_conf->{base});
                my $method = $code_conf->{method} || 'main';
                $runner->$method($c);
            }
        };
        if (my $e = $@) {
            if ($code_conf->{on_error}) {
                $code_conf->{on_error}->($c, $e);
            }
            else {
                _croak("$0\t$e");
            }
        }
    });


    add_method($c => 'show_usage', sub {
        my ($self, %args) = @_;

        require Pod::Usage;
        Pod::Usage::pod2usage(%args);
    });

    add_method($c => 'parse_opt', sub {
        my ($c, %options) = @_;

        my @cli_args = @ARGV; # save @ARGV

        Getopt::Long::GetOptionsFromArray(
            \@cli_args,
            %options,
            'h' => sub {
                $c->show_usage(-exitval => 1);
            },
            'help' => sub {
                $c->show_usage(-exitval => 1, -verbose => 2);
            },
        ) or $c->show_usage(-exitval => 2);

        return $c;
    });

    add_method($c => 'setopt', sub {
        my ($c, $opt) = @_;

        _croak('$opt is not HASH') unless ref $opt eq 'HASH';

        $c->{$CLI_OPT_KEY} = $opt;

        return $c;
    });

    add_method($c => 'getopt', sub {
        my ($c, $opt_key) = @_;

        if (!defined $opt_key || $opt_key eq '') {
            return $c->{$CLI_OPT_KEY};
        }

        return $c->{$CLI_OPT_KEY}{$opt_key};
    });
}

sub _croak {
    my ($msg) = @_;

    require Carp;
    Carp::croak($msg);
}

1;

__END__