Date: 18 Sep 2001 13:57:06 -0400
From: stanb@panix.com (Stan Brown)
Subject: Problem with Storable, and pipes (buffering)
Message-Id: <9o81ti$s91$1@panix1.panix.com>

OK, at the risk of being flaed for posting this.

I have managed to cut this down to what I consider a minimal way of
demonstrating the problem I have. If you run this code, press teh "Execute"
Button. You will see that the new_records subrotuine gets called an blocks
for  lacj of data (I think), In any case, since it's blocked on the
fd_retrieve(0 call, it can;t do anything else (like return to the man
loop).

As you can see I am setting autoflush on the write end of the piep, but
that does not seem to fix the probelm.

I'm certain the problem must be blindingly obvious to some of you bright
people, so how about shareing the wisdom with this poor idiot.


#!/opt/local//bin/perl -w

use strict;
use Tk;
use POSIX qw(strftime strtod _exit);
use Storable qw(store_fd fd_retrieve);
use FileHandle;

# Global so that the error popups can reference it
my $MW;
# Button widgets
# Global so that the "active/disabled" states can be toggled/queried by
# callbacks
my $execute_button;
my $record_qty=0;
my $child_pid;
my $qr = 0;
$::Debug=1;


sub print_debug($$$$) {
##################################################################
#
# Print debug message to STDERR with appropriate number
# of leading "-"s to show level of debuging required
# to invoke this message
#
# Argument 1 is the debuging level required to ge this mesage
# Argument 2 is the message
# Argument 3 is a flag to get a datestamp
# Argument 4 is a flag to get PID printed
#
##################################################################
my ($level, $msg, $need_date, $pid_flag) = @_;
my $leader = '';
my $datetime = '';
my $i = 0;

	STDERR->autoflush(1);
	if ($::Debug >= $level)
	{
		if($pid_flag == 1)
		{
			$leader = " PID->$$: "
		}
		for ($i = 1; $i <= $level; $i++) {
			$leader = "$leader-";
			}
		$leader = "$leader ";
		$msg = "$leader$msg";
		if ($need_date == 1)
		{
			$datetime = localtime();
			# Yes, the leading space is on purpose
			# It helps to sort out these from the other
			# noise teh program may be putting ot
			# If I asked for a datestamp, then I'm probably 
			# on scaning through the noise, looking ofr timeing
			# rleationships
			print STDERR (" $0: $datetime: $msg");
		}
		else
		{
			print STDERR ("$0: $msg");
		}
	}
}

sub cleanup_and_exit() {
################################################################
#
#  cleanup_and_exit
#
#  Should be called anywhere we want to exit the main
#  procees (not the child), instead of exit
#
###############################################################
my $function_name = (caller(0))[3];

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

	if( defined $child_pid)
	{
		kill 'SIGTERM' , $child_pid;
	}	
	if( defined $MW)
	{
		$MW->destroy;
	}
	exit;
}

sub draw_buttons () {
#####################################################################
#
# Create the user action buttons
#
####################################################################
my(@seperator_attributes) = qw/-width 20 -height 10/;
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);


	# Create a little space between entry fileds and buttons
	my $spacer2 = $MW->Frame(@seperator_attributes);
	$spacer2->pack( -side => 'left');

	# Create 'execute' button 
	$execute_button = $MW->Button(-text => "Execute\nQuery", 
						-width => 15, 
						-background => 'PeachPuff1' ,
						-activebackground => 'PeachPuff1' ,
						-state => 'active' ,
						-borderwidth => 2 ,
                        -command => sub 
                          {
                           fetch_records();
                          });
	$execute_button->pack( -side => 'top' );

	# Create 'exit' button 
	my $exit = $MW->Button(-text => 'Exit', 
						-background => 'Red' ,
						-activebackground => 'Red' ,
						-foreground => 'White' ,
						-activeforeground => 'White' ,
						-state => 'active' ,
						-borderwidth => 2 ,
                        -command => sub 
                          {
						   cleanup_and_exit();
                          });
	$exit->pack( -side => 'top');

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

sub fetch_records () {
#####################################################################
#
# Prepares and executes a database query, based upon the
# info in %data_fileds
#
# Inputs
#
# 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 $pid;
my $pipe;
my $rc;
my $sths;
my $rp = 0;
my @a = [1, 2, 3, 4, 5, 6, 7, 8, 9];
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);


	$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;
		$MW->fileevent($reader,
						"readable",
						[\&new_records_avail, 
						  $reader, 
						  $pid]);
	} elsif( defined $pid ) {
		# child process here
		print_debug(1,"Child task started\n",0,1);
		close $reader;
		$writer->autoflush();
		eval {
			# Prepare query 
			my $i;
			while( 1 ) {
				store_fd( \@a, $writer ) or die "can't store to $writer\n";
				if($rp == 100)
				{
					print_debug(1,"Sleeping after $i iterations\n",1,0);
					sleep(10);
					print_debug(1,"Done sleeping\n",1,0);
					$rp = 0;
				}
				++$rp;
				++$i;
			}
			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);
}

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
#
#####################################################################
my ($reader,$pid)=@_;
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(1,"Entering $function_name()\n",1,0);
print_debug(3,"$argtmp\n",0,0);

	my $arow = fd_retrieve $reader;
	print_debug(1,"Got $arow()\n",1,0);
	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", "" );
		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();
		popup_msg("All Records That Match Your Selected Criteria Have Now Been Fetched");
		}
	if($record_qty == 0)
	{
		print_debug(1, "First record recieved\n",1,1);
		++$record_qty;
		print_debug(1, "First record Processing Complete\n",1,1);
		return;
	}
	++$record_qty;
print_debug(1,"Returning from $function_name()\n",1,0);
} 


# main()

# Initialze Tk 
$MW = MainWindow->new();

$MW->title ("Data Manipulation Form");

my $label   = $MW->Label(-text => "DataBase Table Editor For Table" ,
							-anchor => 'n', 
							-justify => 'center');
$label->pack(-side => 'top', -fill => 'y', -expand => 'y');

draw_buttons();
# Interact...
MainLoop();
-- 
"They that would give up essential liberty for temporary safety deserve
neither liberty nor safety."
						-- Benjamin Franklin