Agent-TCLI
view release on metacpan or search on metacpan
lib/Agent/TCLI/Command.pm view on Meta::CPAN
{
# There is a single alias to add.
push( @aliases , $context_hash_key );
# %aliases = ( $context_hash_key => $self );
}
return (\@aliases);
} # End Aliases
#sub RawCommand {
# my $self = shift;
## my %cmd = validate( @_, {
## help_text => { type => Params::Validate::SCALAR }, #required
## usage => { type => Params::Validate::SCALAR }, #required
## topic => { optional => 1, type => Params::Validate::SCALAR },
## name => { type => Params::Validate::SCALAR }, #required
## command => { type => ( Params::Validate::SCALAR | Params::Validate::CODEREF ) }, #required
## context => { optional => 1, type => Params::Validate::ARRAYREF },
## style => { optional => 1, type => Params::Validate::SCALAR },
## start => { optional => 1, type => Params::Validate::CODEREF },
## handler => { optional => 1, type => Params::Validate::SCALAR },
## stop => { optional => 1, type => Params::Validate::CODEREF },
lib/Agent/TCLI/Command.pm view on Meta::CPAN
$request->Respond($kernel, "Invalid Args: $@ !", 400);
return (0);
}
return( $opt );
}
=item Validate( <kernel>, <request>, <package> )
Returns a hash keyed on parameter after the arguments have been parsed
by Getopt::Lucid and validated by FormValidator::Simple as per the constraints
specified in the Parameter or Command definitions.
Will respond itself if there is an error and return nothing.
Takes the POE Kernel, the Request, and the Package as args.
=cut
sub Validate {
my ($self, $kernel, $request, $package) = @_;
lib/Agent/TCLI/Command.pm view on Meta::CPAN
defined( $package->$key ) ) )
);
}
return( %opt );
}
=item BuildCommandLine( <param_hash>, <with_cmd> )
Returns a hash keyed on parameter after the arguments have been parsed
by Getopt::Lucid and validated by FormValidator::Simple as per the constraints
specified in the Parameter or Command definitions.
Will respond itself if there is an error and return nothing.
Takes the POE Kernel, the Request, and the Package as args.
=cut
sub BuildCommandLine {
my ($self, $param_hash, $with_cmd ) = @_;
lib/Agent/TCLI/Control.pm view on Meta::CPAN
'heap' => $self,
);
}
sub _init :Init {
my $self = shift;
# Validate arguments
# $self->Verbose( "spawn: Validating arguments \n" );
# my %args = validate( @_, {
# local_address => { optional => 1 },
# local_port => { optional => 1, default => 42 },
# hostname => { optional => 1, default => hostname() },
# poe_debug => { optional => 1, default => 1 },
# # if not available, silenty fails to load debug
# }
# );
$self->LoadXMLFile();
lib/Agent/TCLI/Control.pm view on Meta::CPAN
=item Register
Register is an internal object method used to register commands with the Control.
=cut
sub Register {
my $self = shift;
$self->Verbose("Register: params",4,@_);
my %cmd = validate( @_, {
help => { type => Params::Validate::SCALAR }, #required
usage => { type => Params::Validate::SCALAR }, #required
topic => { optional => 1, type => Params::Validate::SCALAR },
name => { type => Params::Validate::SCALAR }, #required
command => { type => ( Params::Validate::SCALAR | Params::Validate::CODEREF ) }, #required
contexts => { optional => 1, type => Params::Validate::HASHREF },
call_style => { optional => 1, type => Params::Validate::SCALAR },
# start => { optional => 1, type => Params::Validate::CODEREF },
handler => { optional => 1, type => Params::Validate::SCALAR },
# stop => { optional => 1, type => Params::Validate::CODEREF },
lib/Agent/TCLI/Control.pm view on Meta::CPAN
# @_[KERNEL, OBJECT, SENDER, ARG0, ];
#
# my $txt = '';
# my ($param, $code);
# my $command = $request->command->[0];
# # called directly because $command may be an alias and not the real name
# my $cmd = $self->commands->{'set'};
#
# # TODO a way to unset/restore defaults....
#
# # break down and validate args
# return unless ($param = $cmd->Validate($kernel, $request) );
#
# $self->Verbose("set: param dump",1,$param);
#
# # Get meta data
# my $meth = $self->meta->get_methods();
#
# foreach my $attr ( keys %{$param} )
# {
# # param will have all fields defined, gotta skip the empty ones.
lib/Agent/TCLI/Package/Base.pm view on Meta::CPAN
@_[KERNEL, OBJECT, SENDER, ARG0, ];
my $txt = '';
my ($param, $code);
my $command = $request->command->[0];
# called directly because $command may be an alias and not the real name
my $cmd = $self->commands->{'set'};
# TODO a way to unset/restore defaults....
# break down and validate args
return unless ($param = $cmd->Validate($kernel, $request) );
$self->Verbose("set: param dump",1,$param);
# Get meta data
my $meth = $self->meta->get_methods();
foreach my $attr ( keys %{$param} )
{
# param will have all fields defined, gotta skip the empty ones.
lib/Agent/TCLI/Transport/Base.pm view on Meta::CPAN
'alias' => {
'Default' => 'base',
'Field' => \@alias,
},
);
##u_ subs can't be private if used in %init_args
##named u_ to sort nicer in Eclipse
#sub u_is_text {
# return (
# validate_pos( @_, { type => Params::Validate::SCALAR | Params::Validate::SCALARREF } )
# )
#}
#sub u_is_num {
# return (
# Scalar::Utils->looks_like_number($_[0])
# )
#}
#sub u_is_int {
# my $arg = $_[0];
# return (Scalar::Util::looks_like_number($arg) &&
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
=cut
sub done_id {
my ($self, $id, $wait, $name) = @_;
$wait = 31 unless defined $wait;
my $start = time();
my $ready = 0;
# validate id
unless ( defined($id) && $id )
{
# Use last id if not supplied
$id = $self->make_id( $request_count[$$self] );
}
$self->Verbose($self->alias.":done_id: id($id) start($start) wait($wait)",1);
# Clean out anything in kernel queue
# $poe_kernel->run_one_timeslice unless ($self->running || $wait == 0 );
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
# valid formats to receive the parameter are:
# param=something
# param something
# param="a quoted string with something"
# param "a quoted string with something"
# param: a string yaml-ish style, no comments, to the end of the line
# param: "a quoted string, just what's in quotes"
my $value;
# validate id
unless ( defined($id) && $id )
{
# Use last id if not supplied
$id = $self->make_id( $request_count[$$self]);
}
$self->Verbose("get_param: param($param) id($id) timeout($timeout) ",1);
$self->done_id( $id, $timeout) if ( defined($timeout) );
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
of newlines.
=cut
sub get_responses {
my ($self, $id, $timeout) = @_;
my $value;
# validate id
unless ( defined($id) && $id )
{
# Use last id if not supplied
$id = $self->make_id( $request_count[$$self] );
}
$self->Verbose("get_responses: id($id)",3);
$self->done_id( $id, $timeout) if ( defined($timeout) );
return(undef) unless (exists( $self->responses->{$id} ) );
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
use Date::Parse;
use POE;
use Net::Jabber;
use Socket;
use Agent::TCLI::Control;
use Agent::TCLI::Request;
require Agent::TCLI::Transport::Base;
use Object::InsideOut qw( Agent::TCLI::Transport::Base );
use Params::Validate qw(validate_with);
sub VERBOSE () { 0 }
our $VERSION = '0.031.'.sprintf "%04d", (qw($Id: XMPP.pm 62 2007-05-03 15:55:17Z hacker $))[2];
=head1 INTERFACE
=head2 ATTRIBUTES
The following attributes are accessible through standard accessor/mutator
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
:Arg('name'=>'group_prefix', 'Default' => ':' )
:Acc('group_prefix');
# Standard class utils are inherited
#u_ subs can't be private if used in %init_args
#named u_ to sort nicer in Eclipse
sub u_is_text {
return (
validate_pos( @_, { type => Params::Validate::SCALAR | Params::Validate::SCALARREF } )
)
}
sub u_is_num {
return (
Scalar::Utils->looks_like_number($_[0])
)
}
sub u_is_int {
my $arg = $_[0];
return (Scalar::Util::looks_like_number($arg) &&
lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN
)],
],
);
}
sub _init :Init {
my ($self, $args) = @_;
# Validate deep arguments
# $self->Verbose("Validating arguments \n" ,1);
# my %jabber_connection = validate ($args->{'jabber_connection'}, {
# jabber_package => { regex => qr/^POE::Component::Jabber/,
# type => Params::Validate::SCALAR | Params::Validate::SCALARREF },
# server => { type => Params::Validate::SCALAR | Params::Validate::SCALARREF },
# port => { optional => 1, default => 5222,
# callbacks =>
# { 'is a number' => sub { Scalar::Utils->looks_like_a_number($_[0]) }
# }},
# password => { type => Params::Validate::SCALAR | Params::Validate::SCALARREF },
# });
lib/Agent/TCLI/User.pm view on Meta::CPAN
print $name."'s domain is ".$user->get_domain.". \n";
=cut
use warnings;
use strict;
#use Carp;
use Object::InsideOut qw(Agent::TCLI::Base);
use Params::Validate qw(validate_with);
our $VERSION = '0.030.'.sprintf "%04d", (qw($Id: User.pm 59 2007-04-30 11:24:24Z hacker $))[2];
=head2 ATTRIBUTES
The following attributes are accessible through standard accessor/mutator
methods and may be set as a parameter to new unless otherwise noted.
=over
lib/Agent/TCLI/User.pm view on Meta::CPAN
protocol => qr(jabber), # optional regex for protocol
auth => qr(master|writer), # option regex for auth
} );
=cut
sub not_authorized {
my $self = shift;
# Check if incorrect args are sent and set defaults for optionals
my $args_ref = validate_with ( params => \@_,
spec => {
id => { type => &Params::Validate::SCALAR },
protocol =>
{ optional => 1, default => qr(.*), # default .* means any, simplifies matching if not set
callbacks =>
{ 'is a valid regex' => sub { ref ( $_[0] ) eq 'Regexp' } }
},
auth =>
{ optional => 1, default => qr(.*), # default .* means any, simplifies matching if not set
callbacks =>
( run in 0.488 second using v1.01-cache-2.11-cpan-4d50c553e7e )