view release on metacpan or  search on metacpan

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

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 ] );
}

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

   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) {

t/01always_pass.t  view on Meta::CPAN

use Sys::Hostname;

my $osname = lc $^O; my $host = lc hostname;

sub diag_version {
   my ($module, $version) = @_;

   defined $version or $version = eval "require $module; $module->VERSION";
   defined $version or return warn sprintf "  %-30s    undef\n", $module;

   my ($major, $rest) = split m{ \. }mx, $version;

   return warn sprintf "  %-30s % 4d.%s\n", $module, $major, $rest;
}

sub diag_env {
   my $var = shift;

   return warn sprintf "  \$%-30s   %s\n", $var, exists $ENV{ $var }
                                                      ? $ENV{ $var } : 'undef';
}