view release on metacpan or  search on metacpan

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

	my (@args,$request);

	# is input a request object or plaintext?
	if (ref($input) =~ /Request/)
	{
		$request = $input;
		$input = $request->input;
	    $self->Verbose( "Execute: Request ".$request->dump(1),4);
	    $self->Verbose( "Execute: input from Request ($input)",2,\$input);

	 	# Here we need to extract the command for FindCommand
		# Odds are the request doesn't have args or command populated
		# if it was built outside of the Control.
		if ( defined($request->args) )
		# Hmm, someone thinks they're smarter than the Control at
		# parsing. OK, we'll take that. Later we'll use the real args.
		{
		 	@args = reverse( @{$request->command} );
		}

		# add self to sender/postback stack so that we can put ourself
		# into PostResponse to Transport to handle many contrls per transport
		# Or should I just stuff that into the request at the Transport
		# Well, what if there isn't a request yet at the transport?
		# Either the request exists or it will come from the control....
		# Or just make the stateful transports create a request...
		# I think that is more elegant.
		# Scratch all this.
	}

    $self->Verbose( "Execute: args",2,\@args);

	# Now get args from input.
	if ( ! @args )
	{
		# TODO Still need a better parser.
		# Parsewords chokes on single singlequotes.
		$input =~ s/'//;
		# parsewords also parses whitespace at the beginning poorly.
		$input =~ s/^\s*//;
		# Parsewords doesn't handle trailing backslashes well.
		$input =~ s/\\$//;
	    @args = shellwords($input);
	}

	# substitute for help
    $args[0] = 'help' if ($args[0] eq '?');

#	# The command is broken down into a context, a command, and args.
#	# The context helps find the command to execute and usually
#	# remains the same between transactions unless changed by the user.
#	# Context may be up to five layers deep. A single command may be
#	# usable in more than one context, or even in all.
#
#	# The command is sent as the first arg in @args.
#
#	# Each command gets the following to execute:
#	# $postback -> to send the response
#	# \@args -> typically the user input in an array
#	# $input -> the original user input
#	# $thread -> the thread object for the user's session
#	#	The current context is stored in the $thread as an array but is
#	# retrievable as a string as well.
#
#	# Some commands merely establish context. Such as 'enable' in a Cisco
#	# CLI. Though enable may require additional args. A default method/session
#	# of the Agent::TCLI::Package::Base class called establish_context can handle
#	# the simple case of setting context and confirming for the user.
#
#	# $args[0] will always be the command word to execute, but may have
#	# not been the first word entered if the command is nested deep in a
#	# context. If a command needs to determine exactly how it was called
#	# then it needs to reparse $input.

	my ($cmd, $context, $txt, $code) = $self->FindCommand(\@args);

	unless ($code == 404)
	{

	    $self->Verbose("Execute: Executing cmd(".$cmd->name.
	    	") for ".$id[$$self]." \n");

		# Now actually execute the command
	    if ( ref($request) =~ /Request/ )
	    {
			if ( !defined($request->args) || $request->depth_args == 0 )
			{
				$request->args( \@args );
				$request->command( $context );
			    $self->Verbose( "Execute: Request post FindCommand".$request->dump(1),3);
			}

	    	# The response may bypass the Control's AsYouWished, and go
	    	# directly back to the Transport if that is what is $request(ed)
	    	if ( $cmd->call_style  eq 'sub')
		    {
				# Subs can't handle request objects.
				my (@rargs, $rinput);

				# subs want the command in the @rargs
				push( @rargs, $request->command->[0], $request->args );

				# Make sure there is input, just in case....
				$rinput = defined($request->input) ? $request->input :
					join(' ',$request->command->[0],$request->args);

				# do it
		    	($txt, $code) = $self->DoSub($cmd, \@rargs, $rinput );
		    	$request->Respond( $kernel, $txt, $code);
		    	return;
			}
			elsif ( $cmd->call_style  eq 'state')
			{
				$self->Verbose("Execute: Executing state ".$cmd->handler." \n");
				$kernel->yield( $cmd->handler => $request );
				return;
			}
			elsif ( $cmd->call_style  eq 'session')
			{
				$self->Verbose("Execute: Executing session ".$cmd->command.
					"->".$cmd->handler." \n");
				$kernel->post($cmd->command => $cmd->handler =>

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

} #end sub exit

=item dumpcmd

A POE event to handle some debugging in band.
It expects a request object parameter.

=cut

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

	my $command = $request->command->[0];

	my $txt;

	# dump them all if no args
 	if ( $request->ArgsDepth == 0 )
  	{
		foreach my $cmd ( keys %{ $registered_commands[$$self] } )
		{
			$txt .= $registered_commands[$$self]{$cmd}->dump(1);
		}
	}
	elsif ( $request->ArgsDepth > 0 )
	{
		foreach my $cmd ( @{$request->args} )
		{
			$txt .= $registered_commands[$$self]{$cmd}->dump(1);
		}
	}

	$request->Respond( $kernel,  $txt );
} #end sub dumpcmd

#sub listcmd {
#	my ($kernel,  $self,  $request) =
#	  @_[KERNEL, OBJECT,      ARG0];
#
#	my $command = $request->command->[0];
#
#	my $txt;
#	# TODO this is broken with new commands hash.
#	if ( $request->depth_args == 0
#	{     # dump them all
#		foreach my $context ( $registered_commands[$$self] )
#		{
#  			$txt .= "\nCommands in context ".$context." \n\t";
#  			foreach my $command ( %{ $registered_commands[$$self]{ $context } } )
#  			{
#				$txt .= $registered_commands[$$self]{ $context }{ $command }{'name'}.", ";
#  			} #end foreach command
#		} #end foreach context
#	}
#	else
#	{
#  		# just dump some in a context
#
#		# tHIS SHOULD GRAB AN ARRAY
#  		my $context = $request->depth_args > 0 ? $request->args->[0] : $thread[$$self]->context;
#
#  		# if/eslif on size of array.
#  		# loop over hash1.hash2.hash3.keys getting '.'{'name'}
#  		# loop over wildcards too
#
#		foreach my $cmd ( %{ $registered_commands[$$self]{ $context } } )
#		{
#			$txt .= $registered_commands[$$self]{ $context }{ $cmd }{'name'}.", ";
#		}
#	}
#	$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().")");
#
#	my $txt;
#	# if we have args, then the command is invalid
#	if ( $request->depth_args > 0 )
#	{
#		$txt .= "Invalid input: ".$request->input;
#		$self->Verbose("establish_context: Invalid input (".$request->input.")"  );
#		$request->Respond($kernel, $txt, 404) if $txt;
#		return;
#	}
#
#	# we don't know how deep we're in already. So we'll force a full context shift.
#	# by sending the entire command array back, which is revesred.
#	my @context = reverse (@{$request->command});
#
#	# We don't actualy set the controls context, but let change context do that.
#	# It will also inform the user of change.
#
#   	# Post context back to sender (Control)
#   	$kernel->call( $sender => 'ChangeContext' => $request, \@context );
#	$self->Verbose("establish_context: setting context to "
#			.join(' ',@context)." ",2);
#
#}
#
#=item show
#
#This POE event handler i will accept an argument for the setting to show.
#It will also take an argument of all or * and show all settings.
#