Coro/Coro/Select.pm

=head1 NAME

Coro::Select - a (slow but coro-aware) replacement for CORE::select

=head1 SYNOPSIS

 use Coro::Select;          # replace select globally
 use Core::Select 'select'; # only in this module
 use Coro::Select ();       # use Coro::Select::select

=head1 DESCRIPTION

This module tries to create a fully working replacement for perl's
C<select> built-in, using C<AnyEvent> watchers to do the job, so other
coroutines can run in parallel to any select user. As many libraries that
only have a blocking API do not use global variables and often use select
(or IO::Select), this effectively makes most such libraries "somewhat"
non-blocking w.r.t. other coroutines.

To be effective globally, this module must be C<use>'d before any other
module that uses C<select>, so it should generally be the first module
C<use>'d in the main program.

You can also invoke it from the commandline as C<perl -MCoro::Select>.

Performance naturally isn't great, but unless you need very high select
performance you normally won't notice the difference.

=over 4

=cut

package Coro::Select;

use strict;

use Coro;
use AnyEvent;

use base Exporter::;

our $VERSION = 4.745;
our @EXPORT_OK = "select";

sub import {
   my $pkg = shift;
   if (@_) {
      $pkg->export (scalar caller 0, @_);
   } else {
      $pkg->export ("CORE::GLOBAL", "select");
   }
}

sub select(;*$$$) { # not the correct prototype, but well... :()
   if (@_ == 0) {
      return CORE::select
   } elsif (@_ == 1) {
      return CORE::select $_[0]
   } elsif (defined $_[3] && !$_[3]) {
      return CORE::select $_[0], $_[1], $_[2], $_[3]
   } else {
      my $current = $Coro::current;
      my $nfound = 0;
      my @w;
      # AnyEvent does not do 'e', so replace it by 'r'
      for ([0, 'r', '<'], [1, 'w', '>'], [2, 'r', '<']) {
         my ($i, $poll, $mode) = @$_;
         if (defined (my $vec = $_[$i])) {
            my $rvec = \$_[$i];
            for my $b (0 .. (8 * length $vec)) {
               if (vec $vec, $b, 1) {
                  (vec $$rvec, $b, 1) = 0;
                  open my $fh, "$mode&$b"
                     or die "Coro::Select::fd2fh($b): $!";
                  push @w,
                     AnyEvent->io (fh => $fh, poll => $poll, cb => sub {
                        (vec $$rvec, $b, 1) = 1;
                        $nfound++;
                        $current->ready;
                        undef $current;
                     });
               }
            }
         }
      }

      push @w,
         AnyEvent->timer (after => $_[3], cb => sub {
            $current->ready;
            undef $current;
         })
         if defined $_[3];

      # wait here
      &Coro::schedule;
      &Coro::schedule while $current;

      return $nfound
   }
}

1;

=back

=head1 SEE ALSO

L<Coro::LWP>.

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut


Revision:	1.11
Committed:	Wed Jul 23 22:15:25 2008 UTC (15 years, 10 months ago) by root
Branch:	MAIN
CVS Tags:	rel-4_745
Changes since 1.10:	+1 -1 lines
Log Message:	4.745
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Coro::Select - a (slow but coro-aware) replacement for CORE::select
4
5			=head1 SYNOPSIS
6
7			use Coro::Select; # replace select globally
8			use Core::Select 'select'; # only in this module
9			use Coro::Select (); # use Coro::Select::select
10
11			=head1 DESCRIPTION
12
13			This module tries to create a fully working replacement for perl's
14			C<select> built-in, using C<AnyEvent> watchers to do the job, so other
15	root	1.2	coroutines can run in parallel to any select user. As many libraries that
16			only have a blocking API do not use global variables and often use select
17			(or IO::Select), this effectively makes most such libraries "somewhat"
18			non-blocking w.r.t. other coroutines.
19	root	1.1
20			To be effective globally, this module must be C<use>'d before any other
21			module that uses C<select>, so it should generally be the first module
22			C<use>'d in the main program.
23
24			You can also invoke it from the commandline as C<perl -MCoro::Select>.
25
26	root	1.2	Performance naturally isn't great, but unless you need very high select
27			performance you normally won't notice the difference.
28
29	root	1.1	=over 4
30
31			=cut
32
33			package Coro::Select;
34
35			use strict;
36
37			use Coro;
38			use AnyEvent;
39
40			use base Exporter::;
41
42	root	1.11	our $VERSION = 4.745;
43	root	1.1	our @EXPORT_OK = "select";
44
45			sub import {
46			my $pkg = shift;
47			if (@_) {
48			$pkg->export (scalar caller 0, @_);
49			} else {
50			$pkg->export ("CORE::GLOBAL", "select");
51			}
52			}
53
54			sub select(;*$$$) { # not the correct prototype, but well... :()
55			if (@_ == 0) {
56			return CORE::select
57			} elsif (@_ == 1) {
58			return CORE::select $_[0]
59			} elsif (defined $_[3] && !$_[3]) {
60			return CORE::select $_[0], $_[1], $_[2], $_[3]
61			} else {
62			my $current = $Coro::current;
63			my $nfound = 0;
64			my @w;
65			# AnyEvent does not do 'e', so replace it by 'r'
66			for ([0, 'r', '<'], [1, 'w', '>'], [2, 'r', '<']) {
67			my ($i, $poll, $mode) = @$_;
68			if (defined (my $vec = $_[$i])) {
69			my $rvec = \$_[$i];
70			for my $b (0 .. (8 * length $vec)) {
71			if (vec $vec, $b, 1) {
72			(vec $$rvec, $b, 1) = 0;
73			open my $fh, "$mode&$b"
74			or die "Coro::Select::fd2fh($b): $!";
75			push @w,
76			AnyEvent->io (fh => $fh, poll => $poll, cb => sub {
77			(vec $$rvec, $b, 1) = 1;
78			$nfound++;
79			$current->ready;
80	root	1.3	undef $current;
81	root	1.1	});
82			}
83			}
84			}
85			}
86
87			push @w,
88			AnyEvent->timer (after => $_[3], cb => sub {
89			$current->ready;
90	root	1.3	undef $current;
91	root	1.1	})
92			if defined $_[3];
93
94			# wait here
95	root	1.3	&Coro::schedule;
96			&Coro::schedule while $current;
97	root	1.1
98			return $nfound
99			}
100			}
101
102			1;
103
104			=back
105
106	root	1.2	=head1 SEE ALSO
107
108			L<Coro::LWP>.
109
110	root	1.1	=head1 AUTHOR
111
112			Marc Lehmann <schmorp@schmorp.de>
113			http://home.schmorp.de/
114
115			=cut
116
117