view release on metacpan or  search on metacpan

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

	my ($kernel,  $self, $request, $context) =
	  @_[KERNEL, OBJECT,     ARG0,     ARG1];
    $self->Verbose("ChangeContext: context($context)  \n" , 2 );

	# There is no checking to see if this is a valid context to be in.
	if ( ref($context) eq 'ARRAY' )
	{
		$self->context( $context );
	}
	else
	{
	    # In case someone forgets and gives us a bad context, set to root.
	    $context = 'ROOT' if ( !defined ($context) or $context !~ /\S+/ );

	    # Store the new context
		if ($context eq '..')
		{
		    $self->pop_context;
		}
		elsif ( $context eq '/' )
		{
		    $self->context(['ROOT']);
		}
		else
		{
		    $self->push_context( $context ) ;
		}
	}

    # TODO make sure each transport has a ChangeContext
    # registered as a context shift handler....
    $self->Verbose("ChangeContext: Context now (".$self->print_context.") for request \n" , 4,$request );

	$kernel->call( $self->owner->session->ID => 'SendChangeContext' => $self );

	$request->Respond($kernel, "Context now: ".$self->print_context );
}

=item control_presence

This is very transport specific, and I'm not sure how to handle presence quite yet.

=cut

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

    $self->Verbose("\tCP\tPresence:  ".$presence." \n", 2 );

}

=item Execute

POE event Execute is the main event handler for incoming reuqests.
Transports should send command requests to Execute. The can be either
plain text as entered by the user or request objects.

Usage:

	$kernel->post( 'Control' => 'Execute' => $input );

=cut

sub Execute {
    my ($kernel,  $self, $input) =
      @_[KERNEL, OBJECT,   ARG0];
    $self->Verbose( "Execute: Input($input) ",2);
	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 =>
					$request );
				return;
			}
	    }
		else
	    {
	    	if ( $cmd->call_style  eq 'sub')
		    {
		        ($txt, $code) = $self->DoSub($cmd, \@args, $input );
			}
			else
			{
				my $request = Agent::TCLI::Request->new(
					'args'		=> \@args,
					'command'	=> $context,
					'sender'	=> $self,
					'postback'	=> 'AsYouWished',
					'input'		=> $input,

					'verbose'		=> $self->verbose,
					'do_verbose'	=> $self->do_verbose,

				);
				if ( $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 =>
						$request );
					return;
				}
			}
	    }
	}

    unless ( defined($txt) )
    {
    	$txt = 'Uh oh, Execute bombed';
    	$code = 400;
    }
    $self->Verbose("Execute: Got ".$txt." from in ".$self->id." ", 3 );
    if ( ref($request) =~ /Request/ )
    {
		$request->Respond($kernel, $txt, $code );
    }
    else
    {
		my $response = Agent::TCLI::Response->new(
				'body'		=> $txt,
				'code'		=> $code,
		);
	    $kernel->yield('AsYouWished' => $response ) ;
    }

} #end sub Execute

=item DoSub

This internal object method performs the actual execution of commands
that are only small subs.

=cut

sub DoSub {
	my ($self, $cmd, $args, $input) = @_;
	$self->Verbose("DoSub: sub ".$cmd->name." \n");

	my $txt = eval {
    	&{$cmd->command}( $args, $input );
	};
	if($@)
	{
		$self->Verbose("DoSub: Error (".$@.") \n" );
		return ("RUN ERROR: $@", 400);
	}
	else
	{
		$self->Verbose("DoSub: sub returned (".$txt.") \n",4 );
	}
	return ($txt, 200);
}

=item AsYouWished

This POE state takes a text reply to a transaction and returns it to the proper
transport for sending to the user. This has been somewhat deprecated by
the Respond method in request objects.

Commands that are executed as sessions may use this as a return and
should not try to interact with the transports
directly. It is called by run for legacy command calls.

It prefers a response object, but will wrap plain text into a response object
for consistent transport handling.

=cut

sub AsYouWished {
	my ($kernel, $sender,  $self, $response) =
	  @_[KERNEL,  SENDER, OBJECT,  ARG0 ];

	# at this point, we should be getting a response object,
	# but let's not complain.
	if ( ref($response) =~ /Response/ )
	{
		$self->Verbose( "AsYouWished: Got ".$response->dump(1)." in ".$self->id." \n");
		# um I was going to do something here.
	}
	else   # Need to build response
	{
		$self->Verbose( "AsYouWished: Got '".$response."' in ".$self->id." \n");
		my $response = Agent::TCLI::Response->new(
		# Don't have request, sending just plain response, hopefully the
		# transport knows where it came from based on the sender.
		# We really shouldn't be here anyway.
			'body'		=> $response,
			'code'		=> 200,
		);
	}

	# Is this what I want to do? Or should I Respond?
	# The Control always acts directly as the interface between Transport
	# and control is strictly defined. If we're here, there probably isn't a
	# request object to respond to.
	$self->Verbose( "AsYouWished: self dump \n",5,$self );
	$kernel->post( $self->owner->session->ID => 'PostResponse' => $response, $self );

} #end sub control_AsYouWished

#sub control_err {
#	my ($err, $msg) = @_;
#  croak("ERROR: $err -> $msg  \n");
#}

=item general

A POE event to handle some general commands such as context and status.
It expects a request object parameter.

=cut

sub general {
    my ($kernel,  $self, $sender, $request,) =
      @_[KERNEL, OBJECT,  SENDER,     ARG0,];
	$self->Verbose("general: context(".$self->print_context.")");

	my $command = $request->command->[0];
	$self->Verbose("general: command(".$command.") args[".
		$request->print_args."] input(".$request->input.")", 3);

	my $txt;
	my $time = localtime($start_time[$$self]);

	if ( $command eq 'context')
	{
	    $txt = "Context: ".$self->print_context;
	}
	elsif ( $command eq 'echo' )
	{
    	$txt = "I heard '".$request->input."' in context ".
    		$self->print_context." from ".$user[$$self]->get_name();
	}
	elsif ($command =~ /hi|hello/i)
	{
    	$txt = $command." ".$user[$$self]->get_name().". Tell me what you'd like to do or ask for 'help'. ";
	}
	elsif ($command eq 'status')
	{
		$txt .= "This is a ".__PACKAGE__." v".$VERSION."\n";
		$txt .= "running inside ".$0.".\n";  # with procecss id ".getppid()."\n";
		$txt .= "My IP address is ".$self->local_address.".\n" if defined($self->local_address);
		$txt .= "This console was spawned at ".$time.".\n";
		foreach my $cmdpkg ( @{ $packages[$$self] } )
		{
			my $subtxt = "$cmdpkg";
			$subtxt =~ s/=.*//;
			$txt .= "\tPackage ".$subtxt." is loaded. \n";
		}
		$txt .= "You are ".$user[$$self]->get_name()." and you have "
			.$self->auth()." authorization \n ";
		$txt .= "\n";
	}
	elsif ( $command eq 'Verbose' )
	{
		if ( $request->args->[0])
		{