File Coverage

blib/lib/Net/Async/Matrix/Room/State.pm
Criterion Covered Total %
statement 60 60 100.0
branch 6 12 50.0
condition 5 9 55.5
subroutine 16 16 100.0
pod 9 11 81.8
total 96 108 88.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 -- leonerd@leonerd.org.uk
5              
6             package Net::Async::Matrix::Room::State;
7              
8 12     12   44 use strict;
  12         15  
  12         279  
9 12     12   36 use warnings;
  12         13  
  12         287  
10              
11 12     12   40 use List::Util qw( pairmap );
  12         12  
  12         556  
12              
13 12     12   42 use Struct::Dumb;
  12         14  
  12         73  
14              
15             struct Member => [qw( user displayname membership )];
16              
17             our $VERSION = '0.18_002';
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 13 my $class = shift;
36 7         9 my ( $room ) = @_;
37              
38             return bless {
39             events => {},
40             matrix => $room->{matrix},
41 7         41 }, $class;
42             }
43              
44             sub handle_event
45             {
46 18     18 0 19 my $self = shift;
47 18         16 my ( $event ) = @_;
48              
49 18 50       42 defined $event->{state_key} or return;
50              
51 18         14 my $type = $event->{type};
52 18   50     40 my $state_key = $event->{state_key} // "";
53              
54 18         78 $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 22 my $self = shift;
73 27         28 my ( $type, $state_key ) = @_;
74              
75 27   100     61 $state_key //= "";
76 27         68 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 5 my $self = shift;
92 6         7 my ( $type ) = @_;
93              
94 6   50     36 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 3 my $self = shift;
115 2 50       5 my $event = $self->get_event( "m.room.name" ) or return undef;
116 2         12 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 2 my $self = shift;
131 2 50       5 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       4 my $event = $self->get_event( "m.room.topic" ) or return undef;
147 2         7 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         3 return map { @{ $_->{content}{aliases} } }
  2         12  
163 2         3 values %{ $self->get_events( "m.room.aliases" ) };
  2         3  
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.
172              
173             =cut
174              
175             sub members
176             {
177 3     3 1 3 my $self = shift;
178             return pairmap {
179 5     5   14 my ( $user_id, $event ) = ( $a, $b );
180              
181 5         10 my $user = $self->{matrix}->_get_or_make_user( $user_id );
182 5         18 my $content = $event->{content};
183 5         12 Member( $user, $content->{displayname}, $content->{membership} );
184 3         9 } %{ $self->get_events( "m.room.member" ) };
  3         8  
185             }
186              
187             =head2 member
188              
189             $member = $state->member( $user_id )
190              
191             Returns a Member instance representing a room member of the given user ID, or
192             C if none exists.
193              
194             =cut
195              
196             sub member
197             {
198 12     12 1 19 my $self = shift;
199 12         15 my ( $user_id ) = @_;
200              
201 12 50       17 my $event = $self->get_event( "m.room.member", $user_id ) or return undef;
202              
203 12         30 my $user = $self->{matrix}->_get_or_make_user( $user_id );
204 12         143 my $content = $event->{content};
205 12         38 return Member( $user, $content->{displayname}, $content->{membership} );
206             }
207              
208             =head2 member_level
209              
210             $level = $state->member_level( $user_id )
211              
212             Returns a number indicating the power level that the given user ID would have
213             according to room state, taken from the C event. This
214             takes into account the C field, if no specific level exists for
215             the given user ID.
216              
217             =cut
218              
219             sub member_level
220             {
221 2     2 1 1 my $self = shift;
222 2         3 my ( $user_id ) = @_;
223              
224 2 50       6 my $event = $self->get_event( "m.room.power_levels" ) or return undef;
225 2         4 my $levels = $event->{content};
226 2   33     10 return $levels->{users}{$user_id} // $levels->{users_default};
227             }
228              
229             =head1 AUTHOR
230              
231             Paul Evans
232              
233             =cut
234              
235             0x55AA;