File Coverage

blib/lib/Mojolicious/Matterbridge.pm
Criterion Covered Total %
statement 39 98 39.8
branch 0 4 0.0
condition 0 2 0.0
subroutine 13 22 59.0
pod 0 5 0.0
total 52 131 39.6


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;