File Coverage

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

Criterion	Covered	Total	%
statement	29	29	100.0
branch	5	6	83.3
condition			n/a
subroutine	6	6	100.0
pod	0	2	0.0
total	40	43	93.0

# $Id: Command.pm 222 2004-04-24 17:55:11Z sungo $

=pod

=head1 NAME

POE::Component::ControlPort::Command - Register control port commands

=head1 SYNOPSIS

    use POE::Component::ControlPort::Command;

    POE::Component::ControlPort::Command->register(
        name => 'test',
        topic => 'sample_commands',
        usage => 'test [ text to echo ]'
        help_text => 'test command. will echo back all parameters',
        command => sub {  my %args = @_; return join(" ", @{$args{args}}); }
    );

=head1 DESCRIPTION

This module has one command for public consumption. C is the
way that one registers commands for use in the control port. The
arguments listed in the synopsis are all the available arguments and are
all mandatory.

=cut

package POE::Component::ControlPort::Command;

use warnings;
use strict;

use Carp;
use Params::Validate qw(:all);

our $VERSION = do { my @r= (q|$Revision: 1.3 $| =~/\d+/g); sprintf "%d."."%04d"x$#r, @r };

our %TOPICS;

our %REGISTERED_COMMANDS;


sub register {
    my $class = shift;

    my %args = validate( @_, {
        help_text => { type => SCALAR },
        usage => { type => SCALAR },
        topic => { type => SCALAR },
        name => { type => SCALAR },
        command => { type => CODEREF },
    } );

    push @{ $TOPICS{ $args{topic} } }, $args{name};
    $REGISTERED_COMMANDS{ $args{name} } = \%args;

    return 1;
}

sub run {
    my $class = shift;

    my %args = validate( @_, {
        command => { type => SCALAR },
        oob_data => { type => HASHREF, optional => 1 },
        arguments => { type => ARRAYREF, optional => 1 },
    } );

    if($REGISTERED_COMMANDS{ $args{command} }) {
         return "Bad command '$args{command}" unless
            ref $REGISTERED_COMMANDS{ $args{command} }{ command }  eq 'CODE';

        my $txt = eval {
            &{$REGISTERED_COMMANDS{ $args{command} }{ command }}(
                args => $args{arguments},
                oob => $args{oob_data},
            );
        };


        if($@) {
            return "ERROR: $@";
        } else {
            return $txt;
        }
    } else {
        return "ERROR: '$args{command}' is unknown.";
    }
}


1;
__END__