undef results from the CPAN

undef

Agent-TCLI

view release on metacpan or search on metacpan

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

			'result'=>	$session->postback('recv_iqResponse'),
			},
	);

	$self->set(\@xmpp, $xmpp);

	$kernel->yield('Login') if (defined( $self->jpassword ));

	return ($self->alias."_start whohoo");
} # End sub start

=item stop

Mostly just a placeholder.

=cut

sub _stop {
  my ($kernel,  $self, $session) =
    @_[KERNEL, OBJECT,  SESSION];
    $self->Verbose("\n ".$self->alias." stopping \n\n" ,1);
	return ($self->alias."_stop whohoo");
}

=item shutdown

Forcibly shutdown

=cut

sub _shutdown :Cumulative {
    my ($kernel,  $self, $session) =
    @_[KERNEL, OBJECT,  SESSION];
	# TODO, do some proper signal handling
	# especially reconnect on HUP and something on INT
	$self->Verbose('Shutdown');

	# This is to keep from reconnectiing when XMPP responds that it is disconnected.
	$self->connection_retries(0);

	if ( defined($self->control_options)
		&& exists( $self->control_options->{'packages'}  ))
	{
		# Shut down any packages.
		foreach my $package ( @{$self->control_options->{'packages'} })
		{
			$kernel->post( $package->name => '_shutdown'  );
		}

	}

	if ( $xmpp[$$self]->Connected )
	{
		$xmpp[$$self]->Disconnect;
		$self->Verbose("_shutdown: Disconnecting ");
	}
	# define xmpp
	# what about Disconnected????

	$self->xmpp->SetMessageCallBacks(
    	'normal'		=> undef,
	    'chat'			=> undef,
    	'groupchat'		=> undef,
    	'headline'		=> undef,
    	'error'			=> undef,
	);

	$self->xmpp->SetPresenceCallBacks(
    	available	=> undef,
		unavailable	=> undef,
	);

    $self->xmpp->SetIQCallBacks(
		'tcli:request'	=> {
			'get'	=>	undef,
			'set'	=>	undef,
			'result'=>	undef,
			},
	);


#    $_[KERNEL]->alias_remove( $_[OBJECT]->get_alias );

}

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

	# if connection retries is zero, then we shutdown with no delay.
	# This is important when we try to shutdown and the
	# xmpp->Disconnect is called. :)
	if ( !defined( $count )  && $connection_retries[$$self] > 0 )
	{
		$kernel->delay_set('Disconnected', $connection_delay[$$self], 1 );
		$self->Verbose("Disconnected: got XMPP disconnect waiting ".$connection_delay[$$self]." seconds" );
		return;
	}
	else
	{
		$count++;
		$self->Verbose("Disconnected: count ($count) \n" );
	}

	if ( $count >= $connection_retries[$$self] )
	{
  		$kernel->yield('_shutdown');
		$self->Verbose("Disconnected: SHUTDOWN in progress");
		return;
	}

	# make connection
	$self->Verbose("Disconnected: XMPP connecting to ".$jserver[$$self] );
	$xmpp[$$self]->Connect(
		hostname	=> $jserver[$$self],
	);
	if ( $xmpp[$$self]->Connected )
	{
		$kernel->yield('Login');
		$self->Verbose("Disconnected: Got connected ");
		return;
	}

	$kernel->delay_set('Disconnected', $connection_delay[$$self], $count );

} #end sub Disconnected

=item JoinPeerRooms

This POE event handler will go through each of the users in the peers array,
and if the peers is a groupchat, join the conference room. It will check to
make sure it is not already conencted (though this could be buggy). It does
not take any arguments.

=cut

sub JoinPeerRooms {
	my ($kernel,  $self, ) =
	  @_[KERNEL, OBJECT, ];
    $self->Verbose("JoinPeerRooms:  ",2);

	foreach my $user ( @{$self->peers} )
	{
		if ( $user->protocol =~ /groupchat/  )
		{
			if ( defined( $self->controls ) &&
				exists( $self->controls->{ $user->id.'-groupchat' } ) )
			{
				# should already be logged on?
			    $self->Verbose("JoinPeerRooms: already connected to ".$user->id ,2);
				return;
			}
			$kernel->yield('JoinChatRoom',
				$user->get_name,		# room name
				$user->get_domain,		# server
				$user->password,		# secret
			)
		}
	}
}

sub JoinChatRoom {
	my ($kernel,  $self, $room, $server, $secret) =
	  @_[KERNEL, OBJECT,  ARG0,    ARG1,   	ARG2];
    $self->Verbose("JoinChatroom: $room at $server ",2);

    $self->xmpp->MUCJoin(
    	'room'		=> $room,
		'server'	=> $server,
		'nick'		=> $self->jid->GetUserID,
		'password'	=> defined($secret) ? $secret : undef,
	);
}

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

	my $txt = '';

	# make connection
	$self->Verbose("login: XMPP connecting to ".$jserver[$$self] );
	$xmpp[$$self]->Connect(
		hostname	=> $jserver[$$self],
	);

	my @login;
	if ( $xmpp[$$self]->Connected()  )
	{
		#log in
		$self->Verbose("login: XMPP trying login as ".$self->jid()->GetUserID );
		@login = $xmpp[$$self]->AuthSend(
			username	=> $self->jid()->GetUserID,
			password	=> $jpassword[$$self],
			resource	=> $self->jid()->GetResource,
		);
		$self->Verbose("login: Did login for ".$self->jid()->GetUserID." Got ".$login[0] );

		if ( defined($login[0]) && $login[0] eq 'ok')
		{
		    $kernel->yield('Online');
		}
		elsif ( defined($login[1]) )
		{
			$txt .= "Login error-> ".$login[1];
		}
		else
		{
			$txt .= "Bad Login error-> ".$xmpp[$$self]->GetErrorCode();
		}
	}
	else
	{
		$txt .= "Connection error-> ".$xmpp[$$self]->GetErrorCode();
	}

	if ($txt ne '' )
	{
		$self->Verbose("login: ".$txt."\n",1,$xmpp[$$self]->GetErrorCode());
		$kernel->delay_set('Disconnected' => 10 , 1 );
	}

} # end sub login

sub Online {
	my ($kernel,  $self,  ) =
	  @_[KERNEL, OBJECT,  ];
	$self->Verbose("Online: \n" ,1);

	my %server_time = $self->xmpp->TimeQuery('mode'=>'block');
	$self->Verbose("Online: server_time($server_time{display})", 1,\%server_time );

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


	$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,
#              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);

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

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.
	# don't want peer chats from group.....
	my $user_protocol = $type eq 'groupchat' ? qr(xmpp_groupchat) : qr(xmpp);

	# Don't talk to oneself.......
	return if ( $user->GetJID('full') eq $self->jid->GetJID('full') );

	# or to self in chatroom
	return if ( $user->GetResource eq $self->jid->GetUserID );

	$self->Verbose("GetControlForNode: type(".$type.") user(".$user->GetJID('full').") \n");

	my $control_id;
	# Message Types
	# Using user with resource for normal and chat. Not even sure about headline or error.
	if ( $type eq 'normal' || $type eq '' )
	{
  		$control_id = $user->GetJID('full').'-'.$type;
	}
	elsif ( $type eq 'chat' )
	{
  		$control_id = $user->GetJID('full').'-'.$node->GetThread;
	}
	elsif ( $type eq 'groupchat' )
	{
		# chatroom should not use the resource
  		$control_id = $user->GetJID('base').'-'.$type;
	}
	elsif ( $type eq 'headline' )
	{
  		$control_id = $user->GetJID('full').'-'.$type;
	}
	elsif ( $type eq 'error' )
	{
  		$control_id = $user->GetJID('full').'-'.$type;
	}
	# IQ, treat like a normal message
	elsif ( $type eq 'get' )
	{
  		$control_id = $user->GetJID('full').'-'.$type;
	}

	else
	{
  		$self->Verbose("GetControlForNode: BAD TYPE ignoring node");
  		return(undef);
	}

	my $control = $self->GetControl($control_id, $user->GetJID('base'), $user_protocol);

	# If not auth, no control,
	unless ($control)
	{
		$self->Verbose("GetControlForNode: No Control!!!!");
		return (0);
	};

    $self->Verbose( "GetControlForNode: Control ".$control_id." on input from ".$user." \n",2);

	# These are not part of the default control attributes set by GetControl.
	# TODO don't reset every time.
	$control->set_jid($user);
	$control->type($type);

  return ( $control );

} # End GetControlForNode

=item Peers

This POE event handler performs the transport end of the peer manipulation
commands, such as add peer. It takes an action, a User object and an optional
Request object as arguments.

Valid actions are add and delete. Currently delete does not force a log
off from a chatroom, but it might if I fix that and forget to update the docs.

=cut

sub Peers {
	my ($kernel,  $self, $action, $user, $request) =
	  @_[KERNEL, OBJECT,  ARG0,   ARG1, 	ARG2];

	# either we're given a user or just the id
	my $id = ref($user) =~ /User/i ? $user->id : $user;

    $self->Verbose("Peers: $action ".$id );

	my $txt = '';
	my $code;

	# lets see how it goes....
	if ($action eq 'add' && ref($user) =~ /User/i )
	{
		eval { 	$self->push_peers($user); };

		if( $@ )
		{
			$self->Verbose("Peers: self->push_peers(".$user->id.") got (".$@.') ');
			$txt = "Invalid user ".$user->id." : $@ !";
			$code = 400;
		}
		else
		{
			$txt = $action." ".$user->id." successful. ";
			$code = 200;

( run in 0.608 second using v1.01-cache-2.11-cpan-d80b1682f3f )