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 (be careful, see below)
 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. Note that overriding C<select> globally
might actually cause problems, as some C<AnyEvent> backends use C<select>
themselves, and asking AnyEvent to use Coro::Select, which in turn asks
AnyEvent will not quite work.

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

To override select only for a single module (e.g. C<Net::DBus::Reactor>),
use a code fragment like this to load it:

   {
      package Net::DBus::Reactor;
      use Coro::Select qw(select);
      use Net::DBus::Reactor;
   }

Performance naturally isn't great (every file descriptor must be dup'ed),
but unless you need very high select performance you normally won't notice
the difference.

This implementation works fastest when only very few bits are set in the
fd set(s).

=over 4

=cut

package Coro::Select;

use strict;

use Errno;

use Coro ();
use AnyEvent ();
use Coro::AnyEvent ();

use base Exporter::;

our $VERSION = 5.14;
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 $nfound = 0;
      my @w;
      my $wakeup = Coro::rouse_cb;

      # AnyEvent does not do 'e', so replace it by 'r'
      for ([0, 'r', '<'], [1, 'w', '>'], [2, 'r', '<']) {
         my ($i, $poll, $mode) = @$_;
         if (defined $_[$i]) {
            my $rvec = \$_[$i];

            # we parse the bitmask by first expanding it into
            # a string of bits
            for (unpack "b*", $$rvec) {
               # and then repeatedly matching a regex against it
               while (/1/g) {
                  my $fd = (pos) - 1;

                  (vec $$rvec, $fd, 1) = 0;

                  # we need to dup(), unfortunately
                  open my $fh, "$mode&$fd"
                     or do { $! = Errno::EBADF; return -1 };

                  push @w,
                     $fh,
                     AnyEvent->io (fh => $fh, poll => $poll, cb => sub {
                        (vec $$rvec, $fd, 1) = 1;
                        ++$nfound;
                        $wakeup->();
                     });
               }
            }
         }
      }

      push @w,
         AnyEvent->timer (after => $_[3], cb => $wakeup)
            if defined $_[3];

      Coro::rouse_wait;

      return $nfound
   }
}

1;

=back

=head1 SEE ALSO

L<Coro::LWP>.

=head1 AUTHOR

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

=cut


Revision:	1.35
Committed:	Tue Jun 23 23:40:06 2009 UTC (14 years, 11 months ago) by root
Branch:	MAIN
CVS Tags:	rel-5_14
Changes since 1.34:	+1 -1 lines
Log Message:	5.14
#	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	root	1.32	use Coro::Select; # replace select globally (be careful, see below)
8	root	1.1	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	root	1.32	C<use>'d in the main program. Note that overriding C<select> globally
23			might actually cause problems, as some C<AnyEvent> backends use C<select>
24			themselves, and asking AnyEvent to use Coro::Select, which in turn asks
25			AnyEvent will not quite work.
26	root	1.1
27			You can also invoke it from the commandline as C<perl -MCoro::Select>.
28
29	root	1.32	To override select only for a single module (e.g. C<Net::DBus::Reactor>),
30			use a code fragment like this to load it:
31
32			{
33			package Net::DBus::Reactor;
34			use Coro::Select qw(select);
35			use Net::DBus::Reactor;
36			}
37
38	root	1.31	Performance naturally isn't great (every file descriptor must be dup'ed),
39			but unless you need very high select performance you normally won't notice
40			the difference.
41
42			This implementation works fastest when only very few bits are set in the
43			fd set(s).
44	root	1.2
45	root	1.1	=over 4
46
47			=cut
48
49			package Coro::Select;
50
51			use strict;
52
53	root	1.31	use Errno;
54
55	root	1.25	use Coro ();
56			use AnyEvent ();
57			use Coro::AnyEvent ();
58	root	1.1
59			use base Exporter::;
60
61	root	1.35	our $VERSION = 5.14;
62	root	1.1	our @EXPORT_OK = "select";
63
64			sub import {
65			my $pkg = shift;
66			if (@_) {
67			$pkg->export (scalar caller 0, @_);
68			} else {
69			$pkg->export ("CORE::GLOBAL", "select");
70			}
71			}
72
73			sub select(;*$$$) { # not the correct prototype, but well... :()
74			if (@_ == 0) {
75			return CORE::select
76			} elsif (@_ == 1) {
77			return CORE::select $_[0]
78			} elsif (defined $_[3] && !$_[3]) {
79			return CORE::select $_[0], $_[1], $_[2], $_[3]
80			} else {
81			my $nfound = 0;
82			my @w;
83	root	1.25	my $wakeup = Coro::rouse_cb;
84
85	root	1.1	# AnyEvent does not do 'e', so replace it by 'r'
86			for ([0, 'r', '<'], [1, 'w', '>'], [2, 'r', '<']) {
87			my ($i, $poll, $mode) = @$_;
88	root	1.31	if (defined $_[$i]) {
89	root	1.1	my $rvec = \$_[$i];
90	root	1.31
91			# we parse the bitmask by first expanding it into
92			# a string of bits
93			for (unpack "b*", $$rvec) {
94			# and then repeatedly matching a regex against it
95			while (/1/g) {
96			my $fd = (pos) - 1;
97
98			(vec $$rvec, $fd, 1) = 0;
99
100			# we need to dup(), unfortunately
101			open my $fh, "$mode&$fd"
102			or do { $! = Errno::EBADF; return -1 };
103
104	root	1.1	push @w,
105	root	1.31	$fh,
106	root	1.1	AnyEvent->io (fh => $fh, poll => $poll, cb => sub {
107	root	1.31	(vec $$rvec, $fd, 1) = 1;
108			++$nfound;
109	root	1.25	$wakeup->();
110	root	1.1	});
111			}
112			}
113			}
114			}
115
116			push @w,
117	root	1.25	AnyEvent->timer (after => $_[3], cb => $wakeup)
118			if defined $_[3];
119
120			Coro::rouse_wait;
121	root	1.1
122			return $nfound
123			}
124			}
125
126			1;
127
128			=back
129
130	root	1.2	=head1 SEE ALSO
131
132			L<Coro::LWP>.
133
134	root	1.1	=head1 AUTHOR
135
136			Marc Lehmann <schmorp@schmorp.de>
137			http://home.schmorp.de/
138
139			=cut
140
141