1 package OpenSRF::Transport::Jabber::JabberClient;
2 use strict; use warnings;
4 use Net::Jabber qw( Client );
5 use base qw( OpenSRF Net::Jabber::Client );
6 use OpenSRF::Utils::Logger qw(:level);
10 OpenSRF::Transport::Jabber::JabberClient
12 Subclasses Net::Jabber::Client and, hence, provides the same
13 functionality. What it provides in addition is mainly some logging
14 and exception throwing on the call to 'initialize()', which sets
15 up the connection and authentication.
19 my $logger = "OpenSRF::Utils::Logger";
26 Creates a new JabberClient object. The parameters should be self explanatory.
27 If not, see Net::Jabber::Client for more.
29 debug and log_file are not required if you don't care to log the activity,
30 however all other parameters are.
45 my( $class, %params ) = @_;
47 $class = ref( $class ) || $class;
49 my $host = $params{'host'} || return undef;
50 my $username = $params{'username'} || return undef;
51 my $resource = $params{'resource'} || return undef;
52 my $password = $params{'password'} || return undef;
53 my $debug = $params{'debug'};
54 my $log_file = $params{'log_file'};
58 if( $debug and $log_file ) {
59 $self = Net::Jabber::Client->new(
60 debuglevel => $debug, debugfile => $log_file );
62 else { $self = Net::Jabber::Client->new(); }
64 bless( $self, $class );
67 $self->username( $username );
68 $self->resource( $resource );
69 $self->password( $password );
71 $logger->transport( "Creating Jabber instance: $host, $username, $resource",
74 $self->SetCallBacks( send =>
75 sub { $logger->transport( "JabberClient in 'send' callback: @_", INTERNAL ); } );
81 # -------------------------------------------------
85 Gathers all Jabber messages sitting in the collection queue
86 and hands them each to their respective callbacks. This call
87 does not block (calls Process(0))
91 sub gather { my $self = shift; $self->Process( 0 ); }
93 # -------------------------------------------------
97 Blocks and gathers incoming messages as they arrive. Does not return
98 unless an error occurs.
100 Throws an OpenSRF::EX::JabberException if the call to Process ever fails.
106 my $o = $self->process( -1 );
107 if( ! defined( $o ) ) {
108 throw OpenSRF::EX::Jabber( "Listen Loop failed at 'Process()'" );
113 # -------------------------------------------------
116 my( $self, $password ) = @_;
117 $self->{'oils:password'} = $password if $password;
118 return $self->{'oils:password'};
121 # -------------------------------------------------
124 my( $self, $username ) = @_;
125 $self->{'oils:username'} = $username if $username;
126 return $self->{'oils:username'};
129 # -------------------------------------------------
132 my( $self, $resource ) = @_;
133 $self->{'oils:resource'} = $resource if $resource;
134 return $self->{'oils:resource'};
137 # -------------------------------------------------
140 my( $self, $host ) = @_;
141 $self->{'oils:host'} = $host if $host;
142 return $self->{'oils:host'};
145 # -------------------------------------------------
149 Sends a Jabber message.
152 to - The JID of the recipient
153 thread - The Jabber thread
154 body - The body of the message
159 my( $self, %params ) = @_;
161 my $to = $params{'to'} || return undef;
162 my $body = $params{'body'} || return undef;
163 my $thread = $params{'thread'};
165 my $msg = Net::Jabber::Message->new();
168 $msg->SetThread( $thread ) if $thread;
169 $msg->SetBody( $body );
172 "JabberClient Sending message to $to with thread $thread and body: \n$body", INTERNAL );
180 Connect to the server and log in.
182 Throws an OpenSRF::EX::JabberException if we cannot connect
183 to the server or if the authentication fails.
187 # --- The logging lines have been commented out until we decide
188 # on which log files we're using.
194 my $host = $self->host;
195 my $username = $self->username;
196 my $resource = $self->resource;
197 my $password = $self->password;
199 my $jid = "$username\@$host\/$resource";
201 # --- 5 tries to connect to the jabber server
203 for( ; $x != 5; $x++ ) {
204 $logger->transport( "$jid: Attempting to connecto to server...$x", WARN );
205 if( $self->Connect( 'hostname' => $host ) ) {
212 die "could not connect to server $!\n";
213 throw OpenSRF::EX::Jabber( " Could not connect to Jabber server" );
216 $logger->transport( "Logging into jabber as $jid " .
217 "from " . ref( $self ), DEBUG );
220 my @a = $self->AuthSend( 'username' => $username,
221 'password' => $password, 'resource' => $resource );
223 if( $a[0] eq "ok" ) {
224 $logger->transport( " * $jid: Jabber authenticated and connected", DEBUG );
227 throw OpenSRF::EX::Jabber( " * $jid: Unable to authenticate: @a" );
234 my( $class, $app ) = @_;
235 $logger->transport("Constructing new Jabber connection for $app", INTERNAL );
237 $class->new( $app )->initialize() );
242 my( $self, $timeout ) = @_;
243 if( ! $timeout ) { $timeout = 0; }
245 unless( $self->Connected() ) {
246 OpenSRF::EX::Jabber->throw(
247 "This JabberClient instance is no longer connected to the server", ERROR );
252 if( $timeout eq "-1" ) {
253 $val = $self->Process();
255 else { $val = $self->Process( $timeout ); }
257 if( $timeout eq "-1" ) { $timeout = " "; }
259 if( ! defined( $val ) ) {
260 OpenSRF::EX::Jabber->throw(
261 "Call to Net::Jabber::Client->Process( $timeout ) failed", ERROR );
265 "Call to Net::Jabber::Client->Process( $timeout ) returned 0 bytes of data", DEBUG );
269 "Call to Net::Jabber::Client->Process( $timeout ) successfully returned data", INTERNAL );