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.232 by root, Thu Jul 9 01:08:22 2009 UTC vs.
Revision 1.244 by root, Fri Jul 17 23:15:57 2009 UTC

361invocation, and callback invocation will be synchronous. Synchronous means 361invocation, and callback invocation will be synchronous. Synchronous means
362that it might take a while until the signal gets handled by the process, 362that it might take a while until the signal gets handled by the process,
363but it is guaranteed not to interrupt any other callbacks. 363but it is guaranteed not to interrupt any other callbacks.
364 364
365The main advantage of using these watchers is that you can share a signal 365The main advantage of using these watchers is that you can share a signal
366between multiple watchers. 366between multiple watchers, and AnyEvent will ensure that signals will not
367interrupt your program at bad times.
367 368
368This watcher might use C<%SIG>, so programs overwriting those signals 369This watcher might use C<%SIG> (depending on the event loop used),
369directly will likely not work correctly. 370so programs overwriting those signals directly will likely not work
371correctly.
372
373Also note that many event loops (e.g. Glib, Tk, Qt, IO::Async) do not
374support attaching callbacks to signals, which is a pity, as you cannot do
375race-free signal handling in perl. AnyEvent will try to do it's best, but
376in some cases, signals will be delayed. The maximum time a signal might
377be delayed is specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10
378seconds). This variable can be changed only before the first signal
379watcher is created, and should be left alone otherwise. Higher values
380will cause fewer spurious wake-ups, which is better for power and CPU
381saving. All these problems can be avoided by installing the optional
382L<Async::Interrupt> module.
370 383
371Example: exit on SIGINT 384Example: exit on SIGINT
372 385
373 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 }); 386 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 });
374 387
403 416
404This means you cannot create a child watcher as the very first 417This means you cannot create a child watcher as the very first
405thing in an AnyEvent program, you I<have> to create at least one 418thing in an AnyEvent program, you I<have> to create at least one
406watcher before you C<fork> the child (alternatively, you can call 419watcher before you C<fork> the child (alternatively, you can call
407C<AnyEvent::detect>). 420C<AnyEvent::detect>).
421
422As most event loops do not support waiting for child events, they will be
423emulated by AnyEvent in most cases, in which the latency and race problems
424mentioned in the description of signal watchers apply.
408 425
409Example: fork a process and wait for it 426Example: fork a process and wait for it
410 427
411 my $done = AnyEvent->condvar; 428 my $done = AnyEvent->condvar;
412 429
463 480
464If you are familiar with some event loops you will know that all of them 481If you are familiar with some event loops you will know that all of them
465require you to run some blocking "loop", "run" or similar function that 482require you to run some blocking "loop", "run" or similar function that
466will actively watch for new events and call your callbacks. 483will actively watch for new events and call your callbacks.
467 484
468AnyEvent is different, it expects somebody else to run the event loop and 485AnyEvent is slightly different: it expects somebody else to run the event
469will only block when necessary (usually when told by the user). 486loop and will only block when necessary (usually when told by the user).
470 487
471The instrument to do that is called a "condition variable", so called 488The instrument to do that is called a "condition variable", so called
472because they represent a condition that must become true. 489because they represent a condition that must become true.
473 490
491Now is probably a good time to look at the examples further below.
492
474Condition variables can be created by calling the C<< AnyEvent->condvar 493Condition variables can be created by calling the C<< AnyEvent->condvar
475>> method, usually without arguments. The only argument pair allowed is 494>> method, usually without arguments. The only argument pair allowed is
476
477C<cb>, which specifies a callback to be called when the condition variable 495C<cb>, which specifies a callback to be called when the condition variable
478becomes true, with the condition variable as the first argument (but not 496becomes true, with the condition variable as the first argument (but not
479the results). 497the results).
480 498
481After creation, the condition variable is "false" until it becomes "true" 499After creation, the condition variable is "false" until it becomes "true"
530 after => 1, 548 after => 1,
531 cb => sub { $result_ready->send }, 549 cb => sub { $result_ready->send },
532 ); 550 );
533 551
534 # this "blocks" (while handling events) till the callback 552 # this "blocks" (while handling events) till the callback
535 # calls send 553 # calls -<send
536 $result_ready->recv; 554 $result_ready->recv;
537 555
538Example: wait for a timer, but take advantage of the fact that 556Example: wait for a timer, but take advantage of the fact that condition
539condition variables are also code references. 557variables are also callable directly.
540 558
541 my $done = AnyEvent->condvar; 559 my $done = AnyEvent->condvar;
542 my $delay = AnyEvent->timer (after => 5, cb => $done); 560 my $delay = AnyEvent->timer (after => 5, cb => $done);
543 $done->recv; 561 $done->recv;
544 562
550 568
551 ... 569 ...
552 570
553 my @info = $couchdb->info->recv; 571 my @info = $couchdb->info->recv;
554 572
555And this is how you would just ste a callback to be called whenever the 573And this is how you would just set a callback to be called whenever the
556results are available: 574results are available:
557 575
558 $couchdb->info->cb (sub { 576 $couchdb->info->cb (sub {
559 my @info = $_[0]->recv; 577 my @info = $_[0]->recv;
560 }); 578 });
578immediately from within send. 596immediately from within send.
579 597
580Any arguments passed to the C<send> call will be returned by all 598Any arguments passed to the C<send> call will be returned by all
581future C<< ->recv >> calls. 599future C<< ->recv >> calls.
582 600
583Condition variables are overloaded so one can call them directly 601Condition variables are overloaded so one can call them directly (as if
584(as a code reference). Calling them directly is the same as calling 602they were a code reference). Calling them directly is the same as calling
585C<send>. Note, however, that many C-based event loops do not handle 603C<send>.
586overloading, so as tempting as it may be, passing a condition variable
587instead of a callback does not work. Both the pure perl and EV loops
588support overloading, however, as well as all functions that use perl to
589invoke a callback (as in L<AnyEvent::Socket> and L<AnyEvent::DNS> for
590example).
591 604
592=item $cv->croak ($error) 605=item $cv->croak ($error)
593 606
594Similar to send, but causes all call's to C<< ->recv >> to invoke 607Similar to send, but causes all call's to C<< ->recv >> to invoke
595C<Carp::croak> with the given error message/object/scalar. 608C<Carp::croak> with the given error message/object/scalar.
596 609
597This can be used to signal any errors to the condition variable 610This can be used to signal any errors to the condition variable
598user/consumer. 611user/consumer. Doing it this way instead of calling C<croak> directly
612delays the error detetcion, but has the overwhelmign advantage that it
613diagnoses the error at the place where the result is expected, and not
614deep in some event clalback without connection to the actual code causing
615the problem.
599 616
600=item $cv->begin ([group callback]) 617=item $cv->begin ([group callback])
601 618
602=item $cv->end 619=item $cv->end
603 620
699function will call C<croak>. 716function will call C<croak>.
700 717
701In list context, all parameters passed to C<send> will be returned, 718In list context, all parameters passed to C<send> will be returned,
702in scalar context only the first one will be returned. 719in scalar context only the first one will be returned.
703 720
721Note that doing a blocking wait in a callback is not supported by any
722event loop, that is, recursive invocation of a blocking C<< ->recv
723>> is not allowed, and the C<recv> call will C<croak> if such a
724condition is detected. This condition can be slightly loosened by using
725L<Coro::AnyEvent>, which allows you to do a blocking C<< ->recv >> from
726any thread that doesn't run the event loop itself.
727
704Not all event models support a blocking wait - some die in that case 728Not all event models support a blocking wait - some die in that case
705(programs might want to do that to stay interactive), so I<if you are 729(programs might want to do that to stay interactive), so I<if you are
706using this from a module, never require a blocking wait>, but let the 730using this from a module, never require a blocking wait>. Instead, let the
707caller decide whether the call will block or not (for example, by coupling 731caller decide whether the call will block or not (for example, by coupling
708condition variables with some kind of request results and supporting 732condition variables with some kind of request results and supporting
709callbacks so the caller knows that getting the result will not block, 733callbacks so the caller knows that getting the result will not block,
710while still supporting blocking waits if the caller so desires). 734while still supporting blocking waits if the caller so desires).
711
712Another reason I<never> to C<< ->recv >> in a module is that you cannot
713sensibly have two C<< ->recv >>'s in parallel, as that would require
714multiple interpreters or coroutines/threads, none of which C<AnyEvent>
715can supply.
716
717The L<Coro> module, however, I<can> and I<does> supply coroutines and, in
718fact, L<Coro::AnyEvent> replaces AnyEvent's condvars by coroutine-safe
719versions and also integrates coroutines into AnyEvent, making blocking
720C<< ->recv >> calls perfectly safe as long as they are done from another
721coroutine (one that doesn't run the event loop).
722 735
723You can ensure that C<< -recv >> never blocks by setting a callback and 736You can ensure that C<< -recv >> never blocks by setting a callback and
724only calling C<< ->recv >> from within that callback (or at a later 737only calling C<< ->recv >> from within that callback (or at a later
725time). This will work even when the event loop does not support blocking 738time). This will work even when the event loop does not support blocking
726waits otherwise. 739waits otherwise.
809 822
810=back 823=back
811 824
812=head1 GLOBAL VARIABLES AND FUNCTIONS 825=head1 GLOBAL VARIABLES AND FUNCTIONS
813 826
827These are not normally required to use AnyEvent, but can be useful to
828write AnyEvent extension modules.
829
814=over 4 830=over 4
815 831
816=item $AnyEvent::MODEL 832=item $AnyEvent::MODEL
817 833
818Contains C<undef> until the first watcher is being created. Then it 834Contains C<undef> until the first watcher is being created, before the
835backend has been autodetected.
836
819contains the event model that is being used, which is the name of the 837Afterwards it contains the event model that is being used, which is the
820Perl class implementing the model. This class is usually one of the 838name of the Perl class implementing the model. This class is usually one
821C<AnyEvent::Impl:xxx> modules, but can be any other class in the case 839of the C<AnyEvent::Impl:xxx> modules, but can be any other class in the
822AnyEvent has been extended at runtime (e.g. in I<rxvt-unicode>). 840case AnyEvent has been extended at runtime (e.g. in I<rxvt-unicode> it
841will be C<urxvt::anyevent>).
823 842
824=item AnyEvent::detect 843=item AnyEvent::detect
825 844
826Returns C<$AnyEvent::MODEL>, forcing autodetection of the event model 845Returns C<$AnyEvent::MODEL>, forcing autodetection of the event model
827if necessary. You should only call this function right before you would 846if necessary. You should only call this function right before you would
828have created an AnyEvent watcher anyway, that is, as late as possible at 847have created an AnyEvent watcher anyway, that is, as late as possible at
829runtime. 848runtime, and not e.g. while initialising of your module.
849
850If you need to do some initialisation before AnyEvent watchers are
851created, use C<post_detect>.
830 852
831=item $guard = AnyEvent::post_detect { BLOCK } 853=item $guard = AnyEvent::post_detect { BLOCK }
832 854
833Arranges for the code block to be executed as soon as the event model is 855Arranges for the code block to be executed as soon as the event model is
834autodetected (or immediately if this has already happened). 856autodetected (or immediately if this has already happened).
857
858The block will be executed I<after> the actual backend has been detected
859(C<$AnyEvent::MODEL> is set), but I<before> any watchers have been
860created, so it is possible to e.g. patch C<@AnyEvent::ISA> or do
861other initialisations - see the sources of L<AnyEvent::Strict> or
862L<AnyEvent::AIO> to see how this is used.
863
864The most common usage is to create some global watchers, without forcing
865event module detection too early, for example, L<AnyEvent::AIO> creates
866and installs the global L<IO::AIO> watcher in a C<post_detect> block to
867avoid autodetecting the event module at load time.
835 868
836If called in scalar or list context, then it creates and returns an object 869If called in scalar or list context, then it creates and returns an object
837that automatically removes the callback again when it is destroyed. See 870that automatically removes the callback again when it is destroyed. See
838L<Coro::BDB> for a case where this is useful. 871L<Coro::BDB> for a case where this is useful.
839 872
842If there are any code references in this array (you can C<push> to it 875If there are any code references in this array (you can C<push> to it
843before or after loading AnyEvent), then they will called directly after 876before or after loading AnyEvent), then they will called directly after
844the event loop has been chosen. 877the event loop has been chosen.
845 878
846You should check C<$AnyEvent::MODEL> before adding to this array, though: 879You should check C<$AnyEvent::MODEL> before adding to this array, though:
847if it contains a true value then the event loop has already been detected, 880if it is defined then the event loop has already been detected, and the
848and the array will be ignored. 881array will be ignored.
849 882
850Best use C<AnyEvent::post_detect { BLOCK }> instead. 883Best use C<AnyEvent::post_detect { BLOCK }> when your application allows
884it,as it takes care of these details.
885
886This variable is mainly useful for modules that can do something useful
887when AnyEvent is used and thus want to know when it is initialised, but do
888not need to even load it by default. This array provides the means to hook
889into AnyEvent passively, without loading it.
851 890
852=back 891=back
853 892
854=head1 WHAT TO DO IN A MODULE 893=head1 WHAT TO DO IN A MODULE
855 894
1002 1041
1003=cut 1042=cut
1004 1043
1005package AnyEvent; 1044package AnyEvent;
1006 1045
1046# basically a tuned-down version of common::sense
1047sub common_sense {
1007no warnings; 1048 # no warnings
1049 ${^WARNING_BITS} ^= ${^WARNING_BITS};
1008use strict qw(vars subs); 1050 # use strict vars subs
1051 $^H |= 0x00000600;
1052}
1009 1053
1054BEGIN { AnyEvent::common_sense }
1055
1010use Carp; 1056use Carp ();
1011 1057
1012our $VERSION = 4.801; 1058our $VERSION = 4.83;
1013our $MODEL; 1059our $MODEL;
1014 1060
1015our $AUTOLOAD; 1061our $AUTOLOAD;
1016our @ISA; 1062our @ISA;
1017 1063
1018our @REGISTRY; 1064our @REGISTRY;
1019 1065
1020our $WIN32; 1066our $WIN32;
1067
1068our $VERBOSE;
1021 1069
1022BEGIN { 1070BEGIN {
1023 eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }"; 1071 eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }";
1024 eval "sub TAINT(){ " . (${^TAINT}*1) . " }"; 1072 eval "sub TAINT(){ " . (${^TAINT}*1) . " }";
1025 1073
1026 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV} 1074 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
1027 if ${^TAINT}; 1075 if ${^TAINT};
1028}
1029 1076
1030our $verbose = $ENV{PERL_ANYEVENT_VERBOSE}*1; 1077 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;
1078
1079}
1080
1081our $MAX_SIGNAL_LATENCY = 10;
1031 1082
1032our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred 1083our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred
1033 1084
1034{ 1085{
1035 my $idx; 1086 my $idx;
1046 # as the pureperl backend should work everywhere 1097 # as the pureperl backend should work everywhere
1047 # and is usually faster 1098 # and is usually faster
1048 [Glib:: => AnyEvent::Impl::Glib::], # becomes extremely slow with many watchers 1099 [Glib:: => AnyEvent::Impl::Glib::], # becomes extremely slow with many watchers
1049 [Event::Lib:: => AnyEvent::Impl::EventLib::], # too buggy 1100 [Event::Lib:: => AnyEvent::Impl::EventLib::], # too buggy
1050 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles 1101 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles
1102 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program
1051 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 1103 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
1052 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program
1053 [Wx:: => AnyEvent::Impl::POE::], 1104 [Wx:: => AnyEvent::Impl::POE::],
1054 [Prima:: => AnyEvent::Impl::POE::], 1105 [Prima:: => AnyEvent::Impl::POE::],
1055 # IO::Async is just too broken - we would need workarounds for its 1106 # IO::Async is just too broken - we would need workarounds for its
1056 # byzantine signal and broken child handling, among others. 1107 # byzantine signal and broken child handling, among others.
1057 # IO::Async is rather hard to detect, as it doesn't have any 1108 # IO::Async is rather hard to detect, as it doesn't have any
1086 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1137 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1087} 1138}
1088 1139
1089sub detect() { 1140sub detect() {
1090 unless ($MODEL) { 1141 unless ($MODEL) {
1091 no strict 'refs';
1092 local $SIG{__DIE__}; 1142 local $SIG{__DIE__};
1093 1143
1094 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1144 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {
1095 my $model = "AnyEvent::Impl::$1"; 1145 my $model = "AnyEvent::Impl::$1";
1096 if (eval "require $model") { 1146 if (eval "require $model") {
1097 $MODEL = $model; 1147 $MODEL = $model;
1098 warn "AnyEvent: loaded model '$model' (forced by \$PERL_ANYEVENT_MODEL), using it.\n" if $verbose > 1; 1148 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;
1099 } else { 1149 } else {
1100 warn "AnyEvent: unable to load model '$model' (from \$PERL_ANYEVENT_MODEL):\n$@" if $verbose; 1150 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;
1101 } 1151 }
1102 } 1152 }
1103 1153
1104 # check for already loaded models 1154 # check for already loaded models
1105 unless ($MODEL) { 1155 unless ($MODEL) {
1106 for (@REGISTRY, @models) { 1156 for (@REGISTRY, @models) {
1107 my ($package, $model) = @$_; 1157 my ($package, $model) = @$_;
1108 if (${"$package\::VERSION"} > 0) { 1158 if (${"$package\::VERSION"} > 0) {
1109 if (eval "require $model") { 1159 if (eval "require $model") {
1110 $MODEL = $model; 1160 $MODEL = $model;
1111 warn "AnyEvent: autodetected model '$model', using it.\n" if $verbose > 1; 1161 warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;
1112 last; 1162 last;
1113 } 1163 }
1114 } 1164 }
1115 } 1165 }
1116 1166
1121 my ($package, $model) = @$_; 1171 my ($package, $model) = @$_;
1122 if (eval "require $package" 1172 if (eval "require $package"
1123 and ${"$package\::VERSION"} > 0 1173 and ${"$package\::VERSION"} > 0
1124 and eval "require $model") { 1174 and eval "require $model") {
1125 $MODEL = $model; 1175 $MODEL = $model;
1126 warn "AnyEvent: autoprobed model '$model', using it.\n" if $verbose > 1; 1176 warn "AnyEvent: autoprobed model '$model', using it.\n" if $VERBOSE >= 2;
1127 last; 1177 last;
1128 } 1178 }
1129 } 1179 }
1130 1180
1131 $MODEL 1181 $MODEL
1147 1197
1148sub AUTOLOAD { 1198sub AUTOLOAD {
1149 (my $func = $AUTOLOAD) =~ s/.*://; 1199 (my $func = $AUTOLOAD) =~ s/.*://;
1150 1200
1151 $method{$func} 1201 $method{$func}
1152 or croak "$func: not a valid method for AnyEvent objects"; 1202 or Carp::croak "$func: not a valid method for AnyEvent objects";
1153 1203
1154 detect unless $MODEL; 1204 detect unless $MODEL;
1155 1205
1156 my $class = shift; 1206 my $class = shift;
1157 $class->$func (@_); 1207 $class->$func (@_);
1162# allow only one watcher per fd, so we dup it to get a different one). 1212# allow only one watcher per fd, so we dup it to get a different one).
1163sub _dupfh($$;$$) { 1213sub _dupfh($$;$$) {
1164 my ($poll, $fh, $r, $w) = @_; 1214 my ($poll, $fh, $r, $w) = @_;
1165 1215
1166 # cygwin requires the fh mode to be matching, unix doesn't 1216 # cygwin requires the fh mode to be matching, unix doesn't
1167 my ($rw, $mode) = $poll eq "r" ? ($r, "<") : ($w, ">"); 1217 my ($rw, $mode) = $poll eq "r" ? ($r, "<&") : ($w, ">&");
1168 1218
1169 open my $fh2, "$mode&", $fh 1219 open my $fh2, $mode, $fh
1170 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,"; 1220 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,";
1171 1221
1172 # we assume CLOEXEC is already set by perl in all important cases 1222 # we assume CLOEXEC is already set by perl in all important cases
1173 1223
1174 ($fh2, $rw) 1224 ($fh2, $rw)
1176 1226
1177package AnyEvent::Base; 1227package AnyEvent::Base;
1178 1228
1179# default implementations for many methods 1229# default implementations for many methods
1180 1230
1181BEGIN { 1231sub _time {
1232 # probe for availability of Time::HiRes
1182 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") { 1233 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1234 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;
1183 *_time = \&Time::HiRes::time; 1235 *_time = \&Time::HiRes::time;
1184 # if (eval "use POSIX (); (POSIX::times())... 1236 # if (eval "use POSIX (); (POSIX::times())...
1185 } else { 1237 } else {
1238 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;
1186 *_time = sub { time }; # epic fail 1239 *_time = sub { time }; # epic fail
1187 } 1240 }
1241
1242 &_time
1188} 1243}
1189 1244
1190sub time { _time } 1245sub time { _time }
1191sub now { _time } 1246sub now { _time }
1192sub now_update { } 1247sub now_update { }
1197 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar" 1252 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
1198} 1253}
1199 1254
1200# default implementation for ->signal 1255# default implementation for ->signal
1201 1256
1257our $HAVE_ASYNC_INTERRUPT;
1202our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1258our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1259our (%SIG_ASY, %SIG_ASY_W);
1260our ($SIG_COUNT, $SIG_TW);
1203 1261
1204sub _signal_exec { 1262sub _signal_exec {
1263 $HAVE_ASYNC_INTERRUPT
1264 ? $SIGPIPE_R->drain
1205 sysread $SIGPIPE_R, my $dummy, 4; 1265 : sysread $SIGPIPE_R, my $dummy, 9;
1206 1266
1207 while (%SIG_EV) { 1267 while (%SIG_EV) {
1208 for (keys %SIG_EV) { 1268 for (keys %SIG_EV) {
1209 delete $SIG_EV{$_}; 1269 delete $SIG_EV{$_};
1210 $_->() for values %{ $SIG_CB{$_} || {} }; 1270 $_->() for values %{ $SIG_CB{$_} || {} };
1211 } 1271 }
1212 } 1272 }
1213} 1273}
1214 1274
1275sub _signal {
1276 my (undef, %arg) = @_;
1277
1278 my $signal = uc $arg{signal}
1279 or Carp::croak "required option 'signal' is missing";
1280
1281 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1282
1283 if ($HAVE_ASYNC_INTERRUPT) {
1284 # async::interrupt
1285
1286 $SIG_ASY{$signal} ||= do {
1287 my $asy = new Async::Interrupt
1288 cb => sub { undef $SIG_EV{$signal} },
1289 signal => $signal,
1290 pipe => [$SIGPIPE_R->filenos],
1291 ;
1292 $asy->pipe_autodrain (0);
1293
1294 $asy
1295 };
1296
1297 } else {
1298 # pure perl
1299
1300 $SIG{$signal} ||= sub {
1301 local $!;
1302 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1303 undef $SIG_EV{$signal};
1304 };
1305
1306 # can't do signal processing without introducing races in pure perl,
1307 # so limit the signal latency.
1308 ++$SIG_COUNT;
1309 $SIG_TW ||= AnyEvent->timer (
1310 after => $MAX_SIGNAL_LATENCY,
1311 interval => $MAX_SIGNAL_LATENCY,
1312 cb => sub { }, # just for the PERL_ASYNC_CHECK
1313 );
1314 }
1315
1316 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1317}
1318
1215sub signal { 1319sub signal {
1216 my (undef, %arg) = @_; 1320 # probe for availability of Async::Interrupt
1321 if (!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} && eval "use Async::Interrupt 0.6 (); 1") {
1322 warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8;
1217 1323
1218 unless ($SIGPIPE_R) { 1324 $HAVE_ASYNC_INTERRUPT = 1;
1325 $SIGPIPE_R = new Async::Interrupt::EventPipe;
1326 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec);
1327
1328 } else {
1329 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1330
1219 require Fcntl; 1331 require Fcntl;
1220 1332
1221 if (AnyEvent::WIN32) { 1333 if (AnyEvent::WIN32) {
1222 require AnyEvent::Util; 1334 require AnyEvent::Util;
1223 1335
1238 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n"; 1350 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1239 1351
1240 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec); 1352 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1241 } 1353 }
1242 1354
1243 my $signal = uc $arg{signal} 1355 *signal = \&_signal;
1244 or Carp::croak "required option 'signal' is missing"; 1356 &signal
1245
1246 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1247 $SIG{$signal} ||= sub {
1248 local $!;
1249 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1250 undef $SIG_EV{$signal};
1251 };
1252
1253 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1254} 1357}
1255 1358
1256sub AnyEvent::Base::signal::DESTROY { 1359sub AnyEvent::Base::signal::DESTROY {
1257 my ($signal, $cb) = @{$_[0]}; 1360 my ($signal, $cb) = @{$_[0]};
1361
1362 undef $SIG_TW
1363 unless --$SIG_COUNT;
1258 1364
1259 delete $SIG_CB{$signal}{$cb}; 1365 delete $SIG_CB{$signal}{$cb};
1260 1366
1261 # delete doesn't work with older perls - they then 1367 # delete doesn't work with older perls - they then
1262 # print weird messages, or just unconditionally exit 1368 # print weird messages, or just unconditionally exit
1263 # instead of getting the default action. 1369 # instead of getting the default action.
1370 undef $SIG{$signal}
1264 undef $SIG{$signal} unless keys %{ $SIG_CB{$signal} }; 1371 unless keys %{ $SIG_CB{$signal} };
1265} 1372}
1266 1373
1267# default implementation for ->child 1374# default implementation for ->child
1268 1375
1269our %PID_CB; 1376our %PID_CB;
1271our $CHLD_DELAY_W; 1378our $CHLD_DELAY_W;
1272our $WNOHANG; 1379our $WNOHANG;
1273 1380
1274sub _sigchld { 1381sub _sigchld {
1275 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1382 while (0 < (my $pid = waitpid -1, $WNOHANG)) {
1383 $_->($pid, $?)
1276 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }), 1384 for values %{ $PID_CB{$pid} || {} },
1277 (values %{ $PID_CB{0} || {} }); 1385 values %{ $PID_CB{0} || {} };
1278 } 1386 }
1279} 1387}
1280 1388
1281sub child { 1389sub child {
1282 my (undef, %arg) = @_; 1390 my (undef, %arg) = @_;
1284 defined (my $pid = $arg{pid} + 0) 1392 defined (my $pid = $arg{pid} + 0)
1285 or Carp::croak "required option 'pid' is missing"; 1393 or Carp::croak "required option 'pid' is missing";
1286 1394
1287 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1395 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1288 1396
1397 # WNOHANG is almost cetrainly 1 everywhere
1398 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1399 ? 1
1289 $WNOHANG ||= eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1400 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1290 1401
1291 unless ($CHLD_W) { 1402 unless ($CHLD_W) {
1292 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1403 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld);
1293 # child could be a zombie already, so make at least one round 1404 # child could be a zombie already, so make at least one round
1294 &_sigchld; 1405 &_sigchld;
1346 1457
1347our @ISA = AnyEvent::CondVar::Base::; 1458our @ISA = AnyEvent::CondVar::Base::;
1348 1459
1349package AnyEvent::CondVar::Base; 1460package AnyEvent::CondVar::Base;
1350 1461
1351use overload 1462#use overload
1352 '&{}' => sub { my $self = shift; sub { $self->send (@_) } }, 1463# '&{}' => sub { my $self = shift; sub { $self->send (@_) } },
1353 fallback => 1; 1464# fallback => 1;
1465
1466# save 300+ kilobytes by dirtily hardcoding overloading
1467${"AnyEvent::CondVar::Base::OVERLOAD"}{dummy}++; # Register with magic by touching.
1468*{'AnyEvent::CondVar::Base::()'} = sub { }; # "Make it findable via fetchmethod."
1469*{'AnyEvent::CondVar::Base::(&{}'} = sub { my $self = shift; sub { $self->send (@_) } }; # &{}
1470${'AnyEvent::CondVar::Base::()'} = 1; # fallback
1471
1472our $WAITING;
1354 1473
1355sub _send { 1474sub _send {
1356 # nop 1475 # nop
1357} 1476}
1358 1477
1371sub ready { 1490sub ready {
1372 $_[0]{_ae_sent} 1491 $_[0]{_ae_sent}
1373} 1492}
1374 1493
1375sub _wait { 1494sub _wait {
1495 $WAITING
1496 and !$_[0]{_ae_sent}
1497 and Carp::croak "AnyEvent::CondVar: recursive blocking wait detected";
1498
1499 local $WAITING = 1;
1376 AnyEvent->one_event while !$_[0]{_ae_sent}; 1500 AnyEvent->one_event while !$_[0]{_ae_sent};
1377} 1501}
1378 1502
1379sub recv { 1503sub recv {
1380 $_[0]->_wait; 1504 $_[0]->_wait;
1442C<PERL_ANYEVENT_MODEL>. 1566C<PERL_ANYEVENT_MODEL>.
1443 1567
1444When set to C<2> or higher, cause AnyEvent to report to STDERR which event 1568When set to C<2> or higher, cause AnyEvent to report to STDERR which event
1445model it chooses. 1569model it chooses.
1446 1570
1571When set to C<8> or higher, then AnyEvent will report extra information on
1572which optional modules it loads and how it implements certain features.
1573
1447=item C<PERL_ANYEVENT_STRICT> 1574=item C<PERL_ANYEVENT_STRICT>
1448 1575
1449AnyEvent does not do much argument checking by default, as thorough 1576AnyEvent does not do much argument checking by default, as thorough
1450argument checking is very costly. Setting this variable to a true value 1577argument checking is very costly. Setting this variable to a true value
1451will cause AnyEvent to load C<AnyEvent::Strict> and then to thoroughly 1578will cause AnyEvent to load C<AnyEvent::Strict> and then to thoroughly
1452check the arguments passed to most method calls. If it finds any problems, 1579check the arguments passed to most method calls. If it finds any problems,
1453it will croak. 1580it will croak.
1454 1581
1455In other words, enables "strict" mode. 1582In other words, enables "strict" mode.
1456 1583
1457Unlike C<use strict>, it is definitely recommended to keep it off in 1584Unlike C<use strict> (or it's modern cousin, C<< use L<common::sense>
1458production. Keeping C<PERL_ANYEVENT_STRICT=1> in your environment while 1585>>, it is definitely recommended to keep it off in production. Keeping
1459developing programs can be very useful, however. 1586C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs
1587can be very useful, however.
1460 1588
1461=item C<PERL_ANYEVENT_MODEL> 1589=item C<PERL_ANYEVENT_MODEL>
1462 1590
1463This can be used to specify the event model to be used by AnyEvent, before 1591This can be used to specify the event model to be used by AnyEvent, before
1464auto detection and -probing kicks in. It must be a string consisting 1592auto detection and -probing kicks in. It must be a string consisting
1526 1654
1527When neither C<ca_file> nor C<ca_path> was specified during 1655When neither C<ca_file> nor C<ca_path> was specified during
1528L<AnyEvent::TLS> context creation, and either of these environment 1656L<AnyEvent::TLS> context creation, and either of these environment
1529variables exist, they will be used to specify CA certificate locations 1657variables exist, they will be used to specify CA certificate locations
1530instead of a system-dependent default. 1658instead of a system-dependent default.
1659
1660=item C<PERL_ANYEVENT_AVOID_GUARD> and C<PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT>
1661
1662When these are set to C<1>, then the respective modules are not
1663loaded. Mostly good for testing AnyEvent itself.
1531 1664
1532=back 1665=back
1533 1666
1534=head1 SUPPLYING YOUR OWN EVENT MODEL INTERFACE 1667=head1 SUPPLYING YOUR OWN EVENT MODEL INTERFACE
1535 1668
2074 2207
2075A handler for C<SIGCHLD> is installed by AnyEvent's child watcher 2208A handler for C<SIGCHLD> is installed by AnyEvent's child watcher
2076emulation for event loops that do not support them natively. Also, some 2209emulation for event loops that do not support them natively. Also, some
2077event loops install a similar handler. 2210event loops install a similar handler.
2078 2211
2079If, when AnyEvent is loaded, SIGCHLD is set to IGNORE, then AnyEvent will 2212Additionally, when AnyEvent is loaded and SIGCHLD is set to IGNORE, then
2080reset it to default, to avoid losing child exit statuses. 2213AnyEvent will reset it to default, to avoid losing child exit statuses.
2081 2214
2082=item SIGPIPE 2215=item SIGPIPE
2083 2216
2084A no-op handler is installed for C<SIGPIPE> when C<$SIG{PIPE}> is C<undef> 2217A no-op handler is installed for C<SIGPIPE> when C<$SIG{PIPE}> is C<undef>
2085when AnyEvent gets loaded. 2218when AnyEvent gets loaded.
2103 if $SIG{CHLD} eq 'IGNORE'; 2236 if $SIG{CHLD} eq 'IGNORE';
2104 2237
2105$SIG{PIPE} = sub { } 2238$SIG{PIPE} = sub { }
2106 unless defined $SIG{PIPE}; 2239 unless defined $SIG{PIPE};
2107 2240
2241=head1 RECOMMENDED/OPTIONAL MODULES
2242
2243One of AnyEvent's main goals is to be 100% Pure-Perl(tm): only perl (and
2244it's built-in modules) are required to use it.
2245
2246That does not mean that AnyEvent won't take advantage of some additional
2247modules if they are installed.
2248
2249This section epxlains which additional modules will be used, and how they
2250affect AnyEvent's operetion.
2251
2252=over 4
2253
2254=item L<Async::Interrupt>
2255
2256This slightly arcane module is used to implement fast signal handling: To
2257my knowledge, there is no way to do completely race-free and quick
2258signal handling in pure perl. To ensure that signals still get
2259delivered, AnyEvent will start an interval timer to wake up perl (and
2260catch the signals) with soemd elay (default is 10 seconds, look for
2261C<$AnyEvent::MAX_SIGNAL_LATENCY>).
2262
2263If this module is available, then it will be used to implement signal
2264catching, which means that signals will not be delayed, and the event loop
2265will not be interrupted regularly, which is more efficient (And good for
2266battery life on laptops).
2267
2268This affects not just the pure-perl event loop, but also other event loops
2269that have no signal handling on their own (e.g. Glib, Tk, Qt).
2270
2271=item L<EV>
2272
2273This module isn't really "optional", as it is simply one of the backend
2274event loops that AnyEvent can use. However, it is simply the best event
2275loop available in terms of features, speed and stability: It supports
2276the AnyEvent API optimally, implements all the watcher types in XS, does
2277automatic timer adjustments even when no monotonic clock is available,
2278can take avdantage of advanced kernel interfaces such as C<epoll> and
2279C<kqueue>, and is the fastest backend I<by far>. You can even embed
2280L<Glib>/L<Gtk2> in it (or vice versa, see L<EV::Glib> and L<Glib::EV>).
2281
2282=item L<Guard>
2283
2284The guard module, when used, will be used to implement
2285C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a
2286lot less memory), but otherwise doesn't affect guard operation much. It is
2287purely used for performance.
2288
2289=item L<JSON> and L<JSON::XS>
2290
2291This module is required when you want to read or write JSON data via
2292L<AnyEvent::Handle>. It is also written in pure-perl, but can take
2293advantage of the ulta-high-speed L<JSON::XS> module when it is installed.
2294
2295In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2296installed.
2297
2298=item L<Net::SSLeay>
2299
2300Implementing TLS/SSL in Perl is certainly interesting, but not very
2301worthwhile: If this module is installed, then L<AnyEvent::Handle> (with
2302the help of L<AnyEvent::TLS>), gains the ability to do TLS/SSL.
2303
2304=item L<Time::HiRes>
2305
2306This module is part of perl since release 5.008. It will be used when the
2307chosen event library does not come with a timing source on it's own. The
2308pure-perl event loop (L<AnyEvent::Impl::Perl>) will additionally use it to
2309try to use a monotonic clock for timing stability.
2310
2311=back
2312
2313
2108=head1 FORK 2314=head1 FORK
2109 2315
2110Most event libraries are not fork-safe. The ones who are usually are 2316Most event libraries are not fork-safe. The ones who are usually are
2111because they rely on inefficient but fork-safe C<select> or C<poll> 2317because they rely on inefficient but fork-safe C<select> or C<poll>
2112calls. Only L<EV> is fully fork-aware. 2318calls. Only L<EV> is fully fork-aware.
2113 2319
2114If you have to fork, you must either do so I<before> creating your first 2320If you have to fork, you must either do so I<before> creating your first
2115watcher OR you must not use AnyEvent at all in the child. 2321watcher OR you must not use AnyEvent at all in the child OR you must do
2322something completely out of the scope of AnyEvent.
2116 2323
2117 2324
2118=head1 SECURITY CONSIDERATIONS 2325=head1 SECURITY CONSIDERATIONS
2119 2326
2120AnyEvent can be forced to load any event model via 2327AnyEvent can be forced to load any event model via

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines