File Coverage

blib/lib/Tatsumaki/Service/XMPP.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Tatsumaki::Service::XMPP;
2 1     1   25 use 5.008_001;
  1         4  
  1         63  
3             our $VERSION = "0.02";
4              
5 1     1   1173 use Any::Moose;
  1         52130  
  1         9  
6             extends 'Tatsumaki::Service';
7              
8 1     1   846 use constant DEBUG => $ENV{TATSUMAKI_XMPP_DEBUG};
  1         3  
  1         100  
9              
10 1     1   727 use AnyEvent::XMPP::Client;
  0            
  0            
11             use Carp ();
12             use HTTP::Request::Common;
13             use HTTP::Message::PSGI;
14             use namespace::clean -except => 'meta';
15              
16             has jid => (is => 'rw', isa => 'Str');
17             has password => (is => 'rw', isa => 'Str');
18             has xmpp => (is => 'rw', isa => 'AnyEvent::XMPP::Client', lazy_build => 1);
19              
20             around BUILDARGS => sub {
21             my $orig = shift;
22             my $class = shift;
23              
24             if (@_ == 2) {
25             $class->$orig(jid => $_[0], password => $_[1]);
26             } else {
27             $class->$orig(@_);
28             }
29             };
30              
31             sub _build_xmpp {
32             my $self = shift;
33             my $xmpp = AnyEvent::XMPP::Client->new(debug => DEBUG);
34             $xmpp->add_account($self->jid, $self->password);
35             $xmpp->reg_cb(
36             error => sub { Carp::croak @_ },
37             message => sub {
38             my($client, $acct, $msg) = @_;
39              
40             return unless $msg->any_body;
41              
42             # TODO refactor this
43             my $req = POST "/_services/xmpp/chat", [ from => $msg->from, to => $acct->jid, body => $msg->body ];
44             my $env = $req->to_psgi;
45             $env->{'tatsumaki.xmpp'} = {
46             client => $client,
47             account => $acct,
48             message => $msg,
49             };
50             $env->{'psgi.streaming'} = 1;
51              
52             my $res = $self->application->($env);
53             $res->(sub { my $res = shift }) if ref $res eq 'CODE';
54             },
55             contact_request_subscribe => sub {
56             my($client, $acct, $roster, $contact) = @_;
57             $contact->send_subscribed;
58              
59             my $req = POST "/_services/xmpp/subscribe", [ from => $contact->jid, to => $acct->jid ];
60             my $env = $req->to_psgi;
61             $env->{'tatsumaki.xmpp'} = {
62             client => $client,
63             account => $acct,
64             contact => $contact,
65             };
66             $env->{'psgi.streaming'} = 1;
67              
68             my $res = $self->application->($env);
69             $res->(sub { my $res = shift }) if ref $res eq 'CODE';
70             },
71             );
72             $xmpp;
73             }
74              
75             sub start {
76             my($self, $application) = @_;
77             $self->xmpp->start;
78             }
79              
80             no Any::Moose;
81             __PACKAGE__->meta->make_immutable;
82              
83             1;
84              
85             __END__