Win32, CGI, IE6. (Currently I can't move from win to *nix, so I need just
win32-ActiveState-Perl help.)
1) First of all, I would like to ask for some ready win32-Perl-code I
looking for.
2) If there isn't 1), then I asking to offer me a proper, good, detailed,
effective, bugless and CPU- and memory-cheap algorithm.
3) If neither 1) nor 2), then help me, please, to correct my code (see
below).
I trying to write something like a simplified visual model of multistream
file downloading client (without a function of splitting a single large
file on chunks) with limitation of max number of simultaneously
downloading files and joining a next waiting file from queue to
currently downloading group of files just after any file has been arrived.
In my case it's several (3) child processes working in parallel. Grand
total of files: 9 ('a'. 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i'). The
limit on simultaneously working processes is just the number of processes
working in parallel (3). The rest remain in queue. Each child just typing
a column of a letter via certain pause and different number of times in
the LOOP:
I was forced to resort to writing the CGI script working in browser,
because it seems unable to demonstrate visually the idea of the parallel
work of processes in a shell.
Typing of letters within every column by each child simbolizes the
process of the file's arriving.
Each column simbolizes a file's body, each pause between letters in a
single column is something like delay (response) from a server and also
it may be ISP connection speed, and different number of times of typing
within each column simbolizes different length each of files.
It's most likely, all the files won't be able to arrive at the same time.
Although it's unable in the real Inet to calculate exactly what file will
be arrived most early and what - latest, but I have the model with known
parameters (see above). Therefore we can calculate here the order of
file's arriving:
(Of course, for approaching the model to a real situation we should use
rand() values instead of exact.)
Therefore, the 'd'-letter should be taken from queue (array) just by
2-nd child and start typing in the same column just after all the
'b'-letters will be printed.
The 'e'-letter should be taken by 3-rd child (unless 2-nd child has
time for printing all the 'd'-letters and start to pick out from array
and type 'e'-letter earlier of 3-rd child).
The 'f'-letter should be taken by 1-st child (unless 2-nd and/or 3-rd
children has time to do it earlier).
Anyway, every time just any letter is over printing by a child, a
nearest accessable letter should be taken from head of array by current
child (and also parameters of a letter: its new pause and number of
times) untill letters still there are in array.
Also, I use 'redo' built-in Perl function for synchronization of the
starts all the threads. But I want to know: is it cheaper for CPU and
memory to use 'redo' for synchronization or it will be better to use
semaphores? Or, maybe, something esle (like IPC signals between parent
process and each spawn child or cond_wait, cond_timedwait, cond_signal,
cond_broadcast from threads::shared module)?
Note: every time once any column of a letter is over printing, I don't
exit_from/kill current thread with following spawning a new one! No. I
just keep the existing child; on the last loop of WHILE/FOR's LOOP I do
conditional check: if LOOP's variable has approached to the right
LOOP's boundary, I move it some more right, and the child with even its
LOOP keep alive! I guess it more cheap than exit from current child and
spawning a new one.
In my case, I have to share an array of hashes among all the threads.
It's probably, I have to dereference and share each refrence explicitly,
and then lock and unlock each one as well. But I don't know how to. Once
I add ': shared' to my @params, my script becomes unworkable (excepting
the HTML-table dumping).
------------------------------------------------------------------------
Although this CGI-script is workable, it has runtime 'bugs' (no sync of
starts all the threads, appearing the message: "A thread exited while 3
threads were running.", perceptible slowing-down of working speed at using
lock() for shared arrays or absence any affect at all), incorrect results
(number of printings of the same kind of letter and its program-calculated
value may be different in about 1-2% of runnings, you can be able to see this
divergence for sure, if uncomment #@rv, #@pauses and put comment at the
beginning of first strings of current @rv, @pauses below; you'll see that 'a'
prints for 5 times (it's incorrectly!), and calculated value indicates here:
"for current letter 'a' repetitions 3 via pause 0.325543212890625 sec"
(it's correctly!)) and also the script has some illiteracy (single $thr->join
for several threads, for instance). DO NOT waste your time on learning this
code, just run it and look at the idea. I posting it just for you can be able
to visualize working idea I meaning. Sorry for this ugly code:
----------------------------------------------------------
(1) Source Code:
----------------------------------------------------------
#!C:\Perl\bin\perl -w
$|++;
print "Content-type: text/html\n\n";
# use strict;
use warnings;
use Time::HiRes;
use threads;
use threads::shared;
my ($doc_top, $doc_middle, $doc_bottom);
$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 cellSpacing=\"0\" cellPadding=\"0\" width=\"10%\"
+border=\"0\">\n";
$doc_top .= "\t<tr>\n";
$doc_top .= "\t\t<td>\n";
$doc_top .= "\t\t\t<table width=\"100%\">\n";
#$doc_top .= "\t\t\t\t<tr>\n";
$doc_middle ='';
#$doc_bottom .= "\t\t\t\t</tr>\n";
$doc_bottom .= "\t\t\t</table>\n";
$doc_bottom .= "\t\t</td>\n";
$doc_bottom .= "\t</tr>\n";
$doc_bottom .= "</table>\n\n";
#$doc_bottom .= "</body>\n";
#$doc_bottom .= "</html>\n";
for ($j = 0; $j <= 22; $j++)
{
$doc_middle .= "\t\t\t\t<tr>\n";
for ($i = 0; $i <= 2; $i++)
{
$doc_middle .= "\t\t\t\t\t<td id='cell$i$j' bgColor=\"#eeeeee\" al
+ign=\"center\"> </td>\n";
}
$doc_middle .= "\t\t\t\t</tr>\n";
}
print $doc_top.$doc_middle.$doc_bottom;
our (@rv, @pauses, @letters) : shared;
#@rv[0,1,2, 3,4,5, 6, 7, 8] = (2, 5, 5,<br>
@rv[0,1,2, 3,4,5, 6, 7, 8] = (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);
#@pauses[0,1,2, 3,4,5, 6, 7, 8] = (0.325543212890625, 0.3333251953
+125, 0.345562744140625,<br>
@pauses[0,1,2, 3,4,5, 6, 7, 8] = ((rand(1))+.3, (rand(1))+.3, (ran
+d(1))+.3,
(rand(1))+.3, (rand(1))+.3, (ran
+d(1))+.3,
(rand(1))+.3, (rand(1))+.3, (ran
+d(1))+.3);
@letters[0,1,2, 3,4,5, 6,7,8] = ('a','b','c', 'd','e','f', 'g'
+,'h','i');
my $cur_right_value;
my $cur_pause;
my $cur_letter;
for($f = 0; $f <= 2; $f++)
{
$cur_right_value = @rv[$f];# print $cur_right_value; print "<br>\n";
$cur_pause = @pauses[$f]; # print $cur_pause; print "<br>\n";
$cur_letter = @letters[$f];# print $cur_letter; print "<br>\n";
print "for current letter <b>$cur_letter</b> repetitions <b>".($cur_
+right_value+1)."</b> via pause <b>$cur_pause</b> sec<br>\n";
$thr = threads->new(sub
{
my $cur_var = 0;
for($cur_var = $cur_var; $cur_var <= $cur_right_value; $cur_var++)
{
print "<script>set('cell$f$cur_var', '$cur_letter')</script>\n";
if(Time::HiRes::sleep($cur_pause))
{
lock(@rv);
lock(@pauses);
lock(@letters);
}
if($cur_var == $cur_right_value)
{
# print "<b>\$f = $f</b><br>\n";
$cur_right_value = @rv[0]+$cur_var;
$cur_pause = @pauses[0];
$cur_letter = @letters[0];
shift @rv; # print @rv; print "<br>\n";
shift @pauses; # print @pauses; print "<br>\n";
shift @letters;# print @letters; print "<br>\n";
}
}
});
}
shift @rv; shift @rv; shift @rv; # print @rv; print
+ "<br>\n";
shift @pauses; shift @pauses; shift @pauses; # print @pauses; print
+ "<br>\n";
shift @letters; shift @letters; shift @letters;# print @letters; print
+ "<br>\n";
$thr->join;
print "@letters<br>\n";
print "<br>\n";
print "</body>\n";
print "</html>\n";
------------------------------------------------------------------------
There is also some more literate CGI-script. It even can sync threads starts.
But I can't complete it so it woluld be work accordingly to idea of first
script, but without those 'bugs', errors, incorrect results etc and pretty
literately. I tried to complete it independent, but I couldn't. I would be
glad if you'll be able to help me to gain this idea on first script basis,
because it's still very hard to me to do it alone.
----------------------------------------------------------
(2) Source Code:
----------------------------------------------------------
#!C:\Perl\bin\perl -w
print "Content-type: text/html\n\n";
use warnings;
use Time::HiRes;
use threads;
use threads::shared;
$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 ($j = 0; $j <= 32; $j++) {
$doc_middle .= "\t\t\t<tr>\n";
for ($i = 0; $i <= 2; $i++) {
$doc_middle .= "\t\t\t\t<td width=\"10%\" id='cell$i$j' bgColor=\"
+#eeeeee\" align=\"center\"> </td>\n";
}
$doc_middle .= "\t\t\t</tr>\n";
}
print $doc_top.$doc_middle.$doc_bottom;
print "<font style=\"font: 8pt Verdana, Arial, Helvetica, Sans-serif;
+line-height:8pt;\">\n";
$|++;
my $threads = 3;
my $count : shared = $threads;
my @threads;
my @params =
(
{id => '0', up => 8, to => 0.5, char => 'a'},
{id => '1', up => 5, to => 0.2, char => 'b'},
{id => '2', up => 11, to => 0.3, char => 'c'},
{id => '3', up => 6, to => 1.1, char => 'd'},
{id => '4', up => 2, to => 0.5, char => 'e'},
{id => '5', up => 9, to => 0.6, char => 'f'},
{id => '6', up => 3, to => 0.7, char => 'g'},
{id => '7', up => 5, to => 0.8, char => 'h'},
{id => '8', up => 6, to => 0.9, char => 'i'}
);
sub fun {
my $arg = shift;
$count -= 1;
my $cur_var = 0;
for($cur_var = $cur_var; $cur_var <= $arg->{up}; $cur_var++) {
redo if $count;
print "<script>set('cell$arg->{id}$cur_var', '$arg->{char}')</scri
+pt>\n";
Time::HiRes::sleep($arg->{to});
}
}
foreach(1..$threads) {
push @threads, threads->new(\&fun, shift @params);
}
foreach(1..$threads) {
my $thid = shift @threads;
$thid->join;
}
print "</body>\n";
print "</html>\n";
------------------------------------------------------------------------