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;