Date: 17 Sep 2001 15:27:18 -0400
From: stanb@panix.com (Stan Brown)
Subject: Re: What does this do ? "select( (select($writer), $|=1)[0] );" ?
Message-Id: <9o5iqm$1ed$1@panix1.panix.com>

In <80icqtcv63babmebp7hnss21ive3r2lf3a@4ax.com> Bart Lateur <bart.lateur@skynet.be> writes:

>Stan Brown wrote:

>>So, what does this line do?
>>
>>select( (select($writer), $|=1)[0] );
>>
>>And could it be the culprit?

>I think not.

>It's a shortcut for

>	{
>	     my $old = select($writer);
>	     $| = 1;
>	     select($old);
>	}

>The value for $| defines the buffering behaviour for the currentlty
>selected output filehandle, but not for any other. So this first makes
>$writer the current filehandle for writing, saving info on which was the
>selected filehandle before that, then it sets $|, and then it reselects
>the previous filehandle.

>>At present it's hanging on fd_retrieve, when there is no data ready. This
>>is a problem since it needs to be updating the Tk widgtes at this time.

>Then maybe using the other select() call, first test if anything IS
>available before attempting to read from it. Or, change the behaviour of
>the input filehandle so that it doesn't wait for input. There's a
>function available through Fcntl, to do that.

Thanks for the fast reply.

If you don't mind, could I spell out a few more dtails of what I'm trying
to do, and perhaps you can point out the error of my ways.

Conceptualy I have a perlTK script that forks a child to retrieve data from
Oracle. The parent the is taksed with ahndling the Tk main loop, and
retreiveing data sent to it by the chiled.

Here are teh 2 relevant peices of code. For the parent:



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;
		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)
				{
					# SDB
					print_debug(1,"Sleeping\n",1,0);
					sleep(10);
					print_debug(1,"Done sleeping\n",1,0);
					$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);
}

Rhis forks the child, and sets up a fileevent callback to allow for the
child to get it's atention. The callback loooks like this:


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(1,"Entering $function_name()\n",1,0);
print_debug(3,"$argtmp\n",0,0);

	my $arow = fd_retrieve $reader;
	# SDB
	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", "" );
		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(1,"Returning from $function_name()\n",1,0);
} 
Here is some debug traceing of this task, as it runs:


$ script$ ./f*pl -d1  brkr$ ./f*pl -d1  b300$ 
 ./foo.pl: - Connecting to brown:0
 ./foo.pl: - State = ENTERING_QUERY.
 ./foo.pl: Mon Sep 17 14:56:50 2001: - **** Query = 
->SELECT A_2_B_THD_VOLTS , A_2_B_VOLTS , A_CURRENT , A_DEMAND , A_THD_CURRENT , BRKR_STATE , B_2_C_THD_VOLTS , B_2_C_VOLTS , B_CURRENT , B_DEMAND , B_THD_CURRENT , C_2_A_VOLTS , C_CURRENT , C_DEMAND , C_THD_CURRENT , DSTAMP , HZ , KVA , KVARS , KVA_DEMAND , KW , KW_DEMAND , PF , TSTAMP FROM B300  WHERE DSTAMP > TO_DATE('09-Sep-2001 14:56:31' , 'DD-MON-YYYY HH24:MI:SS' ) ORDER BY DSTAMP<-
 ./foo.pl:  PID->23068: - Child task started
 ./foo.pl: Mon Sep 17 14:56:50 2001:  PID->23068: - Prepare Satrted
 ./foo.pl:  PID->23066: - Parent task
 ./foo.pl: Mon Sep 17 14:56:50 2001:  PID->23068: - Prepare Done. Execute Started
 ./foo.pl: Mon Sep 17 14:56:50 2001:  PID->23068: - Execute done
 ./foo.pl: - State = IN_QUERY.
 ./foo.pl: Mon Sep 17 14:56:50 2001: - Entering main::new_records_avail()
 ./foo.pl: Mon Sep 17 14:56:50 2001: - Got ARRAY(0x409728dc)()
 ./foo.pl: Mon Sep 17 14:56:50 2001:  PID->23066: - First record recieved
 ./foo.pl: Mon Sep 17 14:56:51 2001:  PID->23066: - First record Processing Complete
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Entering main::new_records_avail()
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Got ARRAY(0x404b34d4)()
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Returning from main::new_records_avail()
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Entering main::new_records_avail()
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Got ARRAY(0x40978918)()
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Returning from main::new_records_avail()
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Entering main::new_records_avail()
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Got ARRAY(0x409788e8)()
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Returning from main::new_records_avail()
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Entering main::new_records_avail()
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Got ARRAY(0x409788c4)()
 ./foo.pl: Mon Sep 17 14:56:51 2001: - Returning from main::new_records_avail()
[[ 5402 lines omitted --- MJD ]]  
 ./foo.pl: Mon Sep 17 14:59:54 2001: - Entering main::new_records_avail()
 ./foo.pl: Mon Sep 17 14:59:54 2001: - Got ARRAY(0x40c46768)()
 ./foo.pl: Mon Sep 17 14:59:54 2001: - Returning from main::new_records_avail()
 ./foo.pl: Mon Sep 17 14:59:54 2001: - Entering main::new_records_avail()
 ./foo.pl: Mon Sep 17 14:59:53 2001: - Sleeping
Use of uninitialized value in concatenation (.) at ./foo.pl line 3093.
 ./foo.pl: Mon Sep 17 14:59:58 2001: - Got ()
Unexpected eof Interrupted system call at ./foo.pl line 3094.
]0;flink@phse6;/local/src/project/oracle/perl_formsflink@phse6:/local/src/project/oracle/perl_forms
$ 
 ./foo.pl: Mon Sep 17 15:00:04 2001: - Done sleeping
 ./foo.pl: Mon Sep 17 15:00:04 2001: - Fetch done

script done on Mon Sep 17 15:00:04 2001

As you can see, the parent always winds up blocked on teh fd_retrieve,
while the child is sleeping. I don;t inderstand what I'm doing worng, here.

Any sugestions?

-- 
"They that would give up essential liberty for temporary safety deserve
neither liberty nor safety."
						-- Benjamin Franklin