File Coverage

blib/lib/POE/Component/ControlPort/DefaultCommands.pm

Criterion	Covered	Total	%
statement	34	51	66.6
branch	7	20	35.0
condition			n/a
subroutine	6	8	75.0
pod	0	2	0.0
total	47	81	58.0

# $Id: DefaultCommands.pm 230 2004-04-25 15:49:02Z sungo $

=pod

=head1 NAME

POE::Component::ControlPort::DefaultCommands - Set of default commands available to the control port

=cut

package POE::Component::ControlPort::DefaultCommands;

use warnings;
use strict;

use Getopt::Long;
use POE::Component::ControlPort::Command;

our $VERSION = '1.'.sprintf "%04d", (qw($Rev: 230 $))[1];

our @COMMANDS = ( #{{{
    {
        help_text => 'Display general port status',
        usage => 'status',
        topic => 'general',
        name => 'status',
        command => \&status,
    },

    {
        help_text => 'Display help about available commands',
        usage => 'help [ topic || command ]',
        topic => 'general',
        name => 'help',
        command => \&help,
    },

); #}}}

our $START_TIME = time;


sub status {
    my %args = @_;

    my $time = localtime($START_TIME);

    return qq|
Control port online since $time.
Application $args{oob}{appname} on host $args{oob}{hostname}
Client is $args{oob}{client_addr} port $args{oob}{client_port}
|;

}

sub help {
    my %args = @_;

    my @args = @{$args{args}};

    if(scalar @args > 1) {
        return "ERROR: Can only provide help on one thing at a time. ";
    }

    my $help = shift @args;

    my $txt;
    if(defined $help) {
        if(defined $POE::Component::ControlPort::Command::TOPICS{$help}) {
            $txt = "Commands available in topic '$help':\n";

            foreach my $cmd (sort @{ $POE::Component::ControlPort::Command::TOPICS{$help} }) {
                $txt .= "\t* $cmd\n";
            }

        } elsif (defined $POE::Component::ControlPort::Command::REGISTERED_COMMANDS{$help}) {
            my $data = $POE::Component::ControlPort::Command::REGISTERED_COMMANDS{$help};

            $txt = "Help for command '$help'\n";
            $txt .= "Usage: ".$data->{usage}."\n";
            $txt .= $data->{help_text}."\n";


        } else {
            $txt = "'$help' is an unknown command or help topic\n";
        }
    } else {
        $txt = "The following help topics are available:\n";

        foreach my $topic ( sort keys %POE::Component::ControlPort::Command::TOPICS ) {
            $txt .= "\t * $topic\n";
        }
    }

    return $txt;
}


sub _add_poe_debug_commands {
    eval "use POE::Component::DebugShell; use POE::API::Peek";
    unless($@) {
        if($POE::Component::DebugShell::VERSION >= '1.017') {
            my $cmds = POE::Component::DebugShell->_raw_commands();

            foreach my $cmd_name (keys %$cmds) {
                my $cmd_data = $cmds->{$cmd_name};

                next if $cmd_name eq 'status';
                next if $cmd_name eq 'help';
                next if $cmd_name eq 'exit';
                next if $cmd_name eq 'reload';

                my $api = POE::API::Peek->new();
                POE::Component::ControlPort::Command->register(
                    name => $cmd_name,
                    usage => $cmd_name,
                    help_text => $cmd_data->{help},
                    topic => 'poe_debug',
                    command => sub {
                        my %args = @_;
                        return $cmd_data->{cmd}->(
                            api => $api,
                            args => $args{args}
                        );
                    },
                );
            }
        }
    }
}


1;
__END__