File Coverage

blib/lib/Net/Async/Matrix/Room/State.pm
Criterion Covered Total %
statement 62 64 96.8
branch 7 14 50.0
condition 6 12 50.0
subroutine 16 17 94.1
pod 10 12 83.3
total 101 119 84.8


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2016-2017 -- leonerd@leonerd.org.uk
5              
6             package Net::Async::Matrix::Room::State;
7              
8 12     12   39 use strict;
  12         12  
  12         288  
9 12     12   37 use warnings;
  12         13  
  12         241  
10              
11 12     12   34 use List::Util qw( pairmap );
  12         11  
  12         451  
12              
13 12     12   38 use Struct::Dumb;
  12         22  
  12         47  
14              
15             struct Member => [qw( user displayname membership )];
16              
17             our $VERSION = '0.19';
18             $VERSION = eval $VERSION;
19              
20             =head1 NAME
21              
22             C - represents the state events in a matrix room
23              
24             =head1 DESCRIPTION
25              
26             Instances of this class represent all of the known state events in a
27             L at some instant in time. These objects are mutable
28             so a "live" state object obtained from a room will change to keep track of
29             newly received state events.
30              
31             =cut
32              
33             sub new
34             {
35 7     7 0 10 my $class = shift;
36 7         9 my ( $room ) = @_;
37              
38             return bless {
39             events => {},
40             matrix => $room->{matrix},
41 7         31 }, $class;
42             }
43              
44             sub handle_event
45             {
46 18     18 0 16 my $self = shift;
47 18         15 my ( $event ) = @_;
48              
49 18 50       35 defined $event->{state_key} or return;
50              
51 18         17 my $type = $event->{type};
52 18   50     30 my $state_key = $event->{state_key} // "";
53              
54 18         58 $self->{events}{$type}{$state_key} = $event;
55             }
56              
57             =head1 METHODS
58              
59             =cut
60              
61             =head2 get_event
62              
63             $event = $state->get_event( $type, $state_key )
64              
65             Returns a HASH reference containing the raw event stored for the given type
66             name and optional state key.
67              
68             =cut
69              
70             sub get_event
71             {
72 27     27 1 27 my $self = shift;
73 27         30 my ( $type, $state_key ) = @_;
74              
75 27   100     58 $state_key //= "";
76 27         71 return $self->{events}{$type}{$state_key};
77             }
78              
79             =head2 get_events
80              
81             $events = $state->get_events( $type )
82              
83             Returns a multi-level HASH reference mapping all of the known state keys for a
84             given event type name to their raw stored events. Typically this is useful for
85             C events as the state keys will be user IDs.
86              
87             =cut
88              
89             sub get_events
90             {
91 6     6 1 7 my $self = shift;
92 6         7 my ( $type ) = @_;
93              
94 6   50     30 return $self->{events}{$type} // {};
95             }
96              
97             =head1 CONVENIENCE ACCESSORS
98              
99             The following accessors all fetch single values out of certain events, as they
100             are commonly used.
101              
102             =cut
103              
104             =head2 name
105              
106             $name = $state->name
107              
108             Returns the C field of the C event, if it exists.
109              
110             =cut
111              
112             sub name
113             {
114 2     2 1 2 my $self = shift;
115 2 50       4 my $event = $self->get_event( "m.room.name" ) or return undef;
116 2         13 return $event->{content}{name};
117             }
118              
119             =head2 join_rule
120              
121             $join_rule = $state->join_rule
122              
123             Returns the C field of the C event, if it
124             exists.
125              
126             =cut
127              
128             sub join_rule
129             {
130 2     2 1 3 my $self = shift;
131 2 50       3 my $event = $self->get_event( "m.room.join_rules" ) or return undef;
132 2         7 return $event->{content}{join_rule};
133             }
134              
135             =head2 topic
136              
137             $topic = $state->topic
138              
139             Returns the C field of the C event, if it exists.
140              
141             =cut
142              
143             sub topic
144             {
145 2     2 1 2 my $self = shift;
146 2 50       5 my $event = $self->get_event( "m.room.topic" ) or return undef;
147 2         8 return $event->{content}{topic};
148             }
149              
150             =head2 aliases
151              
152             @aliases = $state->aliases
153              
154             Returns a list of the room alias from all the C events, in no
155             particular order.
156              
157             =cut
158              
159             sub aliases
160             {
161 2     2 1 2 my $self = shift;
162 2         2 return map { @{ $_->{content}{aliases} } }
  2         14  
163 2         2 values %{ $self->get_events( "m.room.aliases" ) };
  2         5  
164             }
165              
166             =head2 members
167              
168             @members = $state->members
169              
170             Returns a list of Member instances representing all of the members of the room
171             from the C events whose membership state is not C.
172              
173             =cut
174              
175             sub members
176             {
177 3     3 1 3 my $self = shift;
178 3         4 my ( $with_leaves ) = @_;
179              
180             return pairmap {
181 5     5   15 my ( $user_id, $event ) = ( $a, $b );
182 5         4 my $content = $event->{content};
183              
184 5 50 33     12 return () if $content->{membership} eq "leave" and !$with_leaves;
185              
186 5         12 my $user = $self->{matrix}->_get_or_make_user( $user_id );
187 5         25 Member( $user, $content->{displayname}, $content->{membership} );
188 3         10 } %{ $self->get_events( "m.room.member" ) };
  3         4  
189             }
190              
191             =head2 all_members
192              
193             @members = $state->members
194              
195             Similar to L but even includes members in C state. This is
196             not normally what you want.
197              
198             =cut
199              
200             sub all_members
201             {
202 0     0 1 0 my $self = shift;
203 0         0 return $self->members( 1 );
204             }
205              
206             =head2 member
207              
208             $member = $state->member( $user_id )
209              
210             Returns a Member instance representing a room member of the given user ID, or
211             C if none exists.
212              
213             =cut
214              
215             sub member
216             {
217 12     12 1 9 my $self = shift;
218 12         12 my ( $user_id ) = @_;
219              
220 12 50       17 my $event = $self->get_event( "m.room.member", $user_id ) or return undef;
221              
222 12         30 my $user = $self->{matrix}->_get_or_make_user( $user_id );
223 12         166 my $content = $event->{content};
224 12         61 return Member( $user, $content->{displayname}, $content->{membership} );
225             }
226              
227             =head2 member_level
228              
229             $level = $state->member_level( $user_id )
230              
231             Returns a number indicating the power level that the given user ID would have
232             according to room state, taken from the C event. This
233             takes into account the C field, if no specific level exists for
234             the given user ID.
235              
236             =cut
237              
238             sub member_level
239             {
240 2     2 1 3 my $self = shift;
241 2         2 my ( $user_id ) = @_;
242              
243 2 50       5 my $event = $self->get_event( "m.room.power_levels" ) or return undef;
244 2         2 my $levels = $event->{content};
245 2   33     9 return $levels->{users}{$user_id} // $levels->{users_default};
246             }
247              
248             =head1 AUTHOR
249              
250             Paul Evans
251              
252             =cut
253              
254             0x55AA;