27,31d26
< #
< # Version 2.6.0
< #  * Support of Xeon for slurm less than 1.2
< #  * Support of PBS Pro
< #
347,354d332
< $rmgr{"pbs"} = {
<     'is_installed'    => \&pbs_is_installed,
<     'get_active_jobs' => \&pbs_get_jobs,
<     'setup_pcmd'      => \&pbs_setup_pcmd,
<     'cleanup_pcmd'    => \&pbs_cleanup_pcmd,
<     'find_pids'       => \&pbs_find_pids,
< };
< 
2376,2523d2331
< # pbs support.
< #
< ###############################################################################
< 
< my @pbs_server;
< my %pbs_tabjobs;
< my $pbs_get_alllist_done = 0;
< my $pbs_dfile;
< 
< sub pbs_is_installed {
<     return find_exe("qstat");
< }
< 
< sub pbs_get_lqsub {
<     my ($server) = @_;
<     my $jobidfound = 0;
<     my $jobid;
<     my $cmd = "qstat -w -n -u $user";   #JLG
<     $cmd .= " \@$server" if (defined $server) ; # add server if defined
<     $cmd .= " 2>/dev/null | ";
<     #
<     open(PS, $cmd );
<     while (<PS>) {
<        if (/\d+\.$server/i) {
<           my @champs = split(/\s+/);    # split by space 
<           if ($champs[9] eq 'R') {      # take only Running
<              $jobid = @champs[0];
<              $jobidfound = 1;
<           } else {
<              $jobidfound = 0;
<           }
<        } elsif ($jobidfound == 1) {
<              $_ =~ s/^ +//;     # suppress blank in front of line
<              $_ =~ s/^\+//;     # suppress first + sign
<              my @champs = split(/\+/);    # split by '+'
<              foreach my $word (@champs){
<                chomp($word);
<                $word =~ s/\/.*//;         # take all from /
<                push (@{$pbs_tabjobs{$jobid}{hosts}}, $word);
<              }
<        }
<     }
<     close PS;
< }
< 
< sub pbs_get_server {
<     my $cmd = "qstat -fB 2>/dev/null |";
<     open(PS, $cmd );
<     my @handle = <PS>;
<     close PS;
<     foreach my $line (@handle) {
<       next if ($line =~ /^\s+/); # skip if line begin with space
<       if ($line =~ /Server:/) {
<          $line =~ s/^ +//;  # take off space at start
<          my @champs = split(/\s+/,$line);   # split buff by space
<          push (@pbs_server,@champs[1]);
<       }
<     }
< }
< 
< sub pbs_get_data {
<     return \%pbs_tabjobs if ($pbs_get_alllist_done == 1) ;
<     pbs_get_server ();
<     foreach my $server (@pbs_server) {
<        pbs_get_lqsub($server);   # get job list by qsub
<     }
<     $pbs_get_alllist_done = 1;
<     return \%pbs_tabjobs;
< }
< 
< # There is a bug here I think, $user isn't used anywhere
< # which is probably bad.
< sub pbs_get_jobs {
<     my $user = shift;
< 
<     my $d    = pbs_get_data();
<     #my @jobs = (sort keys %{$d});
<     my @jobs = keys %{$d};
<     return @jobs;
< }
< 
< sub lpbs_get_script_name{
<     my ($job) = @_;
<     my $jobnum;
<     my $server;
<     my $port;
<     my $mpirpid;
<   
<     if ($conf{rmgr} eq "pbs") { # for pbs must add server
<        my @champs = split ('\.', $job);
<        $jobnum = $champs[0];
<        $server = $champs[1];
<     } else {
<       $jobnum = $job;
<     }
<     my $pwd=$ENV{PWD};
<     my $dirnm = dirname ($0);
<     my $base = basename ($0);
<     # if padb is launch as padb then dirname is .
<     # if padb is launched with a full path then dir is full
<     my $out;
<     if ($dirnm eq ".") {
<        $out=" $pwd\/$base ";
<     } else {
<        $out=" $0 ";
<     }
<     if ($conf{rmgr} eq "lsf-orte") { # for lsf-orte
<        ($server,$mpirpid,$port)=lsfompi_get_hostport($job);
<        if (defined $port) {
<           $out .= "--inner --jobid=$jobnum --server=$server:$mpirpid --port=$port ";
<        } else {
<           $out .= "--inner --jobid=$jobnum";
<        }
<     } elsif ($conf{rmgr} eq "pbs") { # for pbs
<       $out .= "--inner --jobid=$jobnum --server=$server ";
<     } else {
<       $out .= "--inner --jobid=$jobnum ";
<     }
<     return $out;
< }
< 
< sub pbs_setup_pcmd {
<     my $job = shift;
<     my $cmd = "pdsh -w";
<     my $index = 0;
<     my $d = pbs_get_data();
< 
<     my @hosts = @{ $d->{$job}{hosts} };
<     my $i     = @hosts;
< 
<     foreach my $nodes (@hosts) {
<         if ($index == 0) {
<            $cmd .= " $nodes";
<          } else {
<            $cmd .= ",$nodes";
<          }
<          $index++;
<     }
<     $conf{"useoldpdsh"} = 1;
<     return ( $cmd, undef );
< }
< 
< sub pbs_cleanup_pcmd {
<     unlink($pbs_dfile) if ( defined($pbs_dfile) );
< }
< 
3576,3579d2937
<     if ( $conf{"useoldpdsh"} == 1 ) { # TSL when using old pdsh
<         $line =~ s/^[a-zA-Z0-9]+://;
<     }
< 
3701,3703d3058
<                 if ( $conf{"useoldpdsh"} == 1) { # TSL when using old pdsh
<                    $line =~ s/^[a-zA-Z0-9]+://;
<                 }
3849,3855c3204
<         if ($conf{rmgr} eq "pbs" || $conf{rmgr} eq "lsf-mpd" || $conf{rmgr} eq "lsf-orte" ) { # for pbs
<            $cmd .= lpbs_get_script_name($rem_jobid);
<            $cmd .= " " . $rops;
<         } else {
< 
<            $cmd .= " $0 --inner --jobid=$rem_jobid" . $rops;
<         }
---
>         $cmd .= " $0 --inner --jobid=$rem_jobid" . $rops;
5352,5401d4700
< sub get_remote_env_bygdb {
<     my $pid = shift;
< 
<     my %env;
<     my ( $fh, $filetmp ) = tempfile("/tmp/padb.XXXXXX");
<     print $fh 'set pagination off';
<     print $fh "\n";
<     print $fh 'set $envp = *(char ***) &__environ';
<     print $fh "\n";
<     print $fh 'while (*$envp != 0)';
<     print $fh "\n";
<     print $fh 'printf "%s\n",*$envp';
<     print $fh "\n";
<     print $fh 'set $envp = $envp + 1';
<     print $fh "\n";
<     print $fh 'end';
<     print $fh "\n";
<     close $fh;
<     my $psg = {
<         rdr    => "",
<         wtr    => "",
<         err    => "",
<     };
<     my $ret_pid;
<     my $cmd = "gdb -nx -batch -x $filetmp -pid=";
<     $cmd .= $pid;
<     $ret_pid=open3($psg->{wtr}, $psg->{rdr}, $psg->{err}, $cmd );
<     my $handle = $psg->{rdr};
<     while (<$handle>) {
<       next if (/^\[/);
<       next if (/^Using\s+/i);
<       next if (/^0x/i);
<       if (/=/) {
<         chomp;
<         my @f   = split "=";
<         my $key = $f[0];
<         if ($f[1] !~ /^\(\)/) { # not register function
<           shift @f;
<           $env{$key} = join( "=", @f );
<         }
<       }
<     }
<     close $psg->{wtr};
<     close $psg->{rdr};
<     close $psg->{err};
<     waitpid($ret_pid,0);
<     unlink ($filetmp);
<     return %env;
< }
< 
5965,5967d5263
<     if ( !defined ($remote_env{LD_LIBRARY_PATH}) ) {
<        %remote_env = get_remote_env_bygdb($pid);
<     }
6417,6420d5712
<             if (!defined ($env{SLURM_JOBID}) || !defined ($env{SLURM_PROCID})      || !defined ($env{RMS_JOBID}) ) {
<                %env = get_remote_env_bygdb($pid);
<             }
< 
6570,6714d5771
< #
< # PBS support look for all processes whom PPID matches with input
< #
< sub pbs_get_pid_proc {
<     my ($rank_cmd, $rank_pid, $rank_ppid ,$pid_count, @handle) =  @_;
<     my @proc;
<     my @pid_proc;
<     my $count ;
<     my $pbs_attach = 0;
<     # extraction of pid (pids are in the head of @handle)
<     for ($count=0 ; $count < $pid_count; $count++) {
<       # shift get first elem and take it from
<       my $pid = shift(@handle);
<       push (@pid_proc, $pid);
<     }
<     foreach my $line (@handle) {
<        $line =~ s/^ +//;  # take off space at start
<        my @champs = split(/\s+/,$line);
<        foreach my $ppid (@pid_proc) {
<           if (@champs[$rank_ppid] == $ppid) {
<              push (@proc, @champs[$rank_pid]);
<              $pbs_attach++ if (@champs[$rank_cmd] eq "pbs_attach");
<           }
<        }
<     }
<     if ($pbs_attach != 0) {
<       my @proc_attach = @proc;
<       @proc = ();      # re-init
<       foreach my $line (@handle) {
<          $line =~ s/^ +//;  # take off space at start
<          my @champs = split(/\s+/,$line);
<          foreach my $ppid (@proc_attach) {
<             if (@champs[$rank_ppid] == $ppid) {
<                push (@proc, @champs[$rank_pid]);
<             }
<          }
<       }
<     }
<     return @proc;
< }
< #
< # PBS support, look for all mpd processes where PPID matches with input pid_root
< #
< sub pbs_get_pid_mpd {
<     my ( $pid_root, $rank_pid, $rank_ppid , @handle) = @_;
<     my @proc;
<     foreach my $line (@handle) {
<         $line =~ s/^ +//;  # take off space at start to avoid empty field
<         if ( $line =~ /python/ && $line =~ /mpd.py/ && $line =~ /$pid_root/) {
<            my @champs = split(/\s+/,$line);
<            if (@champs[$rank_ppid] == $pid_root) {
<               push (@proc, @champs[$rank_pid]);
<            }
<         }
<     }
<     return @proc;
< }
< sub pbs_get_proc {
<     my (@proc);
<     my $found_cmd = 0;
<     my $rank_pid = 0;
<     my $rank_ppid = 0;
<     my $rank_cmd = 0;
<     my $mpd_ppid_root;
<     my @mpd_pid;
<     my @proc_work;
<     my $cmd = "ps -o uid,pid,ppid,cmd -u $user 2>/dev/null |";
<     open(PS, $cmd );
<     my @handle=<PS>;
<     close PS;
<     foreach my $line (@handle) {
< #      print "=$line";
<       $line =~ s/^ +//;  # take off space at start to avoid empty field
<       if ($found_cmd == 0) {
<          my $count = 0;
<          my @champs = split(/\s+/,$line);
<          foreach my $word (@champs) {
<           if ($word =~ /^Pid/i) {
<              $rank_pid = $count;
<              #print "word=$word PID=@champs[$count] $count \n";
<              $found_cmd++;
<           }
<           if ($word =~ /^PPid/i) {
<              $rank_ppid = $count;
<              #print "word=$word PPID=@champs[$count] $count \n";
<              $found_cmd++;
<           }
<           if ($word =~ /^CMD/i) {
<              $rank_cmd = $count;
<              #print "word=$word cmd=@champs[$count] $count \n";
<              $found_cmd++;
<           }
<           $count++;
<          }
<       } else {
<         if ( $line =~ /python/ && $line =~ /mpd.py/ && $line =~ /opt.mpi/) {
<            my @champs = split(/\s+/,$line);
<            if (@champs[$rank_ppid] == 1 ) {
<               $mpd_ppid_root = @champs[$rank_pid];
<               @mpd_pid = pbs_get_pid_mpd($mpd_ppid_root,$rank_pid,$rank_ppid,@handle);
<               my $count = 0;
<               foreach (@mpd_pid) {
<                 $count++;
<               }
<               if ($confInner{rmgr} eq "pbs") {
<                  @proc_work = pbs_get_pid_proc($rank_cmd, $rank_pid,$rank_ppid,$count,@mpd_pid,@handle);
<               } else {
<                  @proc_work = lsfmpd_get_pid_proc($rank_cmd, $rank_pid,$rank_ppid,$count,@mpd_pid,@handle);
<               }
<               push(@proc,@proc_work);  # if multiple job for this user
<            }
<          }
<       }
<     }
<     return @proc;
< }
< #
< # PBS support 
< #
< sub pbs_find_pids {
<     my $job = shift;
<     my @pids;
<     my %vps;
<     @pids = pbs_get_proc();
<     foreach my $pid (@pids){
<        my $vp;
<        my %env = get_remote_env($pid);
<        if (!defined ($env{PBS_JOBID}) || !defined ($env{PMI_RANK}) ) {
<           %env = get_remote_env_bygdb($pid);
<        }
< 
<        if ( $env{PBS_JOBID} eq $job ) {
<           $vp = $env{PMI_RANK};
<        }
<        if (defined $vp) {
<           $vps{$vp} = $pid;
<        }
<     }
<     foreach my $vp ( sort { $a <=> $b } ( keys %vps ) ) {
<         my $pid = $vps{$vp};
<         maybe_show_pid( $vp, $pid );
<     }
< }
6906,6908d5874
<     my $serv;
<     my $port;
<     my $w_job;
6913,6914d5878
<         "server=s"          => \$serv,
<         "port=s"            => \$port,
6977,6988d5940
<     # for pbs job may have this form aaaa.servname
<     # so must recombine from server
<     if ( defined $serv) {
<        $w_job = "$jobid.$serv";
<     }
<     if ( defined $port) {
<        $w_job .= ".$port";
<     }
<     if (defined $w_job) {
<        $jobid = $w_job;
<     }
< 
7199c6151
<     $ENV{COLUMNS}=158; # for long command output line
---
>