[HRPM] Sorting ps list - source code for server and client

[Matt Shivers]

Hello all,

Warning it's a lot of code...

Here is the code the server uses to load up the array:

#-----------------------------------------------------------------------------

# get_proc_info

#-----------------------------------------------------------------------------

sub get_proc_info {

my $process_name = shift @_;

my @ps_list = `ps -eo pid,uname,uid,time,%cpu,%mem,cmd`;

my @usr_proc_list = grep {/$process_name/} @ps_list;


my $num_procs = @usr_proc_list; # gets the number of instances of a proc.


my @temp = 

"\n$num_procs instance(s) of $process_name running on $host_name\n\n";


# add contents of @usr_proc_list to @temp

foreach $value (@usr_proc_list){

$temp[++$#temp] = $value;

}


# change newlines to question marks, so lines get transmitted across

# the socket.

foreach (@temp){

s/\n/\?/g; # /g ensures all occurences are substituted

}


# convert @temp into a scalar so it can be transmitted across

# the socket.

$lines = join("@", @temp)."\n"; # \n is necessary - terminates transfer

return $lines;

}



And here is the code the client uses to decode and then display the array:



#-----------------------------------------------------------------------------

# search nodes

#

# Gets name of the program entered in the entry widget and sends the name 

# through the socket to the server. The server gathers information about the

# program and returns the info to this client. The list of matching processes

# is then displayed in the listbox widget. Error messages are printed in the 

# textbox widget.

#

# Parameters:

# $sock - socket used for connecting the client to the server

# $target - Hostname of machine running the server

# $e_widg - TK widget: holds the name of the process to be searched for

# $t_widg - TK widget: Error messages are displayed here

# $l_widg - TK widget: Displays list of matching processes

#-----------------------------------------------------------------------------

sub search_nodes {

my ($sock, $target, $e_widg, $t_widg, $l_widg) = @_;

my $prog_name = $e_widg -> get(); # must get info from entry here due to

# scoping issues

my $in_buf = "";

if(!$prog_name){

t_del_ins($t_widg,"Enter a program name.");

l_del_ins($l_widg, "");

} elsif ((!$sock) && (!$target)){

t_del_ins($t_widg,"Select a node.");

l_del_ins($l_widg, "");

} elsif (!$sock){

t_del_ins($t_widg,"Error connecting to $target. Try again.");

l_del_ins($l_widg, "");

} else {

# Contact acheived. Send messages.

t_del_ins($t_widg, "Searching nodes for instances of $prog_name.");

l_del_ins($l_widg, "");

my $process_string = "1?". $prog_name . "\n";

print($sock $process_string);


$SIG{ALRM} = \&timed_out;

eval {

alarm (5);

$in_buf = <$sock>;

alarm(0);

};

if ($@ =~ /GOT TIRED OF WAITING/){

t_del_ins($t_widg, "Server on $target timed out...");

l_del_ins($l_widg, "");

} else {

# split up incoming string into separate lines

my @temp2 = split "@", $in_buf;


# remove all ? from message

foreach (@temp2){

s/\?//g; # /g ensures all occurences of ? are removed

chomp $_;

}


my $numline = shift(@temp2);


# print socket message

t_del_ins($t_widg, "$numline\n"); 

l_del_ins($l_widg, @temp2); // display the array contents in the list widget

}

}

} # end search_nodes

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://mail.pm.org/archives/norfolk-pm/attachments/20001121/c2c77033/attachment.htm