view release on metacpan or  search on metacpan

lib/App/MatrixClient.pm  view on Meta::CPAN

   $self->{console}->remove_tab( $roomtab );
}


# Internal API

sub append_line_colour
{
   my $self = shift;
   my ( $fg, $text ) = @_;

   $self->{globaltab}->append_line(
      String::Tagged->new( $text )->apply_tag( 0, -1, fg => $fg )
   );
}

sub log
{
   my $self = shift;
   my ( $line ) = @_;

   $self->append_line_colour( green => ">> $line" );
}

sub new_room
{
   my $self = shift;
   my ( $room ) = @_;

   my $floatbox;
   my $headline;

   # Until Tickit::Widget::Tabbed supports a 'tab_class' argument to add_tab,
   # we'll have to cheat
   no warnings 'redefine';
   local *Tickit::Widget::Tabbed::TAB_CLASS = sub { "App::MatrixClient::RoomTab" };

   my $roomtab = $self->{console}->add_tab(
      name => $room->room_id,
      make_widget => sub {
         my ( $scroller ) = @_;

         my $vbox = Tickit::Widget::VBox->new;

         $vbox->add( $headline = Tickit::Widget::Static->new(
               text => "",
               style => { bg => "blue" },
            ),
            expand => 0
         );
         $vbox->add( $scroller, expand => 1 );

         return $floatbox = Tickit::Widget::FloatBox->new(
            base_child  => $vbox,
         );
      },
      on_line => sub {
         my ( $tab, $line ) = @_;
         if( $line =~ s{^/}{} ) {
            my ( $cmd, @args ) = split m/\s+/, $line;
            if( my $code = $tab->can( "cmd_$cmd" ) ) {
               $room->adopt_future( $tab->$code( @args ) );
            }
            else {
               $self->do_command( $line, $tab );
            }
         }
         else {
            $room->adopt_future( $room->send_message( $line ) );
            $room->typing_stop;
         }
      },
   );

   $self->{tabs_by_roomid}->{ $room->room_id } = $roomtab;

   $roomtab->_setup(
      room     => $room,
      dist     => $self->{dist},
      url_base => ( $self->{ssl} ? "https" : "http" ) . "://$self->{server}",
      floatbox => $floatbox,
      headline => $headline,
   );
}

sub make_username
{
   # function
   my ( $user ) = @_;

   if( defined $user->displayname ) {
      return "${\$user->displayname} (${\$user->user_id})";
   }
   else {
      return $user->user_id;
   }
}

sub do_command
{
   my $self = shift;
   my ( $line, $tab ) = @_;

   # For now all commands are simple methods on __PACKAGE__
   my ( $cmd, @args ) = split m/\s+/, $line;

   $tab->append_line(
      String::Tagged->new( '$ ' . join " ", $cmd, @args )
         ->apply_tag( 0, -1, fg => "cyan" )
   );

   my $method = "cmd_$cmd";
   $self->{cmd_f} = Future->call( sub { $self->$method( @args ) } )
      ->on_done( sub {
         my @result = @_;
         $tab->append_line( $_ ) for @result;

         undef $self->{cmd_f};
      })
      ->on_fail( sub {
         my ( $failure ) = @_;

         $tab->append_line(
            String::Tagged->new( "Error: $failure" )
               ->apply_tag( 0, -1, fg => "red" )
         );

         undef $self->{cmd_f};
      });
}


## Command handlers

sub cmd_dname_get
{
   my $self = shift;
   my ( $user_id ) = @_;

   $self->{dist}->fire_async( do_get_displayname => $user_id );
}

sub cmd_dname_set
{
   my $self = shift;
   my ( $name ) = @_;

   $self->{dist}->fire_async( do_set_displayname => $name )
      ->then_done( "Set" );
}

sub cmd_offline
{
   my $self = shift;

   $self->{dist}->fire_async( do_set_presence => "offline", @_ )
      ->then_done( "Set" );
}

sub cmd_busy
{
   my $self = shift;

   $self->{dist}->fire_async( do_set_presence => "unavailable", "Busy" )
      ->then_done( "Set" );