Usando Corutinas con LWP

pp2@nereida:~/src/perl/coro$ cat -n lwp.pl
 1  #!/usr/bin/perl
 2  use warnings;
 3  use strict;
 4  use Perl6::Say;
 5
 6  use Coro;
 7  use Coro::Event;
 8  use Coro::LWP;
 9  use LWP::Simple;
10
11  $SIG{PIPE} = 'IGNORE';
12
13  die "Usage\n$0 url1 url2 ...\n" unless @ARGV;
14
15  my @pid;
16
17
18  for (@ARGV) {
19    push @pid, async {
20      my $site = shift;
21
22      say "Starting to fetch $site";
23      getstore("http://$site", "$site.html");
24      say "Fetched $site";
25    } $_;
26  }
27
28  $_->join for @pid;

pp2@nereida:~/src/perl/coro$ time lwp.pl www.google.com www.yahoo.com
Starting to fetch www.google.com
Starting to fetch www.yahoo.com
Fetched www.yahoo.com
Fetched www.google.com

real    0m0.698s
user    0m0.256s
sys     0m0.056s

pp2@nereida:~/src/perl/coro$ ls -ltr | tail -2
-rw-r--r-- 1 pp2 pp2 9562 2008-05-01 12:47 www.yahoo.com.html
-rw-r--r-- 1 pp2 pp2 7191 2008-05-01 12:47 www.google.com.html

PID SS RSS USES Description Where 136064756 US 18k 2 [main::] [./event.pl:45] 136064900 -- 1388 168 [coro manager] [/usr/local/lib/perl/5.8.8/Coro.pm:177] 136065140 N- 52 0 [unblock_sub scheduler] - 136974144 -- 1420 170 [Event idle process] [/usr/local/lib/perl/5.8.8/Coro/Event.pm:211] 138396120 -- 2008 2 dns of 87.30.69.157 [./event.pl:19] 138396876 -- 2008 2 dns of 87.30.69.160 [./event.pl:19] 138397128 -- 2008 2 dns of 87.30.69.161 [./event.pl:19] 138398136 -- 2008 2 dns of 87.30.69.165 [./event.pl:19] ......... -- .... 2 dns of ............ [./event.pl:19] ......... -- 1816 1 dns of ............ [./event.pl:19] 138496856 -- 1816 1 dns of 87.30.69.255 [./event.pl:19] >

La función inet_aton

La función inet_aton toma una dirección IP con notación de punto y la empaqueta:

lhp@nereida:~/Lperl/src/perl_networking/ch3$ cat -n name_trans.pl
 1  #!/usr/bin/perl
 2  use strict;
 3  use Socket;
 4  my $ADDR_PAT = /^\d+\.\d+\.\d+\.\d+$/;
 5
 6  while (<>) {
 7    chomp;
 8    die "$_: Not a valid address" unless /$ADDR_PAT/o;
 9    my $name = gethostbyaddr(inet_aton($_),AF_INET);
10    $name ||= '?';
11    print "$_ => $name\n";
12  }

La función gethostbyaddr

En un contexto escalar la función gethostbyaddr devuelve el nombre lógico que se corresponden con la dirección IP empaquetada. Si la búsqueda fracasa devuelve undef. Toma dos argumentos: la dirección empaquetada y la familia de direcciones (habitualmente AF_INET).

En un contexto de lista devuelve cinco elementos:

 DB<1> use Socket
 DB<2> x gethostbyaddr(inet_aton('209.85.135.103'), AF_INET)
0  'mu-in-f103.google.com'  # Nombre Canonico
1  ''                       # lista de alias
2  2                        # Tipo AF_INET
3  4                        # Longitud de la dirección
4  'ÑUg'                    # Dirección empaquetada

El Módulo Coro::Util

Coro::Util sobreescribe las funciones gethostbyname, gethostbyaddr y inet_aton haciendolas no bloqueantes.

l.

pp2@nereida:~/src/perl/coro$ cat -n isready.pl
 1  #!/usr/bin/perl
 2  use warnings;
 3  use strict;
 4  use Coro;
 5
 6  my $n = 3;
 7  my $end = 1;
 8  my $p = Coro->new( sub {
 9    my $m = shift;
10
11    for (0..$m) {
12      print "p: $_\n";
13      cede;
14    }
15    $end = 0;
16    terminate map { $_*$_ } 1..$m;
17  }, $n
18  );
19
20  $p->ready;
21  do {
22    cede;
23    print "H\n";
24  } while ($end);
25  my @r = $p->join;
26  print "This is the end:(@r)\n";

Al ejecutar este programa obtenemos la salida:

pp2@nereida:~/src/perl/coro$ isready.pl
p: 0
H
p: 1
H
p: 2
H
p: 3
H
H
This is the end:(1 4 9)

El Método on_destroy

El método on_destroy registra un callback que será llamado cuando la corutina sea destruida, pero antes de que ocurra el join. El ejemplo anterior puede reescribirse como sigue:

pp2@nereida:~/src/perl/coro$ cat -n ondestroy.pl
 1  #!/usr/bin/perl
 2  use warnings;
 3  use strict;
 4  use Coro;
 5
 6  my $n = 3;
 7  my $continue = 1;
 8
 9  my $p = Coro->new( sub {
10    my $m = shift;
11
12    for (0..$m) {
13      print "p: $_\n";
14      cede;
15    }
16    terminate map { $_*$_ } 1..$m;
17  }, $n
18  );
19
20  $p->on_destroy( sub { $continue = 0 } );
21  $p->ready;
22  do {
23    cede;
24    print "H\n";
25  } while ($continue);
26  my @r = $p->join;
27  print "This is the end:(@r)\n";

Cuando se ejecuta se obtiene la siguiente salida:

pp2@nereida:~/src/perl/coro$ ondestroy.pl
p: 0
H
p: 1
H
p: 2
H
p: 3
H
H
This is the end:(1 4 9)

Prioridades

El método prio establece la prioridad de una corutina. Las corutinas con prioridad un número mayor se ejecutan con mas frecuencia que las que tienen un número más pequeño.

Nombre	Valor
PRIO_MAX	3
PRIO_HIGH	1
PRIO_NORMAL	0
PRIO_LOW	-1
PRIO_IDLE	-3
PRIO_MIN	-4

La corutina $Coro::idle tiene menos prioridad que ninguna otra.

Los cambios en la prioridad de la corutina actual tiene lugar inmediatamente. Sin embargo, los cambios efectuados en corutinas que esperan en la cola de preparados solo tiene lugar después de su siguiente planificación.

pp2@nereida:~/src/perl/coro$ cat -n priorities.pl
 1  #!/usr/bin/perl
 2  use strict;
 3  use warnings;
 4  use Coro qw{:prio cede async};
 5
 6  my $prio = shift || PRIO_NORMAL;
 7  my $c = async {
 8     print "2\n";
 9     cede; # yield back to main
10     print "4\n";
11  };
12
13  $c->prio($prio);
14
15  print "1\n";
16  cede; # yield to coroutine
17  print "3\n";
18  cede; # and again

Cuando se ejecuta el programa anterior se obtienen salidas como estas:

pp2@nereida:~/src/perl/coro$ priorities.pl 3 # PRIO_MAX
1
2
4
3
pp2@nereida:~/src/perl/coro$ priorities.pl 1 # PRIO_HIGH
1
2
4
3
pp2@nereida:~/src/perl/coro$ priorities.pl 0 # PRIO_NORMAL
1
2
3
4
pp2@nereida:~/src/perl/coro$ priorities.pl -1 # PRIO_LOW
1
2
3
pp2@nereida:~/src/perl/coro$ priorities.pl -3 # PRIO_IDLE
1
2
3
pp2@nereida:~/src/perl/coro$ priorities.pl -4 # PRIO_MIN
1
2
3
pp2@nereida:~/src/perl/coro$ priorities.pl -5 # No existe
1
2
3
pp2@nereida:~/src/perl/coro$ priorities.pl -300 # No se obtienen errores
1
2
3

El método nice

$newprio = $coroutine->nice($change)

puede ser utilizado para cambiar el valor de la prioridad de $coroutine. En este caso $change es un desplazamiento que se resta a la prioridad actual.

Mientras que cede cede el control a corutinas con prioridad igual o superior, la subrutina Coro::cede_notself cede el control a cualquier corutina, independientemente de cual sea su prioridad.

pp2@nereida:~/src/perl/coro$ cat -n prioidle.pl
     1  #!/usr/bin/perl
     2  use strict;
     3  use warnings;
     4  use Coro qw{:prio async};
     5
     6  my $prio = shift || PRIO_NORMAL;
     7  my $c = async {
     8     print "2\n";
     9     Coro::cede_notself; # yield back to main
    10     print "4\n";
    11  };
    12
    13  $c->prio($prio);
    14
    15  print "1\n";
    16  Coro::cede_notself; # yield to coroutine
    17  print "3\n";
    18  Coro::cede_notself; # and again

Al ejecutarse produce:

pp2@nereida:~/src/perl/coro$ prioidle.pl -1
1
2
3
4
pp2@nereida:~/src/perl/coro$ prioidle.pl -2
1
2
3
4
pp2@nereida:~/src/perl/coro$ prioidle.pl -3
1
2
3
4
pp2@nereida:~/src/perl/coro$ prioidle.pl -4
1
2
3
4