[ViewVC] Annotation of: cvs/Net-XMPP2/samples/test

#!/opt/perl/bin/perl
use strict;
use utf8;
use AnyEvent;
use Net::XMPP2 qw/xep-86/;
use Net::XMPP2::IM::Connection;
use Net::XMPP2::Namespaces qw/xmpp_ns/;
use Net::LibIDN qw/idn_prep_resource/;
use Encode;

binmode STDOUT, ":utf8";

my $j = AnyEvent->condvar;

my $res = "Net::XどなPP2";

my $con = Net::XMPP2::IM::Connection->new (
            username => 'elmex', #'elmor',
            domain => 'amessage.eu',#'jabber.org',
            resource => $res,
            password => 'xxxxxx',
          );
$con->connect or die "Couldn't connect: $!";
$con->init;
$con->reg_cb (
   session_ready => sub {
      my ($con) = @_;
      print "stream ready!\n" ;
      $con->send_iq (
         get => sub {
            my ($w) = @_;
            $w->addPrefix (xmpp_ns ('version'), '');
            $w->emptyTag ([xmpp_ns ('version'), 'query']);
         }, sub {
            my ($node, $errnode, $err) = @_;
            unless (defined $node) {
               print "ERROR: $err->[0]/$err->[3]:" .($err->[1]->name)."\n";
               return;
            }
            my (@name) = $node->find_all ([qw/version query/], [qw/version name/]);
            my (@ver)  = $node->find_all ([qw/version query/], [qw/version version/]);
            print "REPL: ".($name[0]->text). " " .($ver[0]->text)."!\n" if @name and @ver;
            print "NO VERSION FOUND!\n" unless @name and @ver;
         },
         to => $con->{domain},#'localhost',
         from => $con->jid
      );
   },
   debug_recv   => sub { print "recv: $_[1]\n"; 1 },
   debug_send   => sub { print "send: $_[1]\n"; 1 },
   stream_error => sub { die "ERROR[$_[1]]{$_[2]}\n" },
);


$j->wait;
Revision:	1.4
Committed:	Sun Jan 28 21:52:19 2007 UTC (19 years, 8 months ago) by elmex
Branch:	MAIN
Changes since 1.3:	+2 -1 lines
Log Message:	further detail work and implemented extension enabling and extensions xep-0086 along with xml stanza error generation. implemented also first parts of Net::XMPP2::IM::Connection.
#	User	Rev	Content
1	elmex	1.1	#!/opt/perl/bin/perl
2			use strict;
3			use utf8;
4			use AnyEvent;
5	elmex	1.4	use Net::XMPP2 qw/xep-86/;
6	elmex	1.1	use Net::XMPP2::IM::Connection;
7			use Net::XMPP2::Namespaces qw/xmpp_ns/;
8			use Net::LibIDN qw/idn_prep_resource/;
9			use Encode;
10
11			binmode STDOUT, ":utf8";
12
13			my $j = AnyEvent->condvar;
14
15			my $res = "Net::XどなPP2";
16
17			my $con = Net::XMPP2::IM::Connection->new (
18	elmex	1.2	username => 'elmex', #'elmor',
19	elmex	1.4	domain => 'amessage.eu',#'jabber.org',
20	elmex	1.1	resource => $res,
21			password => 'xxxxxx',
22			);
23	elmex	1.2	$con->connect or die "Couldn't connect: $!";
24	elmex	1.1	$con->init;
25			$con->reg_cb (
26			session_ready => sub {
27			my ($con) = @_;
28			print "stream ready!\n" ;
29			$con->send_iq (
30			get => sub {
31			my ($w) = @_;
32			$w->addPrefix (xmpp_ns ('version'), '');
33			$w->emptyTag ([xmpp_ns ('version'), 'query']);
34			}, sub {
35			my ($node, $errnode, $err) = @_;
36			unless (defined $node) {
37			print "ERROR: $err->[0]/$err->[3]:" .($err->[1]->name)."\n";
38			return;
39			}
40			my (@name) = $node->find_all ([qw/version query/], [qw/version name/]);
41			my (@ver) = $node->find_all ([qw/version query/], [qw/version version/]);
42			print "REPL: ".($name[0]->text). " " .($ver[0]->text)."!\n" if @name and @ver;
43			print "NO VERSION FOUND!\n" unless @name and @ver;
44			},
45	elmex	1.2	to => $con->{domain},#'localhost',
46	elmex	1.1	from => $con->jid
47			);
48			},
49	elmex	1.3	debug_recv => sub { print "recv: $_[1]\n"; 1 },
50			debug_send => sub { print "send: $_[1]\n"; 1 },
51	elmex	1.1	stream_error => sub { die "ERROR[$_[1]]{$_[2]}\n" },
52			);
53
54
55			$j->wait;