password results from the CPAN

Agent-TCLI


=pod

=head1 NAME

Net::CLI::Transport::XMPP - xmpp transport for Net::CLI

=head1 SYNOPSIS

todo

=head1 DESCRIPTION

=head1 GETTING STARTED

=cut

use warnings;
use strict;
use Carp;
use Date::Parse;

use POE;
use Net::Jabber;
use Socket;
use Agent::TCLI::Control;
use Agent::TCLI::Request;
require Agent::TCLI::Transport::Base;

use Object::InsideOut qw( Agent::TCLI::Transport::Base );
use Params::Validate qw(validate_with);

sub VERBOSE () { 0 }

our $VERSION = '0.031.'.sprintf "%04d", (qw($Id: XMPP.pm 62 2007-05-03 15:55:17Z hacker $))[2];

=head1 INTERFACE

=head2 ATTRIBUTES

The following attributes are accessible through standard accessor/mutator
methods and may be set as a parameter to new unless otherwise noted.

=over

=item jid

xmpp id of user we're connecting as'
B<set_jid> will only accept SCALAR type values.

=cut
my @jid 	   :Field('All' => 'jid', 'Type' => 'Net::XMPP::JID' );

=item jserver

B<jserver> will only accept SCALAR type values.

=cut
my @jserver 	   :Field('All' => 'jserver' );

=item jpassword

The password for the transport to use to log in to the server.
B<jpassword> will only accept scalar type values.

=cut
my @jpassword  :Field('All' => 'jpassword');

=item xmpp_debug

Sets the debug (verbosity) level for the XMPP libraries

=cut
my @xmpp_debug			:Field  :All('xmpp_debug');

=item xmpp_process_time

Sets the time in seconds to wait before calling XMPP Process to look for
more XMPP data. Defaults to 1 and shouldn't be much larger.

=cut
my @xmpp_process_time	:Field
						:Arg('name'=>'xmpp_process_time', 'default'=> 1 )
						:Acc('xmpp_process_time');

=item peers

An array of peers
B<set_peers> will only accept ARRAYREF type values.

=cut
#my @peers 	   :Field('All' => 'peers', 'Type' => 'ARRAY' );

# Holds the XMPP connection session
my @xmpp	 	   :Field('Get' => 'xmpp');

=item connection_retries

A max number to retry connection before giving up.
B<connection_retries> will only accept NUMERIC type values.

=cut
my @connection_retries
			:Field
			:Arg('name'=>'connection_retries','default'=>10)
			:Acc('connection_retries')
			:Type('NUMERIC' );

=item connection_delay

How long to wait beteen connection attempts when failed. Defaults to 30 seconds.
B<connection_delay> will only accept NUMERIC type values.

=cut
my @connection_delay
			:Field
			:Arg('name'=>'connection_delay','default'=>30)
			:Acc('connection_delay')
			:Type('NUMERIC' );

=item roster

Holds the Net::XMPP::Roster if enabled. To enable the roster,
a paramater of 'roster' => 1, must be passed in with new.
B<roster> will contain a Net::XMPP::Roster object after initialization if enabled.

=cut

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


	$args->{'session'} = POE::Session->create(
        object_states => [
        	$self => [ qw(
	            _start
            	_stop
        	    _shutdown
        	    _default
        	    _child

				ControlExecute
        	    Disconnected
        	    JoinPeerRooms
				JoinChatRoom
        	    Login
            	Online
            	Peers
        	    Process
        	    Set
        	    Show

	            recvmsg
	            recvmsgError
	            recvmsgGroupchat
	            recvmsgHeadline

				recv_pres

				recv_iqRequest
				recv_iqResponse

	            send_message
    	        send_presence

				PostRequest
				PostResponse

        	    SendChangeContext

				TransmitRequest
				TransmitResponse

        	)],
        ],
   );

}

sub _init :Init {
	my ($self, $args) = @_;
# Validate deep arguments
#    $self->Verbose("Validating arguments \n" ,1);
#	my %jabber_connection = validate ($args->{'jabber_connection'}, {
#        jabber_package	=> { regex => qr/^POE::Component::Jabber/,
#                            type => Params::Validate::SCALAR | Params::Validate::SCALARREF },
#		server			=> { type => Params::Validate::SCALAR | Params::Validate::SCALARREF },
#		port			=> { optional => 1, default => 5222,
#							callbacks =>
#							{ 'is a number' => sub {  Scalar::Utils->looks_like_a_number($_[0]) }
#							}},
#		password		=> 	{ type => Params::Validate::SCALAR | Params::Validate::SCALARREF },
#	});


}

=back

=head2 METHODS

=over

=item start

Get things rolling. Starts up a POE::Component::Jabber::Client using the user
provided config info.

=cut

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

	# are we up before OIO has finished initializing object?
	if (!defined( $self->alias ))
	{
		$kernel->yield('_start');
		return;
	}

	$self->Verbose("_start: ".$self->alias." Starting up");

	# OK, now we can start up POE stuff.
	$kernel->alias_set($self->alias);

	my $xmpp = Net::Jabber::Client->new(
  		'debuglevel'	=> $xmpp_debug[$$self],
		'debugfile'		=> 'stdout',
	);

  	# Add a namespace for IQ nodes to embed YAML output
	$xmpp->AddNamespace(
			ns    => "tcli:request",
            tag   => "tcli",
            xpath => {
            	'Version'	=> { 'path' => 'version/text()' },
             	'Yaml'		=> { 'path' => 'yaml/text()' },
             	'Request'	=> { 'type' => 'master'},
            }
	);

#	$self->Verbose("_start: Setting General XMPP Callbacks" , 2 );

#	$xmpp->SetCallBacks(
#		'send'			=> $session->postback('VerboseCallBack'),
#		'receive'		=> $session->postback('VerboseCallBack'),
#		'presence'		=> $session->postback('recv_presence'),
#		'iq'			=> $session->postback('recv_iq'),
#	);

	$self->Verbose("_start: Setting XMPP Message Callbacks" , 2 );

	$xmpp->SetMessageCallBacks(
    	'normal'		=> $session->postback('recvmsg'),
	    'chat'			=> $session->postback('recvmsg'),
    	'groupchat'		=> $session->postback('recvmsgGroupchat'),
    	'headline'		=> $session->postback('recvmsgHeadline'),
    	'error'			=> $session->postback('recvmsgError'),
	);

#	$xmpp->SetPresenceCallBacks(
#    	available	=> $session->postback('recv_pres'),
#		unavailable	=> $session->postback('recv_pres'),
#	);

    $xmpp->SetIQCallBacks(
		'tcli:request'	=> {
			'get'	=>	$session->postback('recv_iqRequest'),
		#	'set'	=>	function,
			'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,
	);

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

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

( run in 0.906 second using v1.01-cache-2.11-cpan-d8267643d1d )