ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent.pm (file contents):
Revision 1.264 by root, Wed Jul 29 12:42:09 2009 UTC vs.
Revision 1.320 by root, Mon Apr 12 02:50:31 2010 UTC

7 7
8=head1 SYNOPSIS 8=head1 SYNOPSIS
9 9
10 use AnyEvent; 10 use AnyEvent;
11 11
12 # if you prefer function calls, look at the L<AE> manpage for
13 # an alternative API.
14
12 # file descriptor readable 15 # file handle or descriptor readable
13 my $w = AnyEvent->io (fh => $fh, poll => "r", cb => sub { ... }); 16 my $w = AnyEvent->io (fh => $fh, poll => "r", cb => sub { ... });
14 17
15 # one-shot or repeating timers 18 # one-shot or repeating timers
16 my $w = AnyEvent->timer (after => $seconds, cb => sub { ... }); 19 my $w = AnyEvent->timer (after => $seconds, cb => sub { ... });
17 my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ... 20 my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ...
181my variables are only visible after the statement in which they are 184my variables are only visible after the statement in which they are
182declared. 185declared.
183 186
184=head2 I/O WATCHERS 187=head2 I/O WATCHERS
185 188
189 $w = AnyEvent->io (
190 fh => <filehandle_or_fileno>,
191 poll => <"r" or "w">,
192 cb => <callback>,
193 );
194
186You can create an I/O watcher by calling the C<< AnyEvent->io >> method 195You can create an I/O watcher by calling the C<< AnyEvent->io >> method
187with the following mandatory key-value pairs as arguments: 196with the following mandatory key-value pairs as arguments:
188 197
189C<fh> is the Perl I<file handle> (or a naked file descriptor) to watch 198C<fh> is the Perl I<file handle> (or a naked file descriptor) to watch
190for events (AnyEvent might or might not keep a reference to this file 199for events (AnyEvent might or might not keep a reference to this file
219 undef $w; 228 undef $w;
220 }); 229 });
221 230
222=head2 TIME WATCHERS 231=head2 TIME WATCHERS
223 232
233 $w = AnyEvent->timer (after => <seconds>, cb => <callback>);
234
235 $w = AnyEvent->timer (
236 after => <fractional_seconds>,
237 interval => <fractional_seconds>,
238 cb => <callback>,
239 );
240
224You can create a time watcher by calling the C<< AnyEvent->timer >> 241You can create a time watcher by calling the C<< AnyEvent->timer >>
225method with the following mandatory arguments: 242method with the following mandatory arguments:
226 243
227C<after> specifies after how many seconds (fractional values are 244C<after> specifies after how many seconds (fractional values are
228supported) the callback should be invoked. C<cb> is the callback to invoke 245supported) the callback should be invoked. C<cb> is the callback to invoke
349might affect timers and time-outs. 366might affect timers and time-outs.
350 367
351When this is the case, you can call this method, which will update the 368When this is the case, you can call this method, which will update the
352event loop's idea of "current time". 369event loop's idea of "current time".
353 370
371A typical example would be a script in a web server (e.g. C<mod_perl>) -
372when mod_perl executes the script, then the event loop will have the wrong
373idea about the "current time" (being potentially far in the past, when the
374script ran the last time). In that case you should arrange a call to C<<
375AnyEvent->now_update >> each time the web server process wakes up again
376(e.g. at the start of your script, or in a handler).
377
354Note that updating the time I<might> cause some events to be handled. 378Note that updating the time I<might> cause some events to be handled.
355 379
356=back 380=back
357 381
358=head2 SIGNAL WATCHERS 382=head2 SIGNAL WATCHERS
383
384 $w = AnyEvent->signal (signal => <uppercase_signal_name>, cb => <callback>);
359 385
360You can watch for signals using a signal watcher, C<signal> is the signal 386You can watch for signals using a signal watcher, C<signal> is the signal
361I<name> in uppercase and without any C<SIG> prefix, C<cb> is the Perl 387I<name> in uppercase and without any C<SIG> prefix, C<cb> is the Perl
362callback to be invoked whenever a signal occurs. 388callback to be invoked whenever a signal occurs.
363 389
380 406
381Example: exit on SIGINT 407Example: exit on SIGINT
382 408
383 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 }); 409 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 });
384 410
411=head3 Restart Behaviour
412
413While restart behaviour is up to the event loop implementation, most will
414not restart syscalls (that includes L<Async::Interrupt> and AnyEvent's
415pure perl implementation).
416
417=head3 Safe/Unsafe Signals
418
419Perl signals can be either "safe" (synchronous to opcode handling) or
420"unsafe" (asynchronous) - the former might get delayed indefinitely, the
421latter might corrupt your memory.
422
423AnyEvent signal handlers are, in addition, synchronous to the event loop,
424i.e. they will not interrupt your running perl program but will only be
425called as part of the normal event handling (just like timer, I/O etc.
426callbacks, too).
427
385=head3 Signal Races, Delays and Workarounds 428=head3 Signal Races, Delays and Workarounds
386 429
387Many event loops (e.g. Glib, Tk, Qt, IO::Async) do not support attaching 430Many event loops (e.g. Glib, Tk, Qt, IO::Async) do not support attaching
388callbacks to signals in a generic way, which is a pity, as you cannot do 431callbacks to signals in a generic way, which is a pity, as you cannot
389race-free signal handling in perl. AnyEvent will try to do it's best, but 432do race-free signal handling in perl, requiring C libraries for
433this. AnyEvent will try to do it's best, which means in some cases,
390in some cases, signals will be delayed. The maximum time a signal might 434signals will be delayed. The maximum time a signal might be delayed is
391be delayed is specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10 435specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10 seconds). This
392seconds). This variable can be changed only before the first signal 436variable can be changed only before the first signal watcher is created,
393watcher is created, and should be left alone otherwise. Higher values 437and should be left alone otherwise. This variable determines how often
438AnyEvent polls for signals (in case a wake-up was missed). Higher values
394will cause fewer spurious wake-ups, which is better for power and CPU 439will cause fewer spurious wake-ups, which is better for power and CPU
440saving.
441
395saving. All these problems can be avoided by installing the optional 442All these problems can be avoided by installing the optional
396L<Async::Interrupt> module. This will not work with inherently broken 443L<Async::Interrupt> module, which works with most event loops. It will not
397event loops such as L<Event> or L<Event::Lib> (and not with L<POE> 444work with inherently broken event loops such as L<Event> or L<Event::Lib>
398currently, as POE does it's own workaround with one-second latency). With 445(and not with L<POE> currently, as POE does it's own workaround with
399those, you just have to suffer the delays. 446one-second latency). For those, you just have to suffer the delays.
400 447
401=head2 CHILD PROCESS WATCHERS 448=head2 CHILD PROCESS WATCHERS
449
450 $w = AnyEvent->child (pid => <process id>, cb => <callback>);
402 451
403You can also watch on a child process exit and catch its exit status. 452You can also watch on a child process exit and catch its exit status.
404 453
405The child process is specified by the C<pid> argument (one some backends, 454The child process is specified by the C<pid> argument (one some backends,
406using C<0> watches for any child process exit, on others this will 455using C<0> watches for any child process exit, on others this will
455 # do something else, then wait for process exit 504 # do something else, then wait for process exit
456 $done->recv; 505 $done->recv;
457 506
458=head2 IDLE WATCHERS 507=head2 IDLE WATCHERS
459 508
460Sometimes there is a need to do something, but it is not so important 509 $w = AnyEvent->idle (cb => <callback>);
461to do it instantly, but only when there is nothing better to do. This
462"nothing better to do" is usually defined to be "no other events need
463attention by the event loop".
464 510
465Idle watchers ideally get invoked when the event loop has nothing 511Repeatedly invoke the callback after the process becomes idle, until
466better to do, just before it would block the process to wait for new 512either the watcher is destroyed or new events have been detected.
467events. Instead of blocking, the idle watcher is invoked.
468 513
469Most event loops unfortunately do not really support idle watchers (only 514Idle watchers are useful when there is a need to do something, but it
515is not so important (or wise) to do it instantly. The callback will be
516invoked only when there is "nothing better to do", which is usually
517defined as "all outstanding events have been handled and no new events
518have been detected". That means that idle watchers ideally get invoked
519when the event loop has just polled for new events but none have been
520detected. Instead of blocking to wait for more events, the idle watchers
521will be invoked.
522
523Unfortunately, most event loops do not really support idle watchers (only
470EV, Event and Glib do it in a usable fashion) - for the rest, AnyEvent 524EV, Event and Glib do it in a usable fashion) - for the rest, AnyEvent
471will simply call the callback "from time to time". 525will simply call the callback "from time to time".
472 526
473Example: read lines from STDIN, but only process them when the 527Example: read lines from STDIN, but only process them when the
474program is otherwise idle: 528program is otherwise idle:
490 }); 544 });
491 }); 545 });
492 546
493=head2 CONDITION VARIABLES 547=head2 CONDITION VARIABLES
494 548
549 $cv = AnyEvent->condvar;
550
551 $cv->send (<list>);
552 my @res = $cv->recv;
553
495If you are familiar with some event loops you will know that all of them 554If you are familiar with some event loops you will know that all of them
496require you to run some blocking "loop", "run" or similar function that 555require you to run some blocking "loop", "run" or similar function that
497will actively watch for new events and call your callbacks. 556will actively watch for new events and call your callbacks.
498 557
499AnyEvent is slightly different: it expects somebody else to run the event 558AnyEvent is slightly different: it expects somebody else to run the event
550eventually calls C<< -> send >>, and the "consumer side", which waits 609eventually calls C<< -> send >>, and the "consumer side", which waits
551for the send to occur. 610for the send to occur.
552 611
553Example: wait for a timer. 612Example: wait for a timer.
554 613
555 # wait till the result is ready 614 # condition: "wait till the timer is fired"
556 my $result_ready = AnyEvent->condvar; 615 my $timer_fired = AnyEvent->condvar;
557 616
558 # do something such as adding a timer 617 # create the timer - we could wait for, say
559 # or socket watcher the calls $result_ready->send 618 # a handle becomign ready, or even an
560 # when the "result" is ready. 619 # AnyEvent::HTTP request to finish, but
561 # in this case, we simply use a timer: 620 # in this case, we simply use a timer:
562 my $w = AnyEvent->timer ( 621 my $w = AnyEvent->timer (
563 after => 1, 622 after => 1,
564 cb => sub { $result_ready->send }, 623 cb => sub { $timer_fired->send },
565 ); 624 );
566 625
567 # this "blocks" (while handling events) till the callback 626 # this "blocks" (while handling events) till the callback
568 # calls -<send 627 # calls ->send
569 $result_ready->recv; 628 $timer_fired->recv;
570 629
571Example: wait for a timer, but take advantage of the fact that condition 630Example: wait for a timer, but take advantage of the fact that condition
572variables are also callable directly. 631variables are also callable directly.
573 632
574 my $done = AnyEvent->condvar; 633 my $done = AnyEvent->condvar;
637one. For example, a function that pings many hosts in parallel might want 696one. For example, a function that pings many hosts in parallel might want
638to use a condition variable for the whole process. 697to use a condition variable for the whole process.
639 698
640Every call to C<< ->begin >> will increment a counter, and every call to 699Every call to C<< ->begin >> will increment a counter, and every call to
641C<< ->end >> will decrement it. If the counter reaches C<0> in C<< ->end 700C<< ->end >> will decrement it. If the counter reaches C<0> in C<< ->end
642>>, the (last) callback passed to C<begin> will be executed. That callback 701>>, the (last) callback passed to C<begin> will be executed, passing the
643is I<supposed> to call C<< ->send >>, but that is not required. If no 702condvar as first argument. That callback is I<supposed> to call C<< ->send
644callback was set, C<send> will be called without any arguments. 703>>, but that is not required. If no group callback was set, C<send> will
704be called without any arguments.
645 705
646You can think of C<< $cv->send >> giving you an OR condition (one call 706You can think of C<< $cv->send >> giving you an OR condition (one call
647sends), while C<< $cv->begin >> and C<< $cv->end >> giving you an AND 707sends), while C<< $cv->begin >> and C<< $cv->end >> giving you an AND
648condition (all C<begin> calls must be C<end>'ed before the condvar sends). 708condition (all C<begin> calls must be C<end>'ed before the condvar sends).
649 709
676begung can potentially be zero: 736begung can potentially be zero:
677 737
678 my $cv = AnyEvent->condvar; 738 my $cv = AnyEvent->condvar;
679 739
680 my %result; 740 my %result;
681 $cv->begin (sub { $cv->send (\%result) }); 741 $cv->begin (sub { shift->send (\%result) });
682 742
683 for my $host (@list_of_hosts) { 743 for my $host (@list_of_hosts) {
684 $cv->begin; 744 $cv->begin;
685 ping_host_then_call_callback $host, sub { 745 ping_host_then_call_callback $host, sub {
686 $result{$host} = ...; 746 $result{$host} = ...;
761=item $cb = $cv->cb ($cb->($cv)) 821=item $cb = $cv->cb ($cb->($cv))
762 822
763This is a mutator function that returns the callback set and optionally 823This is a mutator function that returns the callback set and optionally
764replaces it before doing so. 824replaces it before doing so.
765 825
766The callback will be called when the condition becomes "true", i.e. when 826The callback will be called when the condition becomes (or already was)
767C<send> or C<croak> are called, with the only argument being the condition 827"true", i.e. when C<send> or C<croak> are called (or were called), with
768variable itself. Calling C<recv> inside the callback or at any later time 828the only argument being the condition variable itself. Calling C<recv>
769is guaranteed not to block. 829inside the callback or at any later time is guaranteed not to block.
770 830
771=back 831=back
772 832
773=head1 SUPPORTED EVENT LOOPS/BACKENDS 833=head1 SUPPORTED EVENT LOOPS/BACKENDS
774 834
777=over 4 837=over 4
778 838
779=item Backends that are autoprobed when no other event loop can be found. 839=item Backends that are autoprobed when no other event loop can be found.
780 840
781EV is the preferred backend when no other event loop seems to be in 841EV is the preferred backend when no other event loop seems to be in
782use. If EV is not installed, then AnyEvent will try Event, and, failing 842use. If EV is not installed, then AnyEvent will fall back to its own
783that, will fall back to its own pure-perl implementation, which is 843pure-perl implementation, which is available everywhere as it comes with
784available everywhere as it comes with AnyEvent itself. 844AnyEvent itself.
785 845
786 AnyEvent::Impl::EV based on EV (interface to libev, best choice). 846 AnyEvent::Impl::EV based on EV (interface to libev, best choice).
787 AnyEvent::Impl::Event based on Event, very stable, few glitches.
788 AnyEvent::Impl::Perl pure-perl implementation, fast and portable. 847 AnyEvent::Impl::Perl pure-perl implementation, fast and portable.
789 848
790=item Backends that are transparently being picked up when they are used. 849=item Backends that are transparently being picked up when they are used.
791 850
792These will be used when they are currently loaded when the first watcher 851These will be used when they are currently loaded when the first watcher
793is created, in which case it is assumed that the application is using 852is created, in which case it is assumed that the application is using
794them. This means that AnyEvent will automatically pick the right backend 853them. This means that AnyEvent will automatically pick the right backend
795when the main program loads an event module before anything starts to 854when the main program loads an event module before anything starts to
796create watchers. Nothing special needs to be done by the main program. 855create watchers. Nothing special needs to be done by the main program.
797 856
857 AnyEvent::Impl::Event based on Event, very stable, few glitches.
798 AnyEvent::Impl::Glib based on Glib, slow but very stable. 858 AnyEvent::Impl::Glib based on Glib, slow but very stable.
799 AnyEvent::Impl::Tk based on Tk, very broken. 859 AnyEvent::Impl::Tk based on Tk, very broken.
800 AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse. 860 AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse.
801 AnyEvent::Impl::POE based on POE, very slow, some limitations. 861 AnyEvent::Impl::POE based on POE, very slow, some limitations.
802 AnyEvent::Impl::Irssi used when running within irssi. 862 AnyEvent::Impl::Irssi used when running within irssi.
912You should check C<$AnyEvent::MODEL> before adding to this array, though: 972You should check C<$AnyEvent::MODEL> before adding to this array, though:
913if it is defined then the event loop has already been detected, and the 973if it is defined then the event loop has already been detected, and the
914array will be ignored. 974array will be ignored.
915 975
916Best use C<AnyEvent::post_detect { BLOCK }> when your application allows 976Best use C<AnyEvent::post_detect { BLOCK }> when your application allows
917it,as it takes care of these details. 977it, as it takes care of these details.
918 978
919This variable is mainly useful for modules that can do something useful 979This variable is mainly useful for modules that can do something useful
920when AnyEvent is used and thus want to know when it is initialised, but do 980when AnyEvent is used and thus want to know when it is initialised, but do
921not need to even load it by default. This array provides the means to hook 981not need to even load it by default. This array provides the means to hook
922into AnyEvent passively, without loading it. 982into AnyEvent passively, without loading it.
983
984Example: To load Coro::AnyEvent whenever Coro and AnyEvent are used
985together, you could put this into Coro (this is the actual code used by
986Coro to accomplish this):
987
988 if (defined $AnyEvent::MODEL) {
989 # AnyEvent already initialised, so load Coro::AnyEvent
990 require Coro::AnyEvent;
991 } else {
992 # AnyEvent not yet initialised, so make sure to load Coro::AnyEvent
993 # as soon as it is
994 push @AnyEvent::post_detect, sub { require Coro::AnyEvent };
995 }
923 996
924=back 997=back
925 998
926=head1 WHAT TO DO IN A MODULE 999=head1 WHAT TO DO IN A MODULE
927 1000
1076 1149
1077package AnyEvent; 1150package AnyEvent;
1078 1151
1079# basically a tuned-down version of common::sense 1152# basically a tuned-down version of common::sense
1080sub common_sense { 1153sub common_sense {
1081 # no warnings 1154 # from common:.sense 1.0
1082 ${^WARNING_BITS} ^= ${^WARNING_BITS}; 1155 ${^WARNING_BITS} = "\xfc\x3f\x33\x00\x0f\xf3\xcf\xc0\xf3\xfc\x33\x00";
1083 # use strict vars subs 1156 # use strict vars subs - NO UTF-8, as Util.pm doesn't like this atm. (uts46data.pl)
1084 $^H |= 0x00000600; 1157 $^H |= 0x00000600;
1085} 1158}
1086 1159
1087BEGIN { AnyEvent::common_sense } 1160BEGIN { AnyEvent::common_sense }
1088 1161
1089use Carp (); 1162use Carp ();
1090 1163
1091our $VERSION = 4.881; 1164our $VERSION = '5.26';
1092our $MODEL; 1165our $MODEL;
1093 1166
1094our $AUTOLOAD; 1167our $AUTOLOAD;
1095our @ISA; 1168our @ISA;
1096 1169
1097our @REGISTRY; 1170our @REGISTRY;
1098 1171
1099our $WIN32;
1100
1101our $VERBOSE; 1172our $VERBOSE;
1102 1173
1103BEGIN { 1174BEGIN {
1104 eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }"; 1175 require "AnyEvent/constants.pl";
1176
1105 eval "sub TAINT(){ " . (${^TAINT}*1) . " }"; 1177 eval "sub TAINT (){" . (${^TAINT}*1) . "}";
1106 1178
1107 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV} 1179 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
1108 if ${^TAINT}; 1180 if ${^TAINT};
1109 1181
1110 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1; 1182 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;
1122 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6"; 1194 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6";
1123} 1195}
1124 1196
1125my @models = ( 1197my @models = (
1126 [EV:: => AnyEvent::Impl::EV:: , 1], 1198 [EV:: => AnyEvent::Impl::EV:: , 1],
1127 [Event:: => AnyEvent::Impl::Event::, 1],
1128 [AnyEvent::Impl::Perl:: => AnyEvent::Impl::Perl:: , 1], 1199 [AnyEvent::Impl::Perl:: => AnyEvent::Impl::Perl:: , 1],
1129 # everything below here will not (normally) be autoprobed 1200 # everything below here will not (normally) be autoprobed
1130 # as the pureperl backend should work everywhere 1201 # as the pureperl backend should work everywhere
1131 # and is usually faster 1202 # and is usually faster
1203 [Event:: => AnyEvent::Impl::Event::, 1],
1132 [Glib:: => AnyEvent::Impl::Glib:: , 1], # becomes extremely slow with many watchers 1204 [Glib:: => AnyEvent::Impl::Glib:: , 1], # becomes extremely slow with many watchers
1133 [Event::Lib:: => AnyEvent::Impl::EventLib::], # too buggy 1205 [Event::Lib:: => AnyEvent::Impl::EventLib::], # too buggy
1134 [Irssi:: => AnyEvent::Impl::Irssi::], # Irssi has a bogus "Event" package 1206 [Irssi:: => AnyEvent::Impl::Irssi::], # Irssi has a bogus "Event" package
1135 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles 1207 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles
1136 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program 1208 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program
1139 [Prima:: => AnyEvent::Impl::POE::], 1211 [Prima:: => AnyEvent::Impl::POE::],
1140 # IO::Async is just too broken - we would need workarounds for its 1212 # IO::Async is just too broken - we would need workarounds for its
1141 # byzantine signal and broken child handling, among others. 1213 # byzantine signal and broken child handling, among others.
1142 # IO::Async is rather hard to detect, as it doesn't have any 1214 # IO::Async is rather hard to detect, as it doesn't have any
1143 # obvious default class. 1215 # obvious default class.
1144# [0, IO::Async:: => AnyEvent::Impl::IOAsync::], # requires special main program 1216 [IO::Async:: => AnyEvent::Impl::IOAsync::], # requires special main program
1145# [0, IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program 1217 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program
1146# [0, IO::Async::Notifier:: => AnyEvent::Impl::IOAsync::], # requires special main program 1218 [IO::Async::Notifier:: => AnyEvent::Impl::IOAsync::], # requires special main program
1219 [AnyEvent::Impl::IOAsync:: => AnyEvent::Impl::IOAsync::], # requires special main program
1147); 1220);
1148 1221
1149our %method = map +($_ => 1), 1222our %method = map +($_ => 1),
1150 qw(io timer time now now_update signal child idle condvar one_event DESTROY); 1223 qw(io timer time now now_update signal child idle condvar one_event DESTROY);
1151 1224
1152our @post_detect; 1225our @post_detect;
1153 1226
1154sub post_detect(&) { 1227sub post_detect(&) {
1155 my ($cb) = @_; 1228 my ($cb) = @_;
1156 1229
1157 if ($MODEL) {
1158 $cb->();
1159
1160 undef
1161 } else {
1162 push @post_detect, $cb; 1230 push @post_detect, $cb;
1163 1231
1164 defined wantarray 1232 defined wantarray
1165 ? bless \$cb, "AnyEvent::Util::postdetect" 1233 ? bless \$cb, "AnyEvent::Util::postdetect"
1166 : () 1234 : ()
1167 }
1168} 1235}
1169 1236
1170sub AnyEvent::Util::postdetect::DESTROY { 1237sub AnyEvent::Util::postdetect::DESTROY {
1171 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1238 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1172} 1239}
1173 1240
1174sub detect() { 1241sub detect() {
1242 # free some memory
1243 *detect = sub () { $MODEL };
1244
1245 local $!; # for good measure
1246 local $SIG{__DIE__};
1247
1248 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {
1249 my $model = "AnyEvent::Impl::$1";
1250 if (eval "require $model") {
1251 $MODEL = $model;
1252 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;
1253 } else {
1254 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;
1255 }
1256 }
1257
1258 # check for already loaded models
1175 unless ($MODEL) { 1259 unless ($MODEL) {
1176 local $SIG{__DIE__}; 1260 for (@REGISTRY, @models) {
1177 1261 my ($package, $model) = @$_;
1178 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1262 if (${"$package\::VERSION"} > 0) {
1179 my $model = "AnyEvent::Impl::$1";
1180 if (eval "require $model") { 1263 if (eval "require $model") {
1181 $MODEL = $model; 1264 $MODEL = $model;
1182 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2; 1265 warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;
1183 } else { 1266 last;
1184 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE; 1267 }
1185 } 1268 }
1186 } 1269 }
1187 1270
1188 # check for already loaded models
1189 unless ($MODEL) { 1271 unless ($MODEL) {
1272 # try to autoload a model
1190 for (@REGISTRY, @models) { 1273 for (@REGISTRY, @models) {
1191 my ($package, $model) = @$_; 1274 my ($package, $model, $autoload) = @$_;
1275 if (
1276 $autoload
1277 and eval "require $package"
1192 if (${"$package\::VERSION"} > 0) { 1278 and ${"$package\::VERSION"} > 0
1193 if (eval "require $model") { 1279 and eval "require $model"
1280 ) {
1194 $MODEL = $model; 1281 $MODEL = $model;
1195 warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2; 1282 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1196 last; 1283 last;
1197 }
1198 } 1284 }
1199 } 1285 }
1200 1286
1201 unless ($MODEL) {
1202 # try to autoload a model
1203 for (@REGISTRY, @models) {
1204 my ($package, $model, $autoload) = @$_;
1205 if (
1206 $autoload
1207 and eval "require $package"
1208 and ${"$package\::VERSION"} > 0
1209 and eval "require $model"
1210 ) {
1211 $MODEL = $model;
1212 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1213 last;
1214 }
1215 }
1216
1217 $MODEL 1287 $MODEL
1218 or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n"; 1288 or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n";
1219 }
1220 } 1289 }
1221
1222 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1223
1224 unshift @ISA, $MODEL;
1225
1226 require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
1227
1228 (shift @post_detect)->() while @post_detect;
1229 } 1290 }
1291
1292 @models = (); # free probe data
1293
1294 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
1295 unshift @ISA, $MODEL;
1296
1297 # now nuke some methods that are overriden by the backend.
1298 # SUPER is not allowed.
1299 for (qw(time signal child idle)) {
1300 undef &{"AnyEvent::Base::$_"}
1301 if defined &{"$MODEL\::$_"};
1302 }
1303
1304 require AnyEvent::Strict if $ENV{PERL_ANYEVENT_STRICT};
1305
1306 (shift @post_detect)->() while @post_detect;
1307
1308 *post_detect = sub(&) {
1309 shift->();
1310
1311 undef
1312 };
1230 1313
1231 $MODEL 1314 $MODEL
1232} 1315}
1233 1316
1234sub AUTOLOAD { 1317sub AUTOLOAD {
1235 (my $func = $AUTOLOAD) =~ s/.*://; 1318 (my $func = $AUTOLOAD) =~ s/.*://;
1236 1319
1237 $method{$func} 1320 $method{$func}
1238 or Carp::croak "$func: not a valid method for AnyEvent objects"; 1321 or Carp::croak "$func: not a valid AnyEvent class method";
1239 1322
1240 detect unless $MODEL; 1323 detect;
1241 1324
1242 my $class = shift; 1325 my $class = shift;
1243 $class->$func (@_); 1326 $class->$func (@_);
1244} 1327}
1245 1328
1258 # we assume CLOEXEC is already set by perl in all important cases 1341 # we assume CLOEXEC is already set by perl in all important cases
1259 1342
1260 ($fh2, $rw) 1343 ($fh2, $rw)
1261} 1344}
1262 1345
1346=head1 SIMPLIFIED AE API
1347
1348Starting with version 5.0, AnyEvent officially supports a second, much
1349simpler, API that is designed to reduce the calling, typing and memory
1350overhead by using function call syntax and a fixed number of parameters.
1351
1352See the L<AE> manpage for details.
1353
1354=cut
1355
1356package AE;
1357
1358our $VERSION = $AnyEvent::VERSION;
1359
1360# fall back to the main API by default - backends and AnyEvent::Base
1361# implementations can overwrite these.
1362
1363sub io($$$) {
1364 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1365}
1366
1367sub timer($$$) {
1368 AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2])
1369}
1370
1371sub signal($$) {
1372 AnyEvent->signal (signal => $_[0], cb => $_[1])
1373}
1374
1375sub child($$) {
1376 AnyEvent->child (pid => $_[0], cb => $_[1])
1377}
1378
1379sub idle($) {
1380 AnyEvent->idle (cb => $_[0])
1381}
1382
1383sub cv(;&) {
1384 AnyEvent->condvar (@_ ? (cb => $_[0]) : ())
1385}
1386
1387sub now() {
1388 AnyEvent->now
1389}
1390
1391sub now_update() {
1392 AnyEvent->now_update
1393}
1394
1395sub time() {
1396 AnyEvent->time
1397}
1398
1263package AnyEvent::Base; 1399package AnyEvent::Base;
1264 1400
1265# default implementations for many methods 1401# default implementations for many methods
1266 1402
1267sub _time { 1403sub time {
1404 eval q{ # poor man's autoloading {}
1268 # probe for availability of Time::HiRes 1405 # probe for availability of Time::HiRes
1269 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") { 1406 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1270 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8; 1407 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;
1271 *_time = \&Time::HiRes::time; 1408 *AE::time = \&Time::HiRes::time;
1272 # if (eval "use POSIX (); (POSIX::times())... 1409 # if (eval "use POSIX (); (POSIX::times())...
1273 } else { 1410 } else {
1274 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE; 1411 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;
1275 *_time = sub { time }; # epic fail 1412 *AE::time = sub (){ time }; # epic fail
1413 }
1414
1415 *time = sub { AE::time }; # different prototypes
1276 } 1416 };
1417 die if $@;
1277 1418
1278 &_time 1419 &time
1279} 1420}
1280 1421
1281sub time { _time } 1422*now = \&time;
1282sub now { _time } 1423
1283sub now_update { } 1424sub now_update { }
1284 1425
1285# default implementation for ->condvar 1426# default implementation for ->condvar
1286 1427
1287sub condvar { 1428sub condvar {
1429 eval q{ # poor man's autoloading {}
1430 *condvar = sub {
1288 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar" 1431 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
1432 };
1433
1434 *AE::cv = sub (;&) {
1435 bless { @_ ? (_ae_cb => shift) : () }, "AnyEvent::CondVar"
1436 };
1437 };
1438 die if $@;
1439
1440 &condvar
1289} 1441}
1290 1442
1291# default implementation for ->signal 1443# default implementation for ->signal
1292 1444
1293our $HAVE_ASYNC_INTERRUPT; 1445our $HAVE_ASYNC_INTERRUPT;
1294 1446
1295sub _have_async_interrupt() { 1447sub _have_async_interrupt() {
1296 $HAVE_ASYNC_INTERRUPT = 1*(!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} 1448 $HAVE_ASYNC_INTERRUPT = 1*(!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT}
1297 && eval "use Async::Interrupt 1.0 (); 1") 1449 && eval "use Async::Interrupt 1.02 (); 1")
1298 unless defined $HAVE_ASYNC_INTERRUPT; 1450 unless defined $HAVE_ASYNC_INTERRUPT;
1299 1451
1300 $HAVE_ASYNC_INTERRUPT 1452 $HAVE_ASYNC_INTERRUPT
1301} 1453}
1302 1454
1303our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1455our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1304our (%SIG_ASY, %SIG_ASY_W); 1456our (%SIG_ASY, %SIG_ASY_W);
1305our ($SIG_COUNT, $SIG_TW); 1457our ($SIG_COUNT, $SIG_TW);
1306 1458
1307sub _signal_exec {
1308 $HAVE_ASYNC_INTERRUPT
1309 ? $SIGPIPE_R->drain
1310 : sysread $SIGPIPE_R, my $dummy, 9;
1311
1312 while (%SIG_EV) {
1313 for (keys %SIG_EV) {
1314 delete $SIG_EV{$_};
1315 $_->() for values %{ $SIG_CB{$_} || {} };
1316 }
1317 }
1318}
1319
1320# install a dummy wakeup watcher to reduce signal catching latency 1459# install a dummy wakeup watcher to reduce signal catching latency
1460# used by Impls
1321sub _sig_add() { 1461sub _sig_add() {
1322 unless ($SIG_COUNT++) { 1462 unless ($SIG_COUNT++) {
1323 # try to align timer on a full-second boundary, if possible 1463 # try to align timer on a full-second boundary, if possible
1324 my $NOW = AnyEvent->now; 1464 my $NOW = AE::now;
1325 1465
1326 $SIG_TW = AnyEvent->timer ( 1466 $SIG_TW = AE::timer
1327 after => $MAX_SIGNAL_LATENCY - ($NOW - int $NOW), 1467 $MAX_SIGNAL_LATENCY - ($NOW - int $NOW),
1328 interval => $MAX_SIGNAL_LATENCY, 1468 $MAX_SIGNAL_LATENCY,
1329 cb => sub { }, # just for the PERL_ASYNC_CHECK 1469 sub { } # just for the PERL_ASYNC_CHECK
1330 ); 1470 ;
1331 } 1471 }
1332} 1472}
1333 1473
1334sub _sig_del { 1474sub _sig_del {
1335 undef $SIG_TW 1475 undef $SIG_TW
1336 unless --$SIG_COUNT; 1476 unless --$SIG_COUNT;
1337} 1477}
1338 1478
1339our $_sig_name_init; $_sig_name_init = sub { 1479our $_sig_name_init; $_sig_name_init = sub {
1480 eval q{ # poor man's autoloading {}
1340 undef $_sig_name_init; 1481 undef $_sig_name_init;
1341 1482
1342 if (_have_async_interrupt) { 1483 if (_have_async_interrupt) {
1343 *sig2num = \&Async::Interrupt::sig2num; 1484 *sig2num = \&Async::Interrupt::sig2num;
1344 *sig2name = \&Async::Interrupt::sig2name; 1485 *sig2name = \&Async::Interrupt::sig2name;
1345 } else { 1486 } else {
1346 require Config; 1487 require Config;
1347 1488
1348 my %signame2num; 1489 my %signame2num;
1349 @signame2num{ split ' ', $Config::Config{sig_name} } 1490 @signame2num{ split ' ', $Config::Config{sig_name} }
1350 = split ' ', $Config::Config{sig_num}; 1491 = split ' ', $Config::Config{sig_num};
1351 1492
1352 my @signum2name; 1493 my @signum2name;
1353 @signum2name[values %signame2num] = keys %signame2num; 1494 @signum2name[values %signame2num] = keys %signame2num;
1354 1495
1355 *sig2num = sub($) { 1496 *sig2num = sub($) {
1356 $_[0] > 0 ? shift : $signame2num{+shift} 1497 $_[0] > 0 ? shift : $signame2num{+shift}
1357 }; 1498 };
1358 *sig2name = sub ($) { 1499 *sig2name = sub ($) {
1359 $_[0] > 0 ? $signum2name[+shift] : shift 1500 $_[0] > 0 ? $signum2name[+shift] : shift
1501 };
1360 }; 1502 }
1361 } 1503 };
1504 die if $@;
1362}; 1505};
1363 1506
1364sub sig2num ($) { &$_sig_name_init; &sig2num } 1507sub sig2num ($) { &$_sig_name_init; &sig2num }
1365sub sig2name($) { &$_sig_name_init; &sig2name } 1508sub sig2name($) { &$_sig_name_init; &sig2name }
1366 1509
1367sub _signal { 1510sub signal {
1511 eval q{ # poor man's autoloading {}
1512 # probe for availability of Async::Interrupt
1513 if (_have_async_interrupt) {
1514 warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8;
1515
1516 $SIGPIPE_R = new Async::Interrupt::EventPipe;
1517 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1518
1519 } else {
1520 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1521
1522 if (AnyEvent::WIN32) {
1523 require AnyEvent::Util;
1524
1525 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1526 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1527 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W, 1) if $SIGPIPE_W; # just in case
1528 } else {
1529 pipe $SIGPIPE_R, $SIGPIPE_W;
1530 fcntl $SIGPIPE_R, AnyEvent::F_SETFL, AnyEvent::O_NONBLOCK if $SIGPIPE_R;
1531 fcntl $SIGPIPE_W, AnyEvent::F_SETFL, AnyEvent::O_NONBLOCK if $SIGPIPE_W; # just in case
1532
1533 # not strictly required, as $^F is normally 2, but let's make sure...
1534 fcntl $SIGPIPE_R, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1535 fcntl $SIGPIPE_W, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC;
1536 }
1537
1538 $SIGPIPE_R
1539 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1540
1541 $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec;
1542 }
1543
1544 *signal = $HAVE_ASYNC_INTERRUPT
1545 ? sub {
1368 my (undef, %arg) = @_; 1546 my (undef, %arg) = @_;
1369 1547
1370 my $signal = uc $arg{signal}
1371 or Carp::croak "required option 'signal' is missing";
1372
1373 if ($HAVE_ASYNC_INTERRUPT) {
1374 # async::interrupt 1548 # async::interrupt
1375
1376 $signal = sig2num $signal; 1549 my $signal = sig2num $arg{signal};
1377 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1550 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1378 1551
1379 $SIG_ASY{$signal} ||= new Async::Interrupt 1552 $SIG_ASY{$signal} ||= new Async::Interrupt
1380 cb => sub { undef $SIG_EV{$signal} }, 1553 cb => sub { undef $SIG_EV{$signal} },
1381 signal => $signal, 1554 signal => $signal,
1382 pipe => [$SIGPIPE_R->filenos], 1555 pipe => [$SIGPIPE_R->filenos],
1383 pipe_autodrain => 0, 1556 pipe_autodrain => 0,
1557 ;
1558
1559 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1560 }
1561 : sub {
1562 my (undef, %arg) = @_;
1563
1564 # pure perl
1565 my $signal = sig2name $arg{signal};
1566 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1567
1568 $SIG{$signal} ||= sub {
1569 local $!;
1570 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1571 undef $SIG_EV{$signal};
1572 };
1573
1574 # can't do signal processing without introducing races in pure perl,
1575 # so limit the signal latency.
1576 _sig_add;
1577
1578 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1579 }
1384 ; 1580 ;
1385 1581
1386 } else { 1582 *AnyEvent::Base::signal::DESTROY = sub {
1387 # pure perl 1583 my ($signal, $cb) = @{$_[0]};
1388 1584
1389 # AE::Util has been loaded in signal 1585 _sig_del;
1390 $signal = sig2name $signal;
1391 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1392 1586
1393 $SIG{$signal} ||= sub { 1587 delete $SIG_CB{$signal}{$cb};
1394 local $!; 1588
1395 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; 1589 $HAVE_ASYNC_INTERRUPT
1590 ? delete $SIG_ASY{$signal}
1591 : # delete doesn't work with older perls - they then
1592 # print weird messages, or just unconditionally exit
1593 # instead of getting the default action.
1396 undef $SIG_EV{$signal}; 1594 undef $SIG{$signal}
1595 unless keys %{ $SIG_CB{$signal} };
1397 }; 1596 };
1398 1597
1399 # can't do signal processing without introducing races in pure perl, 1598 *_signal_exec = sub {
1400 # so limit the signal latency. 1599 $HAVE_ASYNC_INTERRUPT
1401 _sig_add; 1600 ? $SIGPIPE_R->drain
1402 } 1601 : sysread $SIGPIPE_R, (my $dummy), 9;
1403 1602
1404 bless [$signal, $arg{cb}], "AnyEvent::Base::signal" 1603 while (%SIG_EV) {
1405} 1604 for (keys %SIG_EV) {
1406 1605 delete $SIG_EV{$_};
1407sub signal { 1606 $_->() for values %{ $SIG_CB{$_} || {} };
1408 # probe for availability of Async::Interrupt 1607 }
1409 if (_have_async_interrupt) { 1608 }
1410 warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8;
1411
1412 $SIGPIPE_R = new Async::Interrupt::EventPipe;
1413 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec);
1414
1415 } else {
1416 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1417
1418 require Fcntl;
1419
1420 if (AnyEvent::WIN32) {
1421 require AnyEvent::Util;
1422
1423 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1424 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R) if $SIGPIPE_R;
1425 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case
1426 } else {
1427 pipe $SIGPIPE_R, $SIGPIPE_W;
1428 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;
1429 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case
1430
1431 # not strictly required, as $^F is normally 2, but let's make sure...
1432 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1433 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1434 } 1609 };
1435
1436 $SIGPIPE_R
1437 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1438
1439 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1440 } 1610 };
1611 die if $@;
1441 1612
1442 *signal = \&_signal;
1443 &signal 1613 &signal
1444}
1445
1446sub AnyEvent::Base::signal::DESTROY {
1447 my ($signal, $cb) = @{$_[0]};
1448
1449 _sig_del;
1450
1451 delete $SIG_CB{$signal}{$cb};
1452
1453 $HAVE_ASYNC_INTERRUPT
1454 ? delete $SIG_ASY{$signal}
1455 : # delete doesn't work with older perls - they then
1456 # print weird messages, or just unconditionally exit
1457 # instead of getting the default action.
1458 undef $SIG{$signal}
1459 unless keys %{ $SIG_CB{$signal} };
1460} 1614}
1461 1615
1462# default implementation for ->child 1616# default implementation for ->child
1463 1617
1464our %PID_CB; 1618our %PID_CB;
1465our $CHLD_W; 1619our $CHLD_W;
1466our $CHLD_DELAY_W; 1620our $CHLD_DELAY_W;
1467our $WNOHANG; 1621our $WNOHANG;
1468 1622
1623# used by many Impl's
1469sub _emit_childstatus($$) { 1624sub _emit_childstatus($$) {
1470 my (undef, $rpid, $rstatus) = @_; 1625 my (undef, $rpid, $rstatus) = @_;
1471 1626
1472 $_->($rpid, $rstatus) 1627 $_->($rpid, $rstatus)
1473 for values %{ $PID_CB{$rpid} || {} }, 1628 for values %{ $PID_CB{$rpid} || {} },
1474 values %{ $PID_CB{0} || {} }; 1629 values %{ $PID_CB{0} || {} };
1475} 1630}
1476 1631
1477sub _sigchld {
1478 my $pid;
1479
1480 AnyEvent->_emit_childstatus ($pid, $?)
1481 while ($pid = waitpid -1, $WNOHANG) > 0;
1482}
1483
1484sub child { 1632sub child {
1633 eval q{ # poor man's autoloading {}
1634 *_sigchld = sub {
1635 my $pid;
1636
1637 AnyEvent->_emit_childstatus ($pid, $?)
1638 while ($pid = waitpid -1, $WNOHANG) > 0;
1639 };
1640
1641 *child = sub {
1485 my (undef, %arg) = @_; 1642 my (undef, %arg) = @_;
1486 1643
1487 defined (my $pid = $arg{pid} + 0) 1644 defined (my $pid = $arg{pid} + 0)
1488 or Carp::croak "required option 'pid' is missing"; 1645 or Carp::croak "required option 'pid' is missing";
1489 1646
1490 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1647 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1491 1648
1492 # WNOHANG is almost cetrainly 1 everywhere 1649 # WNOHANG is almost cetrainly 1 everywhere
1493 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/ 1650 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1494 ? 1 1651 ? 1
1495 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1652 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1496 1653
1497 unless ($CHLD_W) { 1654 unless ($CHLD_W) {
1498 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1655 $CHLD_W = AE::signal CHLD => \&_sigchld;
1499 # child could be a zombie already, so make at least one round 1656 # child could be a zombie already, so make at least one round
1500 &_sigchld; 1657 &_sigchld;
1501 } 1658 }
1502 1659
1503 bless [$pid, $arg{cb}], "AnyEvent::Base::child" 1660 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1504} 1661 };
1505 1662
1506sub AnyEvent::Base::child::DESTROY { 1663 *AnyEvent::Base::child::DESTROY = sub {
1507 my ($pid, $cb) = @{$_[0]}; 1664 my ($pid, $cb) = @{$_[0]};
1508 1665
1509 delete $PID_CB{$pid}{$cb}; 1666 delete $PID_CB{$pid}{$cb};
1510 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; 1667 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1511 1668
1512 undef $CHLD_W unless keys %PID_CB; 1669 undef $CHLD_W unless keys %PID_CB;
1670 };
1671 };
1672 die if $@;
1673
1674 &child
1513} 1675}
1514 1676
1515# idle emulation is done by simply using a timer, regardless 1677# idle emulation is done by simply using a timer, regardless
1516# of whether the process is idle or not, and not letting 1678# of whether the process is idle or not, and not letting
1517# the callback use more than 50% of the time. 1679# the callback use more than 50% of the time.
1518sub idle { 1680sub idle {
1681 eval q{ # poor man's autoloading {}
1682 *idle = sub {
1519 my (undef, %arg) = @_; 1683 my (undef, %arg) = @_;
1520 1684
1521 my ($cb, $w, $rcb) = $arg{cb}; 1685 my ($cb, $w, $rcb) = $arg{cb};
1522 1686
1523 $rcb = sub { 1687 $rcb = sub {
1524 if ($cb) { 1688 if ($cb) {
1525 $w = _time; 1689 $w = _time;
1526 &$cb; 1690 &$cb;
1527 $w = _time - $w; 1691 $w = _time - $w;
1528 1692
1529 # never use more then 50% of the time for the idle watcher, 1693 # never use more then 50% of the time for the idle watcher,
1530 # within some limits 1694 # within some limits
1531 $w = 0.0001 if $w < 0.0001; 1695 $w = 0.0001 if $w < 0.0001;
1532 $w = 5 if $w > 5; 1696 $w = 5 if $w > 5;
1533 1697
1534 $w = AnyEvent->timer (after => $w, cb => $rcb); 1698 $w = AE::timer $w, 0, $rcb;
1535 } else { 1699 } else {
1536 # clean up... 1700 # clean up...
1537 undef $w; 1701 undef $w;
1538 undef $rcb; 1702 undef $rcb;
1703 }
1704 };
1705
1706 $w = AE::timer 0.05, 0, $rcb;
1707
1708 bless \\$cb, "AnyEvent::Base::idle"
1539 } 1709 };
1710
1711 *AnyEvent::Base::idle::DESTROY = sub {
1712 undef $${$_[0]};
1713 };
1540 }; 1714 };
1715 die if $@;
1541 1716
1542 $w = AnyEvent->timer (after => 0.05, cb => $rcb); 1717 &idle
1543
1544 bless \\$cb, "AnyEvent::Base::idle"
1545}
1546
1547sub AnyEvent::Base::idle::DESTROY {
1548 undef $${$_[0]};
1549} 1718}
1550 1719
1551package AnyEvent::CondVar; 1720package AnyEvent::CondVar;
1552 1721
1553our @ISA = AnyEvent::CondVar::Base::; 1722our @ISA = AnyEvent::CondVar::Base::;
1601 Carp::croak $_[0]{_ae_croak} if $_[0]{_ae_croak}; 1770 Carp::croak $_[0]{_ae_croak} if $_[0]{_ae_croak};
1602 wantarray ? @{ $_[0]{_ae_sent} } : $_[0]{_ae_sent}[0] 1771 wantarray ? @{ $_[0]{_ae_sent} } : $_[0]{_ae_sent}[0]
1603} 1772}
1604 1773
1605sub cb { 1774sub cb {
1606 $_[0]{_ae_cb} = $_[1] if @_ > 1; 1775 my $cv = shift;
1776
1777 @_
1778 and $cv->{_ae_cb} = shift
1779 and $cv->{_ae_sent}
1780 and (delete $cv->{_ae_cb})->($cv);
1781
1607 $_[0]{_ae_cb} 1782 $cv->{_ae_cb}
1608} 1783}
1609 1784
1610sub begin { 1785sub begin {
1611 ++$_[0]{_ae_counter}; 1786 ++$_[0]{_ae_counter};
1612 $_[0]{_ae_end_cb} = $_[1] if @_ > 1; 1787 $_[0]{_ae_end_cb} = $_[1] if @_ > 1;
1821 warn "read: $input\n"; # output what has been read 1996 warn "read: $input\n"; # output what has been read
1822 $cv->send if $input =~ /^q/i; # quit program if /^q/i 1997 $cv->send if $input =~ /^q/i; # quit program if /^q/i
1823 }, 1998 },
1824 ); 1999 );
1825 2000
1826 my $time_watcher; # can only be used once
1827
1828 sub new_timer {
1829 $timer = AnyEvent->timer (after => 1, cb => sub { 2001 my $time_watcher = AnyEvent->timer (after => 1, interval => 1, cb => sub {
1830 warn "timeout\n"; # print 'timeout' about every second 2002 warn "timeout\n"; # print 'timeout' at most every second
1831 &new_timer; # and restart the time
1832 }); 2003 });
1833 }
1834
1835 new_timer; # create first timer
1836 2004
1837 $cv->recv; # wait until user enters /^q/i 2005 $cv->recv; # wait until user enters /^q/i
1838 2006
1839=head1 REAL-WORLD EXAMPLE 2007=head1 REAL-WORLD EXAMPLE
1840 2008
1913 2081
1914The actual code goes further and collects all errors (C<die>s, exceptions) 2082The actual code goes further and collects all errors (C<die>s, exceptions)
1915that occurred during request processing. The C<result> method detects 2083that occurred during request processing. The C<result> method detects
1916whether an exception as thrown (it is stored inside the $txn object) 2084whether an exception as thrown (it is stored inside the $txn object)
1917and just throws the exception, which means connection errors and other 2085and just throws the exception, which means connection errors and other
1918problems get reported tot he code that tries to use the result, not in a 2086problems get reported to the code that tries to use the result, not in a
1919random callback. 2087random callback.
1920 2088
1921All of this enables the following usage styles: 2089All of this enables the following usage styles:
1922 2090
19231. Blocking: 20911. Blocking:
1971through AnyEvent. The benchmark creates a lot of timers (with a zero 2139through AnyEvent. The benchmark creates a lot of timers (with a zero
1972timeout) and I/O watchers (watching STDOUT, a pty, to become writable, 2140timeout) and I/O watchers (watching STDOUT, a pty, to become writable,
1973which it is), lets them fire exactly once and destroys them again. 2141which it is), lets them fire exactly once and destroys them again.
1974 2142
1975Source code for this benchmark is found as F<eg/bench> in the AnyEvent 2143Source code for this benchmark is found as F<eg/bench> in the AnyEvent
1976distribution. 2144distribution. It uses the L<AE> interface, which makes a real difference
2145for the EV and Perl backends only.
1977 2146
1978=head3 Explanation of the columns 2147=head3 Explanation of the columns
1979 2148
1980I<watcher> is the number of event watchers created/destroyed. Since 2149I<watcher> is the number of event watchers created/destroyed. Since
1981different event models feature vastly different performances, each event 2150different event models feature vastly different performances, each event
2002watcher. 2171watcher.
2003 2172
2004=head3 Results 2173=head3 Results
2005 2174
2006 name watchers bytes create invoke destroy comment 2175 name watchers bytes create invoke destroy comment
2007 EV/EV 400000 224 0.47 0.35 0.27 EV native interface 2176 EV/EV 100000 223 0.47 0.43 0.27 EV native interface
2008 EV/Any 100000 224 2.88 0.34 0.27 EV + AnyEvent watchers 2177 EV/Any 100000 223 0.48 0.42 0.26 EV + AnyEvent watchers
2009 CoroEV/Any 100000 224 2.85 0.35 0.28 coroutines + Coro::Signal 2178 Coro::EV/Any 100000 223 0.47 0.42 0.26 coroutines + Coro::Signal
2010 Perl/Any 100000 452 4.13 0.73 0.95 pure perl implementation 2179 Perl/Any 100000 431 2.70 0.74 0.92 pure perl implementation
2011 Event/Event 16000 517 32.20 31.80 0.81 Event native interface 2180 Event/Event 16000 516 31.16 31.84 0.82 Event native interface
2012 Event/Any 16000 590 35.85 31.55 1.06 Event + AnyEvent watchers 2181 Event/Any 16000 1203 42.61 34.79 1.80 Event + AnyEvent watchers
2013 IOAsync/Any 16000 989 38.10 32.77 11.13 via IO::Async::Loop::IO_Poll 2182 IOAsync/Any 16000 1911 41.92 27.45 16.81 via IO::Async::Loop::IO_Poll
2014 IOAsync/Any 16000 990 37.59 29.50 10.61 via IO::Async::Loop::Epoll 2183 IOAsync/Any 16000 1726 40.69 26.37 15.25 via IO::Async::Loop::Epoll
2015 Glib/Any 16000 1357 102.33 12.31 51.00 quadratic behaviour 2184 Glib/Any 16000 1118 89.00 12.57 51.17 quadratic behaviour
2016 Tk/Any 2000 1860 27.20 66.31 14.00 SEGV with >> 2000 watchers 2185 Tk/Any 2000 1346 20.96 10.75 8.00 SEGV with >> 2000 watchers
2017 POE/Event 2000 6328 109.99 751.67 14.02 via POE::Loop::Event 2186 POE/Any 2000 6951 108.97 795.32 14.24 via POE::Loop::Event
2018 POE/Select 2000 6027 94.54 809.13 579.80 via POE::Loop::Select 2187 POE/Any 2000 6648 94.79 774.40 575.51 via POE::Loop::Select
2019 2188
2020=head3 Discussion 2189=head3 Discussion
2021 2190
2022The benchmark does I<not> measure scalability of the event loop very 2191The benchmark does I<not> measure scalability of the event loop very
2023well. For example, a select-based event loop (such as the pure perl one) 2192well. For example, a select-based event loop (such as the pure perl one)
2035benchmark machine, handling an event takes roughly 1600 CPU cycles with 2204benchmark machine, handling an event takes roughly 1600 CPU cycles with
2036EV, 3100 CPU cycles with AnyEvent's pure perl loop and almost 3000000 CPU 2205EV, 3100 CPU cycles with AnyEvent's pure perl loop and almost 3000000 CPU
2037cycles with POE. 2206cycles with POE.
2038 2207
2039C<EV> is the sole leader regarding speed and memory use, which are both 2208C<EV> is the sole leader regarding speed and memory use, which are both
2040maximal/minimal, respectively. Even when going through AnyEvent, it uses 2209maximal/minimal, respectively. When using the L<AE> API there is zero
2210overhead (when going through the AnyEvent API create is about 5-6 times
2211slower, with other times being equal, so still uses far less memory than
2041far less memory than any other event loop and is still faster than Event 2212any other event loop and is still faster than Event natively).
2042natively.
2043 2213
2044The pure perl implementation is hit in a few sweet spots (both the 2214The pure perl implementation is hit in a few sweet spots (both the
2045constant timeout and the use of a single fd hit optimisations in the perl 2215constant timeout and the use of a single fd hit optimisations in the perl
2046interpreter and the backend itself). Nevertheless this shows that it 2216interpreter and the backend itself). Nevertheless this shows that it
2047adds very little overhead in itself. Like any select-based backend its 2217adds very little overhead in itself. Like any select-based backend its
2121In this benchmark, we use 10000 socket pairs (20000 sockets), of which 100 2291In this benchmark, we use 10000 socket pairs (20000 sockets), of which 100
2122(1%) are active. This mirrors the activity of large servers with many 2292(1%) are active. This mirrors the activity of large servers with many
2123connections, most of which are idle at any one point in time. 2293connections, most of which are idle at any one point in time.
2124 2294
2125Source code for this benchmark is found as F<eg/bench2> in the AnyEvent 2295Source code for this benchmark is found as F<eg/bench2> in the AnyEvent
2126distribution. 2296distribution. It uses the L<AE> interface, which makes a real difference
2297for the EV and Perl backends only.
2127 2298
2128=head3 Explanation of the columns 2299=head3 Explanation of the columns
2129 2300
2130I<sockets> is the number of sockets, and twice the number of "servers" (as 2301I<sockets> is the number of sockets, and twice the number of "servers" (as
2131each server has a read and write socket end). 2302each server has a read and write socket end).
2139a new one that moves the timeout into the future. 2310a new one that moves the timeout into the future.
2140 2311
2141=head3 Results 2312=head3 Results
2142 2313
2143 name sockets create request 2314 name sockets create request
2144 EV 20000 69.01 11.16 2315 EV 20000 62.66 7.99
2145 Perl 20000 73.32 35.87 2316 Perl 20000 68.32 32.64
2146 IOAsync 20000 157.00 98.14 epoll 2317 IOAsync 20000 174.06 101.15 epoll
2147 IOAsync 20000 159.31 616.06 poll 2318 IOAsync 20000 174.67 610.84 poll
2148 Event 20000 212.62 257.32 2319 Event 20000 202.69 242.91
2149 Glib 20000 651.16 1896.30 2320 Glib 20000 557.01 1689.52
2150 POE 20000 349.67 12317.24 uses POE::Loop::Event 2321 POE 20000 341.54 12086.32 uses POE::Loop::Event
2151 2322
2152=head3 Discussion 2323=head3 Discussion
2153 2324
2154This benchmark I<does> measure scalability and overall performance of the 2325This benchmark I<does> measure scalability and overall performance of the
2155particular event loop. 2326particular event loop.
2281As you can see, the AnyEvent + EV combination even beats the 2452As you can see, the AnyEvent + EV combination even beats the
2282hand-optimised "raw sockets benchmark", while AnyEvent + its pure perl 2453hand-optimised "raw sockets benchmark", while AnyEvent + its pure perl
2283backend easily beats IO::Lambda and POE. 2454backend easily beats IO::Lambda and POE.
2284 2455
2285And even the 100% non-blocking version written using the high-level (and 2456And even the 100% non-blocking version written using the high-level (and
2286slow :) L<AnyEvent::Handle> abstraction beats both POE and IO::Lambda by a 2457slow :) L<AnyEvent::Handle> abstraction beats both POE and IO::Lambda
2287large margin, even though it does all of DNS, tcp-connect and socket I/O 2458higher level ("unoptimised") abstractions by a large margin, even though
2288in a non-blocking way. 2459it does all of DNS, tcp-connect and socket I/O in a non-blocking way.
2289 2460
2290The two AnyEvent benchmarks programs can be found as F<eg/ae0.pl> and 2461The two AnyEvent benchmarks programs can be found as F<eg/ae0.pl> and
2291F<eg/ae2.pl> in the AnyEvent distribution, the remaining benchmarks are 2462F<eg/ae2.pl> in the AnyEvent distribution, the remaining benchmarks are
2292part of the IO::lambda distribution and were used without any changes. 2463part of the IO::Lambda distribution and were used without any changes.
2293 2464
2294 2465
2295=head1 SIGNALS 2466=head1 SIGNALS
2296 2467
2297AnyEvent currently installs handlers for these signals: 2468AnyEvent currently installs handlers for these signals:
2339it's built-in modules) are required to use it. 2510it's built-in modules) are required to use it.
2340 2511
2341That does not mean that AnyEvent won't take advantage of some additional 2512That does not mean that AnyEvent won't take advantage of some additional
2342modules if they are installed. 2513modules if they are installed.
2343 2514
2344This section epxlains which additional modules will be used, and how they 2515This section explains which additional modules will be used, and how they
2345affect AnyEvent's operetion. 2516affect AnyEvent's operation.
2346 2517
2347=over 4 2518=over 4
2348 2519
2349=item L<Async::Interrupt> 2520=item L<Async::Interrupt>
2350 2521
2355catch the signals) with some delay (default is 10 seconds, look for 2526catch the signals) with some delay (default is 10 seconds, look for
2356C<$AnyEvent::MAX_SIGNAL_LATENCY>). 2527C<$AnyEvent::MAX_SIGNAL_LATENCY>).
2357 2528
2358If this module is available, then it will be used to implement signal 2529If this module is available, then it will be used to implement signal
2359catching, which means that signals will not be delayed, and the event loop 2530catching, which means that signals will not be delayed, and the event loop
2360will not be interrupted regularly, which is more efficient (And good for 2531will not be interrupted regularly, which is more efficient (and good for
2361battery life on laptops). 2532battery life on laptops).
2362 2533
2363This affects not just the pure-perl event loop, but also other event loops 2534This affects not just the pure-perl event loop, but also other event loops
2364that have no signal handling on their own (e.g. Glib, Tk, Qt). 2535that have no signal handling on their own (e.g. Glib, Tk, Qt).
2365 2536
2377automatic timer adjustments even when no monotonic clock is available, 2548automatic timer adjustments even when no monotonic clock is available,
2378can take avdantage of advanced kernel interfaces such as C<epoll> and 2549can take avdantage of advanced kernel interfaces such as C<epoll> and
2379C<kqueue>, and is the fastest backend I<by far>. You can even embed 2550C<kqueue>, and is the fastest backend I<by far>. You can even embed
2380L<Glib>/L<Gtk2> in it (or vice versa, see L<EV::Glib> and L<Glib::EV>). 2551L<Glib>/L<Gtk2> in it (or vice versa, see L<EV::Glib> and L<Glib::EV>).
2381 2552
2553If you only use backends that rely on another event loop (e.g. C<Tk>),
2554then this module will do nothing for you.
2555
2382=item L<Guard> 2556=item L<Guard>
2383 2557
2384The guard module, when used, will be used to implement 2558The guard module, when used, will be used to implement
2385C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a 2559C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a
2386lot less memory), but otherwise doesn't affect guard operation much. It is 2560lot less memory), but otherwise doesn't affect guard operation much. It is
2387purely used for performance. 2561purely used for performance.
2388 2562
2389=item L<JSON> and L<JSON::XS> 2563=item L<JSON> and L<JSON::XS>
2390 2564
2391This module is required when you want to read or write JSON data via 2565One of these modules is required when you want to read or write JSON data
2392L<AnyEvent::Handle>. It is also written in pure-perl, but can take 2566via L<AnyEvent::Handle>. L<JSON> is also written in pure-perl, but can take
2393advantage of the ultra-high-speed L<JSON::XS> module when it is installed. 2567advantage of the ultra-high-speed L<JSON::XS> module when it is installed.
2394
2395In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2396installed.
2397 2568
2398=item L<Net::SSLeay> 2569=item L<Net::SSLeay>
2399 2570
2400Implementing TLS/SSL in Perl is certainly interesting, but not very 2571Implementing TLS/SSL in Perl is certainly interesting, but not very
2401worthwhile: If this module is installed, then L<AnyEvent::Handle> (with 2572worthwhile: If this module is installed, then L<AnyEvent::Handle> (with
2412 2583
2413 2584
2414=head1 FORK 2585=head1 FORK
2415 2586
2416Most event libraries are not fork-safe. The ones who are usually are 2587Most event libraries are not fork-safe. The ones who are usually are
2417because they rely on inefficient but fork-safe C<select> or C<poll> 2588because they rely on inefficient but fork-safe C<select> or C<poll> calls
2418calls. Only L<EV> is fully fork-aware. 2589- higher performance APIs such as BSD's kqueue or the dreaded Linux epoll
2590are usually badly thought-out hacks that are incompatible with fork in
2591one way or another. Only L<EV> is fully fork-aware and ensures that you
2592continue event-processing in both parent and child (or both, if you know
2593what you are doing).
2594
2595This means that, in general, you cannot fork and do event processing in
2596the child if the event library was initialised before the fork (which
2597usually happens when the first AnyEvent watcher is created, or the library
2598is loaded).
2419 2599
2420If you have to fork, you must either do so I<before> creating your first 2600If you have to fork, you must either do so I<before> creating your first
2421watcher OR you must not use AnyEvent at all in the child OR you must do 2601watcher OR you must not use AnyEvent at all in the child OR you must do
2422something completely out of the scope of AnyEvent. 2602something completely out of the scope of AnyEvent.
2603
2604The problem of doing event processing in the parent I<and> the child
2605is much more complicated: even for backends that I<are> fork-aware or
2606fork-safe, their behaviour is not usually what you want: fork clones all
2607watchers, that means all timers, I/O watchers etc. are active in both
2608parent and child, which is almost never what you want. USing C<exec>
2609to start worker children from some kind of manage rprocess is usually
2610preferred, because it is much easier and cleaner, at the expense of having
2611to have another binary.
2423 2612
2424 2613
2425=head1 SECURITY CONSIDERATIONS 2614=head1 SECURITY CONSIDERATIONS
2426 2615
2427AnyEvent can be forced to load any event model via 2616AnyEvent can be forced to load any event model via

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines