Net-Jabber-Loudmouth-0.07/0000711000175000017500000000000010405062604013746 5ustar raflraflNet-Jabber-Loudmouth-0.07/pm/0000711000175000017500000000000010405062603014361 5ustar raflraflNet-Jabber-Loudmouth-0.07/pm/Loudmouth.pm0000644000175000017500000000423510405062405016713 0ustar raflraflpackage Net::Jabber::Loudmouth; use strict; use warnings; use Glib; require DynaLoader; our @ISA = qw(DynaLoader); our $VERSION = 0.07; our $DefaultPort = 5222; our $DefaultPortSSL = 5223; sub default_port { return $DefaultPort; } sub default_port_ssl { return $DefaultPortSSL; } sub dl_load_flags { 0x01 }; bootstrap Net::Jabber::Loudmouth $VERSION; # Preloaded methods go here. 1; __END__ =head1 NAME Net::Jabber::Loudmouth - Perl interface for the loudmouth jabber library =head1 SYNOPSIS use Net::Jabber::Loudmouth; my $connection = Net::Jabber::Loudmouth::Connection->new("server"); $connection->open_and_block(); $connection->authenticate_and_block("username", "password", "resource"); my $m = Net::Jabber::Loudmouth::Message->new("recipient", 'message'); $m->get_node->add_child("body", "message"); $connection->send($m); =head1 DESCRIPTION Net::Jabber::Loudmouth is a perl interface for libloudmouth, Lightweight C Jabber library. It allows you to do the same stuff with Net::Jabber, but with a nicer interface and much faster, because most of the code is written in C. =head1 FUNCTIONS B only contains two functions. Other functionality can be found in B. =head2 default_port Net::Jabber::Loudmouth->default_port() Returns the default port which will be used for every connection. =head2 default_port_ssl Net::Jabber::Loudmouth->default_port_ssl() Returns the default ssl port. Use $connection->set_port(Net::Jabber::Loudmouth->default_port_ssl()) to tell a connection to use the ssl port. See L. =head1 SEE ALSO Net::Jabber::Loudmouth::Connection, Net::Jabber::Loudmouth::Message, Net::Jabber::Loudmouth::MessageHandler, Net::Jabber::Loudmouth::MessageNode, Net::Jabber::Loudmouth::SSL, Net::Jabber::Loudmouth::Proxy =head1 AUTHOR Florian Ragwitz, Erafl@debian.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2005 by Florian Ragwitz This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.7 or, at your option, any later version of Perl 5 you may have available. =cut Net-Jabber-Loudmouth-0.07/t/0000711000175000017500000000000010405062603014210 5ustar raflraflNet-Jabber-Loudmouth-0.07/t/06_message.t0000644000175000017500000000256510301133735016346 0ustar raflrafluse strict; use Test::More tests => 99; use Net::Jabber::Loudmouth; my %types = ( 'message' => { subtypes => [qw(normal chat groupchat headline error)], default_subtype => 'not-set' }, 'presence' => { subtypes => [qw(normal available unavailable probe subscribe unsubscribe subscribed unsubscribed error)], default_subtype => 'available' }, 'iq' => { subtypes => [qw(normal get set result error)], default_subtype => 'get' }, 'stream' => { subtypes => [qw(normal error)], default_subtype => 'normal' }, 'stream-error' => { subtypes => [qw(normal error)], default_subtype => 'normal' }, 'unknown' => { subtypes => [qw(normal error)], default_subtype => 'normal' } ); for my $type (keys %types) { my $m = Net::Jabber::Loudmouth::Message->new('foo@bar', $type); isa_ok($m, "Net::Jabber::Loudmouth::Message"); isa_ok($m->get_node(), "Net::Jabber::Loudmouth::MessageNode"); is($m->get_type(), $type, "$type message has right type"); is($m->get_sub_type(), $types{$type}->{default_subtype}, "$type message has right default subtype"); for my $sub_type (@{$types{$type}->{subtypes}}) { $m = Net::Jabber::Loudmouth::Message->new_with_sub_type('foo@bar', $type, $sub_type); isa_ok($m, "Net::Jabber::Loudmouth::Message"); is($m->get_type(), $type, "$type-$sub_type message has right type"); is($m->get_sub_type(), $sub_type, "$type-$sub_type message has right subtype"); } } Net-Jabber-Loudmouth-0.07/t/04_basic.t0000644000175000017500000000054310301133162015765 0ustar raflrafluse strict; use POSIX qw/SIGKILL/; use Test::More tests => 3; use Test::Builder; use Net::Jabber::Loudmouth; require 't/server_helper.pl'; my $pid = start_server(); my $c = Net::Jabber::Loudmouth::Connection->new("localhost"); ok($c->open_and_block()); ok($c->authenticate_and_block("foo", "bar", "TestSuite")); ok($c->close()); kill SIGKILL, $pid; Net-Jabber-Loudmouth-0.07/t/05_connection.t0000644000175000017500000001175110301133426017052 0ustar raflrafluse strict; use POSIX qw/SIGKILL/; use Test::More tests => 55; use Test::Exception; use Glib; use Net::Jabber::Loudmouth; require 't/server_helper.pl'; my $pid = start_server(); my $c = Net::Jabber::Loudmouth::Connection->new("foobar"); isa_ok($c, "Net::Jabber::Loudmouth::Connection"); is($c->get_server(), "foobar", 'get_server() works'); dies_ok {$c->open_and_block()} 'open_and_block() fails with invalid server'; $c->set_server("localhost"); is($c->get_server(), "localhost", 'get_server() works'); is($c->get_jid(), undef, 'jid is initialized with undef'); $c->set_jid('foo@localhost'); is($c->get_jid(), 'foo@localhost', 'set_jid() works'); is($c->get_port(), 5222, 'default port is correct / get_port() works'); $c->set_port(4333); is($c->get_port(), 4333, 'set_port() works'); $c->set_port(5222); is($c->get_ssl(), undef, 'ssl is undef by default / get_ssl() works'); $c->set_ssl(Net::Jabber::Loudmouth::SSL->new(sub {})); ok($c->get_ssl(), 'set_ssl() works'); $c->set_ssl(undef); is($c->get_ssl(), undef, 'removing ssl object works'); is($c->get_proxy(), undef, 'proxy is undef by default / get_proxy*( works'); $c->set_proxy(Net::Jabber::Loudmouth::Proxy->new('http')); ok($c->get_proxy(), 'set_proxy() works'); $c->set_proxy(undef); is($c->get_proxy(), undef, 'removing proxy object works'); undef $c; $c = Net::Jabber::Loudmouth::Connection->new("localhost"); my $m = Net::Jabber::Loudmouth::Message->new('foo@localhost', 'message'); $m->get_node->add_child('body', 'bar'); dies_ok {$c->close()} 'closing closed connection dies'; dies_ok {$c->authenticate()} 'authenticating closed connection dies'; dies_ok {$c->send($m)} 'sending over closed connection dies'; dies_ok {$c->send_with_reply($m)} 'sending with reply over closed connection dies'; dies_ok {$c->send_with_reply_and_block($m)} 'blocking send with reply over closed connection dies'; dies_ok {$c->send_raw($m->get_node->to_string())} 'send_raw() over closed connection dies'; is($c->get_state(), 'closed', 'connection is closed by default / get_state() works'); ok(!$c->is_open(), 'connection isn\'t opened by default / is_open() works'); ok($c->open_and_block(), 'open_and_block() returns true'); is($c->get_state(), 'open', 'connection state is open after successful open_and_block()'); ok($c->is_open(), 'is_open() works'); ok(!$c->is_authenticated(), 'we\'re not yet authenticated'); ok($c->close(), 'closing works'); ok(!$c->is_open(), 'we\'re not open anymore'); my $loop = Glib::MainLoop->new(); ok($c->open(\&open_cb), 'open() returns true'); $loop->run(); sub open_cb { my ($connection, $success) = @_; ok(1, 'open callback gets called'); isa_ok($connection, "Net::Jabber::Loudmouth::Connection"); ok($success, 'open was successful'); ok($connection->is_open(), 'is_open() returns true'); is($connection->get_state(), 'open', 'state is open'); ok(!$connection->is_authenticated(), 'we\'re not authenticated yet'); $loop->quit(); } dies_ok {$c->authenticate_and_block("alnsldabsdasd", "", "TestSuite")} 'wrong authentication fails'; ok($c->authenticate_and_block("foo", "bar", "TestSuite"), 'authentication works fine'); is($c->get_state(), 'authenticated', 'state is authenticated after authenticate_and_block()'); ok($c->is_authenticated(), 'is_authenticated() returns true after authenticate_and_block()'); ok($c->close(), 'closing works'); ok(!$c->is_authenticated(), 'closed connection isn\'t authenticated'); ok($c->open_and_block(), 'open_and_block() works'); ok($c->authenticate("foo", "bar", "TestSuite", \&auth_cb), 'authenticate returns true'); $loop->run(); sub auth_cb { my ($connection, $success) = @_; ok(1, 'auth callback gets called'); isa_ok($connection, "Net::Jabber::Loudmouth::Connection"); ok($success, 'authed successful'); ok($connection->is_authenticated(), 'is_authenticated() works'); $loop->quit(); } $c->set_keep_alive_rate(20); my $handler = Net::Jabber::Loudmouth::MessageHandler->new(sub {}); isa_ok($handler, "Net::Jabber::Loudmouth::MessageHandler"); my $retval = $c->register_message_handler('message', 'normal', $handler); isa_ok($retval, "Net::Jabber::Loudmouth::MessageHandler"); $c->unregister_message_handler('message', $handler); $retval = $c->register_message_handler('message', 'normal', sub {}); isa_ok($retval, "Net::Jabber::Loudmouth::MessageHandler"); $c->unregister_message_handler('message', $retval); $retval = $c->register_message_handler('message', 'normal', sub {}, 1); isa_ok($retval, "Net::Jabber::Loudmouth::MessageHandler"); $c->unregister_message_handler('message', $retval); dies_ok {$c->register_message_handler('message', 'normal', $handler, 1)} 'register_message_handler() with a MessageHandler object and user_data dies'; dies_ok {$c->register_message_handler('message', 'normal', 1)} 'register_message_handler() with something that\'s not a MessageHandler or a code reference dies'; $c->register_message_handler('message', 'normal', \&message_cb); ok($c->send($m), 'send() works'); ok($c->send_raw($m->get_node->to_string()), 'send_raw() works'); $c->set_disconnect_function(sub {}); kill SIGKILL, $pid; Net-Jabber-Loudmouth-0.07/t/01_use.t0000644000175000017500000000010710272202306015475 0ustar raflrafluse Test::More tests => 1; BEGIN { use_ok('Net::Jabber::Loudmouth') }; Net-Jabber-Loudmouth-0.07/t/07_message_handler.t0000644000175000017500000000047510301133750020037 0ustar raflrafluse strict; use Test::More tests => 3; use Net::Jabber::Loudmouth; my $handler = Net::Jabber::Loudmouth::MessageHandler->new(sub {}); isa_ok($handler, "Net::Jabber::Loudmouth::MessageHandler"); ok($handler->is_valid(), "handler is valid"); $handler->invalidate(); ok(!$handler->is_valid(), "handler is invalid"); Net-Jabber-Loudmouth-0.07/t/08_message_node.t0000644000175000017500000000325210301133774017352 0ustar raflrafluse strict; use Test::More tests => 21; use Glib qw/TRUE FALSE/; use Net::Jabber::Loudmouth; my $m = Net::Jabber::Loudmouth::Message->new('', 'message'); my $n = $m->get_node(); isa_ok($n, "Net::Jabber::Loudmouth::MessageNode"); is($n->get_name(), 'message', 'message node has right name'); is($n->get_value(), undef, 'default value is undef'); is($n->get_raw_mode(), FALSE, 'raw mode is off per default'); $n->set_name('foo'); is($n->get_name(), 'foo', 'name is now foo'); $n->set_value('bar'); is($n->get_value(), 'bar', 'value is now bar'); $n->set_raw_mode(TRUE); is($n->get_raw_mode(), TRUE, 'raw mode is now on'); my $child = $n->add_child('moo'); isa_ok($child, "Net::Jabber::Loudmouth::MessageNode"); is($child->get_name(), 'moo', 'child name is moo'); is($child->get_value(), undef, 'value is undef per default'); is($child->get_raw_mode(), FALSE, 'raw mode is off per default'); $child = $n->add_child('kooh', 'moo'); isa_ok($child, "Net::Jabber::Loudmouth::MessageNode"); is($child->get_name(), 'kooh', 'child name is kooh'); is($child->get_value(), 'moo', 'child value is moo'); is($child->get_raw_mode(), FALSE, 'raw mode is off per default'); $n->set_attributes(foo => 'bar', moo => 'kooh'); is($n->get_attribute('foo'), 'bar', 'setting multiple attributes'); is($n->get_attribute('moo'), 'kooh', 'setting multiple attributes'); is($n->get_attribute('mookooh'), undef, 'setting multiple attributes'); $n->set_attributes(foo => 'mookooh'); is($n->get_attribute('foo'), 'mookooh', 'setting single attributes'); $child = $n->get_child_by_name('kooh'); isa_ok($child, "Net::Jabber::Loudmouth::MessageNode"); is($child->get_value(), 'moo', 'get_child_by_name() returns the right node'); Net-Jabber-Loudmouth-0.07/t/10_proxy.t0000644000175000017500000000354510307330257016101 0ustar raflrafluse strict; use POSIX qw/SIGKILL/; use Test::More tests => 16; use Net::Jabber::Loudmouth; require 't/server_helper.pl'; require 't/proxy_helper.pl'; my $server_pid = start_server(); #my $proxy_pid = start_proxy(); my $c = Net::Jabber::Loudmouth::Connection->new("localhost"); my $proxy = Net::Jabber::Loudmouth::Proxy->new('none'); isa_ok($proxy, "Net::Jabber::Loudmouth::Proxy"); is($proxy->get_server(), undef, 'default server is undef'); $proxy->set_server("localhost"); is($proxy->get_server(), "localhost", 'set_server() works'); is($proxy->get_type(), 'none', 'type is none'); $proxy->set_type('http'); is($proxy->get_type(), 'http', 'set_type() works'); is($proxy->get_port(), 0, 'default port is 0'); $proxy->set_port(8080); is($proxy->get_port(), 8080, 'set_port() works'); is($proxy->get_username(), undef, 'default username is undef'); $proxy->set_username('foo'); is($proxy->get_username(), 'foo', 'set_username() works'); is($proxy->get_password(), undef, 'default password is undef'); $proxy->set_password('bar'); is($proxy->get_password(), 'bar', 'set_password() works'); undef $proxy; $proxy = Net::Jabber::Loudmouth::Proxy->new_with_server('http', 'localhost', 4143); is($proxy->get_type(), 'http', 'new_with_server() works'); is($proxy->get_server(), 'localhost', 'new_with_server() works'); is($proxy->get_port(), 4143, 'new_with_server() works'); is($proxy->get_username(), undef, 'new_with_server() works'); is($proxy->get_password(), undef, 'new_with_server() works'); $c->set_proxy($proxy); TODO: { local $TODO = "HTTP::Proxy seems to be b0rked"; # ok($c->open_and_block(), 'try to open the connection using a proxy'); # ok($c->is_open(), 'opened'); # ok($c->authenticate_and_block('foo', 'bar', 'TestSuite'), 'try authentication over the proxy'); # ok($c->is_authenticated(), 'authenticated'); } kill SIGKILL, $server_pid; #kill SIGKILL, $proxy_pid; Net-Jabber-Loudmouth-0.07/t/proxy_helper.pl0000644000175000017500000000033710301132741017274 0ustar raflrafluse strict; use HTTP::Proxy; sub start_proxy { my $pid = fork(); die "fork failed" unless defined $pid; unless ($pid) { my $proxy = HTTP::Proxy->new(port => 4143); $proxy->start(); exit; } return $pid; } 1; Net-Jabber-Loudmouth-0.07/t/server_helper.pl0000644000175000017500000000043510301134005017413 0ustar raflrafluse strict; use Net::Jabber qw(Server); use Net::Jabber::Server; sub start_server { my $pid = fork(); die "can't fork" unless defined $pid; unless ($pid) { # my $server = Net::Jabber::Server->new(); # $server->Start(); exit; } # sleep 1; #wait for the server to start } 1; Net-Jabber-Loudmouth-0.07/t/02_pod.t0000644000175000017500000000114310275736465015512 0ustar raflrafluse strict; use Test::More; eval "use Test::Pod 1.0"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; #TODO: thinks .pod files are not valid if they do not start with #!/usr/bin/perl #all_pod_files_ok(); my @files = qw( blib/lib/Net/Jabber/Loudmouth.pm blib/lib/Net/Jabber/Loudmouth/Connection.pod blib/lib/Net/Jabber/Loudmouth/Proxy.pod blib/lib/Net/Jabber/Loudmouth/MessageNode.pod blib/lib/Net/Jabber/Loudmouth/MessageHandler.pod blib/lib/Net/Jabber/Loudmouth/Message.pod blib/lib/Net/Jabber/Loudmouth/SSL.pod blib/lib/Net/Jabber/Loudmouth/index.pod ); all_pod_files_ok(@files); Net-Jabber-Loudmouth-0.07/t/03_pod_coverage.t0000644000175000017500000000032110272400144017336 0ustar raflrafluse strict; use Test::More; eval "use Test::Pod::Coverage;"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok({also_private => [qr/^dl_load_flags$/]}); Net-Jabber-Loudmouth-0.07/t/09_ssl.t0000644000175000017500000000170310301133646015520 0ustar raflrafluse strict; use POSIX qw/SIGKILL/; use Test::More tests => 13; use Net::Jabber::Loudmouth; require 't/server_helper.pl'; my $pid = start_server(); ok(defined Net::Jabber::Loudmouth::SSL->is_supported(), 'is_supported() returns something defined'); SKIP: { skip "No SSL support available", 12 unless Net::Jabber::Loudmouth::SSL->is_supported(); my $c = Net::Jabber::Loudmouth::Connection->new("localhost"); my $ssl = Net::Jabber::Loudmouth::SSL->new(\&ssl_cb); isa_ok($ssl, "Net::Jabber::Loudmouth::SSL"); $c->set_ssl($ssl); $c->set_port($Net::Jabber::Loudmouth::DefaultPortSSL); is($c->get_port(), 5223, 'default ssl port is right'); ok($c->open_and_block(), 'opened connection using ssl'); ok(defined $ssl->get_fingerprint(), 'get_fingerprint() works'); sub ssl_cb { my ($ssl, $status) = @_; isa_ok($ssl, "Net::Jabber::Loudmouth::SSL"); ok(defined $status, "got status message $status"); return 'continue'; } } kill SIGKILL, $pid; Net-Jabber-Loudmouth-0.07/Changes0000644000175000017500000000213110405062370015246 0ustar raflraflRevision history for Perl extension Net::Jabber::Loudmouth. 0.07 Sun Feb 26 16:28:22 2006 - Added accessors for DefaultPort and DefaultPortSSL. Using $Net::Jabber::Loudmouth::DefaultPort{,SSL} is deprecated now. - Make MessageNode_set_attributes C99 compliant. 0.06 Tue Sep 06 21:10:21 2005 - Removed Gtk2::CodeGen dependency in flavour of Glib::CodeGen. 0.05 Tue Aug 16 12:57:07 2005 - Updated MANIFEST - UNTODO some tests. They work with loudmouth 1.0 now. 0.04 Tue Aug 2 23:10:14 2005 - Changed Net::Jabber::Loudmouth::Connection::register_message_handler() to accept Net::Jabber::Loudmouth::MessageHandler instances and regular code references. We now return a Net::Jabber::Loudmouth::MessageHandler object instead of nothing to be able to remove the handler afterwards easily - Removed unneeded type for T_STRUCT_TM from typemap 0.03 Mon Aug 1 22:06:48 2005 - Added lots of tests 0.02 Thu Jul 28 18:13:22 2005 - Added documentation - Removed xs/ppport.h 0.01 Sat Jul 23 02:51:26 2005 - original version; created by h2xs 1.23 with options -AO -n Net::Jabber::Loudmouth Net-Jabber-Loudmouth-0.07/examples/0000711000175000017500000000000010405062603015563 5ustar raflraflNet-Jabber-Loudmouth-0.07/examples/lm-register.pl0000644000175000017500000000266510271467033020402 0ustar raflrafl#!/usr/bin/perl use strict; use warnings; use Glib qw/TRUE FALSE/; use Net::Jabber::Loudmouth; if (@ARGV < 3) { print "Usage: $0 [--ssl]\n"; exit 1; } my ($server, $username, $password, $ssl) = @ARGV; $ssl = TRUE if $ssl && ($ssl eq '-s' || $ssl eq '--ssl'); my $connection = Net::Jabber::Loudmouth::Connection->new($server); if ($ssl) { unless (Net::Jabber::Loudmouth::SSL->is_supported()) { print "This loudmouth installation doesn't support SSL\n"; exit 2; } print "Setting SSL\n"; my $ssl = Net::Jabber::Loudmouth::SSL->new(\&ssl_func); $connection->set_ssl($ssl); $connection->set_port($Net::Jabber::Loudmouth::DefaultPortSSL); } $connection->open_and_block(); my $m = Net::Jabber::Loudmouth::Message->new_with_sub_type('', 'iq', 'set'); my $query = $m->get_node->add_child('query'); $query->set_attributes('xmlns', 'jabber:iq:register'); $query->add_child('username', $username); $query->add_child('password', $password); my $reply = $connection->send_with_reply_and_block($m); if ($reply->get_sub_type() eq 'result') { print "Succeeded in register account '$username\@$server'\n"; } elsif ($reply->get_sub_type() eq 'error') { print "Failed to register account '$username\@$server' due to: "; my $node = $reply->get_node->find_child('error'); if ($node) { printf "%s\n", $node->get_value(); } else { print "Unknown error\n"; } } $connection->close(); sub ssl_func { return 'continue'; } Net-Jabber-Loudmouth-0.07/examples/lm-send-async.pl0000644000175000017500000000307710271174740020620 0ustar raflrafl#!/usr/bin/perl use strict; use warnings; use Glib qw/TRUE FALSE/; use Getopt::Std; use Net::Jabber::Loudmouth; my %opts; getopt('supmtnr', \%opts); if (!$opts{s} || !$opts{m} || !$opts{t} || !$opts{u} || !$opts{p}) { print STDERR "Usage: $0 -s -u -p -m -t [--n ] [-r ]\n"; exit 1; } { no warnings 'once'; $opts{n} ||= $Net::Jaber::Loudmouth::DefaultPort; } $opts{r} ||= 'jabber-send'; my $context = Glib::MainContext->new(); my $connection = Net::Jabber::Loudmouth::Connection->new_with_context($opts{s}, $context); my $msg_data = { recipient => $opts{t}, message => $opts{m} }; my $connection_data = { username => $opts{u}, password => $opts{p}, resource => $opts{r}, msg_data => $msg_data }; $connection->open(\&connection_open_result_cb, $connection_data); my $main_loop = Glib::MainLoop->new($context, FALSE); $main_loop->run(); sub connection_open_result_cb { my ($connection, $success, $data) = @_; unless ($success) { print STDERR "Connection failed\n"; exit 2; } $connection->authenticate($data->{username}, $data->{password}, $data->{resource}, \&connection_auth_cb, $data->{msg_data}); } sub connection_auth_cb { my ($connection, $success, $data) = @_; unless ($success) { print STDERR "Authentication failed\n"; exit 3; } my $m = Net::Jabber::Loudmouth::Message->new($data->{recipient}, 'message'); $m->get_node->add_child('body', $data->{message}); unless ($connection->send($m)) { print STDERR "Send failed\n"; exit 4; } $connection->close(); $main_loop->quit(); } Net-Jabber-Loudmouth-0.07/examples/lm-test-http-proxy.pl0000644000175000017500000000252110271461642021660 0ustar raflrafl#!/usr/bin/perl use strict; use warnings; use Net::Jabber::Loudmouth; if (@ARGV < 5) { print "Usage: $0 \n"; exit 1; } my $connection = Net::Jabber::Loudmouth::Connection->new($ARGV[0]); my $proxy = Net::Jabber::Loudmouth::Proxy->new('http'); $proxy->set_server($ARGV[3]); $proxy->set_port($ARGV[4]); $connection->set_proxy($proxy); my $handler = Net::Jabber::Loudmouth::MessageHandler->new(\&handle_messages); $connection->register_message_handler($handler, 'message', 'normal'); my $info = { name => $ARGV[1], passwd => $ARGV[2] }; $connection->open(\&connection_open_cb, $info); my $main_loop = Glib::MainLoop->new(); $main_loop->run(); sub handle_messages { my ($handler, $connection, $m) = @_; printf "Incoming message from %s\n", $m->get_node->get_attribute('from'); return 'remove-message'; } sub connection_open_cb { my ($connection, $result, $info) = @_; print "Connected callback\n"; $connection->authenticate($info->{name}, $info->{passwd}, "LmTest", \&authentication_cb, $info); print "Sent auth message\n"; } sub authentication_cb { my ($connection, $result) = @_; printf "Auth: %d\n", $result; if ($result) { my $m = Net::Jabber::Loudmouth::Message->new('', 'presence', 'available'); printf ":: %s\n", $m->get_node->to_string(); $connection->send($m); } } Net-Jabber-Loudmouth-0.07/examples/lm-change-password.pl0000644000175000017500000000326210271467205021636 0ustar raflrafl#!/usr/bin/perl use strict; use warnings; use Glib qw/TRUE FALSE/; use Net::Jabber::Loudmouth; sub print_usage { print "Usage: $0 [--ssl] [--host ]\n"; exit 1; } print_usage() if @ARGV < 4; my ($server, $username, $old_pass, $new_pass) = @ARGV; my ($use_ssl, $host) = (FALSE, undef); if (@ARGV > 4) { for (my $i = 4; $i < @ARGV; $i++) { if ($ARGV[$i] eq '-s' || $ARGV[$i] eq '--ssl') { $use_ssl = TRUE; } elsif ($ARGV[$i] eq '-h' || $ARGV[$i] eq '--host') { print_usage() if ++$i >= @ARGV; $host = $ARGV[$i]; print "HOST: $host\n"; } } } my $connection = Net::Jabber::Loudmouth::Connection->new($server); if ($host) { my $jid = "$username\@$host"; printf "Setting jid to %s\n", $jid; $connection->set_jid($jid); } if ($use_ssl) { unless (Net::Jabber::Loudmouth::SSL->is_supported()) { print "This loudmouth installation doesn't support SSL\n"; exit 2; } my $ssl = Net::Jabber::Loudmouth::SSL->new(\&ssl_func); $connection->set_ssl($ssl); $connection->set_port($Net::Jabber::Loudmouth::DefaultPortSSL); } $connection->open_and_block(); $connection->authenticate_and_block($username, $old_pass, 'Password changer'); my $m = Net::Jabber::Loudmouth::Message->new_with_sub_type('', 'iq', 'set'); my $query = $m->get_node->add_child('query'); $query->set_attributes('xmlns', 'jabber:iq:register'); $query->add_child('username', $username); $query->add_child('password', $new_pass); my $reply = $connection->send_with_reply_and_block($m); if ($reply->get_sub_type() eq 'result') { print "Password changed\n"; } else { print "Failed to change password\n"; } $connection->close(); sub ssl_func { return 'continue'; } Net-Jabber-Loudmouth-0.07/examples/lm-send-sync.pl0000644000175000017500000000133310271173524020447 0ustar raflrafl#!/usr/bin/perl use strict; use warnings; use Getopt::Std; use Net::Jabber::Loudmouth; my %opts; getopt('supmtnr', \%opts); if (!$opts{s} || !$opts{m} || !$opts{t} || !$opts{u} || !$opts{p}) { print "Usage: $0 -s -u -p -m -t [--n ] [-r ]\n"; exit 1; } { no warnings 'once'; $opts{n} ||= $Net::Jaber::Loudmouth::DefaultPort; } $opts{r} ||= 'jabber-send'; my $connection = Net::Jabber::Loudmouth::Connection->new($opts{s}); $connection->open_and_block(); $connection->authenticate_and_block($opts{u}, $opts{p}, $opts{r}); my $m = Net::Jabber::Loudmouth::Message->new($opts{t}, 'message'); $m->get_node->add_child('body', $opts{m}); $connection->send($m); Net-Jabber-Loudmouth-0.07/examples/lm-test-tunnel.pl0000644000175000017500000000253610271453546021041 0ustar raflrafl#!/usr/bin/perl use strict; use warnings; use Net::Jabber::Loudmouth; if (@ARGV < 5) { print "Usage: $0 \n"; exit 1; } my $connection = Net::Jabber::Loudmouth::Connection->new($ARGV[3]); my $jid = $ARGV[1].'@'.$ARGV[0]; $connection->set_jid($jid); $connection->set_port($ARGV[4]); my $handler = Net::Jabber::Loudmouth::MessageHandler->new(\&handle_message); $connection->register_message_handler($handler, 'message', 'normal'); my $info = { name => $ARGV[1], passwd => $ARGV[2] }; $connection->open(\&connection_open_cb, $info); print "Returned from the connection->open()\n"; my $main_loop = Glib::MainLoop->new(); $main_loop->run(); sub handle_message { my ($handler, $connection, $m) = @_; printf "Incoming message from %s\n", $m->get_node->get_attribute('from'); return 'remove-message'; } sub connection_open_cb { my ($connection, $result, $info) = @_; print "Connected callback\n"; $connection->authenticate($info->{name}, $info->{passwd}, "LmTest", \&authentication_cb, $info); print "Sent auth message\n"; } sub authentication_cb { my ($connection, $result) = @_; printf "Auth: %d\n", $result; if ($result) { my $m = Net::Jabber::Loudmouth::Message->new_with_sub_type('', 'presence', 'available'); printf ":: %s\n", $m->get_node->to_string(); $connection->send($m); } } Net-Jabber-Loudmouth-0.07/examples/lm-test.pl0000644000175000017500000000435610274375546017546 0ustar raflrafl#!/usr/bin/perl use strict; use warnings; use Net::Jabber::Loudmouth; if (@ARGV < 3) { print STDERR "Usage: $0 []\n"; exit 1; } my $connection = Net::Jabber::Loudmouth::Connection->new($ARGV[0]); if (@ARGV > 3 && !Net::Jabber::Loudmouth::SSL->is_supported()) { print STDERR "No SSL support!\n"; exit 2; } my $handler = Net::Jabber::Loudmouth::MessageHandler->new(\&handle_message); $connection->register_message_handler($handler, 'message', 'normal'); my $info = { name => $ARGV[1], passwd => $ARGV[2] }; if (@ARGV > 3) { $connection->set_port($Net::Jabber::Loudmouth::DefaultPortSSL); my $ssl = Net::Jabber::Loudmouth::SSL->new(\&ssl_cb, $info, $ARGV[3]); $connection->set_ssl($ssl); } $connection->open(\&connection_open_cb, $info); my $main_loop = Glib::MainLoop->new(); $main_loop->run(); sub print_finger { my ($fpr, $size) = @_; for (my $i = 0; $i < $size-1; $i++) { my $c; { no warnings; $c = substr($fpr, $i, 1); } $c &&= ord $c; $c ||= 0; printf "%02X:", $c; } my $c; { no warnings; $c = substr($fpr, $size-1, 1); } $c &&= ord $c; $c ||= 0; printf "%02X", $c; } sub ssl_cb { my ($ssl, $status, $ud) = @_; print "SSL status: $status\n"; if ($status eq 'cert-fingerprint-mismatch') { my $fpr = $ssl->get_fingerprint(); print "Certificate fingerprint does not match expected fingerprint!\n"; print "Remote fingerprint: "; print_finger($fpr, 16); print "\nExpected fingerprint: "; print_finger($ARGV[3], 16); print "\n"; } elsif ($status eq 'generic-error') { print "Generic SSL error!\n"; } return 'continue'; } sub connection_open_cb { my ($connection, $result, $info) = @_; print "Connected callback!\n"; $connection->authenticate($info->{name}, $info->{passwd}, "LmTest", \&authenticate_cb); print "Sent auth message\n"; } sub authenticate_cb { my ($connection, $result, $ud) = @_; print "Auth: $result\n"; if ($result) { my $m = Net::Jabber::Loudmouth::Message->new_with_sub_type("", 'presence', 'available'); printf ":: %s\n", $m->get_node->to_string(); $connection->send($m); } } sub handle_message { my ($handler, $connection, $m) = @_; printf "Incoming message from %s\n", $m->get_node->get_attribute('from'); return 'remove-message'; } Net-Jabber-Loudmouth-0.07/MANIFEST0000644000175000017500000000107410307364355015122 0ustar raflraflChanges examples/lm-change-password.pl examples/lm-register.pl examples/lm-send-async.pl examples/lm-send-sync.pl examples/lm-test-http-proxy.pl examples/lm-test-tunnel.pl examples/lm-test.pl Makefile.PL MANIFEST maps META.yml perlmouth.c perlmouth.h pm/Loudmouth.pm t/01_use.t t/02_pod.t t/03_pod_coverage.t t/04_basic.t t/05_connection.t t/06_message.t t/07_message_handler.t t/08_message_node.t t/09_ssl.t t/10_proxy.t t/proxy_helper.pl t/server_helper.pl TODO xs/Connection.xs xs/Loudmouth.xs xs/Message.xs xs/MessageHandler.xs xs/MessageNode.xs xs/Proxy.xs xs/SSL.xs Net-Jabber-Loudmouth-0.07/xs/0000711000175000017500000000000010405062603014377 5ustar raflraflNet-Jabber-Loudmouth-0.07/xs/SSL.xs0000644000175000017500000000215510300747406015434 0ustar raflrafl#include "perlmouth.h" LmSSLResponse perlmouth_lm_ssl_new_cb(LmSSL* ssl, LmSSLStatus status, gpointer callback) { GValue return_value = {0,}; LmSSLResponse retval; g_value_init(&return_value, ((GPerlCallback*)callback)->return_type); gperl_callback_invoke((GPerlCallback*)callback, &return_value, ssl, status); retval = g_value_get_enum(&return_value); g_value_unset(&return_value); return retval; } MODULE = Net::Jabber::Loudmouth::SSL PACKAGE = Net::Jabber::Loudmouth::SSL PREFIX = lm_ssl_ LmSSL* lm_ssl_new(class, ssl_cb, user_data=NULL, expected_fingerprint=NULL) SV* ssl_cb SV* user_data const gchar* expected_fingerprint PREINIT: GType param_types[2]; GPerlCallback* callback; CODE: param_types[0] = PERLMOUTH_TYPE_SSL; param_types[1] = PERLMOUTH_TYPE_SSL_STATUS; callback = gperl_callback_new(ssl_cb, user_data, 2, param_types, PERLMOUTH_TYPE_SSL_RESPONSE); RETVAL = lm_ssl_new(expected_fingerprint, perlmouth_lm_ssl_new_cb, callback, (GDestroyNotify)gperl_callback_destroy); OUTPUT: RETVAL gboolean lm_ssl_is_supported(class) C_ARGS: const gchar* lm_ssl_get_fingerprint(ssl) LmSSL* ssl Net-Jabber-Loudmouth-0.07/xs/Proxy.xs0000644000175000017500000000176510271155227016123 0ustar raflrafl#include "perlmouth.h" MODULE = Net::Jabber::Loudmouth::Proxy PACKAGE = Net::Jabber::Loudmouth::Proxy PREFIX = lm_proxy_ LmProxy* lm_proxy_new(class, type) LmProxyType type C_ARGS: type LmProxy* lm_proxy_new_with_server(class, type, server, port) LmProxyType type const gchar* server guint port C_ARGS: type, server, port LmProxyType lm_proxy_get_type(proxy) LmProxy* proxy void lm_proxy_set_type(proxy, type) LmProxy* proxy LmProxyType type const gchar* lm_proxy_get_server(proxy) LmProxy* proxy void lm_proxy_set_server(proxy, server) LmProxy* proxy const gchar* server guint lm_proxy_get_port(proxy) LmProxy* proxy void lm_proxy_set_port(proxy, port) LmProxy* proxy guint port const gchar* lm_proxy_get_username(proxy) LmProxy* proxy void lm_proxy_set_username(proxy, username) LmProxy* proxy const gchar* username const gchar* lm_proxy_get_password(proxy) LmProxy* proxy void lm_proxy_set_password(proxy, password) LmProxy* proxy const gchar* password Net-Jabber-Loudmouth-0.07/xs/MessageHandler.xs0000644000175000017500000000244710271434366017666 0ustar raflrafl#include "perlmouth.h" LmHandlerResult perlmouth_lm_message_handler_new_cb(LmMessageHandler* handler, LmConnection* connection, LmMessage* message, gpointer callback) { GValue return_value = {0,}; LmHandlerResult retval; g_value_init(&return_value, ((GPerlCallback*)callback)->return_type); gperl_callback_invoke((GPerlCallback*)callback, &return_value, handler, connection, message); retval = g_value_get_enum(&return_value); g_value_unset(&return_value); return retval; } MODULE = Net::Jabber::Loudmouth::MessageHandler PACKAGE = Net::Jabber::Loudmouth::MessageHandler PREFIX = lm_message_handler_ LmMessageHandler* lm_message_handler_new(class, handler_cb, user_data=NULL) SV* handler_cb SV* user_data PREINIT: GType param_types[3]; GPerlCallback* callback; CODE: param_types[0] = PERLMOUTH_TYPE_MESSAGE_HANDLER; param_types[1] = PERLMOUTH_TYPE_CONNECTION; param_types[2] = PERLMOUTH_TYPE_MESSAGE; callback = gperl_callback_new(handler_cb, user_data, 3, param_types, PERLMOUTH_TYPE_HANDLER_RESULT); RETVAL = lm_message_handler_new(perlmouth_lm_message_handler_new_cb, callback, (GDestroyNotify)gperl_callback_destroy); OUTPUT: RETVAL void lm_message_handler_invalidate(handler) LmMessageHandler* handler gboolean lm_message_handler_is_valid(handler) LmMessageHandler* handler Net-Jabber-Loudmouth-0.07/xs/Loudmouth.xs0000644000175000017500000000021710270463752016755 0ustar raflrafl#include "perlmouth.h" MODULE = Net::Jabber::Loudmouth PACKAGE = Net::Jabber::Loudmouth BOOT: #include "register.xsh" #include "boot.xsh" Net-Jabber-Loudmouth-0.07/xs/Message.xs0000644000175000017500000000112710271150212016343 0ustar raflrafl#include "perlmouth.h" MODULE = Net::Jabber::Loudmouth::Message PACKAGE = Net::Jabber::Loudmouth::Message PREFIX = lm_message_ LmMessage* lm_message_new(class, to, type) const gchar* to LmMessageType type C_ARGS: to, type LmMessage* lm_message_new_with_sub_type(class, to, type, sub_type) const gchar* to LmMessageType type LmMessageSubType sub_type C_ARGS: to, type, sub_type LmMessageType lm_message_get_type(message) LmMessage* message LmMessageSubType lm_message_get_sub_type(message) LmMessage* message LmMessageNode* lm_message_get_node(message) LmMessage* message Net-Jabber-Loudmouth-0.07/xs/Connection.xs0000644000175000017500000001731710400346525017076 0ustar raflrafl#include "perlmouth.h" extern LmHandlerResult perlmouth_lm_message_handler_new_cb(LmMessageHandler* handler, LmConnection* connection, LmMessage* message, gpointer user_data); void perlmouth_lm_connection_open_cb(LmConnection* connection, gboolean success, gpointer callback) { gperl_callback_invoke((GPerlCallback*)callback, NULL, connection, success); } void perlmouth_lm_connection_authenticate_cb(LmConnection* connection, LmDisconnectReason reason, gpointer callback) { gperl_callback_invoke((GPerlCallback*)callback, NULL, connection, reason); } void perlmouth_lm_connection_set_disconnect_function_cb(LmConnection* connection, LmDisconnectReason reason, gpointer callback) { gperl_callback_invoke((GPerlCallback*)callback, NULL, connection, reason); } MODULE = Net::Jabber::Loudmouth::Connection PACKAGE = Net::Jabber::Loudmouth::Connection PREFIX = lm_connection_ LmConnection* lm_connection_new(class, server) const gchar *server C_ARGS: server LmConnection* lm_connection_new_with_context(class, server, context) const gchar *server GMainContext *context C_ARGS: server, context gboolean lm_connection_open(connection, result_cb, user_data=NULL) LmConnection* connection SV *result_cb SV *user_data PREINIT: GError* error = NULL; GType param_types[2]; GPerlCallback *callback; CODE: param_types[0] = PERLMOUTH_TYPE_CONNECTION; param_types[1] = G_TYPE_BOOLEAN; callback = gperl_callback_new(result_cb, user_data, 2, param_types, G_TYPE_NONE); RETVAL = lm_connection_open(connection, perlmouth_lm_connection_open_cb, callback, (GDestroyNotify)gperl_callback_destroy, &error); if (!RETVAL) gperl_croak_gerror(NULL, error); OUTPUT: RETVAL gboolean lm_connection_open_and_block(connection) LmConnection* connection PREINIT: GError* error = NULL; CODE: RETVAL = lm_connection_open_and_block(connection, &error); if (!RETVAL) gperl_croak_gerror(NULL, error); OUTPUT: RETVAL void lm_connection_cancel_open(connection) LmConnection* connection gboolean lm_connection_close(connection) LmConnection* connection PREINIT: GError* error = NULL; CODE: RETVAL = lm_connection_close(connection, &error); if (!RETVAL) gperl_croak_gerror(NULL, error); OUTPUT: RETVAL gboolean lm_connection_authenticate(connection, username, password, resource, auth_cb, user_data=NULL) LmConnection* connection const gchar* username const gchar* password const gchar* resource SV* auth_cb SV* user_data PREINIT: GError* error = NULL; GType param_types[2]; GPerlCallback* callback; CODE: param_types[0] = PERLMOUTH_TYPE_CONNECTION; param_types[1] = G_TYPE_BOOLEAN; callback = gperl_callback_new(auth_cb, user_data, 2, param_types, G_TYPE_NONE); RETVAL = lm_connection_authenticate(connection, username, password, resource, (LmResultFunction)perlmouth_lm_connection_authenticate_cb, callback, (GDestroyNotify)gperl_callback_destroy, &error); if (!RETVAL) gperl_croak_gerror(NULL, error); OUTPUT: RETVAL gboolean lm_connection_authenticate_and_block(connection, username, password, resource) LmConnection* connection const gchar* username const gchar* password const gchar* resource PREINIT: GError* error = NULL; CODE: RETVAL = lm_connection_authenticate_and_block(connection, username, password, resource, &error); if (!RETVAL) gperl_croak_gerror(NULL, error); OUTPUT: RETVAL void lm_connection_set_keep_alive_rate(connection, rate) LmConnection* connection guint rate gboolean lm_connection_is_open(connection) LmConnection* connection gboolean lm_connection_is_authenticated(connection) LmConnection* connection const gchar* lm_connection_get_server(connection) LmConnection* connection void lm_connection_set_server(connection, server) LmConnection* connection const gchar* server void lm_connection_set_jid(connection, jid) LmConnection* connection const gchar* jid const gchar* lm_connection_get_jid(connection) LmConnection* connection guint lm_connection_get_port(connection) LmConnection* connection void lm_connection_set_port(connection, port) LmConnection* connection guint port LmSSL* lm_connection_get_ssl(connection) LmConnection* connection void lm_connection_set_ssl(connection, ssl) LmConnection* connection LmSSL_ornull* ssl LmProxy* lm_connection_get_proxy(connection) LmConnection* connection void lm_connection_set_proxy(connection, proxy) LmConnection* connection LmProxy_ornull* proxy gboolean lm_connection_send(connection, message) LmConnection* connection LmMessage* message PREINIT: GError* error = NULL; CODE: RETVAL = lm_connection_send(connection, message, &error); if (!RETVAL) gperl_croak_gerror(NULL, error); OUTPUT: RETVAL gboolean lm_connection_send_with_reply(connection, message, handler) LmConnection* connection LmMessage* message LmMessageHandler* handler PREINIT: GError* error = NULL; CODE: RETVAL = lm_connection_send_with_reply(connection, message, handler, &error); if (!RETVAL) gperl_croak_gerror(NULL, error); OUTPUT: RETVAL LmMessage* lm_connection_send_with_reply_and_block(connection, message) LmConnection* connection LmMessage* message PREINIT: GError* error = NULL; CODE: RETVAL = lm_connection_send_with_reply_and_block(connection, message, &error); if (!RETVAL) gperl_croak_gerror(NULL, error); OUTPUT: RETVAL gboolean lm_connection_send_raw(connection, str) LmConnection* connection const gchar* str PREINIT: GError* error = NULL; CODE: RETVAL = lm_connection_send_raw(connection, str, &error); if (!RETVAL) gperl_croak_gerror(NULL, error); OUTPUT: RETVAL LmMessageHandler* lm_connection_register_message_handler(connection, type, priority, handler_cb, user_data=NULL) LmConnection* connection LmMessageType type LmHandlerPriority priority SV* handler_cb SV* user_data PREINIT: GType param_types[3]; GPerlCallback* callback; CODE: param_types[0] = PERLMOUTH_TYPE_MESSAGE_HANDLER; param_types[1] = PERLMOUTH_TYPE_CONNECTION; param_types[2] = PERLMOUTH_TYPE_MESSAGE; if (!handler_cb || !SvOK(handler_cb) || !SvROK(handler_cb)) { croak("handler_cb must be either a code reference or derived from Net::Jabber::Loudmouth::MessageHandler"); } else if (SvTYPE(SvRV(handler_cb)) == SVt_PVCV) { callback = gperl_callback_new(handler_cb, user_data, 3, param_types, PERLMOUTH_TYPE_HANDLER_RESULT); RETVAL = lm_message_handler_new(perlmouth_lm_message_handler_new_cb, callback, (GDestroyNotify)gperl_callback_destroy); } else if (sv_isobject(handler_cb) && sv_derived_from(handler_cb, "Net::Jabber::Loudmouth::MessageHandler")) { if (user_data != NULL) croak("You can't use user_data if you pass a Net::Jabber::Loudmouth::MessageHandler derived object as handler_cb"); RETVAL = SvLmMessageHandler(handler_cb); } else { croak("your handler_cb ist weird. This shouldn't happen. Please report a bug."); } lm_connection_register_message_handler(connection, RETVAL, type, priority); OUTPUT: RETVAL void lm_connection_unregister_message_handler(connection, type, handler) LmConnection* connection LmMessageType type LmMessageHandler* handler C_ARGS: connection, handler, type void lm_connection_set_disconnect_function(connection, disconnect_cb, user_data=NULL) LmConnection* connection SV* disconnect_cb SV* user_data PREINIT: GPerlCallback* callback; GType param_types[2]; CODE: param_types[0] = PERLMOUTH_TYPE_CONNECTION; param_types[1] = PERLMOUTH_TYPE_DISCONNECT_REASON; callback = gperl_callback_new(disconnect_cb, user_data, 2, param_types, G_TYPE_NONE); lm_connection_set_disconnect_function(connection, perlmouth_lm_connection_set_disconnect_function_cb, callback, (GDestroyNotify)gperl_callback_destroy); LmConnectionState lm_connection_get_state(connection) LmConnection* connection Net-Jabber-Loudmouth-0.07/xs/MessageNode.xs0000644000175000017500000000433510400345506017163 0ustar raflrafl#include "perlmouth.h" MODULE = Net::Jabber::Loudmouth::MessageNode PACKAGE = Net::Jabber::Loudmouth::MessageNode PREFIX = lm_message_node_ const gchar* lm_message_node_get_value(node) LmMessageNode* node void lm_message_node_set_value(node, value) LmMessageNode* node const gchar* value const gchar* get_name(node) LmMessageNode* node CODE: RETVAL = node->name; OUTPUT: RETVAL void set_name(node, name) LmMessageNode* node gchar* name CODE: node->name = name; LmMessageNode* lm_message_node_add_child(node, name, value=NULL) LmMessageNode* node const gchar* name const gchar* value void lm_message_node_set_attributes(node, ...) LmMessageNode* node PREINIT: int i; CODE: if (((items - 1) % 2) != 0) croak("set_attributes expects name => value pairs " "(odd number of arguments detected)"); for (i = 1; i < items; i += 2) { const gchar *name, *value; sv_utf8_upgrade(ST(i)); name = (const gchar*)SvPV_nolen(ST(i)); sv_utf8_upgrade(ST(i+1)); value = (const gchar*)SvPV_nolen(ST(i+1)); lm_message_node_set_attribute(node, name, value); } void lm_message_node_set_attribute(node, name, value) LmMessageNode* node const gchar* name const gchar* value const gchar* lm_message_node_get_attribute(node, name) LmMessageNode* node const gchar* name LmMessageNode* lm_message_node_get_child_by_name(node, child_name) LmMessageNode* node const gchar* child_name CODE: RETVAL = lm_message_node_get_child(node, child_name); OUTPUT: RETVAL LmMessageNode* lm_message_node_find_child(node, child_name) LmMessageNode* node const gchar* child_name gboolean lm_message_node_get_raw_mode(node) LmMessageNode* node void lm_message_node_set_raw_mode(node, raw_mode) LmMessageNode* node gboolean raw_mode gchar* lm_message_node_to_string(node) LmMessageNode* node LmMessageNode* get_child(node) LmMessageNode* node CODE: RETVAL = node->children; OUTPUT: RETVAL LmMessageNode* get_parent(node) LmMessageNode* node CODE: RETVAL = node->parent; OUTPUT: RETVAL LmMessageNode* get_next(node) LmMessageNode* node CODE: RETVAL = node->next; OUTPUT: RETVAL LmMessageNode* get_prev(node) LmMessageNode* node CODE: RETVAL = node->prev; OUTPUT: RETVAL Net-Jabber-Loudmouth-0.07/TODO0000644000175000017500000000040610307330265014450 0ustar raflrafl* More tests for Net::Jabber::Loudmouth::MessageNode. * Fix Glib and perl warnings (caused by HTTP::Proxy) for t/10_proxy.t. * Find a pure perl Jabber server implementation that actually works. Net::Jabber::Server and POE::Component::Jabber appearently don't. Net-Jabber-Loudmouth-0.07/META.yml0000600000175000017500000000054110405062604015217 0ustar raflrafl# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Net-Jabber-Loudmouth version: 0.07 version_from: pm/Loudmouth.pm installdirs: site requires: Glib: 1.093 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30 Net-Jabber-Loudmouth-0.07/perlmouth.h0000644000175000017500000000214610271136653016160 0ustar raflrafl#include #include #include "perlmouth-gtypes.h" #ifndef PERLMOUTH_TYPE_CONNECTION #define PERLMOUTH_TYPE_CONNECTION (perlmouth_lm_connection_get_type ()) GType perlmouth_lm_connection_get_type (void) G_GNUC_CONST; #endif #ifndef PERLMOUTH_TYPE_MESSAGE #define PERLMOUTH_TYPE_MESSAGE (perlmouth_lm_message_get_type ()) GType perlmouth_lm_message_get_type (void) G_GNUC_CONST; #endif #ifndef PERLMOUTH_TYPE_SSL #define PERLMOUTH_TYPE_SSL (perlmouth_lm_ssl_get_type ()) GType perlmouth_lm_ssl_get_type (void) G_GNUC_CONST; #endif #ifndef PERLMOUTH_TYPE_PROXY #define PERLMOUTH_TYPE_PROXY (perlmouth_lm_proxy_get_type ()) GType perlmouth_lm_proxy_get_type (void) G_GNUC_CONST; #endif #ifndef PERLMOUTH_TYPE_MESSAGE_HANDLER #define PERLMOUTH_TYPE_MESSAGE_HANDLER (perlmouth_lm_message_handler_get_type ()) GType perlmouth_lm_message_handler_get_type (void) G_GNUC_CONST; #endif #ifndef PERLMOUTH_TYPE_MESSAGE_NODE #define PERLMOUTH_TYPE_MESSAGE_NODE (perlmouth_lm_message_node_get_type ()) GType perlmouth_lm_message_node_get_type (void) G_GNUC_CONST; #endif #include "loudmouth-autogen.h" Net-Jabber-Loudmouth-0.07/maps0000644000175000017500000000173010271155172014646 0ustar raflraflPERLMOUTH_TYPE_CONNECTION LmConnection GBoxed Net::Jabber::Loudmouth::Connection PERLMOUTH_TYPE_MESSAGE LmMessage GBoxed Net::Jabber::Loudmouth::Message PERLMOUTH_TYPE_MESSAGE_NODE LmMessageNode GBoxed Net::Jabber::Loudmouth::MessageNode PERLMOUTH_TYPE_SSL LmSSL GBoxed Net::Jabber::Loudmouth::SSL PERLMOUTH_TYPE_PROXY LmProxy GBoxed Net::Jabber::Loudmouth::Proxy PERLMOUTH_TYPE_MESSAGE_HANDLER LmMessageHandler GBoxed Net::Jabber::Loudmouth::MessageHandler PERLMOUTH_TYPE_MESSAGE_TYPE LmMessageType GEnum Net::Jabber::Loudmouth::MessageType PERLMOUTH_TYPE_MESSAGE_SUB_TYPE LmMessageSubType GEnum Net::Jabber::Loudmouth::MessageSubType PERLMOUTH_TYPE_CONNECTION_STATE LmConnectionState GEnum Net::Jabber::Loudmouth::ConnectionState PERLMOUTH_TYPE_HANDLER_PRIORITY LmHandlerPriority GEnum Net::Jabber::Loudmouth::HandlerPriority PERLMOUTH_TYPE_SSL_STATUS LmSSLStatus GEnum Net::Jabber::Loudmouth::SSLStatus PERLMOUTH_TYPE_PROXY_TYPE LmProxyType GEnum Net::Jabber::Loudmouth::ProxyType Net-Jabber-Loudmouth-0.07/perlmouth.c0000644000175000017500000000244110271007427016145 0ustar raflrafl#include "perlmouth.h" GType perlmouth_lm_connection_get_type(void) { static GType t = 0; if (!t) t = g_boxed_type_register_static( "LmConnection", (GBoxedCopyFunc) g_boxed_copy, (GBoxedFreeFunc) g_boxed_free); return t; } GType perlmouth_lm_message_get_type(void) { static GType t = 0; if (!t) t = g_boxed_type_register_static( "LmMessage", (GBoxedCopyFunc) g_boxed_copy, (GBoxedFreeFunc) g_boxed_free); return t; } GType perlmouth_lm_proxy_get_type(void) { static GType t = 0; if (!t) t = g_boxed_type_register_static( "LmProxy", (GBoxedCopyFunc) g_boxed_copy, (GBoxedFreeFunc) g_boxed_free); return t; } GType perlmouth_lm_ssl_get_type(void) { static GType t = 0; if (!t) t = g_boxed_type_register_static( "LmSSL", (GBoxedCopyFunc) g_boxed_copy, (GBoxedFreeFunc) g_boxed_free); return t; } GType perlmouth_lm_message_handler_get_type(void) { static GType t = 0; if (!t) t = g_boxed_type_register_static( "LmMessageHandler", (GBoxedCopyFunc) g_boxed_copy, (GBoxedFreeFunc) g_boxed_free); return t; } GType perlmouth_lm_message_node_get_type(void) { static GType t = 0; if (!t) t = g_boxed_type_register_static( "LmMessageNode", (GBoxedCopyFunc) g_boxed_copy, (GBoxedFreeFunc) g_boxed_free); return t; } Net-Jabber-Loudmouth-0.07/Makefile.PL0000644000175000017500000000546310307364562015751 0ustar raflrafl#!/usr/bin/perl use strict; use warnings; use File::Spec; use Glib::CodeGen; use Glib::MakeHelper; use ExtUtils::Depends; use ExtUtils::PkgConfig; use ExtUtils::MakeMaker; mkdir 'build', 0777; chomp(my $pm_includes = `pkg-config --variable includedir loudmouth-1.0`); my @lm_headers = glob($pm_includes.'/loudmouth-1.0/loudmouth/*.h'); my %pkg_config = ExtUtils::PkgConfig->find('loudmouth-1.0'); system(q(glib-mkenums --fhead "#ifndef __PERLMOUTH_GTYPES_H__\n" ). q(--fhead "#define __PERLMOUTH_GTYPES_H__ 1\n\n" ). q(--fhead "#include \n\n" ). q(--fhead "G_BEGIN_DECLS\n\n" ). q(--eprod "#define PERLMOUTH_TYPE_@ENUMSHORT@ perlmouth_@enum_name@_get_type()\n" ). q(--eprod "GType perlmouth_@enum_name@_get_type (void) G_GNUC_CONST;\n" ). q(--ftail "G_END_DECLS\n\n" ). q(--ftail "#endif /* __PERLMOUTH_GTYPES_H__ */\n" ). "@lm_headers > build/perlmouth-gtypes.h"); system(q(glib-mkenums --fhead "#include \n" ). q(--fhead "#include \"perlmouth.h\"\n\n" ). q(--vhead "static const G@Type@Value _perlmouth_@enum_name@_values[] = {" ). q(--vprod " { @VALUENAME@, \"@VALUENAME@\", \"@valuenick@\" }," ). q(--vtail " { 0, NULL, NULL }\n};\n\n" ). q(--vtail "GType\nperlmouth_@enum_name@_get_type (void) {\n" ). q(--vtail " static GType t = 0;\n" ). q(--vtail " if (!t)\n" ). q(--vtail " t = g_@type@_register_static(\"@EnumName@\", _perlmouth_@enum_name@_values);\n" ). q(--vtail " return t;\n}\n\n" ). "@lm_headers > build/perlmouth-gtypes.c"); Glib::CodeGen->parse_maps('loudmouth'); Glib::CodeGen->write_boot(ignore => qr/^Net::Jabber::Loudmouth$/); our $loudmouth = ExtUtils::Depends->new('Net::Jabber::Loudmouth', 'Glib'); our @xs_files = ; $loudmouth->add_xs(@xs_files); $loudmouth->add_c('perlmouth.c', 'build/perlmouth-gtypes.c'); $loudmouth->add_typemaps(File::Spec->rel2abs(File::Spec->catfile('build', 'loudmouth.typemap'))); $loudmouth->set_inc($pkg_config{cflags}.' -I./build -Werror'); $loudmouth->set_libs($pkg_config{libs}); $loudmouth->install(File::Spec->catfile('build', 'loudmouth-autogen.h')); $loudmouth->add_pm( 'pm/Loudmouth.pm' => '$(INST_LIBDIR)/Loudmouth.pm' ); # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Net::Jabber::Loudmouth', VERSION_FROM => File::Spec->catfile('pm', 'Loudmouth.pm'), XSPROTOARG => '-noprototypes', PREREQ_PM => { 'Glib' => '1.093' }, MAN3PODS => { 'pm/Loudmouth.pm' => '$(INST_MAN3DIR)/Net::Jabber::Loudmouth.$(MAN3EXT)', Glib::MakeHelper->do_pod_files(@xs_files) }, $loudmouth->get_makefile_vars() ); package MY; sub postamble { return Glib::MakeHelper->postamble_clean() . Glib::MakeHelper->postamble_docs_full(DEPENDS => $main::loudmouth); }