Date: 17 Sep 2001 09:08:39 -0400
From: stanb@panix.com (Stan Brown)
Subject: Parent/Child Tk::fileevent & very confused
Message-Id: <9o4skn$a6c$1@panix1.panix.com>

 I have a task the splits itself inot a parent, and a child, then passes
 information retrieved from an Oracle DB by the child back to the parent.

 Problem is, that the TK widgets (controled by the parent) refuse to update
 themseleves while this transfer is going on. I have even added a 10 second
 sleep, every 100 records, in the child! It still does not update the
 widgets, even while in this slepp! Also during the sleeep, system CPU
 loading becomes very low. 

 Here are some snipets of the code:


	The subroutine that does the fork.

sub fetch_records ($$$) {
#####################################################################
#
# Prepares and executes a database query, based upon the
# info in %data_fileds
#
# Inputs
#
# 1. Name of the table we are working on
# 2. Total number of rows in the table we are working on
# 3. pointer to hash of column names, and atributes
#
# Side effects
# Spawns a child task to execute the DB fetch
# The callback triggered by this cahild does the followig:
# Sets %record_set[] to contain all the returned records
# Adds quantity of records, and currently displayed record
# number widgets to main window
#
#####################################################################
my ($ltable,$total_rows_this_table,$hash_pointer)=@_;
my $pid;
my $pipe;
my $rc;
my $sths;
my $rp = 0;
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map "Arg$_ " . 
			( defined $_[$_] ? "->$_[$_]<-" : 
			'*UNDEF*'), 0 .. $#_;

print_debug(2,"Entering $function_name()\n",0,0);
print_debug(3,"$argtmp\n",0,0);

	my $stmt = create_query_statement($ltable,$hash_pointer);
	print_debug(1, "**** Query = \n->$stmt<-\n",1,0);

	$record_qty = 0;
	undef $records_array_ref;
	# $MW->Busy;
	pipe my ($reader, $writer) or die "pipe: $!";
	if( my $pid = fork ) {
		# parent process here
		print_debug(1,"Parent task\n",0,1);
		$child_pid = $pid;
		close $writer;
		$please_wait_popup = popup_info("Retrieving Records From DB. Please wait");
		$MW->fileevent($reader,
						"readable",
						[\&new_records_avail, 
						  $reader, 
						  $pid, 
						  $total_rows_this_table]);
	} elsif( defined $pid ) {
		# child process here
		print_debug(1,"Child task started\n",0,1);
		close $reader;
		$writer->autoflush(1);
		select( (select($writer), $|=1)[0] );
		eval {
			# Prepare query 
			print_debug(1, "Prepare Satrted\n",1,1);
			$sths = $dbh->prepare("$stmt");
			print_debug(1, "Prepare Done. Execute Started\n",1,1);
			$rc = $sths->execute or die $DBI::errstr;
			print_debug(1, "Execute done\n",1,1);
			while( my $onerow = $sths->fetchrow_arrayref ) {
				store_fd( $onerow, $writer ) or die "can't store to $writer\n";
				if($rp == 100)
				{
					sleep(10);
					# SDB
					print "Sleeping\n";
					$rp = 0;
				}
				++$rp;
			}
			store_fd( [], $writer ) or die "can't store to $writer\n";
			print_debug(1, "Fetch done\n",1,0);
		};
		store_fd \$DBI::errstr, $writer if $@;
		close $writer;
		$sths->finish();
		print_debug(5,"Child task done\n",0,1);
		undef $child_pid;
		POSIX::_exit(0);
	}

print_debug(3,"Returning from $function_name()\n",0,0);
}

The parents fileevent callback:


sub new_records_avail($$$) {
######################################################################
#
# new_records_avail
#
# The callback routine, that is called when the child task, which
# does the actual DB fetch, has data available.
#
# Inpits
# 
# 1. The filehandle to read from
# 2. The pid of the child
# 3. The total number of records in the table we are working on
#
#####################################################################
my ($reader,$pid,$total_rows_this_table)=@_;
my $rb;
my $sb;
my $cb;
my $col;
my $plural;
my $junk;
my(@seperator_attributes) = qw/-width 10 -height 40/;
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map "Arg$_ " . 
			( defined $_[$_] ? "->$_[$_]<-" : 
			'*UNDEF*'), 0 .. $#_;

print_debug(2,"Entering $function_name()\n",0,0);
print_debug(3,"$argtmp\n",0,0);

	my $arow = fd_retrieve $reader;
	die "Unexpected eof $!" if !$arow;
	if( !@$arow ) {
		print_debug(1, "Done With Fetching commify($record_qty) Selected Records\n",1,1);
		$MW->fileevent( $reader, "readable", "" );
		if ($record_qty == 1)
		{
  			$next_button->configure( -state => 'disabled');
  			$prev_button->configure( -state => 'disabled');
		}
		print_debug(1, "Sending kill for preocess $pid\n",1,1);
		kill 9, $pid;
		waitpid( $pid , 0);
		print_debug(1, "Preocess $pid is terminated\n",1,1);
		close $reader;
		$MW->Unbusy();
		if (defined $please_wait_popup)
		{
			$please_wait_popup->destroy();
		}
		popup_msg("All Records That Match Your Selected Criteria Have Now Been Fetched");
		if($record_qty == 0)
		{
			popup_msg("No Records match this query");
		}
		else
		{
			if($record_qty > 1)
			{
				$plural = "Records";
			}
			else
			{
				$plural = "Record";
			}
			my $cq = commify($record_qty);
			$fetch_status = "Displaying Record $pos Of $cq $plural Fetched So Far.";
			# Go to new state
			#
			# Yes, I know I said all of these should be in DoIT()
			# However now that the actual DB fetch is done
			# via a child process, this is asynchronous,
			# and MUST be done in this callback
			$State = 'PROCESING_QUERY_RESULTS';
		}
		return;
	}
	@{$records_array_ref->[$record_qty]} = @$arow;
	if($record_qty == 0)
	{
		STDOUT->autoflush(1);
		print_debug(1, "First record recieved\n",1,1);
		# Display first record
		$pos = 1;
		# We depend upon the order of the columns to retrieve
		# in the SELECT statement being created in this same order
		# I don't like this, but the alternative was copying
		# all the retrieved data rows, and this was prooblematic
		# on large (1 million row) record sets
		my $i = 0;
		foreach $col (sort keys  %cols)
		{
			if($cols{$col}{'DATA_TYPE'} eq 'DATE')
			{
				my $dt = ParseDate( $records_array_ref->[($pos - 1)]->[$i]);
				$data_fields{$col} = UnixDate($dt, "%s");
			}
			else
			{
				$data_fields{$col} = $records_array_ref->[($pos - 1)]->[$i];
				print_debug(6,
					"Set data_fields{col} for $col to ->$data_fields{$col}<-\n",
					0,
					0);
			}
			$i++;
		}
		# Make a copy, BEFORE anyone can change this
		# Need this to use in UPDATE
		%this_record = %data_fields;
	
		$MW->packPropagate(1);
		# Create a little space between buttons and record qty status fileds
		$rec_spacer = $MW->Frame(@seperator_attributes);
		$rec_spacer->pack( -side => 'left');

		$rec_label   = $MW->Label(-text => "Displaying Record" ,
								-anchor => 'se', 
								-height => 1, 
								-justify => 'center');
		$rec_label->pack( -side => 'top' ,
						-expand => 'n' ,
						-fill => 'none' );
		my $w = length($record_qty);
		$rec_entry   = $MW->Entry(-textvariable => \$pos ,
									-relief => 'solid' ,
									-borderwidth => 0 ,
									-takefocus => 0 ,
									-width => $w );
		$rec_entry->pack( -side => 'top' ,
						-expand => 'n' ,
						-fill => 'none' );
		$w = length($fetch_status) + 10;
		$rec_label2   = $MW->Entry(-textvariable => \$fetch_status,
								-relief => 'solid' ,
								-borderwidth => 0 ,
								-takefocus => 0,
								-width => $w );
		$fetch_status = "Displaying Record 1 Of 1 Records Fetched So Far.";
		$w = length($fetch_status);
		$rec_label2->pack( -side => 'top' ,
						-expand => 'y' ,
						-fill => 'x' );
		# Got record(s)
		# Set widgets to proper enabled/disabled state for the allowed
		# actions in this state
		if(defined $insert_button)
		{
  			$insert_button->configure( -state => 'active');
		}
		if(defined $update_button)
		{
  					$update_button->configure( -state => 'active');
		}
		if(defined $delete_button)
		{
  					$delete_button->configure( -state => 'active');
		}
  		$execute_button->configure( -state => 'disabled');
  		$enter_button->configure( -state => 'active');
  		$next_button->configure( -state => 'active');
  		$prev_button->configure( -state => 'active');
		if(defined $save_button)
		{
  			$save_button->configure( -state => 'active');
		}
 		foreach $rb (@radiobuttons) {
			if(defined $rb)
			{
  						$rb->configure( -state => 'active');
			}
		}
		while (($junk, $cb) = each %comparebuttons) {
			if(defined $cb)
			{
  						$cb->configure( -state => 'disabled');
			}
		}
		while (($junk, $sb) = each %sortbuttons) {
			if(defined $sb)
			{
  						$sb->configure( -state => 'disabled');
			}
		}
		++$record_qty;
		print_debug(1, "First record Processing Complete\n",1,1);
		return;
	}
	++$record_qty;
	# SDB
	++$qr;
	if($qr == ($total_rows_this_table / 100))
	{
		if($record_qty > 1)
		{
			$plural = "Records";
		}
		else
		{
			$plural = "Record";
		}
		my $cq = commify($record_qty);
		$fetch_status = "Displaying Record $pos Of $cq $plural Fetched So Far.";
		my $qty = commify($record_qty);
		print "\r$qty";
		$qr = 0;
		$MW->update();
	}
print_debug(3,"Returning from $function_name()\n",0,0);
} 

Can anyone explain this beahvior to me?

I originally thought the problem was sim,ple CPU loadinbg while passing all
this data back. But I have (at least for test pruposes) elimnated this. So
it looks like the parent must be stucj in some sort of system call? 

I really don't have a clue what's going on here.