view release on metacpan or  search on metacpan

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

	$self->Verbose("Online: server_time($server_time{display})", 1,\%server_time );
	$self->set(\@server_time, $server_time{utc});

	# start roster
	if ($self->roster)
	{
		$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

=item Process (    )

This event interfaces with the XMPP Process to have it check for new data

=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...

sub recv_pres {
	my ($kernel,  $self, $jSessionID, $response) =
      @_[KERNEL, OBJECT,        ARG0,      ARG1 ];
    my $msg = $response->[1];
    $self->Verbose( "\tRP\tGot no response \n") if ( !defined ($response) );

#    my $thread = $self->get_thread($msg);
#    $self->Verbose( "\tRP\tThread:  ".$thread->id()." \n") if ( defined ($thread));

	# If we get our own presence, ignore it.
    my $from = $msg->GetFrom('jid');
    return if ( $from eq $self->jid->GetUserID );

    # TODO more presence handling
	# need to put presence into thread participant state? Maybe but we
	# don't get the thread with the presence.
	# how would we find group participants in a groupchat?
	# do we need have presence of groupchat participants for anything
    return ();
}

sub GetRequestForNode {
	my ($self, $node ) = @_;
	# This is used to package up a simple request easily

	my $input = $node->GetBody;
	$self->Verbose("GetRequestForNode: input($input)\n",2);

	my $request = Agent::TCLI::Request->new({
					'sender'	=> $self->alias,
					'postback'	=> 'PostResponse',
					'input'		=> $input,

					'response_verbose' => 1,

					'verbose'		=> $self->verbose,
					'do_verbose'	=> $self->do_verbose,
	});

	$request->set_recv($node);

	return( $request );
}

sub recvmsg {
 my ($kernel,  $self, $jSessionID, $response) =
	  @_[KERNEL, OBJECT,        ARG0,      ARG1 ];
	my $msg = $response->[1];
	$self->Verbose("recvmsg: got message from ".
  	$msg->GetFrom('jid')->GetJID('full')." ",1);

	my $control = $self->GetControlForNode( $msg );

	return unless $control;

	my $request = $self->GetRequestForNode($msg);

	# The control is transport agnostic. All it needs to know
	# is the input and what is stored in the control and request.
	$self->Verbose("recvmsg: sending to contol \n",2);

	$kernel->post( $control->id() => 'Execute' => $request );
}

sub recvmsgGroupchat {
	my ($kernel,  $self, $jSessionID, $packet) =
	@_[KERNEL, OBJECT,        ARG0,      ARG1 ];
	my $msg = $packet->[1];
	$self->Verbose("recvmsgGroupchat: msg dump",3,$msg);

	if ( $msg->GetFrom eq $jid[$$self] )
	{
		$self->Verbose("recvmsgGroupchat: ignoring from me \n",2);
		return;
	}

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

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,
#              meta=>string,
#              icon=>string,
#              show=>string,
#              loc=>string)

  $xmpp[$$self]->PresenceSend(
  	'to'		=> $to,
	'status'	=> $status,
	'priority'	=> $priority,
	'type'		=> $type,
  );
  return;
}  # end end_pres

=item send_message

Sends a xmpp message for a control. Takes the thread and the messaage as parameters. It will overwrite the control->send attribute text with the message parameter.

=begin code

   $kernel->yield('send_message' => $control => $message )

=end code

=cut

sub send_message {
	my ($kernel,  $self, $msg, $message) =
	  @_[KERNEL, OBJECT,  ARG0,     ARG1];
	return unless (my $xmpp = $self->xmpp);
	$self->Verbose("send_message: node(".$msg->GetFrom.") Message(".$message.") \n");
	my $rmsg;
	# If the send message has not been set up, then do it.
	if ( ref($msg) eq 'Net::XMPP::Message')
	{
	  	$self->Verbose("send_message:  Creating new reply XMPP::Message", 2);

	  	# If we've got a recieved message, use it
	  	$rmsg = $msg->Reply();
		if ( $msg->GetType eq 'groupchat' )
		{
  			$self->Verbose("send_response: Reply dump ", 2, $rmsg);
  			$rmsg->SetTo( $msg->GetFrom('jid')->GetJID('base') );
			$rmsg->SetFrom( $jid[$$self] );
  			$self->Verbose("send_response: Reply post dump ", 2, $rmsg);
		}
	}

	$msg->SetBody( $message );

	$self->Verbose("send_message: Sending to xmpp", 2);
#	$control->send($rmsg);
	$self->xmpp->Send($rmsg);

} # end sub xmpp_send_msg

=item GetControlForNode (  node  )

Determines the control from a node and returns the control object.

Takes a node parameter and returns the hash key to the proper control
object in the controls array. If the control object is not in the array,
it will add it.

When a new control object is created, a new Control session must be started
for the control and that is handled here as well.

=cut

sub GetControlForNode {
	my ($self, $node) = @_;
	$self->Verbose("GetControlForNode: node(".ref($node).") \n");

	my $type = $node->GetType;
	my $user = $node->GetFrom('jid');

	# chats to other groupchat users come from group/nick and not from user.