File Coverage

blib/lib/Circle/Net/Matrix.pm
Criterion Covered Total %
statement 30 121 24.7
branch 0 10 0.0
condition 0 3 0.0
subroutine 10 29 34.4
pod 0 15 0.0
total 40 178 22.4


line stmt bran cond sub pod time code
1             # You may distribute under the terms of the GNU General Public License
2             #
3             # (C) Paul Evans, 2014-2017 -- leonerd@leonerd.org.uk
4              
5             package Circle::Net::Matrix;
6              
7 1     1   799 use strict;
  1         1  
  1         29  
8 1     1   3 use warnings;
  1         1  
  1         33  
9 1     1   11 use base qw( Circle::Net );
  1         2  
  1         417  
10              
11             our $VERSION = '0.01';
12              
13             require Circle;
14             Circle->VERSION( '0.142470' ); # require late-loading of Tangence::Class
15              
16 1     1   71240 use constant NETTYPE => 'matrix';
  1         1  
  1         55  
17              
18 1     1   4 use Circle::Widget::Box;
  1         2  
  1         19  
19 1     1   388 use Circle::Widget::Label;
  1         104  
  1         22  
20              
21 1     1   4 use Data::Dump qw( pp );
  1         2  
  1         41  
22 1     1   5 use Scalar::Util qw( weaken );
  1         1  
  1         735  
23              
24             =head1 NAME
25              
26             C - use C as a I client
27              
28             =head1 SYNOPSIS
29              
30             On the global tab:
31              
32             /networks add -type matrix Matrix
33              
34             On the newly-added "Matrix" tab:
35              
36             /set homeserver example.com
37             /set user_id @me:example.com
38             /set access_token MDAxABCDE...
39              
40             /connect
41              
42             (for now you'll have to log in and steal and access token from another Matrix
43             client; for example L).
44              
45             =cut
46              
47             # To allow for out-of-tree development, use an inline Tangence class
48             # declaration instead of a .tan file
49             #
50             # class Circle.Net.Matrix {
51             # isa Circle.WindowItem;
52             # }
53              
54             sub DECLARE_TANGENCE
55             {
56 0     0 0   Tangence::Class->declare( __PACKAGE__,
57             superclasses => [qw( Circle::WindowItem )],
58             );
59              
60             # Also load the other classes
61 0           require Circle::Net::Matrix::Room;
62 0           Circle::Net::Matrix::Room->DECLARE_TANGENCE;
63              
64 0           require Net::Async::Matrix;
65 0           Net::Async::Matrix->VERSION( '0.18' );
66             }
67              
68             sub WEAKSELF_EVAL
69             {
70 0     0 0   my ( $self, $method ) = @_;
71 0 0   0     my $code = $self->can( $method ) or return sub {};
72              
73 0           weaken( $self );
74             return sub {
75 0     0     my @args = @_;
76 0 0         eval { $self->$code( @args ); 1 } or
  0            
  0            
77             warn $@;
78 0           };
79             }
80              
81             sub new
82             {
83 0     0 0   my $class = shift;
84 0           my %args = @_;
85              
86 0           my $self = $class->SUPER::new( %args );
87              
88 0           $self->{root} = $args{root};
89 0           my $loop = $self->{loop} = $args{loop};
90              
91             # For WindowItem
92 0           $self->set_prop_tag( $args{tag} );
93              
94 0           weaken( my $weakself = $self );
95             my $matrix = $self->{matrix} = Net::Async::Matrix->new(
96       0     on_log => sub { }, # TODO
97 0           on_presence => $self->WEAKSELF_EVAL( 'on_presence' ),
98             on_room_new => $self->WEAKSELF_EVAL( 'on_room_new' ),
99             on_room_del => $self->WEAKSELF_EVAL( 'on_room_del' ),
100              
101             on_error => $self->WEAKSELF_EVAL( 'on_error' ),
102             );
103              
104 0           $loop->add( $matrix );
105              
106 0           $self->set_network_status( "disconnected" );
107              
108 0           return $self;
109             }
110              
111             sub on_error
112             {
113 0     0 0   my $self = shift; shift;
  0            
114 0           my ( $message ) = @_;
115              
116 0           $self->push_displayevent( error => { text => $message } );
117 0           $self->bump_level( 3 );
118             }
119              
120             sub parent
121             {
122 0     0 0   my $self = shift;
123 0           return $self->{root};
124             }
125              
126             sub enumerable_name
127             {
128 0     0 0   my $self = shift;
129 0           return $self->get_prop_tag;
130             }
131              
132             sub commandable_parent
133             {
134 0     0 0   my $self = shift;
135 0           return $self->{root};
136             }
137              
138             sub get_room_or_create
139             {
140 0     0 0   my $self = shift;
141 0           my ( $room ) = @_;
142              
143 0           my $room_id = $room->room_id;
144              
145 0 0         return $self->{rooms}{$room_id} if exists $self->{rooms}{$room_id};
146              
147 0           my $registry = $self->{registry};
148 0           my $root = $self->{root};
149              
150 0           my $roomobj = $registry->construct(
151             "Circle::Net::Matrix::Room",
152             root => $root,
153             net => $self,
154             room => $room,
155             );
156 0           $self->{rooms}{$room_id} = $roomobj;
157              
158 0           $root->broadcast_sessions( new_item => $roomobj );
159              
160 0           return $roomobj;
161             }
162              
163             sub on_room_new
164             {
165 0     0 0   my $self = shift; shift;
  0            
166 0           my ( $room ) = @_;
167              
168 0           $self->get_room_or_create( $room );
169             }
170              
171             sub on_room_del
172             {
173 0     0 0   my $self = shift; shift;
  0            
174 0           my ( $room ) = @_;
175              
176 0 0         my $roomobj = delete $self->{rooms}{$room->room_id} or return;
177            
178 0           $self->{root}->broadcast_sessions( delete_item => $roomobj );
179 0           $roomobj->destroy;
180             }
181              
182             sub on_presence
183             {
184 0     0 0   my $self = shift; shift;
  0            
185 0           my ( $user, %changes ) = @_;
186              
187 0           $self->push_displayevent( "text", {
188 0           text => "User ${\$user->user_id} presence change " . pp(\%changes),
189             });
190             }
191              
192             __PACKAGE__->APPLY_Setting( homeserver =>
193             description => "Hostname of the homeserver",
194             type => 'str',
195             );
196              
197             __PACKAGE__->APPLY_Setting( user_id =>
198             description => "User ID to use",
199             type => 'str',
200             );
201              
202             __PACKAGE__->APPLY_Setting( access_token =>
203             description => "Access Token of the user",
204             type => 'str',
205             );
206              
207             sub command_connect
208             : Command_description("Connect to the homeserver")
209             : Command_arg('homeserver?')
210             {
211 0     0 0 0 my $self = shift;
212 0         0 my ( $homeserver, $cinv ) = @_;
213              
214 0 0       0 $homeserver = $self->{homeserver} unless defined $homeserver;
215              
216 0         0 my $matrix = $self->{matrix};
217 0         0 $matrix->configure(
218             server => $homeserver,
219             );
220              
221             # TODO: would be nice if Circle could cope with Future-returning
222             # command subs...
223              
224 0         0 $self->push_displayevent( "status", { text => "logging in" } );
225 0         0 $self->set_network_status( "logging in" );
226              
227             my $f = $matrix->login(
228             user_id => $self->{user_id},
229             access_token => $self->{access_token},
230             )->on_done( sub {
231 0     0   0 $self->push_displayevent( "status", { text => "syncing..." } );
232 0         0 $self->set_network_status( "syncing" );
233              
234             $matrix->start->on_done( sub {
235 0         0 $self->set_network_status( "" );
236 0         0 });
237 0         0 });
238              
239 0         0 $matrix->adopt_future( $f );
240              
241 0         0 return ();
242 1     1   5 }
  1         1  
  1         4  
243              
244             sub command_join
245             : Command_description("Join a named room")
246             : Command_arg('roomname')
247             {
248 0     0 0   my $self = shift;
249 0           my ( $roomname, $cinv ) = @_;
250              
251 0           my $matrix = $self->{matrix};
252              
253 0           $matrix->join_room( $roomname );
254              
255 0           return;
256 1     1   359 }
  1         1  
  1         3  
257              
258             ###
259             # Widgets
260             ###
261              
262             sub get_widget_my_displayname
263             {
264 0     0 0   my $self = shift;
265              
266 0   0       return $self->{widget_displayname} ||= do {
267 0           my $registry = $self->{registry};
268              
269 0           my $widget = $registry->construct(
270             "Circle::Widget::Label",
271             classes => [qw( nick )],
272             );
273              
274 0           $widget->set_prop_text( $self->{matrix}->myself->displayname );
275              
276 0           $widget;
277             };
278             }
279              
280             sub get_widget_statusbar
281             {
282 0     0 0   my $self = shift;
283              
284 0           my $registry = $self->{registry};
285              
286 0           my $statusbar = $registry->construct(
287             "Circle::Widget::Box",
288             classes => [qw( status )],
289             orientation => "horizontal",
290             );
291              
292 0           $statusbar->add( $self->get_widget_netname );
293              
294 0           $statusbar->add( $self->get_widget_my_displayname );
295              
296             # $statusbar->add( $self->get_widget_presence );
297              
298 0           return $statusbar;
299             }
300              
301             =head1 AUTHOR
302              
303             Paul Evans
304              
305             =cut
306              
307             0x55AA;