Práctica: Cálculo con Hilos

El área bajo la curva $y = \frac{1}{1+x^2}$ entre 0 y $1$ nos proporciona un método para calcular $\pi$:

$$\int_{0}^{1} \frac{4}{(1+x^2)} dx = 4 \arctan(x) \vert _{0}^{1} = 4 ( \frac{\pi}{4} - 0) = \pi$$

Esta integral puede aproximarse por la suma:

$$\pi \simeq \sum_{i=0}^{N-1} \frac{4}{N \times \left (1+ (\frac{i+0.5}{N})^2 \right)}$$

Después que una thread ha terminado de hacer su suma parcial deberá actualizar una variable compartida $pi en la cual pretendemos guardar el valor final. Observe que la variable $pi es un recurso compartido por los $p hilos que debe ser accedido en exclusión mutua. Para realizar la práctica es conveniente que, además de consultar los manuales de threads y threads::shared lea el tutorial sobre threads: perldoc perlthrtut.

Rellene el código que falta en el listado que aparece a continuación:

lhp@nereida:~/Lperl/src/threads$ cat -n pilock.pl
 1  #!/usr/bin/perl -w
 2  use strict;
 3  use threads;
 4  use threads::shared;
 5
 6  { # clausura
 7    my $pi : shared = 0;
 8
 9    sub chunk {
10      my $N = shift;
11      my $numthreads = shift;
12
13      my ($i, $x, $sum, $w);
14      my $id = threads->self()->tid();
15      $w = 1/$N;
16      $sum = 0;
17      for ($i = $id; $i < $N; $i += $numthreads) {
18        $x = .............; # abcisa
19        $sum += .................; # suma parcial
20      }
21      {
22        lock $pi;
23        $pi += $sum;
24      }
25      print "thread $id: $pi\n";
26      return  $pi;
27    }
28
29    sub postprocess {
30      my $N = shift;
31      return ......; # Retornar valor final
32    }
33  } # clausura
34
35  sub par {
36    my $nt = shift();
37    my $task = shift;
38    my $post = shift;
39    my @t; # array of tasks
40    my $result;
41
42    for(my $i=1; $i < $nt; $i++) {
43      ................................; # crear threads
44    }
45    $task->(@_);
46    .............................; # sincronizar
47    return $post->(@_);
48  }
49
50  ### main ###
51  my $numthreads = (shift || 2);
52  my $N = (shift || 10000);
53
54  my $result = par($numthreads, \&chunk, \&postprocess, $N, $numthreads);
55  print "$result\n";
lhp@nereida:~/Lperl/src/threads$ ./pilock.pl 8 100000
thread 1: 39270.533168727
thread 3: 78540.566344954
thread 2: 117810.849518681
thread 4: 157080.632694908
thread 7: 196349.665856134
thread 5: 235619.19902986
thread 6: 274888.482198587
thread 0: 314159.265359813
3.14159265359813
lhp@nereida:~/Lperl/src/threads$

/properldebugging/Chapter10$ ./shared3.pl Maestro: 0:4 0:6 0:10 0:13 0:16 0:19 0:22 0:25 0:28 0:30 Esclavo: 1:1 1:2 1:7 1:8 1:11 1:14 1:17 1:20 1:23 1:26 lhp@nereida:~/Lperl/src/properldebugging/Chapter10$ ./shared3.pl Maestro: 0:3 0:5 0:8 0:10 0:14 0:16 0:19 0:22 0:24 0:26 Esclavo: 1:1 1:6 1:11 1:12 1:17 1:20 1:27 1:28 1:29 1:30 lhp@nereida:~/Lperl/src/properldebugging/Chapter10$ ./shared3.pl Maestro: 0:2 0:4 0:7 0:10 0:13 0:16 0:19 0:23 0:25 0:28 Esclavo: 1:5 1:8 1:11 1:14 1:17 1:20 1:21 1:26 1:29 1:30 lhp@nereida:~/Lperl/src/properldebugging/Chapter10$ ./shared3.pl Maestro: 0:2 0:5 0:9 0:11 0:14 0:17 0:19 0:22 0:24 0:27 Esclavo: 1:3 1:6 1:7 1:12 1:15 1:20 1:25 1:28 1:29 1:30

Si se comentan las llamadas al método lock se pierde la atomicidad al acceso y el resultado final en la variable locked puede cambiar:

lhp@nereida:~/Lperl/src/properldebugging/Chapter10$ ./nolock.pl 

Maestro: 0:3 0:6 0:9 0:12 0:15 0:18 0:20 0:23 0:26 0:29 
Esclavo: 1:1 1:4 1:7 1:12 1:13 1:18 1:21 1:24 1:27 1:30 
lhp@nereida:~/Lperl/src/properldebugging/Chapter10$ ./nolock.pl 

Maestro: 0:2 0:5 0:8 0:10 0:12 0:14 0:17 0:20 0:23 0:26 
Esclavo: 1:5 1:6 1:11 1:12 1:15 1:18 1:21 1:24 1:27 1:28

"timed-process", $seconds, "/usr/sbin/traceroute", $host; 117 die "Cannot execute traceroute: $!"; 118 } 119 my $buf = ""; 120 while (<$F>) { 121 $buf .= $_; 122 $cache->set($session, [0, $buf]); 123 } 124 $cache->set($session, [1, $buf]); 125 exit 0; 126 } else { 127 die "Cannot fork: $!"; 128 } ... ...........................................

El hijo queda a la espera de la salida de la aplicación, leyendo mediante el manejador $F. Cada vez que lee algo nuevo lo vuelca en la cache con $cache->set($session, [0, $buf]). Cuando recibe el EOF desde la aplicación vuelca de nuevo el buffer indicando la finalización del proceso $cache->set($session, [1, $buf])

El Programa Completo

 1  #!/usr/local/bin/perl -w -T
 2  use strict;
 3  use Template;
 4  use CGI qw(:all delete_all);
 5  use CGI::Carp qw(carpout fatalsToBrowser);
 6  use Proc::Background;
 7  use Cache::FileCache;
 8  use Digest::MD5;
 9
10
11  BEGIN {
12    open (my $LOG,'>>/tmp/cgisearch.errors') || die "couldn't open file: $!";
13    carpout($LOG);
14  }
15
16  # Templates
17  my $result_tt = 'results.html';  # For results
18  my $form_tt   = 'form';          # For the form
19  my $wrapper   = 'page';          # General wrapper
20
21  $|++;
22
23  # To avoid the message 'Insecure $ENV{PATH} while running with -T'
24  $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin";
25
26  my $seconds = 6;
27  my $refreshseconds = 3;
28
29  my $form_val  = {
30    title      => 'Traceroute',
31    head       => 'Traceroute',
32    action     => script_name(),
33    question   => '',
34    submit     => 'traceroute to this host',
35    name       => 'host',
36  };
37
38  if (my $session = param('session')) {
39    continue_session($session)
40  }
41  elsif (my $host = param('host')) {
42    new_session($host);
43  }
44  else {
45    show_form($form_tt, $form_val);
46  }
47  exit 0;
48
49  sub show_form {
50    my ($form_tt, $vars) = @_;
51
52    my $template = Template->new( WRAPPER => $wrapper );
53    print header(-charset => 'utf-8' );
54    $template->process($form_tt, $vars);
55  }
56
57  sub get_cache_handle {
58
59    Cache::FileCache->new
60        ({
61          namespace => 'tracerouter',
62          username => 'nobody',
63          default_expires_in => '30 minutes',
64          auto_purge_interval => '4 hours',
65         });
66  }
67
68  sub get_session_id {
69      Digest::MD5::md5_hex(Digest::MD5::md5_hex(time().{}.rand().$$));
70  }
71
72  sub continue_session { # returning to pick up session data
73    my $session = shift;
74
75    my $cache = get_cache_handle();
76    my $data = $cache->get($session);
77    unless ($data and ref $data eq "ARRAY") { # something is wrong
78      show_form($form_tt, $form_val);
79      exit 0;
80    }
81
82    my $template = Template->new();
83
84    my $finished = $data->[0];
85    print header(-charset => 'utf-8' );
86    my $vars = {
87      finished => $finished,
88      title    => "Traceroute Results",
89      refresh  => ($finished ? "" : "<meta http-equiv=refresh content=$refreshseconds>"),
90      header   => 'Traceroute Results',
91      continue => ($finished ? "FINISHED" : "... CONTINUING ..."),
92      message  => $data->[1],
93      %$form_val,                # Insert form parameters
94    };
95    $template->process($result_tt, $vars);
96  }
97
98  sub new_session { # returning to select host
99    my $host = shift;
100
101    if ($host =~ /\A([\w.-]{1,100})\Z/) { # create a session
102      $host = $1;                 # untainted now
103      my $session = get_session_id();
104      my $cache = get_cache_handle();
105      $cache->set($session, [0, ""]); # no data yet
106
107      if (my $pid = fork) {       # parent does
108        delete_all();             # clear parameters
109        param('session', $session);
110        print redirect(self_url());
111      } elsif (defined $pid) {    # child does
112        close STDOUT;             # so parent can go on
113        my $F;
114        unless (open $F, "-|") {
115          open STDERR, ">&=1";
116          exec "timed-process", $seconds, "/usr/sbin/traceroute", $host;
117          die "Cannot execute traceroute: $!";
118        }
119        my $buf = "";
120        while (<$F>) {
121          $buf .= $_;
122          $cache->set($session, [0, $buf]);
123        }
124        $cache->set($session, [1, $buf]);
125        exit 0;
126      } else {
127        die "Cannot fork: $!";
128      }
129    } else {
130      show_form($form_tt, $form_val);
131    }
132  }

El Template con el Formulario

$ cat -n form
 1  <h1>[% head %]</h1>
 2  <form method="post" action="[% action %]" enctype="multipart/form-data">
 3  [% question %] <input type="text" name="[% name %]" />
 4  <input type="submit" value="[% submit %]">
 5  </form>

Wrapper

$ cat -n page
 1  <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
 2  <head>
 3  <title>[% title %]</title>
 4  <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
 5  </head>
 6  <body bgcolor = [% bgcol %]>
 7  [% content %]
 8  <hr>
 9  </body>
10  </html>

Véase También

Véase Watching long processes through CGI de Randall Schwartz (Merlin). Este ejemplo es una modificación.