perl-modperl mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Randy Kobes <ra...@theoryx5.uwinnipeg.ca>
Subject Re: win32, mod_perl/2.0.1, Apache/2.0.54 - ithreads problem
Date Wed, 17 Aug 2005 03:41:07 GMT
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\">&nbsp</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

Mime
View raw message