line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mojolicious::Matterbridge; |
2
|
1
|
|
|
1
|
|
603
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
25
|
|
3
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
4
|
1
|
|
|
1
|
|
436
|
use Mojo::Base 'Mojo::EventEmitter'; |
|
1
|
|
|
|
|
165623
|
|
|
1
|
|
|
|
|
9
|
|
5
|
1
|
|
|
1
|
|
2874
|
use Moo::Role 2; |
|
1
|
|
|
|
|
9494
|
|
|
1
|
|
|
|
|
6
|
|
6
|
1
|
|
|
1
|
|
740
|
use API::Matterbridge::Message; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
33
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
7
|
use feature 'current_sub'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
9
|
1
|
|
|
1
|
|
5
|
use Filter::signatures; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
8
|
|
10
|
1
|
|
|
1
|
|
40
|
use feature 'signatures'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
11
|
1
|
|
|
1
|
|
6
|
no warnings 'experimental::signatures'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
38
|
|
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
610
|
use URI; |
|
1
|
|
|
|
|
3906
|
|
|
1
|
|
|
|
|
27
|
|
14
|
1
|
|
|
1
|
|
501
|
use Mojo::UserAgent; |
|
1
|
|
|
|
|
220928
|
|
|
1
|
|
|
|
|
9
|
|
15
|
1
|
|
|
1
|
|
40
|
use API::Matterbridge::Message; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
748
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 NAME |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
Mojolicious::Matterbridge - a simplistic module to connect to chat servers via matterbridge |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 SYNOPSIS |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
use Mojolicious::Matterbridge; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $client = Mojolicious::Matterbridge->new( |
28
|
|
|
|
|
|
|
url => 'http://localhost:4242/api/', |
29
|
|
|
|
|
|
|
); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
$client->on('message' => sub( $c, $message ) { |
32
|
|
|
|
|
|
|
print sprintf "<%s> %s\n", $message->username, $message->text; |
33
|
|
|
|
|
|
|
$client->send( "Haha!" ); |
34
|
|
|
|
|
|
|
}); |
35
|
|
|
|
|
|
|
$client->connect(); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Mojo::IOLoop->start unless Mojo::IOLoop->is_running; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=cut |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
with 'API::Matterbridge'; |
42
|
|
|
|
|
|
|
#use Mojo::Future; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
has 'stream_ua' => ( |
45
|
|
|
|
|
|
|
is => 'lazy', |
46
|
|
|
|
|
|
|
default => sub { |
47
|
|
|
|
|
|
|
Mojo::UserAgent->new( |
48
|
|
|
|
|
|
|
inactivity_timeout => 0, # permanent connection to localhost |
49
|
|
|
|
|
|
|
max_response_size => 0, # we will be retrieving streams |
50
|
|
|
|
|
|
|
), |
51
|
|
|
|
|
|
|
}, |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
has 'short_ua' => ( |
55
|
|
|
|
|
|
|
is => 'lazy', |
56
|
|
|
|
|
|
|
default => sub { |
57
|
|
|
|
|
|
|
Mojo::UserAgent->new( |
58
|
|
|
|
|
|
|
inactivity_timeout => 0, # permanent connection to localhost |
59
|
|
|
|
|
|
|
), |
60
|
|
|
|
|
|
|
}, |
61
|
|
|
|
|
|
|
); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
has 'token' => ( |
64
|
|
|
|
|
|
|
is => 'ro', |
65
|
|
|
|
|
|
|
); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# has 'on_message' # use the Mojo-dispatch feature here |
68
|
|
|
|
|
|
|
|
69
|
0
|
|
|
0
|
0
|
|
sub build_request( $self, %parameters ) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
70
|
0
|
0
|
|
|
|
|
my $ua = $parameters{ ua } or die "No UA?!"; |
71
|
0
|
|
|
|
|
|
my $method = delete $parameters{ method }; |
72
|
0
|
|
|
|
|
|
my $url = delete $parameters{ url }; |
73
|
0
|
|
0
|
|
|
|
my $headers = delete $parameters{ headers } || {}; |
74
|
0
|
|
|
|
|
|
my $data = delete $parameters{ data }; |
75
|
0
|
|
|
|
|
|
my $res = $ua->build_tx( |
76
|
|
|
|
|
|
|
$method => "$url", |
77
|
|
|
|
|
|
|
$headers, |
78
|
|
|
|
|
|
|
$data, |
79
|
|
|
|
|
|
|
); |
80
|
|
|
|
|
|
|
#warn "Built request"; |
81
|
0
|
|
|
|
|
|
return $res; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
0
|
|
|
0
|
0
|
|
sub connect( $self ) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# Fetch all the pent up rage |
86
|
|
|
|
|
|
|
#$self->get_messages(); |
87
|
0
|
|
|
|
|
|
$self->get_stream(); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
0
|
|
|
0
|
0
|
|
sub get_messages( $self ) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
91
|
0
|
|
|
|
|
|
my $tx = $self->build_get_messages(); |
92
|
0
|
|
|
0
|
|
|
$self->short_ua->start_p($tx)->then(sub($tx) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
93
|
0
|
|
|
|
|
|
my $payload = $self->json->decode( $tx->result->body ); |
94
|
0
|
|
|
|
|
|
for my $message (@$payload) { |
95
|
0
|
|
|
|
|
|
my $m = API::Matterbridge::Message->new( $message ); |
96
|
0
|
|
|
|
|
|
$self->emit('message', $m ); |
97
|
|
|
|
|
|
|
}; |
98
|
0
|
|
|
|
|
|
}); |
99
|
|
|
|
|
|
|
}; |
100
|
|
|
|
|
|
|
|
101
|
0
|
|
|
0
|
0
|
|
sub get_stream( $self ) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
102
|
0
|
|
|
|
|
|
my $tx = $self->build_get_message_stream(); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# Just in case we read half a JSON message |
105
|
0
|
|
|
|
|
|
state $buffer = ''; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# Replace "read" events to disable default content parser |
108
|
0
|
|
|
0
|
|
|
$tx->res->content->unsubscribe('read')->on(read => sub($content,$bytes) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
109
|
0
|
|
|
|
|
|
$buffer .= $bytes; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# Every (full) line should be a JSON stanza |
112
|
0
|
|
|
|
|
|
while( $buffer =~ s!^(.*?)\n!! ) { |
113
|
0
|
|
|
|
|
|
my $m = API::Matterbridge::Message->from_bytes( $1 ); |
114
|
0
|
|
|
|
|
|
$self->emit('message', $m ); |
115
|
|
|
|
|
|
|
}; |
116
|
0
|
|
|
|
|
|
}); |
117
|
|
|
|
|
|
|
# Process transaction |
118
|
0
|
|
|
|
|
|
$tx = $self->stream_ua->start_p($tx); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
0
|
|
|
0
|
0
|
|
sub send( $self, @messages ) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
|
my $msg = shift @messages; |
123
|
0
|
|
|
|
|
|
my $tx = $self->build_post_message(%$msg); |
124
|
0
|
|
|
|
|
|
state @queue; |
125
|
0
|
|
|
0
|
|
|
my $message_sender = sub($tx) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
my $next = shift @messages; |
127
|
0
|
0
|
|
|
|
|
if( $next ) { |
128
|
0
|
|
|
|
|
|
push @queue, $self->short_ua->start_p($next)->then(__SUB__); |
129
|
|
|
|
|
|
|
} else { |
130
|
0
|
|
|
|
|
|
@queue = (); |
131
|
|
|
|
|
|
|
}; |
132
|
0
|
|
|
|
|
|
}; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
push @queue, $self->short_ua->start_p($tx)->then($message_sender)->catch(sub { |
135
|
1
|
|
|
1
|
|
7
|
use Data::Dumper; warn "Error: " . Dumper \@_; |
|
1
|
|
|
0
|
|
3
|
|
|
1
|
|
|
|
|
130
|
|
|
0
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
|
}); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
1; |