view release on metacpan or  search on metacpan

lib/Yakuake/Sessions/TraitFor/DBus.pm  view on Meta::CPAN

      my $pid      =  $self->_get_session_process_id( $ksess_id );

      push @{ $tabs }, {
         active    => $sess_id == $active_sess,
         cmd       => $self->_get_executing_command( $pid, $fgpid ),
         cwd       => $self->_get_current_directory( $pid ),
         title     => $self->_get_tab_title( $sess_id ),
      };
   }

   return $tabs;
}

sub set_tab_title_for_session {
   my ($self, $title, $sess_id) = @_; $title or return;

   $sess_id //= $self->_get_active_session_id;

   return $self->tabs->setTabTitle( $sess_id, $title );
}

# Private methods
sub _close_sessions {
   my $self        = shift;
   my $active_sess = $self->_get_active_session_id;
   my $borked      = FALSE;

   for my $sess_id  ($self->_get_session_ids) {
      my $ksess_id = $self->_get_session_map->{ $sess_id };
      my $fgpid    = $self->_get_session_fg_process_id( $ksess_id );
      my $pid      = $self->_get_session_process_id( $ksess_id );

      $pid != $fgpid and kill 'TERM', $fgpid;

      # Konsole removed the close method from the API after 4.4 before 4.8.4
      # Utterly useless bastards
      unless ($borked) {
         try   { $self->_get_session_object( $ksess_id )->close }
         catch { $borked = TRUE };
      }

      if ($borked and $sess_id != $active_sess) {
         $self->sessions->raiseSession( $sess_id );
         $self->sessions->runCommand( 'exit' );
         sleep 1;
      }
   }

   return;
}

sub _get_active_session_id {
   return int $_[ 0 ]->sessions->activeSessionId;
}

sub _get_current_directory {
   my ($self, $pid) = @_; my $cmd = [ 'pwdx', $pid ];

   my $out = $self->run_cmd( $cmd, { debug => $self->debug } )->stdout;

   return trim( (split m{ : }msx, $out)[ 1 ] );
}

sub _get_executing_command {
   my ($self, $pid, $fgpid) = @_; $pid == $fgpid and return NUL;

   my $cmd = [ qw( ps --format command --no-headers --pid ), $fgpid ];

   $cmd = trim $self->run_cmd( $cmd, { debug => $self->debug } )->stdout;

   return $cmd =~ m{ \A perl (.+) $PROGRAM_NAME }msx ? NUL : $cmd;
}

sub _get_ksession_ids {
   return ( sort   { $a <=> $b }
            map    { m{ name = [\"] (\d+) [\"] }mx }
            grep   { m{ <node \s+ name }mx }
            split m{ \n }msx,
            $_[ 0 ]->service->get_object( '/Sessions' )->Introspect );
}

sub _get_session_at_tab {
   return int $_[ 0 ]->tabs->sessionAtTab( $_[ 1 ] );
}

sub _get_session_fg_process_id {
   return $_[ 0 ]->_get_session_object( $_[ 1 ] )->foregroundProcessId;
}

sub _get_session_ids {
   return ( sort   { $a <=> $b }
            map    { int $_ }
            split m{ , }msx, $_[ 0 ]->sessions->sessionIdList );
}

sub _get_session_map {
   return { zip $_[ 0 ]->_get_session_ids, $_[ 0 ]->_get_ksession_ids };
}

sub _get_session_object {
   return $_[ 0 ]->service->get_object( '/Sessions/'.$_[ 1 ] );
}

sub _get_session_process_id {
   return $_[ 0 ]->_get_session_object( $_[ 1 ] )->processId;
}

sub _get_tab_title {
  (my $title = $_[ 0 ]->tabs->tabTitle( $_[ 1 ] ) ) =~ s{ \A \d+ \s+ }{}mx;

   return $title;
}

sub _get_tty_num {
   my ($self, $ksess_id) = @_; defined $ksess_id or return '?';

   my $pid = $self->_get_session_process_id( $ksess_id );
   my $cmd = [ qw( ps --no-headers -o tty -p ), $pid ];

   return (split m{ [/] }mx, $self->run_cmd( $cmd )->out)[ -1 ];
}

sub _maybe_add_session {
   my ($self, $tab_no) = @_; my $sess_id = $self->_get_active_session_id;

   $tab_no > 0 or return $sess_id;

   my $old_id = $sess_id; $self->sessions->addSession;

   while (not length $sess_id or $sess_id <= $old_id) {
      nap $self->config->nap_time; $sess_id = $self->_get_active_session_id;
   }

   return $sess_id;
}

1;

__END__

=pod

=encoding utf8

=head1 Name

Yakuake::Sessions::TraitFor::DBus - Interface with DBus

=head1 Synopsis

   use Moo;

   extends 'Yakuake::Sessions::Base';
   with    'Yakuake::Sessions::TraitFor::DBus';

=head1 Description

Abstract away the mechanics of communicating with Yakuake via DBus

=head1 Configuration and Environment

Defines the following attributes;

=over 3

=item C<dbus_class>

A lazy loaded class which defaults to L<Net::DBus>

=item C<service>

A lazy object ref for the C<org.kde.yakuake> DBus service

=item C<sessions>

A lazy object ref for the C</yakuake/sessions> DBus service object

=item C<tabs>

A lazy object ref for the C</yakuake/tabs> DBus service object