view release on metacpan or  search on metacpan

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

sub TransmitResponse {
	my ($kernel,  $self, $sender, $response, ) =
  	  @_[KERNEL, OBJECT,  SENDER,      ARG0, ];
	$self->Verbose("TransmitResponse: Code(".$response->code.") id(".
		$response->id.") \n");

#	my $request = $response->request;
	my $addressee;

	# First, check if we're on the bottom of the stack.
	if ( $response->sender->[0] eq 'XMPP' )
	{
		#we're here, take us off
		$response->shift_sender;
		$addressee = $response->shift_postback;
	}
	elsif ( defined($response->sender->[0]) )  # implied != 'XMPP'
	{
		# TODO Genereate real error
		$self->Verbose("TransmitResponse: Whoops! Got something in sender that shouldn't be there ".$response->dump(1));
		return;
	}
	else
	{
		# TODO Genereate real error
		$self->Verbose("TransmitResponse: Got nowhere to go. ");
		return;
	}

	# Prepare the response..
	my $packed_response = $self->PackResponse($response);

	# Create new msg
	my $msg = Net::XMPP::IQ->new();

	# addressee must have resource. For now, everybody should be tcli.
	$msg->SetIQ (
		'to'	=> $addressee,
		'from'	=> $self->jid,
		'type'	=> 'result',
	);

	my $msgRequest = $msg->NewChild("tcli:request");

	$msgRequest->SetRequest(
		'Version'	=> '1.0',
		'Yaml'		=>	$packed_response,
	);

	$self->Verbose("TransmitResponse: Sending to xmpp for $addressee", 1);

	$self->xmpp->Send($msg);

}

sub SendChangeContext {
	my ($kernel,  $self, $control ) =
	  @_[KERNEL, OBJECT,    ARG0 ];
	# for xmpp, we announce context with presence.
	# for a terminal, it might be a prompt...
	$self->Verbose("SendChangeContext: for control ".$control->id());

	# Todo, what happens with a groupchat?

	my $presence = Net::XMPP::Presence->new(
		'to'		=> $control->get_jid(),
		'status'	=> 'Available',
		'priority'	=> '1',
		'type'		=> $control->print_context,
	);

	$self->Verbose("SendChangeContext: presence dump",4,$presence);

	$xmpp[$$self]->PresenceSend($presence);
}

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

	$self->Verbose("recv_exit: got XMPP exit \n" );

	$kernel->delay_set('Disconnected',30, 1 );
} #end sub recv_exit

=item send_presence

Sends a xmpp presence message. See Net::XMPP::Presence for parameter details.

=begin code

    $kernel->yield('send_presence' => {
    	'type'		=> 'available',   # optional, defaults
       	'to'		=>  xmpp_id,    # optional, no default
        'status'	=>  'Online',     # optional, defaults
        'priority'	=>  '8',          # optional, defaults
        });

=end code

=cut

sub send_presence {
  my ($kernel,  $self, $args) =
    @_[KERNEL, OBJECT,  ARG0];
  my $xmpp = $xmpp[$$self];

  # get params or use defaults
  my $status   = defined($args->{'status'})   ? $args->{'status'}   : 'Online';
  my $priority = defined($args->{'priority'}) ? $args->{'priority'} : '8';
  my $to       = defined($args->{'to'})       ? $args->{'to'}       : undef;
  my $type     = defined($args->{'type'})     ? $args->{'type'}     : 'available';

  $self->Verbose( "send_presence: type($type) status($status) priority($priority) \n");

#	  SetPresence(to=>string|JID
#              from=>string|JID,
#              type=>string,
#              status=>string,
#              priority=>integer,