Catalyst-Engine-XMPP2
view release on metacpan or search on metacpan
lib/Catalyst/Engine/XMPP2.pm view on Meta::CPAN
{ package Catalyst::Engine::XMPP2;
use strict;
use warnings;
our $VERSION = '0.4';
use base qw(Catalyst::Engine::Embeddable);
use Event qw(loop);
use Encode;
use HTTP::Request;
use AnyEvent::XMPP::Connection;
use UNIVERSAL qw(isa);
__PACKAGE__->mk_accessors(qw( connections ));
my %http_xmpp_error_map =
(
400 => { cond => 'bad-request',
type => 'modify' },
409 => { cond => 'conflict',
type => 'cancel' },
501 => { cond => 'feature-not-implemented',
type => 'cancel' },
403 => { cond => 'forbidden',
type => 'auth' },
410 => { cond => 'gone',
type => 'modify' },
500 => { cond => 'internal-server-error',
type => 'wait' },
404 => { cond => 'item-not-found',
type => 'cancel' },
520 => { cond => 'jid-malformed',
type => 'modify' },
406 => { cond => 'not-acceptable',
type => 'modify' },
420 => { cond => 'not-allowed',
type => 'cancel' },
401 => { cond => 'not-authorized',
type => 'auth' },
402 => { cond => 'payment-required',
type => 'auth' },
521 => { cond => 'recipient-unavailable',
type => 'wait' },
302 => { cond => 'redirect',
type => 'modify' },
421 => { cond => 'registration-required',
type => 'auth' },
502 => { cond => 'remote-server-not-found',
type => 'cancel' },
504 => { cond => 'remote-server-timeout',
type => 'wait' },
412 => { cond => 'resource-constraint',
type => 'wait' },
503 => { cond => 'service-unavailable',
type => 'cancel' },
422 => { cond => 'subscription-required',
type => 'auth' },
423 => { cond => 'undefined-condition',
type => 'cancel' },
424 => { cond => 'unexpected-request',
type => 'wait' },
);
sub run {
my ($self, $app) = @_;
die 'No Engine::XMPP2 configuration found'
unless ref $app->config->{'Engine::XMPP2'} eq 'HASH';
# list the path actions that will be mapped as resources.
lib/Catalyst/Engine/XMPP2.pm view on Meta::CPAN
foreach my $resource (@resources) {
$self->connections->{$resource} =
AnyEvent::XMPP::Connection->new(resource => $resource,
%template);
}
#$app->log->debug('Connecting XMPP resources.');
foreach my $resource (@resources) {
$self->connections->{$resource}->connect
or die 'Could not connect resource: '.$resource.', '.$!;
$self->connections->{$resource}->reg_cb
(stream_ready => sub {
$self->connections->{$resource}->send_presence('available', sub{});
},
bind_error => sub {
die 'Error binding resource '.$resource.': '.shift;
},
# the four events are registered as separate to let AnyEvent::XMPP
# handle all other types of events, but we can actually process
# them the same way.
iq_get_request_xml => sub {
my ($conn, $node) = @_;
#$app->log->debug('Received an iq get stanza at '.$resource);
$self->handle_xmpp_node($app, $resource, $node, 'iq');
},
iq_set_request_xml => sub {
my ($conn, $node) = @_;
#$app->log->debug('Received an iq set stanza at '.$resource);
$self->handle_xmpp_node($app, $resource, $node, 'iq');
},
message_xml => sub {
my ($conn, $node) = @_;
#$app->log->debug('Received a message stanza at '.$resource);
$self->handle_xmpp_node($app, $resource, $node, 'message');
},
presence_xml => sub {
my ($conn, $node) = @_;
#$app->log->debug('Received a presence stanza at '.$resource);
$self->handle_xmpp_node($app, $resource, $node, 'presence');
});
}
loop();
}
sub handle_xmpp_node {
my ($self, $app, $resource, $node, $type) = @_;
# we're going to avoid doing any action on a message of type "error"
return if
defined $type &&
$type eq 'message' &&
defined $node->attr('type') &&
$node->attr('type') eq 'error';
my $config = $app->config->{'Engine::XMPP2'};
my $url = 'xmpp://'.$config->{username}.'@'.$config->{domain}.'/'.$resource;
my $request = HTTP::Request->new(POST => $url);
$request->header('Content-type' => 'application/xml; charset=utf-8');
$request->header('XMPP_Stanza' => $type);
$request->header('XMPP_Resource' => $resource);
$request->header('XMPP_Stanza_'.$_ => $node->attr($_))
for grep { $node->attr($_) } qw(to from id type xml:lang);
my $content = join '', $node->text, map { $_->as_string } $node->nodes;
$request->content_length( length($content) );
$request->content( $content);
#$app->log->debug('[Request Content] '.$request->content);
my $response;
$app->handle_request($request, \$response);
my %response_attrs = map { $_ => $response->header('XMPP_Stanza_'.$_) }
grep { $response->header($_) } qw(to from id type xml:lang);
if ($response->is_success && $type ne 'iq') {
#$app->log->debug('Request ended successfully, no response needed.');
} elsif ($response->is_success) {
my $content_type = $response->header('Content-type');
my $content_raw = $response->content();
$self->connections->{$resource}->reply_iq_result
($node, sub {
my $xml_writer = shift;
my $ctype = $content_type;
my $craw = $content_raw;
if ($ctype &&
$ctype =~ /xml/) {
$xml_writer->raw($craw);
} else {
$xml_writer->raw('<body>'.$craw.'</body>');
}
}, %response_attrs);
} else {
my $cond = $http_xmpp_error_map{$response->code}{cond}
|| 'internal-server-error';
my $type = $http_xmpp_error_map{$response->code}{type}
|| 'wait';
if (my $over = $response->header('XMPP_error-type')) {
$type = $over;
}
if ($node->name eq 'iq') {
$self->connections->{$resource}->reply_iq_error
($node, $type, $cond, %response_attrs);
} else {
my $content_raw = $response->content();
$self->connections->{$resource}->send_message
($node->attr('from'), 'error', sub {
my $xml_writer = shift;
$xml_writer->raw($content.'<error type="'.$type.'">'.
'<'.$cond.' xmlns=\'urn:ietf:params:xml:ns:xmpp-stanzas\'/>'.
'<text>'.$content_raw.'</text></error>');
} , %response_attrs);
}
}
}
lib/Catalyst/Engine/XMPP2.pm view on Meta::CPAN
=item $c->engine->send_message($c, $to, $type, $create_cb, %attrs)
This will call send_message on the connection that generated the
current request with the parameters as described in
AnyEvent::XMPP::Connection.
One important hint: if $create_db is a CODE ref, it will be executed
with a XML::Writer object in UNSAFE mode as its first argument, which
means you can call "raw" on it to send unencoded data.
As you'll be sending the message with the connection that generated
this request, it will have the complete JID, with the resource, as the
"from".
=item $c->engine->send_presence($c, $type, $create_cb, %attrs)
Same as above.
=item $c->engine->send_iq($c, $type, $create_cb, $result_cb, %attrs)
Same as above.
Hint: $result_cb is a coderef that will be executed once the response
for this iq arrives. This method won't block, so you might have to
implement a semaphore if the reply for this iq is relevant to the rest
of this request.
=back
=head1 DIRECT CONNECTION MANIPULATION
This is strongly discouraged, but it might be life-saving for some
corner cases.
=over
=item $c->engine->connection($c)
Access the connection object that generated the current request.
=item $c->engine->connections()
This returns a hashref identifying all the connections by the resource
name.
=back
=head1 INTERNAL METHODS
=over
=item $engine->handle_xmpp_node($app, $resource, $node)
This method is called by the stanza callbacks in the connections.
=back
=head1 SEE ALSO
L<Catalyst::Engine>, L<Catalyst::Engine::CGI>, L<HTTP::Request>,
L<HTTP::Reponse>, L<Catalyst>, L<AnyEvent::XMPP::Connection>,
L<Catalyst::Engine::Embeddable>
=head1 AUTHORS
Daniel Ruoso C<daniel@ruoso.com>
=head1 BUG REPORTS
Please submit all bugs regarding C<Catalyst::Engine::XMPP2> to
C<bug-catalyst-engine-xmpp2@rt.cpan.org>
=head1 LICENSE
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
( run in 0.507 second using v1.01-cache-2.11-cpan-acf6aa7dc9e )