| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Net::XMPP::Client::GTalk ; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 24208 | use 5.006                        ; | 
|  | 1 |  |  |  |  | 4 |  | 
|  | 1 |  |  |  |  | 58 |  | 
| 4 | 1 |  |  | 1 |  | 6 | use strict                       ; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 38 |  | 
| 5 | 1 |  |  | 1 |  | 5 | use warnings FATAL => 'all'      ; | 
|  | 1 |  |  |  |  | 12 |  | 
|  | 1 |  |  |  |  | 46 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 1 |  |  | 1 |  | 5 | use Carp                         ; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 78 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 | 1 |  |  | 1 |  | 934 | use Net::XMPP                    ; | 
|  | 1 |  |  |  |  | 190768 |  | 
|  | 1 |  |  |  |  | 28 |  | 
| 10 | 1 |  |  | 1 |  | 992 | use XML::Smart                   ; | 
|  | 1 |  |  |  |  | 27332 |  | 
|  | 1 |  |  |  |  | 2309 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | =head1 NAME | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | Net::XMPP::Client::GTalk - This module provides an easy to use wrapper around the Net::XMPP class of modules for specific access to GTalk ( Both on Gmail and Google Apps ). | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | =head1 VERSION | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | Version 0.01 | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | =cut | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | our $VERSION = '0.01'; | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | =head1 GLOBAL VARIABLES | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | our $COMMUNICATION    ; | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | our $RECEIVE_CALLBACK ; | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | =cut | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | our $COMMUNICATION    ; | 
| 33 |  |  |  |  |  |  | our $RECEIVE_CALLBACK ; | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | This module provides an easy to use wrapper around the Net::XMPP class of modules for specific access to GTalk ( Both on Gmail and Google Apps ). | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | Example: | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | This example connects to GTalk and waits for a chat message from someone. It replies to that person with the chat message that it received. | 
| 42 |  |  |  |  |  |  | Additionally it will dump online buddies at regular intervals along with the contents of the message it receives. | 
| 43 |  |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  | You can quit this program by sending it the chat message 'exit'. | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | use Net::XMPP::Client::GTalk    ; | 
| 48 |  |  |  |  |  |  | use Data::Dump qw( dump )       ; | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | my $username ; # = '' ; Set GTalk username here [ WITHOUT '@gmail.com' ]. | 
| 51 |  |  |  |  |  |  | my $password ; # = '' ; Set GTalk password here. | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  |  | 
| 54 |  |  |  |  |  |  | unless( defined( $username ) and defined( $password ) ) { | 
| 55 |  |  |  |  |  |  | die( "SET YOUR GTALK USERNAME AND PASSWORD ABOVE!\n" ) ; | 
| 56 |  |  |  |  |  |  | } | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | # See options for domain below in documentation for new. | 
| 59 |  |  |  |  |  |  | my $ob = new Net::XMPP::Client::GTalk( | 
| 60 |  |  |  |  |  |  | USERNAME   =>  $username         , | 
| 61 |  |  |  |  |  |  | PASSWORD   =>  $password         , | 
| 62 |  |  |  |  |  |  | ); | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | my $require_run = 1 ; | 
| 66 |  |  |  |  |  |  | my $iteration   = 1 ; | 
| 67 |  |  |  |  |  |  | while( $require_run ) { | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | my $message = $ob->wait_for_message( 60 ) ; | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | unless( $message ) { | 
| 72 |  |  |  |  |  |  | print "GOT NO MESSAGE - waiting longer\n" ; | 
| 73 |  |  |  |  |  |  | } | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | if( $message->{ error } ) { | 
| 76 |  |  |  |  |  |  | print "ERROR \n" ; | 
| 77 |  |  |  |  |  |  | next             ; | 
| 78 |  |  |  |  |  |  | } else { | 
| 79 |  |  |  |  |  |  | dump( $message ) ; | 
| 80 |  |  |  |  |  |  | } | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | if( $message->{ message } eq 'exit' ) { | 
| 83 |  |  |  |  |  |  | print "Asked to exit by " . $message->{ from } . "\n" ; | 
| 84 |  |  |  |  |  |  | $message->{ message } = 'Exiting ... ' ; | 
| 85 |  |  |  |  |  |  | $require_run = 0 ; | 
| 86 |  |  |  |  |  |  | } | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | $ob->send_message( $message->{ from }, $message->{ message } ) ; | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | if( int( $iteration / 3 ) == ( $iteration / 3 ) ) { | 
| 91 |  |  |  |  |  |  | my @online_buddies = @{ $ob->get_online_buddies() } ; | 
| 92 |  |  |  |  |  |  | dump( \@online_buddies ) ; | 
| 93 |  |  |  |  |  |  | } | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | $iteration++ ; | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  | } | 
| 98 |  |  |  |  |  |  |  | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | exit() ; | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  |  | 
| 103 |  |  |  |  |  |  | =head1 USAGE NOTES | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | The NET::XMPP connection object is available through $object_of_Net_XMPP_Client_GTalk->{ RAW_CONNECTION } and can be used to call | 
| 106 |  |  |  |  |  |  | all functions of the NET::XMPP class of modules ( listed below ). | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | It should be noted, however, that calling the SetCallBacks function on the NET::XMPP object will cause wait_for_message to fail. | 
| 109 |  |  |  |  |  |  | SetCallBacks can be called indirectly through new as follows: | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | my $ob = new Net::XMPP::Client::GTalk( | 
| 112 |  |  |  |  |  |  | USERNAME     =>  $username         , | 
| 113 |  |  |  |  |  |  | PASSWORD     =>  $password         , | 
| 114 |  |  |  |  |  |  | DOMAIN       => 'gmail.com'        ,           # [ OPTIONAL ] [ DEFAULT gmail.com - set if other such as google apps domain ] | 
| 115 |  |  |  |  |  |  | SetCallBacks =>  { | 
| 116 |  |  |  |  |  |  | message     =>  \&function , | 
| 117 |  |  |  |  |  |  | presence    =>  \&function , | 
| 118 |  |  |  |  |  |  | iq          =>  \&function , | 
| 119 |  |  |  |  |  |  | send        =>  \&function , | 
| 120 |  |  |  |  |  |  | receive     =>  \&function , | 
| 121 |  |  |  |  |  |  | update      =>  \&function , | 
| 122 |  |  |  |  |  |  | }                                , | 
| 123 |  |  |  |  |  |  | RESOURCE     => 'My Chat Prog'     , | 
| 124 |  |  |  |  |  |  | ) ; | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | Other than USERNAME and PASSWORD the other two parameters above are optional. | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | The presence_send function does NOT update the chat status. This is because the corresponding NET::XMPP functions do not work. | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | Additionally the following does NOT work and this module provides get_online_buddies as a work around. | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | my $roster = $NET_XMPP_Connection->Roster(); | 
| 133 |  |  |  |  |  |  | my $user   = $roster->online( 'somebuddy@gmail.com' ); | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | The value of resource can be changed as shown above. | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | The connection to GTalk does not have to be explicitly disconnected as it is automatically done when this module object goes out of | 
| 138 |  |  |  |  |  |  | scope or when the program terminates. It is a B idea to do: $object_of_Net_XMPP_Client_GTalk->{ RAW_CONNECTION }->Disconnect(); | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | Modules from which you can use functions include: | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | Net::XMPP | 
| 143 |  |  |  |  |  |  | Net::XMPP::Client | 
| 144 |  |  |  |  |  |  | Net::XMPP::Connection | 
| 145 |  |  |  |  |  |  | Net::XMPP::Debug | 
| 146 |  |  |  |  |  |  | Net::XMPP::IQ | 
| 147 |  |  |  |  |  |  | Net::XMPP::JID | 
| 148 |  |  |  |  |  |  | Net::XMPP::Message | 
| 149 |  |  |  |  |  |  | Net::XMPP::Namespaces | 
| 150 |  |  |  |  |  |  | Net::XMPP::Presence | 
| 151 |  |  |  |  |  |  | Net::XMPP::PrivacyLists | 
| 152 |  |  |  |  |  |  | Net::XMPP::Protocol | 
| 153 |  |  |  |  |  |  | Net::XMPP::Roster | 
| 154 |  |  |  |  |  |  | Net::XMPP::Stanza | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  |  | 
| 157 |  |  |  |  |  |  | THREADS: This module is B. To use it within a thread you need to require this module from within the thread. | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | B If the person you are sending a chat message to is not online then they will not receive an offline chat message, | 
| 160 |  |  |  |  |  |  | however, if they come online before the program terminates they will receive the chat. | 
| 161 |  |  |  |  |  |  |  | 
| 162 |  |  |  |  |  |  | =head1 EXPORT | 
| 163 |  |  |  |  |  |  |  | 
| 164 |  |  |  |  |  |  | This is a purely object-oriented module and does not export anything. | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | =head1 SUBROUTINES/METHODS | 
| 167 |  |  |  |  |  |  |  | 
| 168 |  |  |  |  |  |  | =head2 new | 
| 169 |  |  |  |  |  |  |  | 
| 170 |  |  |  |  |  |  | Usage: | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | my $ob = new Net::XMPP::Client::GTalk( | 
| 173 |  |  |  |  |  |  | USERNAME     =>  $username         , | 
| 174 |  |  |  |  |  |  | PASSWORD     =>  $password         , | 
| 175 |  |  |  |  |  |  | DOMAIN       => 'gmail.com'        ,           # [ OPTIONAL ] [ DEFAULT gmail.com - set if other such as google apps domain ] | 
| 176 |  |  |  |  |  |  | SetCallBacks =>  {                             # [ OPTIONAL ] | 
| 177 |  |  |  |  |  |  | message     =>  \&function , | 
| 178 |  |  |  |  |  |  | presence    =>  \&function , | 
| 179 |  |  |  |  |  |  | iq          =>  \&function , | 
| 180 |  |  |  |  |  |  | send        =>  \&function , | 
| 181 |  |  |  |  |  |  | receive     =>  \&function , | 
| 182 |  |  |  |  |  |  | update      =>  \&function , | 
| 183 |  |  |  |  |  |  | }                                , | 
| 184 |  |  |  |  |  |  | RESOURCE     => 'My Chat Prog'     ,           # [ OPTIONAL ] | 
| 185 |  |  |  |  |  |  | ) ; | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | =cut | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | sub new { | 
| 190 |  |  |  |  |  |  |  | 
| 191 | 0 |  |  | 0 | 1 |  | my $class = shift; | 
| 192 |  |  |  |  |  |  |  | 
| 193 | 0 |  |  |  |  |  | my %parameter_hash; | 
| 194 |  |  |  |  |  |  |  | 
| 195 | 0 |  |  |  |  |  | my $count = @_; | 
| 196 |  |  |  |  |  |  |  | 
| 197 | 0 |  |  |  |  |  | my $useage_howto = " | 
| 198 |  |  |  |  |  |  |  | 
| 199 |  |  |  |  |  |  | Usage: | 
| 200 |  |  |  |  |  |  |  | 
| 201 |  |  |  |  |  |  | my \$ob = new Net::XMPP::Client::GTalk( | 
| 202 |  |  |  |  |  |  | USERNAME     =>  \$username         , | 
| 203 |  |  |  |  |  |  | PASSWORD     =>  \$password         , | 
| 204 |  |  |  |  |  |  | DOMAIN       => 'gmail.com'        ,           # [ OPTIONAL ] [ DEFAULT gmail.com - set if other such as google apps domain ] | 
| 205 |  |  |  |  |  |  | SetCallBacks =>  {                             # [ OPTIONAL ] | 
| 206 |  |  |  |  |  |  | message     =>  \&function , | 
| 207 |  |  |  |  |  |  | presence    =>  \&function , | 
| 208 |  |  |  |  |  |  | iq          =>  \&function , | 
| 209 |  |  |  |  |  |  | send        =>  \&function , | 
| 210 |  |  |  |  |  |  | receive     =>  \&function , | 
| 211 |  |  |  |  |  |  | update      =>  \&function , | 
| 212 |  |  |  |  |  |  | }                                , | 
| 213 |  |  |  |  |  |  | RESOURCE     => 'My Chat Prog'     ,           # [ OPTIONAL ] | 
| 214 |  |  |  |  |  |  | ) ; | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | "; | 
| 217 |  |  |  |  |  |  |  | 
| 218 | 0 |  |  |  |  |  | %parameter_hash = @_ ; | 
| 219 |  |  |  |  |  |  |  | 
| 220 | 0 | 0 |  |  |  |  | croak( $useage_howto )           unless( $parameter_hash{ USERNAME    }   ) ; | 
| 221 | 0 | 0 |  |  |  |  | croak( $useage_howto )           unless( $parameter_hash{ PASSWORD    }   ) ; | 
| 222 |  |  |  |  |  |  |  | 
| 223 | 0 | 0 |  |  |  |  | $parameter_hash{ DEBUG     } = 0 unless( $parameter_hash{ DEBUG       }   ) ; | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | $parameter_hash{ RESOURCE  } = 'Net::XMPP::Client::GTalk-V:' . $VERSION | 
| 226 | 0 | 0 |  |  |  |  | unless( $parameter_hash{ RESOURCE } ) ; | 
| 227 |  |  |  |  |  |  |  | 
| 228 | 0 | 0 |  |  |  |  | $parameter_hash{ DOMAIN    } = 'gmail.com' unless( $parameter_hash{ DOMAIN } ) ; | 
| 229 |  |  |  |  |  |  |  | 
| 230 | 0 |  |  |  |  |  | my %call_backs ; | 
| 231 | 0 | 0 |  |  |  |  | if( defined( $parameter_hash{ SetCallBacks } ) ) { | 
| 232 |  |  |  |  |  |  |  | 
| 233 | 0 |  |  |  |  |  | $RECEIVE_CALLBACK = $parameter_hash{ receive } ; | 
| 234 |  |  |  |  |  |  |  | 
| 235 | 0 |  |  |  |  |  | $call_backs{ receive } = \&_receive_callback  ; | 
| 236 |  |  |  |  |  |  |  | 
| 237 | 0 | 0 |  |  |  |  | if( defined( $parameter_hash{ SetCallBacks }{ message } ) ) { | 
| 238 | 0 |  |  |  |  |  | $call_backs{ message  } = $parameter_hash{ SetCallBacks }{ message  } ; | 
| 239 |  |  |  |  |  |  | } | 
| 240 |  |  |  |  |  |  |  | 
| 241 | 0 | 0 |  |  |  |  | if( defined( $parameter_hash{ SetCallBacks }{ send    } ) ) { | 
| 242 | 0 |  |  |  |  |  | $call_backs{ send     } = $parameter_hash{ SetCallBacks }{ send     } ; | 
| 243 |  |  |  |  |  |  | } | 
| 244 |  |  |  |  |  |  |  | 
| 245 | 0 | 0 |  |  |  |  | if( defined( $parameter_hash{ SetCallBacks }{ iq      } ) ) { | 
| 246 | 0 |  |  |  |  |  | $call_backs{ iq       } = $parameter_hash{ SetCallBacks }{ iq       } ; | 
| 247 |  |  |  |  |  |  | } | 
| 248 |  |  |  |  |  |  |  | 
| 249 | 0 | 0 |  |  |  |  | if( defined( $parameter_hash{ SetCallBacks }{ presence     } ) ) { | 
| 250 | 0 |  |  |  |  |  | $call_backs{ presence } = $parameter_hash{ SetCallBacks }{ presence } ; | 
| 251 |  |  |  |  |  |  | } | 
| 252 |  |  |  |  |  |  |  | 
| 253 | 0 | 0 |  |  |  |  | if( defined( $parameter_hash{ SetCallBacks }{ update       } ) ) { | 
| 254 | 0 |  |  |  |  |  | $call_backs{ update   } = $parameter_hash{ SetCallBacks }{ update   } ; | 
| 255 |  |  |  |  |  |  | } | 
| 256 |  |  |  |  |  |  |  | 
| 257 |  |  |  |  |  |  | } else { | 
| 258 | 0 |  |  |  |  |  | $call_backs{ receive } = \&_receive_callback  ; | 
| 259 |  |  |  |  |  |  | } | 
| 260 |  |  |  |  |  |  |  | 
| 261 |  |  |  |  |  |  |  | 
| 262 | 0 |  |  |  |  |  | my $username = $parameter_hash{ USERNAME } ; | 
| 263 | 0 |  |  |  |  |  | my $password = $parameter_hash{ PASSWORD } ; | 
| 264 |  |  |  |  |  |  |  | 
| 265 | 0 |  |  |  |  |  | my $resource          = $parameter_hash{ RESOURCE }              ; | 
| 266 | 0 |  |  |  |  |  | my $componentname     = $parameter_hash{ DOMAIN   }              ; | 
| 267 | 0 |  |  |  |  |  | my $hostname          = 'talk.google.com'                        ; | 
| 268 | 0 |  |  |  |  |  | my $connectiontype    = 'tcpip'                                  ; | 
| 269 | 0 |  |  |  |  |  | my $port              = 5222                                     ; | 
| 270 | 0 |  |  |  |  |  | my $tls               = 1                                        ; | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  |  | 
| 273 | 0 |  |  |  |  |  | my $connection = new Net::XMPP::Client()      ; | 
| 274 | 0 |  |  |  |  |  | my %params = ( | 
| 275 |  |  |  |  |  |  | tls               => $tls                , | 
| 276 |  |  |  |  |  |  | port              => $port               , | 
| 277 |  |  |  |  |  |  | hostname          => $hostname           , | 
| 278 |  |  |  |  |  |  | componentname     => $componentname      , | 
| 279 |  |  |  |  |  |  | connectiontype    => $connectiontype     , | 
| 280 |  |  |  |  |  |  | ); | 
| 281 |  |  |  |  |  |  |  | 
| 282 | 0 |  |  |  |  |  | my $res = _connect( | 
| 283 |  |  |  |  |  |  | $connection                              , | 
| 284 |  |  |  |  |  |  | $username                                , | 
| 285 |  |  |  |  |  |  | $password                                , | 
| 286 |  |  |  |  |  |  | $resource                                , | 
| 287 |  |  |  |  |  |  | \%params                                 , | 
| 288 |  |  |  |  |  |  | \%call_backs                             , | 
| 289 |  |  |  |  |  |  | ) ; | 
| 290 |  |  |  |  |  |  |  | 
| 291 |  |  |  |  |  |  |  | 
| 292 | 0 |  |  |  |  |  | my @online_buddies ; | 
| 293 |  |  |  |  |  |  |  | 
| 294 |  |  |  |  |  |  | my $self = { | 
| 295 |  |  |  |  |  |  |  | 
| 296 |  |  |  |  |  |  | RAW_CONNECTION      => $connection                   , | 
| 297 |  |  |  |  |  |  | ONLINE_BUDDIES      => \@online_buddies              , | 
| 298 |  |  |  |  |  |  |  | 
| 299 |  |  |  |  |  |  | LAST_PRESENCE_SEND  => 0                             , | 
| 300 |  |  |  |  |  |  |  | 
| 301 |  |  |  |  |  |  | DEBUG               => $parameter_hash{ DEBUG     }  , | 
| 302 |  |  |  |  |  |  |  | 
| 303 | 0 |  |  |  |  |  | _USERNAME           => $username                     , | 
| 304 |  |  |  |  |  |  | _PASSWORD           => $password                     , | 
| 305 |  |  |  |  |  |  | _RESOURCE           => $resource                     , | 
| 306 |  |  |  |  |  |  | _PARAMS             => \%params                      , | 
| 307 |  |  |  |  |  |  |  | 
| 308 |  |  |  |  |  |  | _CALLBACKS          => \%call_backs                  , | 
| 309 |  |  |  |  |  |  |  | 
| 310 |  |  |  |  |  |  | }; | 
| 311 |  |  |  |  |  |  |  | 
| 312 |  |  |  |  |  |  | ## Private and class data here. | 
| 313 |  |  |  |  |  |  |  | 
| 314 | 0 |  |  |  |  |  | bless( $self, $class ); | 
| 315 |  |  |  |  |  |  |  | 
| 316 | 0 |  |  |  |  |  | return $self; | 
| 317 |  |  |  |  |  |  |  | 
| 318 |  |  |  |  |  |  | } | 
| 319 |  |  |  |  |  |  |  | 
| 320 |  |  |  |  |  |  |  | 
| 321 |  |  |  |  |  |  | =head2 send_message | 
| 322 |  |  |  |  |  |  |  | 
| 323 |  |  |  |  |  |  | This function sends a message to a contact. ( eg: $ob->send_message( $to, $message ) ) | 
| 324 |  |  |  |  |  |  |  | 
| 325 |  |  |  |  |  |  | =cut | 
| 326 |  |  |  |  |  |  |  | 
| 327 |  |  |  |  |  |  | sub send_message { | 
| 328 |  |  |  |  |  |  |  | 
| 329 | 0 |  |  | 0 | 1 |  | my $self    = shift ; | 
| 330 | 0 |  |  |  |  |  | my $to      = shift ; | 
| 331 | 0 |  |  |  |  |  | my $message = shift ; | 
| 332 |  |  |  |  |  |  |  | 
| 333 | 0 | 0 |  |  |  |  | unless( UNIVERSAL::isa( $self, 'Net::XMPP::Client::GTalk' )  ) { | 
| 334 | 0 |  |  |  |  |  | croak( 'Function needs to be called on the Net::XMPP::Client::GTalk object, please see documentation for details.' . "\n" ) ; | 
| 335 |  |  |  |  |  |  | } | 
| 336 |  |  |  |  |  |  |  | 
| 337 |  |  |  |  |  |  |  | 
| 338 | 0 | 0 |  |  |  |  | return 0 unless( $to )             ; | 
| 339 |  |  |  |  |  |  |  | 
| 340 |  |  |  |  |  |  | $self->{ RAW_CONNECTION }->MessageSend( | 
| 341 |  |  |  |  |  |  | to         => $to                                   , | 
| 342 |  |  |  |  |  |  | body       => $message                              , | 
| 343 |  |  |  |  |  |  | resource   => $self->{ _RESOURCE }                  , | 
| 344 |  |  |  |  |  |  | subject    => 'Message via ' . $self->{ _RESOURCE } , | 
| 345 | 0 |  |  |  |  |  | type       => 'chat'                                , | 
| 346 |  |  |  |  |  |  |  | 
| 347 |  |  |  |  |  |  | # thread     =>"id"            , | 
| 348 |  |  |  |  |  |  | ); | 
| 349 |  |  |  |  |  |  |  | 
| 350 | 0 |  |  |  |  |  | return 1; | 
| 351 |  |  |  |  |  |  |  | 
| 352 |  |  |  |  |  |  | } | 
| 353 |  |  |  |  |  |  |  | 
| 354 |  |  |  |  |  |  |  | 
| 355 |  |  |  |  |  |  | =head2 wait_for_message | 
| 356 |  |  |  |  |  |  |  | 
| 357 |  |  |  |  |  |  | This function waits for a message for a maximum of 10 sec ( or for the duration set by parameter ), | 
| 358 |  |  |  |  |  |  | returns the parsed message in a hash if there is one or undef it there is none. | 
| 359 |  |  |  |  |  |  |  | 
| 360 |  |  |  |  |  |  | The difference between this and wait_for_communication is that this will only return a chat message | 
| 361 |  |  |  |  |  |  | recieved and not other communications such as pings. | 
| 362 |  |  |  |  |  |  |  | 
| 363 |  |  |  |  |  |  | Pings recieved for presence of a buddy online are used to update the 'online_buddy' list ( see get_buddies below ). | 
| 364 |  |  |  |  |  |  |  | 
| 365 |  |  |  |  |  |  | =cut | 
| 366 |  |  |  |  |  |  |  | 
| 367 |  |  |  |  |  |  | sub wait_for_message { | 
| 368 |  |  |  |  |  |  |  | 
| 369 | 0 |  |  | 0 | 1 |  | my $self        = shift ; | 
| 370 | 0 |  |  |  |  |  | my $wait_time   = shift ; | 
| 371 |  |  |  |  |  |  |  | 
| 372 | 0 |  |  |  |  |  | my $start_time  = time  ; | 
| 373 | 0 |  |  |  |  |  | my $got_message         ; | 
| 374 |  |  |  |  |  |  |  | 
| 375 | 0 | 0 |  |  |  |  | unless( UNIVERSAL::isa( $self, 'Net::XMPP::Client::GTalk' )  ) { | 
| 376 | 0 |  |  |  |  |  | croak( 'Function needs to be called on the Net::XMPP::Client::GTalk object, please see documentation for details.' . "\n" ) ; | 
| 377 |  |  |  |  |  |  | } | 
| 378 |  |  |  |  |  |  |  | 
| 379 | 0 |  |  |  |  |  | while( $wait_time ) { | 
| 380 | 0 | 0 |  |  |  |  | if( $self->wait_for_communication( $wait_time ) ) { | 
| 381 | 0 |  |  |  |  |  | my $communication = $COMMUNICATION ; | 
| 382 | 0 |  |  |  |  |  | $COMMUNICATION    = ''             ; | 
| 383 |  |  |  |  |  |  |  | 
| 384 | 0 |  |  |  |  |  | my $parsed_communication = $self->_parse_communication( $communication ) ; | 
| 385 |  |  |  |  |  |  |  | 
| 386 | 0 | 0 |  |  |  |  | if( $parsed_communication->{ message } ) { | 
| 387 | 0 |  |  |  |  |  | return    $self->_process_message_communication(     $parsed_communication ) ; | 
| 388 |  |  |  |  |  |  | } else { | 
| 389 | 0 |  |  |  |  |  | my $val = $self->_process_non_message_communication( $parsed_communication ) ; | 
| 390 |  |  |  |  |  |  |  | 
| 391 | 0 | 0 |  |  |  |  | if( defined( $val ) ) { | 
| 392 | 0 | 0 |  |  |  |  | if( defined( $got_message ) ) { | 
| 393 | 0 | 0 |  |  |  |  | if( $got_message == 1 ) { | 
| 394 | 0 |  |  |  |  |  | $got_message = $got_message ; | 
| 395 |  |  |  |  |  |  | } else { | 
| 396 | 0 |  |  |  |  |  | $got_message = $val         ; | 
| 397 |  |  |  |  |  |  | } | 
| 398 |  |  |  |  |  |  | } else { | 
| 399 | 0 |  |  |  |  |  | $got_message = $val ; | 
| 400 |  |  |  |  |  |  | } | 
| 401 |  |  |  |  |  |  | } else { | 
| 402 | 0 |  |  |  |  |  | $got_message = $got_message ; | 
| 403 |  |  |  |  |  |  | } | 
| 404 |  |  |  |  |  |  |  | 
| 405 |  |  |  |  |  |  |  | 
| 406 |  |  |  |  |  |  | } | 
| 407 |  |  |  |  |  |  |  | 
| 408 |  |  |  |  |  |  | } | 
| 409 |  |  |  |  |  |  |  | 
| 410 | 0 |  |  |  |  |  | $wait_time = $wait_time - ( time() - $start_time ) ; | 
| 411 |  |  |  |  |  |  | } | 
| 412 |  |  |  |  |  |  |  | 
| 413 | 0 |  |  |  |  |  | return $got_message ; | 
| 414 |  |  |  |  |  |  |  | 
| 415 |  |  |  |  |  |  | } | 
| 416 |  |  |  |  |  |  |  | 
| 417 |  |  |  |  |  |  | =head2 wait_for_communication | 
| 418 |  |  |  |  |  |  |  | 
| 419 |  |  |  |  |  |  | This function waits for any kind of communication from GTalk for a maximum of 10 sec ( or for the duration set by parameter ), | 
| 420 |  |  |  |  |  |  | returns the raw xml of the message or undef if there is none. | 
| 421 |  |  |  |  |  |  |  | 
| 422 |  |  |  |  |  |  | =cut | 
| 423 |  |  |  |  |  |  |  | 
| 424 |  |  |  |  |  |  | sub wait_for_communication { | 
| 425 |  |  |  |  |  |  |  | 
| 426 | 0 |  |  | 0 | 1 |  | my $self      = shift ; | 
| 427 | 0 |  |  |  |  |  | my $wait_time = shift ; | 
| 428 |  |  |  |  |  |  |  | 
| 429 | 0 | 0 |  |  |  |  | unless( UNIVERSAL::isa( $self, 'Net::XMPP::Client::GTalk' )  ) { | 
| 430 | 0 |  |  |  |  |  | croak( 'Function needs to be called on the Net::XMPP::Client::GTalk object, please see documentation for details.' . "\n" ) ; | 
| 431 |  |  |  |  |  |  | } | 
| 432 |  |  |  |  |  |  |  | 
| 433 | 0 | 0 |  |  |  |  | $wait_time = defined( $wait_time ) ? $wait_time : 10 ; | 
| 434 |  |  |  |  |  |  |  | 
| 435 | 0 |  |  |  |  |  | $self->presence_send()                                             ; | 
| 436 | 0 |  |  |  |  |  | my $got_message = $self->{ RAW_CONNECTION }->Process( $wait_time ) ; | 
| 437 | 0 |  |  |  |  |  | $self->presence_send()                                             ; | 
| 438 |  |  |  |  |  |  |  | 
| 439 | 0 |  |  |  |  |  | return $got_message ; | 
| 440 |  |  |  |  |  |  |  | 
| 441 |  |  |  |  |  |  | } | 
| 442 |  |  |  |  |  |  |  | 
| 443 |  |  |  |  |  |  | =head2 presence_send | 
| 444 |  |  |  |  |  |  |  | 
| 445 |  |  |  |  |  |  | This function sends out a presence based on the last presence send timestamp. The presence ping sent to GTalk will show | 
| 446 |  |  |  |  |  |  | the authenticated user as 'online'. | 
| 447 |  |  |  |  |  |  |  | 
| 448 |  |  |  |  |  |  | It should be noted that wait_for_message, wait_for_communication and send_message all call this function and | 
| 449 |  |  |  |  |  |  | so calling it is explicitly not required unless those functions are not called for a significantly long time ( i.e. over 300 sec ). | 
| 450 |  |  |  |  |  |  |  | 
| 451 |  |  |  |  |  |  | This function takes no parameters by default but if called with any non zero value [ ex: $object->presence_send( 1 ) ] | 
| 452 |  |  |  |  |  |  | it will force send a presence request regardless of when the last one was sent. | 
| 453 |  |  |  |  |  |  |  | 
| 454 |  |  |  |  |  |  | =cut | 
| 455 |  |  |  |  |  |  |  | 
| 456 |  |  |  |  |  |  | sub presence_send { | 
| 457 |  |  |  |  |  |  |  | 
| 458 | 0 |  |  | 0 | 1 |  | my $self       = shift ; | 
| 459 | 0 |  |  |  |  |  | my $force_send = shift ; | 
| 460 |  |  |  |  |  |  |  | 
| 461 | 0 | 0 |  |  |  |  | unless( UNIVERSAL::isa( $self, 'Net::XMPP::Client::GTalk' )  ) { | 
| 462 | 0 |  |  |  |  |  | croak( 'Function needs to be called on the Net::XMPP::Client::GTalk object, please see documentation for details.' . "\n" ) ; | 
| 463 |  |  |  |  |  |  | } | 
| 464 |  |  |  |  |  |  |  | 
| 465 | 0 | 0 |  |  |  |  | $force_send = 0 unless( $force_send ) ; | 
| 466 |  |  |  |  |  |  |  | 
| 467 | 0 | 0 | 0 |  |  |  | if( ( ( time() - $self->{ LAST_PRESENCE_SEND } ) > 100 ) or $force_send )  { | 
| 468 | 0 |  |  |  |  |  | $self->{ RAW_CONNECTION }->PresenceSend() ; | 
| 469 | 0 |  |  |  |  |  | $self->{ LAST_PRESENCE_SEND } = time()    ; | 
| 470 |  |  |  |  |  |  | } | 
| 471 |  |  |  |  |  |  |  | 
| 472 | 0 |  |  |  |  |  | return 1 ; | 
| 473 |  |  |  |  |  |  |  | 
| 474 |  |  |  |  |  |  | } | 
| 475 |  |  |  |  |  |  |  | 
| 476 |  |  |  |  |  |  |  | 
| 477 |  |  |  |  |  |  | =head2 get_buddies | 
| 478 |  |  |  |  |  |  |  | 
| 479 |  |  |  |  |  |  | This function gets a list of all chat contacts. The returned list is NOT a list of online buddies but that of all contacts. | 
| 480 |  |  |  |  |  |  |  | 
| 481 |  |  |  |  |  |  | =cut | 
| 482 |  |  |  |  |  |  |  | 
| 483 |  |  |  |  |  |  | sub get_buddies { | 
| 484 |  |  |  |  |  |  |  | 
| 485 | 0 |  |  | 0 | 1 |  | my $self = shift ; | 
| 486 |  |  |  |  |  |  |  | 
| 487 | 0 | 0 |  |  |  |  | unless( UNIVERSAL::isa( $self, 'Net::XMPP::Client::GTalk' )  ) { | 
| 488 | 0 |  |  |  |  |  | croak( 'Function needs to be called on the Net::XMPP::Client::GTalk object, please see documentation for details.' . "\n" ) ; | 
| 489 |  |  |  |  |  |  | } | 
| 490 |  |  |  |  |  |  |  | 
| 491 | 0 |  |  |  |  |  | my @buddies = $self->{ RAW_CONNECTION }->RosterGet() ; | 
| 492 |  |  |  |  |  |  |  | 
| 493 | 0 |  |  |  |  |  | my @clean_buddy_list ; | 
| 494 | 0 |  |  |  |  |  | foreach my $buddy ( @buddies ) { | 
| 495 | 0 | 0 |  |  |  |  | next if( ref( $buddy ) eq 'HASH' ) ; | 
| 496 | 0 |  |  |  |  |  | push @clean_buddy_list, $buddy     ; | 
| 497 |  |  |  |  |  |  | } | 
| 498 |  |  |  |  |  |  |  | 
| 499 | 0 |  |  |  |  |  | return \@clean_buddy_list ; | 
| 500 |  |  |  |  |  |  |  | 
| 501 |  |  |  |  |  |  | } | 
| 502 |  |  |  |  |  |  |  | 
| 503 |  |  |  |  |  |  | =head2 get_online_buddies | 
| 504 |  |  |  |  |  |  |  | 
| 505 |  |  |  |  |  |  | This function returns a list of buddies for which we have presence information. This function does not use the inbuilt functions | 
| 506 |  |  |  |  |  |  | provided by NET::XMPP because, for some reason, they do not work. | 
| 507 |  |  |  |  |  |  |  | 
| 508 |  |  |  |  |  |  | This means that the longer you wait the better this list. | 
| 509 |  |  |  |  |  |  |  | 
| 510 |  |  |  |  |  |  | =cut | 
| 511 |  |  |  |  |  |  |  | 
| 512 |  |  |  |  |  |  | sub get_online_buddies { | 
| 513 |  |  |  |  |  |  |  | 
| 514 | 0 |  |  | 0 | 1 |  | my $self = shift ; | 
| 515 |  |  |  |  |  |  |  | 
| 516 | 0 | 0 |  |  |  |  | unless( UNIVERSAL::isa( $self, 'Net::XMPP::Client::GTalk' )  ) { | 
| 517 | 0 |  |  |  |  |  | croak( 'Function needs to be called on the Net::XMPP::Client::GTalk object, please see documentation for details.' . "\n" ) ; | 
| 518 |  |  |  |  |  |  | } | 
| 519 |  |  |  |  |  |  |  | 
| 520 | 0 |  |  |  |  |  | return $self->{ ONLINE_BUDDIES } ; | 
| 521 |  |  |  |  |  |  |  | 
| 522 |  |  |  |  |  |  | } | 
| 523 |  |  |  |  |  |  |  | 
| 524 |  |  |  |  |  |  | =head1 INTERNAL SUBROUTINES/METHODS | 
| 525 |  |  |  |  |  |  |  | 
| 526 |  |  |  |  |  |  | These functions are used by the module. They are not meant to be called directly using the Net::XMPP::Client::GTalk object although | 
| 527 |  |  |  |  |  |  | there is nothing stoping you from doing that. | 
| 528 |  |  |  |  |  |  |  | 
| 529 |  |  |  |  |  |  | =head2 _connect | 
| 530 |  |  |  |  |  |  |  | 
| 531 |  |  |  |  |  |  | This is an internal function and should not be used externally. | 
| 532 |  |  |  |  |  |  |  | 
| 533 |  |  |  |  |  |  | Used to connect to GTalk. | 
| 534 |  |  |  |  |  |  |  | 
| 535 |  |  |  |  |  |  | =cut | 
| 536 |  |  |  |  |  |  |  | 
| 537 |  |  |  |  |  |  | sub _connect { | 
| 538 |  |  |  |  |  |  |  | 
| 539 | 0 |  |  | 0 |  |  | my $connection = shift ; | 
| 540 | 0 |  |  |  |  |  | my $username   = shift ; | 
| 541 | 0 |  |  |  |  |  | my $password   = shift ; | 
| 542 | 0 |  |  |  |  |  | my $resource   = shift ; | 
| 543 | 0 |  |  |  |  |  | my $params     = shift ; | 
| 544 | 0 |  |  |  |  |  | my $call_backs = shift ; | 
| 545 |  |  |  |  |  |  |  | 
| 546 | 0 |  |  |  |  |  | my %params     = %{ $params     } ; | 
|  | 0 |  |  |  |  |  |  | 
| 547 | 0 |  |  |  |  |  | my %call_backs = %{ $call_backs } ; | 
|  | 0 |  |  |  |  |  |  | 
| 548 |  |  |  |  |  |  |  | 
| 549 | 0 |  |  |  |  |  | $connection->SetCallBacks( %call_backs ) ; | 
| 550 |  |  |  |  |  |  |  | 
| 551 | 0 | 0 |  |  |  |  | my $stat = $connection->Connect( %params ) or croak "Failed to connect to GTalk:$!\n" ; | 
| 552 |  |  |  |  |  |  |  | 
| 553 | 0 | 0 |  |  |  |  | my @res = $connection->AuthSend( | 
| 554 |  |  |  |  |  |  | username => $username, | 
| 555 |  |  |  |  |  |  | password => $password, | 
| 556 |  |  |  |  |  |  | resource => $resource | 
| 557 |  |  |  |  |  |  | ) or croak "Failed to Authenticate :$!\n" ; | 
| 558 |  |  |  |  |  |  |  | 
| 559 | 0 |  |  |  |  |  | return \@res ; | 
| 560 |  |  |  |  |  |  |  | 
| 561 |  |  |  |  |  |  | } | 
| 562 |  |  |  |  |  |  |  | 
| 563 |  |  |  |  |  |  |  | 
| 564 |  |  |  |  |  |  | =head2 _receive_callback | 
| 565 |  |  |  |  |  |  |  | 
| 566 |  |  |  |  |  |  | This is an internal function and is not to be used externally. | 
| 567 |  |  |  |  |  |  |  | 
| 568 |  |  |  |  |  |  | This function is used to receive the contents of a message from GTalk. | 
| 569 |  |  |  |  |  |  |  | 
| 570 |  |  |  |  |  |  | =cut | 
| 571 |  |  |  |  |  |  |  | 
| 572 |  |  |  |  |  |  | sub _receive_callback { | 
| 573 |  |  |  |  |  |  |  | 
| 574 | 0 |  |  | 0 |  |  | my $id      = shift ; | 
| 575 | 0 |  |  |  |  |  | my $message = shift ; | 
| 576 |  |  |  |  |  |  |  | 
| 577 | 0 |  |  |  |  |  | $COMMUNICATION = $message ; | 
| 578 |  |  |  |  |  |  |  | 
| 579 | 0 | 0 |  |  |  |  | if( defined( $RECEIVE_CALLBACK ) ) { | 
| 580 | 0 |  |  |  |  |  | $RECEIVE_CALLBACK->( $id, $message ) ; | 
| 581 |  |  |  |  |  |  | } | 
| 582 |  |  |  |  |  |  |  | 
| 583 | 0 |  |  |  |  |  | return 1; | 
| 584 |  |  |  |  |  |  |  | 
| 585 |  |  |  |  |  |  | } | 
| 586 |  |  |  |  |  |  |  | 
| 587 |  |  |  |  |  |  |  | 
| 588 |  |  |  |  |  |  | =head2 _parse_communication | 
| 589 |  |  |  |  |  |  |  | 
| 590 |  |  |  |  |  |  | This is an internal function and is not to be used externally. | 
| 591 |  |  |  |  |  |  |  | 
| 592 |  |  |  |  |  |  | This function parses the XML recieved from GTalk. | 
| 593 |  |  |  |  |  |  |  | 
| 594 |  |  |  |  |  |  | =cut | 
| 595 |  |  |  |  |  |  |  | 
| 596 |  |  |  |  |  |  | sub _parse_communication { | 
| 597 |  |  |  |  |  |  |  | 
| 598 | 0 |  |  | 0 |  |  | my $self          = shift ; | 
| 599 | 0 |  |  |  |  |  | my $communication = shift ; | 
| 600 |  |  |  |  |  |  |  | 
| 601 | 0 | 0 |  |  |  |  | unless( UNIVERSAL::isa( $self, 'Net::XMPP::Client::GTalk' )  ) { | 
| 602 | 0 |  |  |  |  |  | croak( 'Function needs to be called on the Net::XMPP::Client::GTalk object, please see documentation for details.' . "\n" ) ; | 
| 603 |  |  |  |  |  |  | } | 
| 604 |  |  |  |  |  |  |  | 
| 605 | 0 |  |  |  |  |  | return XML::Smart->new( $communication )->tree() ; | 
| 606 |  |  |  |  |  |  |  | 
| 607 |  |  |  |  |  |  | } | 
| 608 |  |  |  |  |  |  |  | 
| 609 |  |  |  |  |  |  |  | 
| 610 |  |  |  |  |  |  | =head2 _process_message_communication | 
| 611 |  |  |  |  |  |  |  | 
| 612 |  |  |  |  |  |  | This is an internal function and is not to be called externally. | 
| 613 |  |  |  |  |  |  |  | 
| 614 |  |  |  |  |  |  | It parses the message XML to return a hash while also updating the online buddy list. | 
| 615 |  |  |  |  |  |  |  | 
| 616 |  |  |  |  |  |  | =cut | 
| 617 |  |  |  |  |  |  |  | 
| 618 |  |  |  |  |  |  | sub _process_message_communication { | 
| 619 |  |  |  |  |  |  |  | 
| 620 | 0 |  |  | 0 |  |  | my $self    = shift ; | 
| 621 | 0 |  |  |  |  |  | my $message = shift ; | 
| 622 |  |  |  |  |  |  |  | 
| 623 | 0 | 0 |  |  |  |  | unless( UNIVERSAL::isa( $self, 'Net::XMPP::Client::GTalk' )  ) { | 
| 624 | 0 |  |  |  |  |  | croak( 'Function needs to be called on the Net::XMPP::Client::GTalk object, please see documentation for details.' . "\n" ) ; | 
| 625 |  |  |  |  |  |  | } | 
| 626 |  |  |  |  |  |  |  | 
| 627 | 0 |  |  |  |  |  | my $from_expression = $message->{ message }{ from } ; | 
| 628 | 0 | 0 |  |  |  |  | if( $message->{ message }{ error } ) { | 
| 629 | 0 |  |  |  |  |  | $message->{ error } = 1 ; | 
| 630 | 0 |  |  |  |  |  | return $message         ; | 
| 631 |  |  |  |  |  |  | } | 
| 632 |  |  |  |  |  |  |  | 
| 633 | 0 |  |  |  |  |  | my ( $success, $from, $client ) = $self->_parse_from_expression( $from_expression ) ; | 
| 634 | 0 | 0 |  |  |  |  | unless( $success ) { | 
| 635 | 0 |  |  |  |  |  | croak( "Unable to find message source!\n" ) ; | 
| 636 |  |  |  |  |  |  | } | 
| 637 |  |  |  |  |  |  |  | 
| 638 | 0 |  |  |  |  |  | my $message_text = $message->{ message }{ body }{ CONTENT } ; | 
| 639 | 0 |  |  |  |  |  | my $id           = $message->{ message }{ id   }            ; | 
| 640 | 0 |  |  |  |  |  | my $type         = $message->{ message }{ type }            ; | 
| 641 |  |  |  |  |  |  |  | 
| 642 |  |  |  |  |  |  |  | 
| 643 | 0 |  |  |  |  |  | my %presence = ( | 
| 644 |  |  |  |  |  |  | from        => $from        , | 
| 645 |  |  |  |  |  |  | # photo       => $photo       , # -- Do not have this info here. | 
| 646 |  |  |  |  |  |  | # status      => $status      , # -- Do not have this info here. | 
| 647 |  |  |  |  |  |  | from_client => $client      , | 
| 648 |  |  |  |  |  |  | ); | 
| 649 |  |  |  |  |  |  |  | 
| 650 | 0 |  |  |  |  |  | $self->_process_presence( \%presence ) ; | 
| 651 |  |  |  |  |  |  |  | 
| 652 | 0 |  |  |  |  |  | my %message = ( | 
| 653 |  |  |  |  |  |  | id      => $id           , | 
| 654 |  |  |  |  |  |  | type    => $type         , | 
| 655 |  |  |  |  |  |  | from    => $from         , | 
| 656 |  |  |  |  |  |  | message => $message_text , | 
| 657 |  |  |  |  |  |  | ); | 
| 658 |  |  |  |  |  |  |  | 
| 659 | 0 |  |  |  |  |  | return \%message ; | 
| 660 |  |  |  |  |  |  |  | 
| 661 |  |  |  |  |  |  | } | 
| 662 |  |  |  |  |  |  |  | 
| 663 |  |  |  |  |  |  | =head2 _process_non_message_communication | 
| 664 |  |  |  |  |  |  |  | 
| 665 |  |  |  |  |  |  | This is an internal function and is not to be used externally. | 
| 666 |  |  |  |  |  |  |  | 
| 667 |  |  |  |  |  |  | It processes non-chat messages from GTalk. | 
| 668 |  |  |  |  |  |  |  | 
| 669 |  |  |  |  |  |  | =cut | 
| 670 |  |  |  |  |  |  |  | 
| 671 |  |  |  |  |  |  | sub _process_non_message_communication { | 
| 672 |  |  |  |  |  |  |  | 
| 673 | 0 |  |  | 0 |  |  | my $self          = shift ; | 
| 674 | 0 |  |  |  |  |  | my $communication = shift ; | 
| 675 |  |  |  |  |  |  |  | 
| 676 | 0 | 0 |  |  |  |  | unless( UNIVERSAL::isa( $self, 'Net::XMPP::Client::GTalk' )  ) { | 
| 677 | 0 |  |  |  |  |  | croak( 'Function needs to be called on the Net::XMPP::Client::GTalk object, please see documentation for details.' . "\n" ) ; | 
| 678 |  |  |  |  |  |  | } | 
| 679 |  |  |  |  |  |  |  | 
| 680 | 0 | 0 |  |  |  |  | if( $communication->{ presence } ) { | 
| 681 | 0 |  |  |  |  |  | my $from_expression = $communication->{ presence }{ from } ; | 
| 682 |  |  |  |  |  |  |  | 
| 683 | 0 |  |  |  |  |  | my ( $success, $from, $from_client ) = $self->_parse_from_expression( $from_expression ) ; | 
| 684 | 0 | 0 |  |  |  |  | unless( $success ) { | 
| 685 | 0 |  |  |  |  |  | carp( "WARNING ( Mostly Harmless ): Unable to process presence\n" ) ; | 
| 686 | 0 |  |  |  |  |  | return 0                                                            ; | 
| 687 |  |  |  |  |  |  | } | 
| 688 |  |  |  |  |  |  |  | 
| 689 | 0 |  |  |  |  |  | my $status = $communication->{ presence }{ status }{ CONTENT }     ; | 
| 690 | 0 |  |  |  |  |  | my $photo  ; | 
| 691 |  |  |  |  |  |  |  | 
| 692 | 0 |  |  |  |  |  | my $photo_location = $communication->{ presence }{ x } ; | 
| 693 | 0 | 0 |  |  |  |  | if( $photo_location ) { | 
| 694 | 0 | 0 |  |  |  |  | if( ref $photo_location eq 'ARRAY' ) { | 
| 695 | 0 |  |  |  |  |  | foreach my $loc ( @{ $photo_location } ) { | 
|  | 0 |  |  |  |  |  |  | 
| 696 | 0 | 0 |  |  |  |  | if( $loc->{ photo } ) { | 
| 697 |  |  |  |  |  |  | $photo = $loc->{ photo }{ CONTENT } | 
| 698 | 0 |  |  |  |  |  | } | 
| 699 |  |  |  |  |  |  | } | 
| 700 |  |  |  |  |  |  | } else { | 
| 701 | 0 | 0 |  |  |  |  | if( $photo_location->{ photo } ) { | 
| 702 |  |  |  |  |  |  | $photo = $photo_location->{ photo }{ CONTENT } | 
| 703 | 0 |  |  |  |  |  | } | 
| 704 |  |  |  |  |  |  | } | 
| 705 |  |  |  |  |  |  | } | 
| 706 |  |  |  |  |  |  |  | 
| 707 | 0 |  |  |  |  |  | my %presence = ( | 
| 708 |  |  |  |  |  |  | from        => $from        , | 
| 709 |  |  |  |  |  |  | photo       => $photo       , | 
| 710 |  |  |  |  |  |  | status      => $status      , | 
| 711 |  |  |  |  |  |  | from_client => $from_client , | 
| 712 |  |  |  |  |  |  | ); | 
| 713 |  |  |  |  |  |  |  | 
| 714 | 0 |  |  |  |  |  | $self->_process_presence( \%presence ) ; | 
| 715 |  |  |  |  |  |  |  | 
| 716 | 0 |  |  |  |  |  | return 1 ; | 
| 717 |  |  |  |  |  |  |  | 
| 718 |  |  |  |  |  |  | } | 
| 719 |  |  |  |  |  |  |  | 
| 720 | 0 | 0 |  |  |  |  | if( $self->{ DEBUG } ) { | 
| 721 | 0 |  |  |  |  |  | carp( "VERBOSE WARNING: Unknown Communication type\n" ) ; | 
| 722 |  |  |  |  |  |  | } | 
| 723 |  |  |  |  |  |  |  | 
| 724 | 0 |  |  |  |  |  | return 0 ; | 
| 725 |  |  |  |  |  |  | } | 
| 726 |  |  |  |  |  |  |  | 
| 727 |  |  |  |  |  |  | =head2 _parse_from_expression | 
| 728 |  |  |  |  |  |  |  | 
| 729 |  |  |  |  |  |  | This is an internal function and should not be used externally. | 
| 730 |  |  |  |  |  |  |  | 
| 731 |  |  |  |  |  |  | It breaks the from field of a communication down into from and client. | 
| 732 |  |  |  |  |  |  |  | 
| 733 |  |  |  |  |  |  | =cut | 
| 734 |  |  |  |  |  |  |  | 
| 735 |  |  |  |  |  |  | sub _parse_from_expression { | 
| 736 |  |  |  |  |  |  |  | 
| 737 | 0 |  |  | 0 |  |  | my $self            = shift ; | 
| 738 | 0 |  |  |  |  |  | my $from_expression = shift ; | 
| 739 |  |  |  |  |  |  |  | 
| 740 | 0 | 0 |  |  |  |  | unless( UNIVERSAL::isa( $self, 'Net::XMPP::Client::GTalk' )  ) { | 
| 741 | 0 |  |  |  |  |  | croak( 'Function needs to be called on the Net::XMPP::Client::GTalk object, please see documentation for details.' . "\n" ) ; | 
| 742 |  |  |  |  |  |  | } | 
| 743 |  |  |  |  |  |  |  | 
| 744 | 0 |  |  |  |  |  | my $from    ; | 
| 745 |  |  |  |  |  |  | my $client  ; | 
| 746 | 0 | 0 |  |  |  |  | if( $from_expression =~ /^([^\/]*)\/(.*)$/ ) { | 
| 747 | 0 |  |  |  |  |  | $from        = $1 ; | 
| 748 | 0 |  |  |  |  |  | $client      = $2 ; | 
| 749 |  |  |  |  |  |  | } else { | 
| 750 | 0 |  |  |  |  |  | return 0          ;                                                  ; | 
| 751 |  |  |  |  |  |  | } | 
| 752 |  |  |  |  |  |  |  | 
| 753 | 0 |  |  |  |  |  | return ( 1, $from, $client ) ; | 
| 754 |  |  |  |  |  |  |  | 
| 755 |  |  |  |  |  |  | } | 
| 756 |  |  |  |  |  |  |  | 
| 757 |  |  |  |  |  |  | =head2 _process_presence | 
| 758 |  |  |  |  |  |  |  | 
| 759 |  |  |  |  |  |  | This is an internal function and is not to be used externally. | 
| 760 |  |  |  |  |  |  |  | 
| 761 |  |  |  |  |  |  | This function adds a buddy to the online buddy list and removes buddies based on a timeout of 700 sec ( i.e. If there has been no | 
| 762 |  |  |  |  |  |  | presence from a particular buddy for over 700 sec ) | 
| 763 |  |  |  |  |  |  |  | 
| 764 |  |  |  |  |  |  | =cut | 
| 765 |  |  |  |  |  |  |  | 
| 766 |  |  |  |  |  |  | sub _process_presence { | 
| 767 |  |  |  |  |  |  |  | 
| 768 | 0 |  |  | 0 |  |  | my $self     = shift ; | 
| 769 | 0 |  |  |  |  |  | my $presence = shift ; | 
| 770 |  |  |  |  |  |  |  | 
| 771 | 0 | 0 |  |  |  |  | unless( UNIVERSAL::isa( $self, 'Net::XMPP::Client::GTalk' )  ) { | 
| 772 | 0 |  |  |  |  |  | croak( 'Function needs to be called on the Net::XMPP::Client::GTalk object, please see documentation for details.' . "\n" ) ; | 
| 773 |  |  |  |  |  |  | } | 
| 774 |  |  |  |  |  |  |  | 
| 775 | 0 |  |  |  |  |  | my @online_buddies = @{ $self->{ ONLINE_BUDDIES } } ; | 
|  | 0 |  |  |  |  |  |  | 
| 776 |  |  |  |  |  |  |  | 
| 777 | 0 |  |  |  |  |  | my $this_presence_processed = 0 ; | 
| 778 | 0 |  |  |  |  |  | my @now_online_buddies          ; | 
| 779 | 0 |  |  |  |  |  | foreach my $buddy ( @online_buddies ) { | 
| 780 | 0 | 0 |  |  |  |  | if( time() - $buddy->{ presence_time } < 700 ) { | 
| 781 | 0 | 0 |  |  |  |  | if( $buddy->{ from } eq $presence->{ from } ) { | 
| 782 | 0 |  |  |  |  |  | $buddy->{ presence_time } = time() ; | 
| 783 | 0 |  |  |  |  |  | $this_presence_processed  = 1      ; | 
| 784 |  |  |  |  |  |  | } | 
| 785 | 0 |  |  |  |  |  | push @now_online_buddies, $buddy ; | 
| 786 |  |  |  |  |  |  | } | 
| 787 |  |  |  |  |  |  | } | 
| 788 |  |  |  |  |  |  |  | 
| 789 | 0 | 0 |  |  |  |  | unless( $this_presence_processed ) { | 
| 790 | 0 |  |  |  |  |  | $presence->{ presence_time } = time() ; | 
| 791 | 0 |  |  |  |  |  | push @now_online_buddies, $presence   ; | 
| 792 |  |  |  |  |  |  | } | 
| 793 |  |  |  |  |  |  |  | 
| 794 | 0 |  |  |  |  |  | $self->{ ONLINE_BUDDIES } = \@now_online_buddies ; | 
| 795 |  |  |  |  |  |  |  | 
| 796 | 0 |  |  |  |  |  | return 1 ; | 
| 797 |  |  |  |  |  |  |  | 
| 798 |  |  |  |  |  |  | } | 
| 799 |  |  |  |  |  |  |  | 
| 800 |  |  |  |  |  |  |  | 
| 801 |  |  |  |  |  |  | =head2 DESTROY | 
| 802 |  |  |  |  |  |  |  | 
| 803 |  |  |  |  |  |  | Global Destructor. | 
| 804 |  |  |  |  |  |  |  | 
| 805 |  |  |  |  |  |  | This function closes the connection to Gtalk if Disconnect has not already been called. | 
| 806 |  |  |  |  |  |  |  | 
| 807 |  |  |  |  |  |  | =cut | 
| 808 |  |  |  |  |  |  |  | 
| 809 |  |  |  |  |  |  | sub DESTROY { | 
| 810 |  |  |  |  |  |  |  | 
| 811 | 0 |  |  | 0 |  |  | my $self = shift; | 
| 812 |  |  |  |  |  |  |  | 
| 813 | 0 |  |  |  |  |  | $self->{ RAW_CONNECTION }->Disconnect() ; | 
| 814 |  |  |  |  |  |  |  | 
| 815 | 0 |  |  |  |  |  | return 1 ; | 
| 816 |  |  |  |  |  |  |  | 
| 817 |  |  |  |  |  |  | } | 
| 818 |  |  |  |  |  |  |  | 
| 819 |  |  |  |  |  |  | =head1 AUTHOR | 
| 820 |  |  |  |  |  |  |  | 
| 821 |  |  |  |  |  |  | Harish Madabushi, C<<  >> | 
| 822 |  |  |  |  |  |  |  | 
| 823 |  |  |  |  |  |  | =head1 BUGS | 
| 824 |  |  |  |  |  |  |  | 
| 825 |  |  |  |  |  |  | Please report any bugs or feature requests to C, or through | 
| 826 |  |  |  |  |  |  | the web interface at L. | 
| 827 |  |  |  |  |  |  | I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. | 
| 828 |  |  |  |  |  |  |  | 
| 829 |  |  |  |  |  |  | =head1 SUPPORT | 
| 830 |  |  |  |  |  |  |  | 
| 831 |  |  |  |  |  |  | You can find documentation for this module with the perldoc command. | 
| 832 |  |  |  |  |  |  |  | 
| 833 |  |  |  |  |  |  | perldoc Net::XMPP::Client::GTalk | 
| 834 |  |  |  |  |  |  |  | 
| 835 |  |  |  |  |  |  | You can also look for information at: | 
| 836 |  |  |  |  |  |  |  | 
| 837 |  |  |  |  |  |  | =over 4 | 
| 838 |  |  |  |  |  |  |  | 
| 839 |  |  |  |  |  |  | =item * RT: CPAN's request tracker (report bugs here) | 
| 840 |  |  |  |  |  |  |  | 
| 841 |  |  |  |  |  |  | L | 
| 842 |  |  |  |  |  |  |  | 
| 843 |  |  |  |  |  |  | =item * AnnoCPAN: Annotated CPAN documentation | 
| 844 |  |  |  |  |  |  |  | 
| 845 |  |  |  |  |  |  | L | 
| 846 |  |  |  |  |  |  |  | 
| 847 |  |  |  |  |  |  | =item * CPAN Ratings | 
| 848 |  |  |  |  |  |  |  | 
| 849 |  |  |  |  |  |  | L | 
| 850 |  |  |  |  |  |  |  | 
| 851 |  |  |  |  |  |  | =item * Search CPAN | 
| 852 |  |  |  |  |  |  |  | 
| 853 |  |  |  |  |  |  | L | 
| 854 |  |  |  |  |  |  |  | 
| 855 |  |  |  |  |  |  | =back | 
| 856 |  |  |  |  |  |  |  | 
| 857 |  |  |  |  |  |  | =head1 LICENSE AND COPYRIGHT | 
| 858 |  |  |  |  |  |  |  | 
| 859 |  |  |  |  |  |  | Copyright 2013 Harish Madabushi. | 
| 860 |  |  |  |  |  |  |  | 
| 861 |  |  |  |  |  |  | This program is free software; you can redistribute it and/or modify it | 
| 862 |  |  |  |  |  |  | under the terms of the the Artistic License (2.0). You may obtain a | 
| 863 |  |  |  |  |  |  | copy of the full license at: | 
| 864 |  |  |  |  |  |  |  | 
| 865 |  |  |  |  |  |  | L | 
| 866 |  |  |  |  |  |  |  | 
| 867 |  |  |  |  |  |  | Any use, modification, and distribution of the Standard or Modified | 
| 868 |  |  |  |  |  |  | Versions is governed by this Artistic License. By using, modifying or | 
| 869 |  |  |  |  |  |  | distributing the Package, you accept this license. Do not use, modify, | 
| 870 |  |  |  |  |  |  | or distribute the Package, if you do not accept this license. | 
| 871 |  |  |  |  |  |  |  | 
| 872 |  |  |  |  |  |  | If your Modified Version has been derived from a Modified Version made | 
| 873 |  |  |  |  |  |  | by someone other than you, you are nevertheless required to ensure that | 
| 874 |  |  |  |  |  |  | your Modified Version complies with the requirements of this license. | 
| 875 |  |  |  |  |  |  |  | 
| 876 |  |  |  |  |  |  | This license does not grant you the right to use any trademark, service | 
| 877 |  |  |  |  |  |  | mark, tradename, or logo of the Copyright Holder. | 
| 878 |  |  |  |  |  |  |  | 
| 879 |  |  |  |  |  |  | This license includes the non-exclusive, worldwide, free-of-charge | 
| 880 |  |  |  |  |  |  | patent license to make, have made, use, offer to sell, sell, import and | 
| 881 |  |  |  |  |  |  | otherwise transfer the Package with respect to any patent claims | 
| 882 |  |  |  |  |  |  | licensable by the Copyright Holder that are necessarily infringed by the | 
| 883 |  |  |  |  |  |  | Package. If you institute patent litigation (including a cross-claim or | 
| 884 |  |  |  |  |  |  | counterclaim) against any party alleging that the Package constitutes | 
| 885 |  |  |  |  |  |  | direct or contributory patent infringement, then this Artistic License | 
| 886 |  |  |  |  |  |  | to you shall terminate on the date that such litigation is filed. | 
| 887 |  |  |  |  |  |  |  | 
| 888 |  |  |  |  |  |  | Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER | 
| 889 |  |  |  |  |  |  | AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. | 
| 890 |  |  |  |  |  |  | THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR | 
| 891 |  |  |  |  |  |  | PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY | 
| 892 |  |  |  |  |  |  | YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR | 
| 893 |  |  |  |  |  |  | CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR | 
| 894 |  |  |  |  |  |  | CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, | 
| 895 |  |  |  |  |  |  | EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | 
| 896 |  |  |  |  |  |  |  | 
| 897 |  |  |  |  |  |  | =cut | 
| 898 |  |  |  |  |  |  |  | 
| 899 |  |  |  |  |  |  | # TO ADD: | 
| 900 |  |  |  |  |  |  |  | 
| 901 |  |  |  |  |  |  | #     change     my $componentname     = 'gmail.com'   to see if it works for apps. | 
| 902 |  |  |  |  |  |  |  | 
| 903 |  |  |  |  |  |  | 1; # End of Net::XMPP::Client::GTalk |