[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;

sub dumpxml {
   my $data = shift;
   my $t = XML::Twig->new;
   if ($t->safe_parse ("<deb>$data</deb>")) {
      $t->set_pretty_print ('indented');
      $t->print;
      print "\n";
   } else {
      print "[$data]\n";
   }
}

binmode STDOUT, ":utf8";

my $j = AnyEvent->condvar;

my $cl = Net::XMPP2::Client->new;
#$cl->add_account ('elmex@jabber.org/Net::XどなPP2', 'xxxxxxxx');
$cl->add_account ('elmor@jabber.org/Net::XどなPP2', 'xxxxxxxx');
$cl->reg_cb (
   connected => sub {
     # $cl->send_message ("Hello!" => 'elmex@jabber.org');
      0
   },
   roster_update => sub {
      my ($cl, $acc, $roster, $contacts) = @_;
      warn "ROSTER UPD\n";
      $roster->debug_dump;
      1
   },
   presence_update => sub {
      my ($cl, $acc, $roster, $contact, $old, $new) = @_;
      warn "PRESENCE UPD\n";
      $roster->debug_dump;
      1
   },
   sasl_error => sub {
      my ($cl, $acc, $error) = @_;
      print "SASL ERROR".$error->string."\n";
   }
);

$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->new_contact ('elmex@jabber.org', 'Der elmex', ['ABC', 'TEst'], sub {
  #    $roster->get_contact ('elmex@jabber.org')->send_subscribe;
  #    $roster->delete_contact ('elmex@jabber.org');
   });

   0
});

$cl->start;

$j->wait;
Revision:	1.4
Committed:	Sun Jun 24 10:41:58 2007 UTC (19 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.3:	+15 -3 lines
Log Message:	finished subscription implementation and also added the possibility of forwarding all events of an object to some other object and forwarded all events from a IM::Connection to the Client.
#	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	sub dumpxml {
12	my $data = shift;
13	my $t = XML::Twig->new;
14	if ($t->safe_parse ("<deb>$data</deb>")) {
15	$t->set_pretty_print ('indented');
16	$t->print;
17	print "\n";
18	} else {
19	print "[$data]\n";
20	}
21	}
22
23	binmode STDOUT, ":utf8";
24
25	my $j = AnyEvent->condvar;
26
27	my $cl = Net::XMPP2::Client->new;
28	#$cl->add_account ('elmex@jabber.org/Net::XどなPP2', 'xxxxxxxx');
29	$cl->add_account ('elmor@jabber.org/Net::XどなPP2', 'xxxxxxxx');
30	$cl->reg_cb (
31	connected => sub {
32	# $cl->send_message ("Hello!" => 'elmex@jabber.org');
33	0
34	},
35	roster_update => sub {
36	my ($cl, $acc, $roster, $contacts) = @_;
37	warn "ROSTER UPD\n";
38	$roster->debug_dump;
39	1
40	},
41	presence_update => sub {
42	my ($cl, $acc, $roster, $contact, $old, $new) = @_;
43	warn "PRESENCE UPD\n";
44	$roster->debug_dump;
45	1
46	},
47	sasl_error => sub {
48	my ($cl, $acc, $error) = @_;
49	print "SASL ERROR".$error->string."\n";
50	}
51	);
52
53	$cl->reg_cb (contact_request_subscribe => sub {
54	my ($cl, $acc, $roster, $contact, $rdoit) = @_;
55	$$rdoit = 1;
56	$contact->send_subscribe;
57	1
58	});
59
60	$cl->reg_cb (contact_did_unsubscribe => sub {
61	my ($cl, $acc, $roster, $contact, $rdoit) = @_;
62	$$rdoit = 1;
63	1
64	});
65
66	$cl->reg_cb (roster_update => sub {
67	my ($cl, $acc, $roster, $contacts) = @_;
68
69	$roster->new_contact ('elmex@jabber.org', 'Der elmex', ['ABC', 'TEst'], sub {
70	# $roster->get_contact ('elmex@jabber.org')->send_subscribe;
71	# $roster->delete_contact ('elmex@jabber.org');
72	});
73
74	0
75	});
76
77	$cl->start;
78
79	$j->wait;