process results from the CPAN

process

Agent-TCLI

view release on metacpan or search on metacpan

#		'auth'		=> 'master',
#	),
);

Agent::TCLI::Transport::XMPP->new(
     'jid'		=> Net::XMPP::JID->new($username.'@'.$domain.'/'.$resource),
     'jserver'	=> $host,
	 'jpassword'=> $password,
	 'peers'	=> \@users,

	 'xmpp_process_time'=> 1,

     'verbose'    => \$verbose,        # Verbose sets level or warnings

     'control_options'	=> {
	     'packages' 		=> \@packages,
     },
);

print "Starting ".$alias unless $verbose;

lib/Agent/TCLI.pm view on Meta::CPAN

=head2 Agent::TCLI::Command

L<Agent::TCLI::Command> is used by Packages to define the components of a
command. It includes the necessary parameters, the manual and help text, as
well and the context information for the Control to use.

=head2 Agent::TCLI::Parameter

L<Agent::TCLI::Parameter> is used in Packages and Commands to define the
parameters that commands accept. It includes help and manual text,
validation constraints and other information to make processing consitent.

=head2 Agent::TCLI::Request

L<Agent::TCLI::Request> is used internally in the TCLI system to describe
the user's request and route it between components. Transports may serialize
requests and send them between agents just use them locally to interact
with the Control.

=head2 Agent::TCLI::Response

lib/Agent/TCLI/Command.pm view on Meta::CPAN

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.

Test scripts not thorough enough.

Probably many others.

lib/Agent/TCLI/Control.pm view on Meta::CPAN


	my (@c, $cmd, $txt, $code, $thisdepth);

	my $depth; 	# How deep are we in already. Don't want to be searching
				# deeper than we should.

    # regex matches on /non-whitespace followed by none or more whitespace
    if ( $args->[0] =~ /^\/(\S+)\s*/ )
    {
	    # Special command option to backout context
	    # We won't process whole context trees (../cmd) but we should
	    # allow a root context to get out of poorly coded commands or whatnot
	    # as a one time option. Hey Cisco, can you do that?
        $args->[0] = $1;
        $self->Verbose( "FindCommand: Root context called, now using ".
          $args->[0]." from root\n" );
 		push ( @c, @{$args} );
    	$depth = 0;
    }
    elsif ( $args->[0] eq '/' && scalar( @{$args} ) > 1 )
    {

lib/Agent/TCLI/Control.pm view on Meta::CPAN

#	}
#	$txt =~ s/,\s$//;
#	$request->Respond( $kernel,  $txt );
#} #end sub listcmd


#=item establish_context
#
#This POE event handler is the primary way to set context with a command.
#Just about any command that has subcommands will use this method as it's handler.
#An exception would be a command that sets an single handler to process all
#subcoammnds/args using the 'A*' context. See the Eliza package for an example of
#how to establish that type of context.
#
#=cut
#
#sub establish_context {
#    my ($kernel,  $self, $sender, $request, ) =
#      @_[KERNEL, OBJECT,  SENDER,     ARG0, ];
#	$self->Verbose("establish_context: ".$self->name." for request(".
#		$request->id().")");

lib/Agent/TCLI/Control.pm view on Meta::CPAN

        'call_style'=> 'state',
        'handler'	=> 'general'
    ),
	 '/' => Agent::TCLI::Command->new(
        'name'      => 'root',
        'help' 		=> "exit to root context, use '/command' for a one time switch",
        'usage'     => 'root or /   ',
        'manual'	=> "root, or '/' for the Unix geeks, will change the context back to root. See 'manual context' for more information on context. ".
        	"Unless otherwise noted, changing to root context does not normally clear out any default settings that were established in that context. \n\n".
        	"One can preceed a command directly with a '/' such as '/exit' to force the root context. ".
        	"Sometimes a context may independently process everything said within the context and, if misbehaving, doesn't provide a way to leave the context. ".
        	"Using '/exit' or '/help' should always work. The example package Eliza is known to have trouble saying Goodbye and exiting properly.",
        'topic'     => 'general',
        'command'   => 'pre-loaded',
        'contexts'  => { 'UNIVERSAL' => ['/','root'] },
        'call_style'=> 'state',
        'handler'	=> 'exit',
    ),
#    {
#        'name'      => 'load',
#        'help' 		=> 'Load a new control package',

lib/Agent/TCLI/Package/Base.pm view on Meta::CPAN

  my ($kernel,  $self, $session, $id, $error) =
    @_[KERNEL, OBJECT,  SESSION, ARG1, ARG2 ];

   $self->Verbose("child: pid($id) ");
}

=item establish_context

This POE event handler is the primary way to set context with a command.
Just about any command that has subcommands will use this method as it's handler.
An exception would be a command that sets an single handler to process all
subcoammnds/args using the 'A*' context. See the Eliza package for an example of
how to establish that type of context.

=cut

sub establish_context {
    my ($kernel,  $self, $sender, $request, ) =
      @_[KERNEL, OBJECT,  SENDER,     ARG0, ];
	$self->Verbose("establish_context: ".$self->name." for request(".
		$request->id().")");

lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN

B<active> will only contain hash values.

=cut
my @active			:Field
					:Type('hash')
					:Arg('name'=>'active', 'default'=> { '0' => 1 } )
					:Acc('active');

=item ordered

The default setting for ordered test processing.
B<ordered> should only contain boolean values.

=cut
my @ordered			:Field
#					:Type('boolean')
					:Arg('name'=>'ordered','default'=>0)
					:Acc('ordered');

=item interval

lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN

	foreach my $state ( sort keys %{$self->active} )
	{
		$kernel->yield( $state => 'Append', $self->line_count );
	}
}

=item Activate

This POE event handler activates tests in the queue by registering an
event with SimpleLog and creating an event handler.
This whole process is currently ineffecient and will hopefully get
redone sometime.

=cut

sub Activate {
   my ($kernel,   $self,  ) =
      @_[KERNEL,  OBJECT,  ];

	my $counter = $self->activated_count;

lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN

	# Note that a sufficiently large number for TTL could get a test to last
	# for years...
	$test->increment_ttl( time() ) if ( $test->ttl != 0 );

	$self->Verbose('Activate: counter('.$counter.') time('.time().') test dump ',3,$test );

	# Set up state to receive an event for this test
	$kernel->state( $num => $self => $test->handler );
	$self->Verbose('Activate: state('.$num.') handler('.$test->handler.')',1);

	# kick off state to process cache
	$kernel->yield( $num );

	return('activated '.$num );
}

=item Check

The POE event handler is what does the actual test/watch on the line
objects.

=cut

sub Check {
    my ($kernel,   $self, $sender, $session, $state ) =
      @_[KERNEL,  OBJECT,  SENDER,  SESSION,  STATE ];

    # Note the right now we're ignoring the ARGS which has the
    # Line number, since we keep track of that in each test.
    # The line number is not supplied if we're processing the cache
    # This might be used for optimization in the future

	$self->Verbose('Check: state('.$state.') lines('.$self->depth_line_cache.
		') completed('.$self->tests_complete.') ',1);
	$self->Verbose('Check: state('.$state.') test queue dump ',5,$self->test_queue );

	# OK, so I actually had a bug where I created a Check event with no event name.
	return unless defined ($state);

	my $test = $self->test_queue->[$state -1];

lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN

---
Agent::TCLI::Parameter:
  name: line_hold_time
  alaises: hold_time
  constraints:
    - UINT
  help: The time, in seconds, to keep lines in the cache.
  manual: >
    The line_hold_time parameter sets how many seconds to keep lines in
    the line_cache. This is not an exact amount but rather the minimum,
    The purge_line_cache process does not run every second, but lines that
    exceeed the hold_time will be purged when it does run.
  type: Param
---
Agent::TCLI::Parameter:
  name: test_max_lines
  alaises: max_lines
  help: The maximum number of lines to check before failing.
  manual: >
    The max_lines parameter sets how many lines to check before giving up
    and failing. For tests, the default is ten, which is the default size

lib/Agent/TCLI/Package/Tail.pm view on Meta::CPAN

  aliases: ttl
  help: The time-to-live in seconds.
  manual: >
    The ttl parameter sets how many seconds to wait before giving up
    and failing. For tests, the default is 30. For watches, the default is
    zero, which means it does not ever expire.
  type: Param
---
Agent::TCLI::Parameter:
  name: ordered
  help: Set the order for processing tests.
  manual: >
    Ordered is a boolean switch indicating how to process the tests. If set
    a test will not be checked against a line until the previous test has
    passed. If ordered is off then multiple tests are running, and tests
    are always processed in the order that they were created. The default
    ordered setting is off for both tests and watches.
  type: Switch
---
Agent::TCLI::Parameter:
  name: feedback
  help: Sets the feedback level for what is seen.
  manual: >
    Feedback sets the level of additional information about the line that is
    returned. Currently it is either zero, which is nothing,
    or one, which returns the whole line. Feedback occurs when a line is

lib/Agent/TCLI/Package/Tail/Test.pm view on Meta::CPAN

B<line_count> will only contain numeric values.

=cut
my @line_count		:Field
					:Type('numeric')
					:Arg('name'=>'line_count','default'=>0)
					:Acc('line_count');

=item last_line

The last line number processed.
B<last_line> will only contain numeric values.

=cut
my @last_line		:Field
					:Type('numeric')
					:Arg('name'=>'last_line','default'=>0)
					:Acc('last_line');

=item success

lib/Agent/TCLI/Package/UnixBase.pm view on Meta::CPAN

	use Object::InsideOut qw(Agent::TCLI::Package::UnixBase);

=head1 DESCRIPTION

Base class for Packages needing to run other Unix programs. It provides methods
to asnychronously call Unix programs using POW::Wheel::Run through
POE::Component::Child. This base class comes with simple
event handlers to accept the output and/or errors returned from the wheel.

Typically, one may want their subclass to replace the stdout method
with one that does more processing of the responses. One should use the
methods here as a starting point in such cases.

Commands run through these methods are run in their own processes asychonously.
Other Agent processing continues while the results of the commands are
captured and returned. Package authors need to ensure that their command
threads shut down or else they may exhaust system resources.

=head1 INTERFACE

=cut

use warnings;
use strict;
use Carp;

lib/Agent/TCLI/Package/XMPP.pm view on Meta::CPAN

  help: an integer for verbosity
  manual: >
    This debugging parameter can be used to adjust the verbose setting
    for the XMPP transport.
  type: Counter
---
Agent::TCLI::Parameter:
  name: group_mode
  constraints:
    - ASCII
  help: sets how the control processes group chats
  manual: |
    The group_mode tells the control how to determine if a group chat
    message is directed at itself. The possible settings are:
        all - treat everything from others as a command
        log - ignore everything from others, only use chatroom for logging
        named - only accept commands prefixed by the name followed by a colon
        prefixed - only accept commands prefixed by the group_prefix,
          by default a colon
  type: Param
---

lib/Agent/TCLI/Request.pm view on Meta::CPAN

An object for storing Agent::TCLI::Request information. Used by Transports
and not externally accessible at this point.

=head1 OVERVIEW

Requests are the basic transaction in TCLI. In the simplest form, they are created by Control
for sending to the Command to perform the Request. Requests come with their own Respond
method that will generate a Response object, so that Commands do not need to implement that logic.

In the more complex form, Requests may be handled directly by Transports. Of course,
Transports do not process a Request, they merely move them. If a Transport if acting on a Request (or the Reponse)
it must have it's own logic for doing so. In order to facilitate this process, sender and postback attrbutes
are arrays, so that they may be stacked. The Respond method will remove the entries from the stack.

=cut

use warnings;
use strict;
#use Carp;

use Object::InsideOut qw(Agent::TCLI::Base);
use Agent::TCLI::Response;

lib/Agent/TCLI/Testee.pm view on Meta::CPAN

test both the code and the body on the same response. One can test the code of
the first response and the body of the second. All additional tests must
immediately follow the original populated request.

A request is not actually sent until a new request is made or a test_master
command like run or done is called.

When there are multiple responses per request, the tests will be executed
on the responses in the order that they are written in the script. However, the
test script is usually running asnchronously, and other responses to later
requests may be processed before all responses to earlier requests have arrived.

Currently each test requires a response. There is no mechanism that allows one
to write a test that pass if three to five responses with code 200 are
revceived. That is a desired future feature.

=head3 Greedy Tests

B<is_*> and B<like_*> tests are greedy by default. That is they use up and expect
a response for every test. Other tests (not yet available), such as
B<response_time> (coming soon) are not greedy and act on the next response

lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN


	# returning $post_it so that it can be checked to see if it is safe to proceed.
	# This could be used by done() to loop until timed out.
	$self->Verbose($self->alias.":dispatch: post_it($post_it)",2);

	return($post_it);
}

=item do_test

This is an internal method to process responses.
B<do_test> actually executes the test and send the output to the TAP processor.
It takes an ARRAYREF for the test and the Agent::TCLI::Response to be checked as
parameters.

=cut

sub do_test {
	my ($self, $t, $response) = @_;

	# Split out test name and test class.
	my ($test, $class) = split('-',$t->[0]);

lib/Agent/TCLI/Transport/Test.pm view on Meta::CPAN

}

=item GetControl ( id )

Inherited from Agent::TCLI::Trasnport::Base

=cut

=item _shutdown

Shutdown begins the shutdown of all child processes.

=cut

sub _shutdown :Cumulative {
    my ($kernel,  $self, $session) =
    @_[KERNEL, OBJECT,  SESSION];
	$self->Verbose($self->alias.':_shutdown:');

	foreach my $package ( @{$self->control_options->{'packages'} })
	{

lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN

=cut
my @jpassword  :Field('All' => 'jpassword');

=item xmpp_debug

Sets the debug (verbosity) level for the XMPP libraries

=cut
my @xmpp_debug			:Field  :All('xmpp_debug');

=item xmpp_process_time

Sets the time in seconds to wait before calling XMPP Process to look for
more XMPP data. Defaults to 1 and shouldn't be much larger.

=cut
my @xmpp_process_time	:Field
						:Arg('name'=>'xmpp_process_time', 'default'=> 1 )
						:Acc('xmpp_process_time');

=item peers

An array of peers
B<set_peers> will only accept ARRAYREF type values.

=cut
#my @peers 	   :Field('All' => 'peers', 'Type' => 'ARRAY' );

# Holds the XMPP connection session

lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN

B<server_time> should only contain hash values.

=cut
my @server_time		:Field
#					:Type('hash')
					:All('server_time');

=item group_mode

The default setting to determine how to interact with groups. Options are:
'all' - process everything said in room
'named' - process only when called by name: (name followed by colon).
'log' -	don't listen to anything, but log events there (which ones?)
'prefixed' - named + anything beginning with a designated prefix character
B<group_mode> should only contain scalar values.

=cut
my @group_mode		:Field
#					:Type('scalar')
					:Arg('name'=>'group_mode', 'Default' => 'named' )
					:Acc('group_mode');

lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN

		$self->Verbose("Online: enabling Roster ");
		$self->set(\@roster, $self->xmpp->Roster);
	}

	if (defined($self->control_options) )
	{
		$self->control_options->{'local_address'} = $self->Address
			unless defined($self->control_options->{'local_address'});
	}

	$kernel->delay_set( 'Process' => $xmpp_process_time[$$self] );

    $kernel->yield('send_presence',(
    {
		status   =>  'Online',
		priority =>  '1',
    } ) );

	$kernel->yield('JoinPeerRooms') if defined($self->peers);

} #end sub Online

lib/Agent/TCLI/Transport/XMPP.pm view on Meta::CPAN

=cut

sub Process {
	my ($kernel,  $self, ) =
	  @_[KERNEL, OBJECT, ];
	$self->Verbose("Process: " , 4);
	my $result = $xmpp[$$self]->Process(1);
	if ( defined($result) )
	{
		$self->Verbose("Process: (".$result.") for ".$self->alias." as ".$jid[$$self]->GetJID('full') );
		$kernel->delay_set( 'Process' => $xmpp_process_time[$$self] );
    }
    else
    {
		$kernel->yield( 'Disconnected' );
    }
} # End Process

# When we recv anything from XMPP the $response will be
# an array of the XMPP Session ID and then the XML message
# In ARG1 for some reason...

lib/auto/Agent/TCLI/Control/config.xml view on Meta::CPAN

<package>
  <Parameter name="local_address" aliases="ip" help="local ip address" manual="" type="Param" />
  <Parameter name="auth" aliases="" help="auth level within control" manual="" type="Param" />
  <Parameter name="user" aliases="" help="control user" manual="" type="Param" />
<Command name="show" call_style="state" command="pre-loaded" handler="show" help="show Control variables" topic="admin" usage="Control show local_address">
  <contexts Control="show" ></contexts>
  <parameters user="1" local_address="1" auth="1"></parameters></Command>
<Command name="root" call_style="state" command="pre-loaded" handler="exit" help="exit to root context, use '/command' for a one time switch" manual="root, or '/' for the Unix geeks, will change the context back to root. See 'manual context' for more...

One can preceed a command directly with a '/' such as '/exit' to force the root context. Sometimes a context may independently process everything said within the context and, if misbehaving, doesn't provide a way to leave the context. Using '/exit' o...
  <contexts>
    <UNIVERSAL>/</UNIVERSAL>
    <UNIVERSAL>root</UNIVERSAL>
  </contexts>
</Command>
<Command name="manual" call_style="state" command="pre-loaded" handler="manual" help="Display detailed help about a command" manual="The manual command provides detailed information about running a command and the parameters the command accepts. Manu...
  <contexts>
    <UNIVERSAL>manual</UNIVERSAL>
    <UNIVERSAL>man</UNIVERSAL>
  </contexts>

t/TCLI.Package.Tail.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 tests => 264;
use lib 'blib/lib';
use warnings;
use strict;

use Getopt::Long;

# process options
my ($verbose,$poe_td,$poe_te);
eval { GetOptions (
  		"verbose+"		=> \$verbose,
  		"event_trace+"		=> \$poe_te,
  		"default_trace+"		=> \$poe_td,
)};
if($@) {die "ERROR: $@";}

$verbose = 0 unless defined($verbose);
$poe_td = 0 unless defined($poe_td);

t/TCLI.Package.XMPP.t view on Meta::CPAN

#	),
);

Agent::TCLI::Transport::XMPP->new(
     'jid'		=> Net::XMPP::JID->new($username.'@'.$domain.'/tcli'),
     'jserver'	=> $host,
#	 'jpassword'=> $password,
	 'peers'	=> \@users,

	 'xmpp_debug' 		=> 0,
	 'xmpp_process_time'=> 1,

     'verbose'    => \$verbose,        # Verbose sets level or warnings
	 'do_verbose'	=> sub { diag( @_ ) },

     'control_options'	=> {
	     'packages' 	=> \@packages,

     },
);

( run in 0.434 second using v1.01-cache-2.11-cpan-8d75d55dd25 )