CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Perl Programming Help: Intermediate:
problem in forking using perl/tk

 



osamaamin
New User

Nov 2, 2011, 12:29 AM

Post #1 of 6 (1002 views)
problem in forking using perl/tk Can't Post

hi.
i m building a GUI based script in which the user is prompted for some input. when a button is pressed, a long time consuming command starts which freezes the GUI. in order to overcome this problem, i tried using fork but the script crashes with the following error msg:

perl: xcb_io.c:221: poll_for_event: Assertion `(((long) (event_sequence) - (long) (dpy->request)) <= 0)' failed.
Abort (core dumped)

this is my general program structure:

main gui :
when button pressed, fork a new process to do background processing so that gui not freeze
notify the user when background processing completes (child process ends)

background process:
do some time consuming work
exit


Jukari
Novice

Nov 2, 2011, 5:18 PM

Post #2 of 6 (976 views)
Re: [osamaamin] problem in forking using perl/tk [In reply to] Can't Post

I really don't have time to explain fork... but I know it can be a pain to work with. Especially when referencing child processes. Here's a copy of my script for pinging it creates fork process to ping... Been a while since I looked at the code. Hope it helps.

#!/usr/bin/perl

use Net::Ping;
use Socket;
use Term::ANSIColor;
use Win32::Console::ANSI;
use Cwd;

$cwd = getcwd;

$execute = "on";
####################################################################
####################################################################
unlink("Queue.txt");
open(QUEUE,">> Queue.txt") || die("Cannot Open File");
close(QUEUE);
sub execute_queue
{
$ip = $_[0];
if($execute eq "on")
{
open(QUEUE,">> Queue.txt") || die("Cannot Open File");
print QUEUE "$ip\n";
close(QUEUE);
}
}
####################################################################
####################################################################
sub IP_ENTRY
{

my $ip = $_[0];
my $iaddr = inet_aton("$ip");
my $host = gethostbyaddr($iaddr, AF_INET);
my @hostsplit = split(/\./,$host);
my $name = $hostsplit[0];
if($name eq "")
{
$name = "Not Available";
}
else
{
$name =~ tr/a-z/A-Z/;
}
####################################
$name_length = length($name);
$name_size = (20 - $name_length);
undef $name_length;
while($name_size > $count)
{
$count++;
$name_space = $name_space." ";
}
undef $ip_size;
undef $count;
$ip_length = length($ip);
$ip_size = (20 - $ip_length);
undef $ip_length;
while($ip_size > $count)
{
$count++;
$ip_space = $ip_space." ";
}
undef $ip_size;
undef $count;


####################################
undef(@hostsplit);
my $online;
my $p = Net::Ping->new( "icmp", 1, 64 );
if ( $p->ping($ip) )
{
$online = "Online";
print colored ['bold blue']," |";
print colored ['bold green']," $name$name_space$ip$ip_space$online ";
print colored ['bold blue'],"|\n";
execute_queue($ip);
}
else
{
$online = "Offline";
print colored ['bold blue']," |";
print colored ['bold red']," $name$name_space$ip$ip_space$online ";
print colored ['bold blue'],"|\n";

}
open(DUMP,">> $dump") || die("Cannot Open File");
print DUMP "$counter,$name,$ip,$online\n";
close(DUMP);
exit;
}
####################################################################
####################################################################
sub NAME_ENTRY
{
my $name = $_[0];
my $ip;
my $packed_ip = (gethostbyname($name));
if(defined $packed_ip eq "")
{
$ip = "Not Available";
}
else
{
$ip = inet_ntoa($packed_ip);
}
#########################################
$name =~ tr/a-z/A-Z/;
$name_length = length($name);
$name_size = (20 - $name_length);
while($name_size > $count)
{
$count++;
$name_space = $name_space." ";
}
undef $count;
$ip_length = length($ip);
$ip_size = (20 - $ip_length);
while($ip_size > $count)
{
$count++;
$ip_space = $ip_space." ";
}
undef $count;
########################################
my $online;
my $p = Net::Ping->new( "icmp", 1, 64 );
if ( $p->ping($ip) )
{
$online = "Online";
print colored ['bold blue']," |";
print colored ['bold green']," $name$name_space$ip$ip_space$online ";
print colored ['bold blue'],"|\n";
execute_queue($ip);
}
else
{
$online = "Offline";
print colored ['bold blue']," |";
print colored ['bold red']," $name$name_space$ip$ip_space$online ";
print colored ['bold blue'],"|\n";
}
open(DUMP,">> $dump") || die("Cannot Open File");
print DUMP "$counter,$name,$ip,$online\n";
close(DUMP);
exit;

}
####################################################################
####################################################################


####################################################################
####################################################################
system(($^O eq 'MSWin32') ? 'cls' : 'clear');
print colored ['bold cyan'], ,"Computer Pinger \nby: Anthony Brechtel\n\n\n";




if(-e "computers.csv")
{

$computer_file = 'computers.csv';
}
else
{
if(-e "computers.txt")
{

$computer_file = 'computers.txt';
}
else
{
print "No Read File\n";
exit;
}
}

$dump = "Done.csv";
unlink($dump);


print colored ['bold blue']," ===================================================== \n";


open (COMP, "computers.csv") || die("Cannot Open File");
while ($line = <COMP>) {
$counter++;
chomp($line);
if($line ne "")
{
$process_counter++;
if($process_counter eq 60)
{
$process_counter = 0;
foreach $process(@pids)
{
waitpid $process, 0;
}
undef(@pids);

}
@line_data = split(/,/, $line);

my $pid = fork();
if (not defined $pid)
{

#warn "$counter = No resources\n";
foreach $process(@pids)
{
waitpid $process, 0;
}
undef(@pids);

my $pid = fork();
if (not defined $pid)
{
warn "$counter = Still no resources\n";
}
elsif ($pid == 0)
{
if($line_data[0] =~/\./)
{
IP_ENTRY($line_data[0])
}
else
{
NAME_ENTRY($line_data[0])
}
}
push(@pids, $pid);
}
elsif ($pid == 0)
{
if($line_data[0] =~/\./)
{
IP_ENTRY($line_data[0])
}
else
{
NAME_ENTRY($line_data[0])
}
}
push(@pids, $pid);
#print "Parent: I talk to child by adding to QUEUE associated with $pid+\n";



}


}

foreach $process(@pids)
{
waitpid $process, 0;
}

print colored ['bold blue']," ===================================================== \n\n\n\n";

In Reply To


osamaamin
New User

Nov 3, 2011, 3:09 AM

Post #3 of 6 (944 views)
Re: [Jukari] problem in forking using perl/tk [In reply to] Can't Post

thanks for help, i finally got the forking successful.

now the other problem arises is how do i share variables between a parent and a child process?


Jukari
Novice

Nov 3, 2011, 5:01 AM

Post #4 of 6 (933 views)
Re: [osamaamin] problem in forking using perl/tk [In reply to] Can't Post

As far as I know there isn't a way to share variables between forked processes. I believe it will share variables all the way up until the process is forked. Then it re-runs the entire script in the fork, from start to finish. What you could do it create a "slush" file. That is being read and written by both child and parent.

Parent Starts
Parent Has child
Parent Reads "slush file" (continuously)- no variable
Child starts
Child writes to "slush file"
Parent Reads "slush file - Gets variable
Parent Prints variable to GUI
Child dies

That's just a suggestion, and I am by no means a pro at Perl. But in my dealings with fork I find that its best to try and have the parent and child talk as little as possible.

In Reply To


osamaamin
New User

Nov 3, 2011, 5:07 AM

Post #5 of 6 (932 views)
Re: [Jukari] problem in forking using perl/tk [In reply to] Can't Post

thank u so much, i will try this approach


FishMonger
Veteran / Moderator

Nov 3, 2011, 6:23 AM

Post #6 of 6 (924 views)
Re: [osamaamin] problem in forking using perl/tk [In reply to] Can't Post

http://search.cpan.org/~dsnopek/Xmldoom-0.0.16/lib/Thread/Shared.pm

http://search.cpan.org/~jryan/Net-Shared-0.30/Shared.pm

http://search.cpan.org/~jdhedden/threads-shared-1.40/lib/threads/shared.pm

http://search.cpan.org/~rybskej/forks-0.34/lib/forks/shared.pm

 
 


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives