[ViewVC] Contents of: cvs/cvsroot/Net-XMPP2/samples/test_client

#!/opt/perl/bin/perl
use strict;
use utf8;
use Event;
use AnyEvent;
use XML::Twig;
use Net::XMPP2 qw/xep-86/;
use Net::XMPP2::Client;
use Encode;

binmode STDOUT, ":utf8";

my $j = AnyEvent->condvar;
my $cl = Net::XMPP2::Client->new (debug => 1);
$cl->set_presence ('away', 'I\'m a bot now.', -1);
$cl->add_account (@ARGV);
$cl->reg_cb (
   connected => sub {
      $cl->send_message ("Hello!" => 'elmex@jabber.org');
      0
   },
   roster_update => sub {
      my ($cl, $acc, $roster, $contacts) = @_;
      $roster->debug_dump;
      #$acc->connection ()->send_presence ('probe' => undef, to => 'elmex@jabfber.org');
      #print "OEOFWEFIEJWFEWO\n" if not $roster->is_retrieved;
      1
   },
   presence_update => sub {
      my ($cl, $acc, $roster, $contact, $old, $new) = @_;
      $roster->debug_dump;
      1
   },
   error => sub {
      my ($cl, $acc, $error) = @_;
      print "ERROR: ".$error->string."\n";
   },
   disconnect => sub { warn "DISCON[@_]\n"; 1 },
);

$cl->reg_cb (contact_request_subscribe => sub {
   my ($cl, $acc, $roster, $contact, $rdoit) = @_;
   $$rdoit = 1;
   $contact->send_subscribe;
   1
});

$cl->reg_cb (contact_did_unsubscribe => sub {
   my ($cl, $acc, $roster, $contact, $rdoit) = @_;
   $$rdoit = 1;
   1
});

$cl->reg_cb (roster_update => sub {
   my ($cl, $acc, $roster, $contacts) = @_;
   $roster->debug_dump;
   0
});

$cl->start;

$j->wait;
Revision:	1.9
Committed:	Thu Jul 19 11:36:34 2007 UTC (19 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.8:	+8 -45 lines
Log Message:	added initial_presence argument to the IM::Connection and the Client. added and upgraded some examples. further work on the registration forms.
#	Content
1	#!/opt/perl/bin/perl
2	use strict;
3	use utf8;
4	use Event;
5	use AnyEvent;
6	use XML::Twig;
7	use Net::XMPP2 qw/xep-86/;
8	use Net::XMPP2::Client;
9	use Encode;
10
11	binmode STDOUT, ":utf8";
12
13	my $j = AnyEvent->condvar;
14	my $cl = Net::XMPP2::Client->new (debug => 1);
15	$cl->set_presence ('away', 'I\'m a bot now.', -1);
16	$cl->add_account (@ARGV);
17	$cl->reg_cb (
18	connected => sub {
19	$cl->send_message ("Hello!" => 'elmex@jabber.org');
20	0
21	},
22	roster_update => sub {
23	my ($cl, $acc, $roster, $contacts) = @_;
24	$roster->debug_dump;
25	#$acc->connection ()->send_presence ('probe' => undef, to => 'elmex@jabfber.org');
26	#print "OEOFWEFIEJWFEWO\n" if not $roster->is_retrieved;
27	1
28	},
29	presence_update => sub {
30	my ($cl, $acc, $roster, $contact, $old, $new) = @_;
31	$roster->debug_dump;
32	1
33	},
34	error => sub {
35	my ($cl, $acc, $error) = @_;
36	print "ERROR: ".$error->string."\n";
37	},
38	disconnect => sub { warn "DISCON[@_]\n"; 1 },
39	);
40
41	$cl->reg_cb (contact_request_subscribe => sub {
42	my ($cl, $acc, $roster, $contact, $rdoit) = @_;
43	$$rdoit = 1;
44	$contact->send_subscribe;
45	1
46	});
47
48	$cl->reg_cb (contact_did_unsubscribe => sub {
49	my ($cl, $acc, $roster, $contact, $rdoit) = @_;
50	$$rdoit = 1;
51	1
52	});
53
54	$cl->reg_cb (roster_update => sub {
55	my ($cl, $acc, $roster, $contacts) = @_;
56	$roster->debug_dump;
57	0
58	});
59
60	$cl->start;
61
62	$j->wait;