On Fri, 5 Aug 2005, Plymouth Rock wrote:
Could you post a complete (but minimal) script that
illustrates the problem you're encountering? From what
you wrote above, I tried this Registry script:
Here is a simplest ithread-based perl-script I'd testing. At first, run it
just with Perl (or, it's desirable, on win32-platform with ActivePerl), look
at
results. Then try the same with mod_perl2. I suspect you won't see any
results at all or you will be able to see incorrect results via great delay.
#!C:\Perl\bin\perl -w
print "Content-type: text/html\n\n";
use strict;
use warnings;
use Time::HiRes;
use threads;
use threads::shared;
use Thread::Queue;
my ($doc_top, $doc_middle, $doc_bottom);
my $threads = 3;
my $itable;
$doc_top = "<html>\n";
$doc_top .= "<head>\n";
$doc_top .= "<script>\n";
$doc_top .= "function set(id,text) {\n";
$doc_top .= " document.getElementById(id).innerText = text\n";
$doc_top .= "}\n";
$doc_top .= "</script>\n\n";
$doc_top .= "</head>\n";
$doc_top .= "<body>\n\n";
$doc_top .= "<table style=\"font: 8pt Verdana, Arial, Helvetica, Sans-serif;
line-height:8pt;\" cellSpacing=\"1\" cellPadding=\"2\" width=\"21%\"
border=\"1\">\n";
$doc_top .= "\t<tr>\n";
$doc_top .= "\t\t<td>\n";
$doc_middle ='';
$doc_bottom .= "\t\t</td>\n";
$doc_bottom .= "\t</tr>\n";
$doc_bottom .= "</table>\n\n";
for ($itable = 0; $itable <= 98; $itable++) {
$doc_middle .= "\t\t\t<tr>\n" if $itable%$threads == 0;
$doc_middle .= "\t\t\t\t<td width=\"10%\" id='cell$itable'
bgColor=\"#eeeeee\" align=\"center\"> </td>\n";
$doc_middle .= "\t\t\t</tr>\n" if $itable%$threads - ($threads - 1) == 0
|| $itable >= 98;
}
print $doc_top.$doc_middle.$doc_bottom;
print "<font style=\"font: 8pt Verdana, Arial, Helvetica, Sans-serif;
line-height:8pt;\">\n";
$|++;
my $q_letters = new Thread::Queue;
my $q_pauses = new Thread::Queue;
my $q_rvalues = new Thread::Queue;
$q_letters->enqueue('a','b','c', 'd','e','f', 'g','h','i');
$q_pauses->enqueue
(
(rand(1))+.3, (rand(1))+.3, (rand(1))+.3,
(rand(1))+.3, (rand(1))+.3, (rand(1))+.3,
(rand(1))+.3, (rand(1))+.3, (rand(1))+.3
);
$q_rvalues->enqueue
(
int(rand(4))+2, int(rand(4))+2, int(rand(4))+2,
int(rand(4))+2, int(rand(4))+2, int(rand(4))+2,
int(rand(4))+2, int(rand(4))+2, int(rand(4))+2
);
my $count : shared = $threads;
my @threads;
sub fun {
$count -= 1;
my $pos;
my $cur_var = 0;
my $left_rval;
my $left_letter;
my $left_pause;
my $scal = scalar(@threads);
my $rval = $q_rvalues->dequeue;
my $letter = $q_letters->dequeue;
my $pause = $q_pauses->dequeue;
for($cur_var = $cur_var; $cur_var <= $rval; $cur_var++) {
redo if $count;
$pos = $cur_var*$threads + $scal;
print "<script>set('cell$pos', '$letter')</script>\n";
Time::HiRes::sleep($pause);
if($cur_var == $rval) {
$left_rval = $q_rvalues->pending;
$left_letter = $q_letters->pending;
$left_pause = $q_pauses->pending;
if($left_rval > 0 && $left_letter > 0 && $left_pause > 0) {
$rval = $q_rvalues->dequeue + $cur_var;
$letter = $q_letters->dequeue;
$pause = $q_pauses->dequeue;
}
}
}
}
foreach(1..$threads) {
push @threads, threads->new(\&fun)
}
foreach(1..$threads) {
my $thid = shift @threads;
$thid->join
}
print "</body>\n";
print "</html>\n";
As a registry script, you have some "variable will not
stay shared" warnings in this (as you indicated in the
original message). This type of thing is discussed at
http://perl.apache.org/docs/general/perl_reference/perl_reference.html#my___Scoped_Variable_in_Nested_Subroutines
Does it help any if you get rid of these warnings
(eg, declare appropriate variables with "our").
--
best regards,
randy
