perl-modperl mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "Plymouth Rock" <Triangu...@newmail.ru>
Subject Re: win32, mod_perl/2.0.1, Apache/2.0.54 - ithreads problem
Date Fri, 05 Aug 2005 04:43:45 GMT
> 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";


Mime
View raw message