Agent-TCLI
view release on metacpan or search on metacpan
license => 'perl',
dist_author => 'Eric Hacker <hacker@cpan.org>',
dist_abstract => 'Transactional Contextual Line Interface Agent',
dist_version_from => 'lib/Agent/TCLI.pm',
requires => {
'Data::Dump' => '0',
# 'TimeDate' => '1.16',
'Date::Parse' => '1.16',
'File::ShareDir' => '0.05',
'FormValidator::Simple' => '0',
'Getopt::Lucid' => '0.16',
# 'Scalar::List::Utils' => '1.18',
'Scalar::Util' => '1.18',
'Module::Build' => '0',
'Net::Jabber' => 'undef',
'Net::XMPP' => '1.02',
'NetAddr::IP' => '3',
'Object::InsideOut' => '3.07',
'POE' => '0.9',
'POE::Component::Child' => '0',
'Test::Simple' => '0.62',
lib/Agent/TCLI/User.pm
lib/auto/Agent/TCLI/Control/config.xml
lib/auto/Agent/TCLI/Package/Base/config.xml
Makefile.PL
MANIFEST This list of files
META.yml
README
t/00.load.t
t/pod.t
t/TCLI.Command.BuildCommandLine.t
t/TCLI.Command.GetoptLucid.t
t/TCLI.Command.t
t/TCLI.Control.Interactive.t
t/TCLI.Control.t
t/TCLI.Package.Base.t
t/TCLI.Package.Base.xml
t/TCLI.Package.Tail.t
t/TCLI.Package.XMPP.t
t/TCLI.Parameter.t
t/TCLI.Request.t
t/TCLI.Transport.Test.t
- Eric Hacker <hacker@cpan.org>
abstract: Transactional Contextual Line Interface Agent
license: perl
resources:
license: http://dev.perl.org/licenses/
requires:
Data::Dump: 0
Date::Parse: 1.16
File::ShareDir: 0.05
FormValidator::Simple: 0
Getopt::Lucid: 0.16
Module::Build: 0
Net::Jabber: undef
Net::XMPP: 1.02
NetAddr::IP: 3
Object::InsideOut: 3.07
POE: 0.9
POE::Component::Child: 0
Scalar::Util: 1.18
Test::Simple: 0.62
XML::Simple: 0
./Build install
Alternatively, one may load from CPAN, or hopefully a PPM repository on Windows
machines.
DEPENDENCIES
'Data::Dump' => '0',
'TimeDate' => '1.16',
'FormValidator::Simple' => '0',
'Getopt::Lucid' => '0.16',
'Scalar::List::Utils' => '1.18',
'Module::Build' => '0',
'Net::Jabber' => 'undef',
'Net::XMPP' => '1.02',
'NetAddr::IP' => '3',
'Object::InsideOut' => '3.07',
'Test::Simple' => '0.62',
'YAML::Syck' => '0'
USING
bin/agent_tail.pl view on Meta::CPAN
This script is free software; you may redistribute it
and/or modify it under the same terms as Perl itself.
=cut
# Useful for debugging or just seeing what the Agent is doing.
sub VERBOSE () { 0 }
# Process optional parameters from the command line and assign defaults.
use Getopt::Lucid qw(:all);
my ($opt, $verbose,$domain,$username,$password,$resource,$host);
eval {$opt = Getopt::Lucid->getopt([
Param("domain|d"),
Param("username|u"),
Param("password|p"),
Param("resource|r"),
Param("host"),
Counter("verbose|v"),
Switch("help"),
Switch("man"),
])};
lib/Agent/TCLI/Command.pm view on Meta::CPAN
to load or define Parameters before Commands that use them.
=cut
use warnings;
use strict;
our $VERSION = '0.030.'.sprintf "%04d", (qw($Id: Command.pm 59 2007-04-30 11:24:24Z hacker $))[2];
use Object::InsideOut qw(Agent::TCLI::Base);
use Getopt::Lucid qw(:all);
use FormValidator::Simple;
=head2 ATTRIBUTES
The following attributes are accessible through standard named accessor/mutator
methods unless otherwise noted
=over
=item name
lib/Agent/TCLI/Command.pm view on Meta::CPAN
# $cmdhash{'topic'} = $topic[$$self] if (defined($topic[$$self]));
# $cmdhash{'contexts'} = $contexts[$$self] if (defined($contexts[$$self]));
# $cmdhash{'call_style'} = $call_style[$$self] if (defined($call_style[$$self]));
# $cmdhash{'handler'} = $handler[$$self] if (defined($handler[$$self]));
# $cmdhash{'start'} = $start[$$self] if (defined($start[$$self]));
# $cmdhash{'stop'} = $stop[$$self] if (defined($stop[$$self]));
#
# return ( \%cmdhash );
#}
=item GetoptLucid( $kernel, $request)
Returns an option hash keyed on parameter after the arguments have bee parsed
by Getopt::Lucid. Will respond itself if there is an error and return nothing.
Takes the POE Kernel and the request as args.
=cut
sub GetoptLucid {
my ($self, $kernel, $request, $package) = @_;
my (@options, $func);
# Creat an array for Getopt::Lucid
foreach my $param ( values %{ $self->parameters } )
{
# my $name = defined($param->aliases)
# ? $param->name.'|'.$param->aliases
# : $param->name;
my $name = $param->name;
# don't put as required if default is set.
if ( exists $self->required->{$name} &&
( defined ($package) &&
lib/Agent/TCLI/Command.pm view on Meta::CPAN
no strict 'refs';
push(@options, $param->type->($param->Alias)->required() );
}
else
{
no strict 'refs';
push(@options, $param->type->($param->Alias) );
}
}
$self->Verbose("GetoptLucid: options ",2,\@options);
my $opt;
# $self->Verbose("GetoptLucid: request args",1,$request->args );
# Parse the args using parameters.
eval {$opt = Getopt::Lucid->getopt(
\@options,
$request->args,
);
};
# If it went bad, error and return nothing.
if( $@ )
{
$self->Verbose('GetoptLucid: got ('.$@.') ');
$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) = @_;
# Getopt will send error if problem.
return unless (my $opt = $self->GetoptLucid($kernel, $request, $package) );
# my %args = $opt->options;
my %args = $self->ApplyDefaults($opt, $package, $request->input );
# $self->Verbose("Validate: param",1,\%args);
# $self->Verbose('Validate: $request->input ',1,$request->input);
# are there any left?
if (keys %args == 0 )
{
lib/Agent/TCLI/Command.pm view on Meta::CPAN
Returns a hash keyed on parameter after the defaults from the Package
attributes have been applied. This is used during the Validate method.
=cut
sub ApplyDefaults {
my ($self, $opt, $package, $input ) = @_;
my %defaults;
# Creat defaults hash for Getopt::Lucid
foreach my $param ( values %{ $self->parameters } )
{
# add to the default hash if an attribute exists in the package
my $acc = $param->name;
if (defined( $package ) &&
$package->can( $acc ) &&
defined( $package->$acc )
)
{
$defaults{$acc} = $package->$acc;
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/Command.pm view on Meta::CPAN
inherits methods from both. Please refer to their documentation for more
details.
=head1 AUTHOR
Eric Hacker E<lt>hacker at cpan.orgE<gt>
=head1 BUGS
When naming commands in the preinit commands hash or loading from loadyaml()
it is easy to accidentally
duplicate names and cause commands not to load. The author expects that when he
makes this a habit, he'll try to fix it by doing something better than a loading
a hash with no validation.
Most command packages process args in an eval statement which will sometimes
return rather gnarly detailed traces back to the user. This is not a security issue
because open source software is not a black box where such obscurity might
be relied upon (albeit ineffectively), but it is a bug.
SHOULDS and MUSTS are currently not always enforced.
lib/Agent/TCLI/Package/Base.pm view on Meta::CPAN
=cut
use warnings;
use strict;
use Carp;
use Object::InsideOut qw(Agent::TCLI::Base);
use POE;
use Scalar::Util qw(blessed looks_like_number);
use Getopt::Lucid;
use YAML::Syck;
use XML::Simple;
use File::ShareDir;
#use FormValidator::Simple;
$YAML::Syck::Headless = 1;
$YAML::Syck::SortKeys = 1;
our $VERSION = '0.030.'.sprintf "%04d", (qw($Id: Base.pm 62 2007-05-03 15:55:17Z hacker $))[2];
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
use Object::InsideOut qw( Agent::TCLI::Package::Base );
use POE qw(Wheel::FollowTail);
use Agent::TCLI::Command;
use Agent::TCLI::Parameter;
use Agent::TCLI::Package::Tail::Line;
use Agent::TCLI::Package::Tail::Test;
use Getopt::Lucid qw(:all);
our $VERSION = '0.030.'.sprintf "%04d", (qw($Id: Tail.pm 59 2007-04-30 11:24:24Z hacker $))[2];
=head2 ATTRIBUTES
These attrbiutes are generally internal and are probably only useful to
someone trying to enhance the functionality of this Package module.
It would be unusual to set any of these attributes on creation of the
package for an Agent. That doesn't mean you can't.
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
$self->Verbose("test: request ".$request->id." input(".$request->input.") ",1);
my $txt = '';
my $opt;
my $sub_command = $request->command->[0];
my $command = $request->command->[1];
# break down args
eval { $opt = Getopt::Lucid->getopt( [
Param("like"),
Param("unlike"),
Param("ok"),
Param("name"),
Param("max_lines|l"),
Param("match_times|t"),
Param("ttl"),
Switch('ordered'),
Switch('cache')->default(1),
Switch("verbose|v"),
Switch("feedback|f"),
], $request->args )};
if( $@ )
{
$self->Verbose('set: getopt lucid got ('.$@.') ');
$request->Respond($kernel, "Invalid Args: $@ !", 400);
return;
}
# Validate args
# Need to evolve this into being more automated code but not sure how yet.
# Probably should check that like and unlike and ok are not all set at once.
# someday....
$txt .= $self->NotRegex(qr($opt->get_like), "like" );
$txt .= $self->NotRegex(qr($opt->get_unlike), "unlike");
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
sub file {
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
my $txt = '';
my $opt;
my $command = $request->command->[0];
# break down args
eval { $opt = Getopt::Lucid->getopt( [
Param("file")->required(),
Param("filter"),
Param("interval"),
Param("seek"),
Param("seekback"),
], $request->args )};
if( $@ )
{
$self->Verbose('file: getopt lucid got ('.$@.') ');
$request->Respond($kernel, "Invalid Args: $@ !", 400);
return;
}
# Validate args
# Need to evolve this into being more automated code but not sure how yet.
$txt .= $self->NotScalar($opt->get_file, "file" );
$txt .= $self->NotType($opt->get_filter, "filter", qr(POE::Filter));
$txt .= $self->NotPosInt($opt->get_interval, "interval" );
$txt .= $self->NotPosInt($opt->get_seek, "seek");
lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
my $txt = '';
my $opt;
my $command = $request->command->[0];
# TODO a way to unset/restore defaults....
# break down args
eval { $opt = Getopt::Lucid->getopt( [
Counter("test_verbose"),
Counter("test_feedback"),
Param("ordered"),
Param("interval"),
Param("line_max_cache"),
Param("line_hold_time"),
Param("test_max_lines"),
Param("test_match_times"),
Param("test_ttl"),
], $request->args )};
if( $@ )
{
$self->Verbose('set: getopt lucid got ('.$@.') ');
$request->Respond($kernel, "Invalid Args: $@ !", 400);
return;
}
# Validate args
# Need to evolve this into being more automated code but not sure how yet.
$txt .= $self->NotPosInt($opt->get_test_verbose, "test_verbose", 'set');
$txt .= $self->NotPosInt($opt->get_test_feedback, "test_feedback", 'set');
$txt .= $self->NotPosInt($opt->get_ordered, "ordered", 'set');
$txt .= $self->NotPosInt($opt->get_interval, "interval", 'set');
lib/Agent/TCLI/Package/XMPP.pm view on Meta::CPAN
=cut
use warnings;
use strict;
use POE;
use Agent::TCLI::Command;
use Agent::TCLI::Parameter;
use Agent::TCLI::User;
use Getopt::Lucid qw(:all);
use Object::InsideOut qw(Agent::TCLI::Package::Base);
our $VERSION = '0.030.'.sprintf "%04d", (qw($Id: XMPP.pm 59 2007-04-30 11:24:24Z hacker $))[2];
=head2 ATTRIBUTES
The following attributes are accessible through standard <attribute>
methods unless otherwise noted.
lib/Agent/TCLI/Parameter.pm view on Meta::CPAN
}
=head1 DESCRIPTION
Parameters are the arguements supplied with a command. TCLI defines them as
objects to make it easier to provide several necessary interface features
in a consistent manner. One can use the new function to create Parameters
to load into a package, but the author prefers the YAML syntax as it is
easier to work with.
Arguement parsing may be done with Getopt::Lucid. One should define the type
if using the provided parsing.
Arguement validation may be performed using FormValidator::Simple constraints
as defined in the parameter. Otherwise it should be performed within the
Package subroutine handling the command.
Typically each Package will have a field defined with a standard
accessor/mutator that represents the default value to be used for the
parameter when the command the command is called. This field can be
manually defined in the Package, or it can be autocreated upon parameter
loading within the Package. If necessary, the class filed may be used to
set the Object::InsideOut type to be used for the field.
The reason for the use of Parameter and Command objects is to push a Package
to be as data driven as possible, with only the only code being the actual
command logic. It was decided that it would be best to evolve towards that
goal, rather than try to get it right from the outset. So what you see what
you get.
=cut
use warnings;
use strict;
use Object::InsideOut qw(Agent::TCLI::Base);
lib/Agent/TCLI/Parameter.pm view on Meta::CPAN
B<name> should only contain scalar values.
=cut
my @name :Field
# :Type('scalar')
:All('name');
=item aliases
The aliases will be used by Getopt::Lucid in addition to the name when
parsing the arguments to a command. This allows one to create
variations on the argument name.
This is useful for verbose and other times when names might clash. One can
name the argument I<command_verbose> and create an alias of I<verbose>.
If B<aliases> are defined, they will be appended to the name in the Getopt::Lucid
specification. B<aliases> should being with an alias with
each subsequent alias separated by the vertical bar character. E.g.:
name: command_verbose
aliases: "verbose|v"
means name "command_verbose", alias "verbose" and alias "v"
B<aliases> should only contain scalar values. When represented in YAML, they
should be quoted to keep YAML from trying to interpret the bars.
=cut
my @aliases :Field
# :Type('scalar')
:All('aliases');
=item type
The type will be used by Getopt::Lucid to parse the arguments into the
parameters. It will also be used in a future HTTP inerface to determine
what type of form field to present to the user. Refer to Getopt::Lucid
for the complete details on how it works. A summary of the Getopt::Lucid
supported types:
=over 8
=item Switch -- a true/fals value
=item Counter -- a numerical counter
=item Param -- a variable taking an argument
lib/Agent/TCLI/Parameter.pm view on Meta::CPAN
See the attributes above for a description of the available attributes.
The preferred method of creating a Parameter object for a Package module
is to use the LoadYaml command in the module. This will create the object,
and insert it correctly into the Package parameter store.
=item Alias ()
Alias simply returns the name and aliases joined togetehr with a
bar for use in Getopt::Lucid or a regular expression. If the name of the
parameter is foo, and the aliases is bar, then $param->alias returns foo|bar.
=cut
sub Alias {
my $self = shift;
if ( $self->aliases )
{
return ( $self->name."|".$self->aliases )
}
lib/Agent/TCLI/Parameter.pm view on Meta::CPAN
This module is an Object::InsideOut object that inherits from Agent::TCLI::Base. It
inherits methods from both. Please refer to their documentation for more
details.
=head1 AUTHOR
Eric Hacker E<lt>hacker at cpan.orgE<gt>
=head2 BUGS
When naming parametersit is easy to accidentally
duplicate names and cause problems. The author expects that when he
makes this a habit, he'll try to fix it by doing something better than a loading
a hash with no validation.
SHOULDS and MUSTS are currently not always enforced.
Test scripts not thorough enough.
Probably many others.
lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN
=cut
sub PostResponse {
my ($kernel, $self, $sender, $response) =
@_[KERNEL, OBJECT, SENDER, ARG0];
$self->Verbose($self->alias.":PostResponse: sender(".$sender->ID.") Code(".$response->code.") \n");
# Test always terminates a response transmission. The buck stops here,
# unlike other transports
# TODO Need to figure out how to decide it is time to start checking the tests!
# Hmm. I donn't want to optimize this better with another object right now.
# Push response into a responses array in a hash keyed on id.
push( @{ $responses[$$self]->{$response->id} }, $response );
$self->Verbose($self->alias.":PostResponse: responses(".@{ $responses[$$self]->{$response->id} }.
") ",3,$responses[$$self]->{$response->id} );
# Work off of the first response for tracking.
t/TCLI.Command.BuildCommandLine.t view on Meta::CPAN
#!/usr/bin/env perl
# $Id: TCLI.Command.BuildCommandLine.t 48 2007-04-11 12:43:07Z hacker $
use warnings;
use strict;
use Test::More tests => 13;
use Agent::TCLI::Parameter;
#use Agent::TCLI::Request;
#use Getopt::Lucid;
#use POE;
#
#use Data::Dump qw(pp);
# TASK Test suite is not complete. Need more testing for catching errors.
BEGIN {
use_ok('Agent::TCLI::Command');
}
t/TCLI.Command.GetoptLucid.t view on Meta::CPAN
#!/usr/bin/env perl
# $Id: TCLI.Command.GetoptLucid.t 57 2007-04-30 11:07:22Z hacker $
use Test::More tests => 36;
use Agent::TCLI::Parameter;
use Agent::TCLI::Request;
use Getopt::Lucid;
use POE;
use Data::Dump qw(pp);
# TASK Test suite is not complete. Need testing for catching errors.
BEGIN {
use_ok('Agent::TCLI::Command');
}
my $request = Agent::TCLI::Request->new({
t/TCLI.Command.GetoptLucid.t view on Meta::CPAN
# Test command get-set methods
is($test1->command,'test1', '$test1->command get from init args');
ok($test2->command('test2'),'$test2->command set ');
is($test2->command,'test2', '$test2->command get from set');
# Test handler get-set methods
is($test1->handler,'cmd1', '$test1->handler get from init args');
ok($test2->handler('cmd2'),'$test2->handler set ');
is($test2->handler,'cmd2', '$test2->handler get from set');
# Test GetoptLucid
my $testee = "GetoptLucid";
$request->args([qw(paramint 7 verbose)]);
my $opt1 = $test1->GetoptLucid($poe_kernel, $request );
is($opt1->get_paramint,7,"$testee paramint ok");
is($opt1->get_test_verbose,1,"$testee verbose ok");
$request->args([qw(paramA AAAAA verbose)]);
my $opt2 = $test2->GetoptLucid($poe_kernel, $request );
is($opt2->get_paramA,'AAAAA',"$testee paramA ok");
is($opt2->get_test_verbose,1,"$testee verbose ok");
# Test Validator
my $testee = "Validator";
$request->args([qw(paramint 7 verbose)]);
$opt1 = $test1->Validate($poe_kernel, $request);
t/TCLI.Control.Interactive.t view on Meta::CPAN
# $Id: TCLI.Control.Interactive.t 62 2007-05-03 15:55:17Z hacker $
use warnings;
use strict;
use Test::More tests => 49;
#use Test::More qw(no_plan);
# TASK Test suite is not complete. Need more testing for catching errors.
use Getopt::Lucid qw(:all);
sub VERBOSE () { 0 }
my ($opt, $verbose, $poe_td, $poe_te);
eval {$opt = Getopt::Lucid->getopt([
Counter("poe_debug|d"),
Counter("poe_event|e"),
Counter("verbose|v"),
Switch("blib|b"),
])};
if($@) {die "ERROR: $@";}
if ($opt->get_blib)
{
use lib 'blib/lib';
t/TCLI.Control.t view on Meta::CPAN
#!/usr/bin/env perl
# $Id: TCLI.Control.t 62 2007-05-03 15:55:17Z hacker $
use warnings;
use strict;
use Test::More tests => 402;
# TASK Test suite is not complete. Need more testing for catching errors.
use Getopt::Lucid qw(:all);
sub VERBOSE () { 0 }
my ($opt, $verbose, $poe_td, $poe_te);
eval {$opt = Getopt::Lucid->getopt([
Counter("poe_debug|d"),
Counter("poe_event|e"),
Counter("verbose|v"),
Switch("blib|b"),
])};
if($@) {die "ERROR: $@";}
if ($opt->get_blib)
{
use lib 'blib/lib';
t/TCLI.Package.XMPP.t view on Meta::CPAN
#!/usr/bin/env perl
# $Id: TCLI.Package.XMPP.t 49 2007-04-25 10:32:36Z hacker $
use Test::More tests => 32;
use lib 'blib/lib';
use warnings;
use strict;
use Getopt::Lucid qw(:all);
sub VERBOSE () { 0 }
my ($opt, $verbose,$domain,$username,$password,$host, $poe_td, $poe_te);
eval {$opt = Getopt::Lucid->getopt([
Param("domain"),
Param("username|u"),
Param("password|p"),
Param("host"),
Counter("poe_debug|d"),
Counter("poe_event|e"),
Counter("xmpp_debug|x"),
Counter("verbose|v"),
])};
if($@) {die "ERROR: $@";}
t/TCLI.Transport.Test.t view on Meta::CPAN
#!/usr/bin/env perl
# $Id: TCLI.Package.Tail.t 49 2007-04-25 10:32:36Z hacker $
use Test::More qw(no_plan);
use warnings;
use strict;
use Getopt::Lucid qw(:all);
my ($opt, $verbose, $poe_td, $poe_te);
eval {$opt = Getopt::Lucid->getopt([
Counter("poe_debug|d"),
Counter("poe_event|e"),
Counter("verbose|v"),
Switch("blib|b"),
])};
if($@) {die "ERROR: $@";}
if ($opt->get_blib)
{
use lib 'blib/lib';
( run in 2.093 seconds using v1.01-cache-2.11-cpan-de7293f3b23 )