File Coverage

blib/lib/Circle/Net/Matrix/Room.pm

Criterion	Covered	Total	%
statement	24	132	18.1
branch	0	22	0.0
condition	0	18	0.0
subroutine	8	29	27.5
pod	0	18	0.0
total	32	219	14.6

#  You may distribute under the terms of the GNU General Public License
#
#  (C) Paul Evans, 2014-2017 -- [e-mail]

package Circle::Net::Matrix::Room;

use strict;
use warnings;
use base qw( Tangence::Object Circle::WindowItem );

our $VERSION = '0.01';

use Data::Dump qw( pp );
use Scalar::Util qw( weaken );

# To allow for out-of-tree development, use an inline Tangence class
# declaration instead of a .tan file
#
# class Circle.Net.Matrix.Room {
#   isa Circle.WindowItem;
#
#   smashed prop name = str;
#   smashed prop topic = str;
# }

sub DECLARE_TANGENCE
{
   Tangence::Class->declare( __PACKAGE__,
      props => {
         name => {
            dim  => Tangence::Constants::DIM_SCALAR,
            type => 'str',
         },
         topic => {
            dim  => Tangence::Constants::DIM_SCALAR,
            type => 'str',
         },
      },

      superclasses => [qw( Circle::WindowItem )],
   );
}

sub WEAKSELF_EVAL
{
   my ( $self, $method ) = @_;
   my $code = $self->can( $method ) or return sub {};

   weaken( $self );
   return sub {
      my @args = @_;
      eval { $self->$code( @args ); 1 } or
         warn $@;
   };
}

sub init_prop_topic { "" }

sub new
{
   my $class = shift;
   my %args = @_;

   my $self = $class->SUPER::new( @_ );

   my $room = $self->{room} = $args{room};

   my $name = $room->name;

   $self->set_prop_name( $name );
   $self->set_prop_tag( $name );

   $self->{root} = $args{root};
   $self->{net}  = $args{net};

   weaken( my $weakself = $self );
   $room->configure(
      on_synced_state => $self->WEAKSELF_EVAL( 'on_synced_state' ),

      on_message       => $self->WEAKSELF_EVAL( 'on_message' ),
      on_membership    => $self->WEAKSELF_EVAL( 'on_membership' ),
      on_state_changed => $self->WEAKSELF_EVAL( 'on_state_changed' ),
   );

   return $self;
}

# Convenience accessor
sub name
{
   my $self = shift;
   return $self->get_prop_name;
}

sub enumerable_name
{
   my $self = shift;
   return $self->name;
}

sub get_prop_tag
{
   my $self = shift;
   return $self->name;
}

sub parent
{
   my $self = shift;
   return $self->{net};
}

sub commandable_parent
{
   my $self = shift;
   return $self->parent;
}

sub on_synced_state
{
   my $self = shift;

   my $room = $self->{room};

   # Since we now know the true name
   $self->set_prop_name( $room->name );
   $self->set_prop_tag( $room->name );

   $self->set_prop_topic( $room->topic );
}

sub on_message
{
   my $self = shift; shift;
   my ( $member, $content, $event ) = @_;
   my $member_id = $member->user->user_id;

   my $tstamp = $event->{origin_server_ts} / 1000;
   my $type = $content->{msgtype};

   my ( $etype, $args );
   if( $type eq "m.text" ) {
      ( $etype, $args ) = ( "matrix.text" => {
         name => $member->displayname,
         user_id => $member_id,
         text => $content->{body},
      });
   }
   elsif( $type eq "m.emote" ) {
      ( $etype, $args ) = ( "matrix.emote" => {
         name => $member->displayname,
         user_id => $member_id,
         text => $content->{body},
      });
   }
   else {
      ( $etype, $args ) = ( "text" => {
         text => "Unrecognised Matrix event msgtype <$type>"
      });
   }

   $self->push_displayevent( $etype, $args, time => $tstamp );
   $self->bump_level( 2 );
}

sub on_membership
{
   my $self = shift; shift;
   my ( $member, $event, $subject, %changes ) = @_;
   my $member_id = $member->user->user_id;

   my $tstamp = $event->{origin_server_ts} / 1000;

   if( my $membership = $changes{membership} ) {
      if( !defined $membership->[0] and $membership->[1] eq "join" ) {
         $self->push_displayevent( "matrix.join" => {
            name    => $member->displayname // "[$member_id]",
            user_id => $member_id,
         }, time => $tstamp );
         $self->bump_level( 1 );
         return
      }
      if( $membership->[0] eq "join" and !defined $membership->[1] ) {
         $self->push_displayevent( "matrix.leave" => {
            name    => $member->displayname // "[$member_id]",
            user_id => $member_id,
         });
         $self->bump_level( 1 );
         return
      }
   }

   if( my $displayname = $changes{displayname} ) {
      $self->push_displayevent( "matrix.rename" => {
         oldname => $displayname->[0],
         newname => $displayname->[1],
         user_id => $member_id,
      }, time => $tstamp );
      $self->bump_level( 1 );
   }
   elsif( my $state = $changes{state} ) {
      my $message = $changes{status_msg} && $changes{status_msg}[1];

      $self->push_displayevent( "matrix.state" => {
         state   => $state->[1],
         message => ( defined $message ? "($message)" : "" ),
         name    => $member->displayname // "[$member_id]",
      }, time => $tstamp );
      $self->bump_level( 1 );
   }
   elsif( keys %changes ) { # ignore "empty" changes e.g. avatar_url
      # TODO for debugging
      $self->push_displayevent( text => {
         text => "Member $member changed to ${\pp \%changes}"
      }, time => $tstamp );

      $self->bump_level( 2 );
   }
}

sub on_state_changed
{
   my $self = shift; shift;
   my ( $member, $event, %changes ) = @_;
   my $member_id = $member->user->user_id;

   my $tstamp = $event->{origin_server_ts} / 1000;

   if( 1 ) {
      # TODO for debugging
      $self->push_displayevent( text => {
         text => "Member $member changed room state ${\pp \%changes}"
      }, time => $tstamp );
   }
}

sub enter_text
{
   my $self = shift;
   my ( $text ) = @_;

   my $room = $self->{room};
   my $f = $room->send_message( $text );

   $room->adopt_future( $f );
}

sub command_leave
   : Command_description("Leave the room")
{
   my $self = shift;
   my ( $cinv ) = @_;

   my $matrix = $self->{net}{matrix};

   $matrix->leave_room( $self->{room}->room_id );

   return;
}

sub command_say
   : Command_description("Quote text directly as a text message")
   : Command_arg('text', eatall => 1)
{
   my $self = shift;
   my ( $text ) = @_;

   $self->enter_text( $text );

   return;
}

sub command_me
   : Command_description("Send an emote message")
   : Command_arg('text', eatall => 1)
{
   my $self = shift;
   my ( $text ) = @_;

   my $room = $self->{room};
   my $f = $room->send_message( type => "m.emote", body => $text );

   $room->adopt_future( $f );

   return;
}

sub make_widget_pre_scroller
{
   my $self = shift;
   my ( $box ) = @_;

   my $registry = $self->{registry};

   my $topicentry = $registry->construct(
      "Circle::Widget::Entry",
      classes => [qw( topic )],
      # on_enter => sub { $self->topic( $_[0] ) },
   );
   $self->watch_property( "topic",
      on_updated => sub { $topicentry->set_prop_text( $_[1] ) }
   );

   $box->add( $topicentry );
}

0x55AA;