Initial revision
[OpenSRF.git] / src / perlmods / OpenSRF / Transport / Jabber / JabberClient.pm
1 package OpenSRF::Transport::Jabber::JabberClient;
2 use strict; use warnings;
3 use OpenSRF::EX;
4 use Net::Jabber qw( Client );
5 use base qw( OpenSRF Net::Jabber::Client );
6 use OpenSRF::Utils::Logger qw(:level);
7
8 =head1 Description
9
10 OpenSRF::Transport::Jabber::JabberClient
11
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.
16
17 =cut
18
19 my $logger = "OpenSRF::Utils::Logger";
20
21 sub DESTROY{};
22
23
24 =head2 new()
25
26 Creates a new JabberClient object.  The parameters should be self explanatory.
27 If not, see Net::Jabber::Client for more.  
28
29 debug and log_file are not required if you don't care to log the activity, 
30 however all other parameters are.
31
32 %params:
33
34         host
35         username
36         resource        
37         password
38         debug    
39         log_file
40
41 =cut
42
43 sub new {
44
45         my( $class, %params ) = @_;
46
47         $class = ref( $class ) || $class;
48
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'};
55
56         my $self;
57
58         if( $debug and $log_file ) {
59                 $self = Net::Jabber::Client->new( 
60                                 debuglevel => $debug, debugfile => $log_file );
61         }
62         else { $self = Net::Jabber::Client->new(); }
63
64         bless( $self, $class );
65
66         $self->host( $host );
67         $self->username( $username );
68         $self->resource( $resource );
69         $self->password( $password );
70
71         $logger->transport( "Creating Jabber instance: $host, $username, $resource",
72                         $logger->INFO );
73
74         $self->SetCallBacks( send => 
75                         sub { $logger->transport( "JabberClient in 'send' callback: @_", INTERNAL ); } );
76
77
78         return $self;
79 }
80
81 # -------------------------------------------------
82
83 =head2 gather()
84
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))
88
89 =cut
90
91 sub gather { my $self = shift; $self->Process( 0 ); }
92
93 # -------------------------------------------------
94
95 =head2 listen()
96
97 Blocks and gathers incoming messages as they arrive.  Does not return
98 unless an error occurs.
99
100 Throws an OpenSRF::EX::JabberException if the call to Process ever fails.
101
102 =cut
103 sub listen {
104         my $self = shift;
105         while(1) {
106                 my $o = $self->process( -1 );
107                 if( ! defined( $o ) ) {
108                         throw OpenSRF::EX::Jabber( "Listen Loop failed at 'Process()'" );
109                 }
110         }
111 }
112
113 # -------------------------------------------------
114
115 sub password {
116         my( $self, $password ) = @_;
117         $self->{'oils:password'} = $password if $password;
118         return $self->{'oils:password'};
119 }
120
121 # -------------------------------------------------
122
123 sub username {
124         my( $self, $username ) = @_;
125         $self->{'oils:username'} = $username if $username;
126         return $self->{'oils:username'};
127 }
128         
129 # -------------------------------------------------
130
131 sub resource {
132         my( $self, $resource ) = @_;
133         $self->{'oils:resource'} = $resource if $resource;
134         return $self->{'oils:resource'};
135 }
136
137 # -------------------------------------------------
138
139 sub host {
140         my( $self, $host ) = @_;
141         $self->{'oils:host'} = $host if $host;
142         return $self->{'oils:host'};
143 }
144
145 # -------------------------------------------------
146
147 =head2 send()
148
149         Sends a Jabber message.
150         
151         %params:
152                 to                      - The JID of the recipient
153                 thread  - The Jabber thread
154                 body            - The body of the message
155
156 =cut
157
158 sub send {
159         my( $self, %params ) = @_;
160
161         my $to = $params{'to'} || return undef;
162         my $body = $params{'body'} || return undef;
163         my $thread = $params{'thread'};
164
165         my $msg = Net::Jabber::Message->new();
166
167         $msg->SetTo( $to );
168         $msg->SetThread( $thread ) if $thread;
169         $msg->SetBody( $body );
170
171         $logger->transport( 
172                         "JabberClient Sending message to $to with thread $thread and body: \n$body", INTERNAL );
173
174         $self->Send( $msg );
175 }
176
177
178 =head2 inintialize()
179
180 Connect to the server and log in.  
181
182 Throws an OpenSRF::EX::JabberException if we cannot connect
183 to the server or if the authentication fails.
184
185 =cut
186
187 # --- The logging lines have been commented out until we decide 
188 # on which log files we're using.
189
190 sub initialize {
191
192         my $self = shift;
193
194         my $host                        = $self->host; 
195         my $username    = $self->username;
196         my $resource    = $self->resource;
197         my $password    = $self->password;
198
199         my $jid = "$username\@$host\/$resource";
200
201         # --- 5 tries to connect to the jabber server
202         my $x = 0;
203         for( ; $x != 5; $x++ ) {
204                 $logger->transport( "$jid: Attempting to connecto to server...$x", WARN );
205                 if( $self->Connect( 'hostname' => $host ) ) {
206                         last; 
207                 }
208                 else { sleep 3; }
209         }
210
211         if( $x == 5 ) {
212                 die "could not connect to server $!\n";
213                 throw OpenSRF::EX::Jabber( " Could not connect to Jabber server" );
214         }
215
216         $logger->transport( "Logging into jabber as $jid " .
217                         "from " . ref( $self ), DEBUG );
218
219         # --- Log in
220         my @a = $self->AuthSend( 'username' => $username, 
221                 'password' => $password, 'resource' => $resource );
222
223         if( $a[0] eq "ok" ) { 
224                 $logger->transport( " * $jid: Jabber authenticated and connected", DEBUG );
225         }
226         else {
227                 throw OpenSRF::EX::Jabber( " * $jid: Unable to authenticate: @a" );
228         }
229
230         return $self;
231 }
232
233 sub construct {
234         my( $class, $app ) = @_;
235         $logger->transport("Constructing new Jabber connection for $app", INTERNAL );
236         $class->peer_handle( 
237                         $class->new( $app )->initialize() );
238 }
239
240 sub process {
241
242         my( $self, $timeout ) = @_;
243         if( ! $timeout ) { $timeout = 0; }
244
245         unless( $self->Connected() ) {
246                 OpenSRF::EX::Jabber->throw( 
247                   "This JabberClient instance is no longer connected to the server", ERROR );
248         }
249
250         my $val;
251
252         if( $timeout eq "-1" ) {
253                 $val = $self->Process();
254         }
255         else { $val = $self->Process( $timeout ); }
256
257         if( $timeout eq "-1" ) { $timeout = " "; }
258         
259         if( ! defined( $val ) ) {
260                 OpenSRF::EX::Jabber->throw( 
261                   "Call to Net::Jabber::Client->Process( $timeout ) failed", ERROR );
262         }
263         elsif( ! $val ) {
264                 $logger->transport( 
265                         "Call to Net::Jabber::Client->Process( $timeout ) returned 0 bytes of data", DEBUG );
266         }
267         elsif( $val ) {
268                 $logger->transport( 
269                         "Call to Net::Jabber::Client->Process( $timeout ) successfully returned data", INTERNAL );
270         }
271
272         return $val;
273
274 }
275
276
277 1;