El Módulo IO::Multiplex

Véase IO::Multiplex

Cliente

pp2@nereida:~/src/perl/testing$ cat -n iomultiplextelnet.pl
 1  use IO::Socket;
 2  use IO::Multiplex;
 3
 4  # Create a multiplex object
 5  my $mux  = new IO::Multiplex;
 6  # Connect to the host/port specified on the command line,
 7  # or localhost:23
 8  my $sock = new IO::Socket::INET(Proto    => 'tcp',
 9                                  PeerAddr => shift || 'localhost',
10                                  PeerPort => shift || 23)
11      or die "socket: $@";
12
13  # add the relevant file handles to the mux
14  $mux->add($sock);
15  $mux->add(\*STDIN);
16  # We want to buffer output to the terminal.  This prevents the program
17  # from blocking if the user hits CTRL-S for example.
18  $mux->add(\*STDOUT);
19
20  # We're not object oriented, so just request callbacks to the
21  # current package
22  $mux->set_callback_object(__PACKAGE__);
23
24  # Enter the main mux loop.
25  $mux->loop;
26
27  # mux_input is called when input is available on one of
28  # the descriptors.
29  sub mux_input {
30      my $package = shift;
31      my $mux     = shift;
32      my $fh      = shift;
33      my $input   = shift;
34
35      # Figure out whence the input came, and send it on to the
36      # other place.
37      if ($fh == $sock) {
38          print STDOUT $$input;
39      } else {
40          print $sock $$input;
41      }
42      # Remove the input from the input buffer.
43      $$input = '';
44  }
45
46  # This gets called if the other end closes the connection.
47  sub mux_close {
48      print STDERR "Connection Closed\n";
49      exit;
50  }

Servidor

pp2@nereida:~/src/perl/testing$ cat -n iomultiplexserver.pl
 1  use IO::Socket;
 2  use IO::Multiplex;
 3
 4  my $mux  = new IO::Multiplex;
 5
 6  # Create a listening socket
 7  my $sock = new IO::Socket::INET(Proto     => 'tcp',
 8                                  LocalPort => shift || 2300,
 9                                  Listen    => 4)
10      or die "socket: $@";
11
12  # We use the listen method instead of the add method.
13  $mux->listen($sock);
14
15  $mux->set_callback_object(__PACKAGE__);
16  $mux->loop;
17
18  sub mux_input {
19      my $package = shift;
20      my $mux     = shift;
21      my $fh      = shift;
22      my $input   = shift;
23
24      # The handles method returns a list of references to handles which
25      # we have registered, except for listen sockets.
26      foreach $c ($mux->handles) {
27          print $c $$input;
28      }
29      $$input = '';
30  }

R="0" SRC="logopcgull.gif" ALT="pcgull">
Sig: El Módulo IO::Multiplex Sup: Eventos Ant: El Módulo AnyEvent ict; 4 5 use Coro; 6 use Coro::Event; 7 8 async { 9 print "2\n"; 10 cede; 11 print "4\n"; 12 }; 13 14 sub timer : Coro { 15 my $w = Coro::Event->timer (after => 1); 16 my $e = $w->next; # get the event 17 print "Got: ".$e->got." Hits: ".$e->hits."\n"; 18 $Coro::main->ready; # Put $main coroutine in the queue 19 } 20 21 print "1\n"; 22 schedule; 23 print "3\n";

La corutina timer crea un vigilante en la clase Coro::Event::timer mediante la llamada:

    my $w = Coro::Event->timer (after => 1, repeat => 0);

Caundo este vigilante detecta el evento la ejecucíón de la corutina/callback vuelve a introducir la corutina $Coro::main en la cola de preparados dandole oportunidad de acabar.

pp2@nereida:~/src/perl/coro$ schedule.pl
1
2
4
Got: 0 Hits: 1
3

A diferencia de Event aquí no se especifica callback: El callback es la propia corutina.

El Atributo Coro

Como hemos visto es posible añadir el atributo Coro a una subrutina, lo que la convierte en corutina.

pp2@nereida:~/src/perl/coro$ cat -n attributes2.pl
 1  #!/usr/bin/perl
 2  use strict;
 3  use warnings;
 4
 5  use Coro;
 6
 7  my $p = 2;
 8
 9  sub p1 : Coro {
10     for (0..9) {
11        print "p1: $_\n";
12        cede;
13     }
14     $p--;
15  }
16
17  sub p2 : Coro {
18     for (10..23) {
19        print "p2: $_\n";
20        cede;
21     }
22     $p--;
23  }
24
25  eval {
26     cede while $p;
27  };

Argumentos y Retorno: terminate y cancel

Es posible pasar argumentos a la subrutina

                    async { ... } [ @args ]

y es posible retornar valores usando terminate o cancel:

terminate [arg ... ]
$coroutine->cancel( arg ... )

Los valores retornados pueden ser recuperados con join.

Sin embargo no es posible pasar parámetros a una corutina ni retornar valores cuando se cede el control a una corutina. De hecho cuando múltiples corutinas están activas es difícil sabe cuál tomará el control.

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 quecede 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