File Coverage

blib/lib/Net/XMPP/Client/GTalk.pm
Criterion Covered Total %
statement 18 222 8.1
branch 0 96 0.0
condition 0 3 0.0
subroutine 6 21 28.5
pod 7 7 100.0
total 31 349 8.8


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