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.242 by root, Fri Jul 17 22:05:12 2009 UTC vs.
Revision 1.276 by root, Sun Aug 9 10:53:33 2009 UTC

1=head1 NAME 1=head1 NAME
2 2
3AnyEvent - provide framework for multiple event loops 3AnyEvent - the DBI of event loop programming
4 4
5EV, Event, Glib, Tk, Perl, Event::Lib, Qt and POE are various supported 5EV, Event, Glib, Tk, Perl, Event::Lib, Irssi, rxvt-unicode, IO::Async, Qt
6event loops. 6and POE are various supported event loops/environments.
7 7
8=head1 SYNOPSIS 8=head1 SYNOPSIS
9 9
10 use AnyEvent; 10 use AnyEvent;
11 11
40=head1 INTRODUCTION/TUTORIAL 40=head1 INTRODUCTION/TUTORIAL
41 41
42This manpage is mainly a reference manual. If you are interested 42This manpage is mainly a reference manual. If you are interested
43in a tutorial or some gentle introduction, have a look at the 43in a tutorial or some gentle introduction, have a look at the
44L<AnyEvent::Intro> manpage. 44L<AnyEvent::Intro> manpage.
45
46=head1 SUPPORT
47
48There is a mailinglist for discussing all things AnyEvent, and an IRC
49channel, too.
50
51See the AnyEvent project page at the B<Schmorpforge Ta-Sa Software
52Repository>, at L<http://anyevent.schmorp.de>, for more info.
45 53
46=head1 WHY YOU SHOULD USE THIS MODULE (OR NOT) 54=head1 WHY YOU SHOULD USE THIS MODULE (OR NOT)
47 55
48Glib, POE, IO::Async, Event... CPAN offers event models by the dozen 56Glib, POE, IO::Async, Event... CPAN offers event models by the dozen
49nowadays. So what is different about AnyEvent? 57nowadays. So what is different about AnyEvent?
173my variables are only visible after the statement in which they are 181my variables are only visible after the statement in which they are
174declared. 182declared.
175 183
176=head2 I/O WATCHERS 184=head2 I/O WATCHERS
177 185
186 $w = AnyEvent->io (
187 fh => <filehandle_or_fileno>,
188 poll => <"r" or "w">,
189 cb => <callback>,
190 );
191
178You can create an I/O watcher by calling the C<< AnyEvent->io >> method 192You can create an I/O watcher by calling the C<< AnyEvent->io >> method
179with the following mandatory key-value pairs as arguments: 193with the following mandatory key-value pairs as arguments:
180 194
181C<fh> is the Perl I<file handle> (or a naked file descriptor) to watch 195C<fh> is the Perl I<file handle> (or a naked file descriptor) to watch
182for events (AnyEvent might or might not keep a reference to this file 196for events (AnyEvent might or might not keep a reference to this file
211 undef $w; 225 undef $w;
212 }); 226 });
213 227
214=head2 TIME WATCHERS 228=head2 TIME WATCHERS
215 229
230 $w = AnyEvent->timer (after => <seconds>, cb => <callback>);
231
232 $w = AnyEvent->timer (
233 after => <fractional_seconds>,
234 interval => <fractional_seconds>,
235 cb => <callback>,
236 );
237
216You can create a time watcher by calling the C<< AnyEvent->timer >> 238You can create a time watcher by calling the C<< AnyEvent->timer >>
217method with the following mandatory arguments: 239method with the following mandatory arguments:
218 240
219C<after> specifies after how many seconds (fractional values are 241C<after> specifies after how many seconds (fractional values are
220supported) the callback should be invoked. C<cb> is the callback to invoke 242supported) the callback should be invoked. C<cb> is the callback to invoke
347 369
348=back 370=back
349 371
350=head2 SIGNAL WATCHERS 372=head2 SIGNAL WATCHERS
351 373
374 $w = AnyEvent->signal (signal => <uppercase_signal_name>, cb => <callback>);
375
352You can watch for signals using a signal watcher, C<signal> is the signal 376You can watch for signals using a signal watcher, C<signal> is the signal
353I<name> in uppercase and without any C<SIG> prefix, C<cb> is the Perl 377I<name> in uppercase and without any C<SIG> prefix, C<cb> is the Perl
354callback to be invoked whenever a signal occurs. 378callback to be invoked whenever a signal occurs.
355 379
356Although the callback might get passed parameters, their value and 380Although the callback might get passed parameters, their value and
368 392
369This watcher might use C<%SIG> (depending on the event loop used), 393This watcher might use C<%SIG> (depending on the event loop used),
370so programs overwriting those signals directly will likely not work 394so programs overwriting those signals directly will likely not work
371correctly. 395correctly.
372 396
397Example: exit on SIGINT
398
399 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 });
400
401=head3 Signal Races, Delays and Workarounds
402
373Also note that many event loops (e.g. Glib, Tk, Qt, IO::Async) do not 403Many event loops (e.g. Glib, Tk, Qt, IO::Async) do not support attaching
374support attaching callbacks to signals, which is a pity, as you cannot do 404callbacks to signals in a generic way, which is a pity, as you cannot
375race-free signal handling in perl. AnyEvent will try to do it's best, but 405do race-free signal handling in perl, requiring C libraries for
406this. AnyEvent will try to do it's best, which means in some cases,
376in some cases, signals will be delayed. The maximum time a signal might 407signals will be delayed. The maximum time a signal might be delayed is
377be delayed is specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10 408specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10 seconds). This
378seconds). This variable can be changed only before the first signal 409variable can be changed only before the first signal watcher is created,
379watcher is created, and should be left alone otherwise. Higher values 410and should be left alone otherwise. This variable determines how often
411AnyEvent polls for signals (in case a wake-up was missed). Higher values
380will cause fewer spurious wake-ups, which is better for power and CPU 412will cause fewer spurious wake-ups, which is better for power and CPU
413saving.
414
381saving. All these problems can be avoided by installing the optional 415All these problems can be avoided by installing the optional
382L<Async::Interrupt> module. 416L<Async::Interrupt> module, which works with most event loops. It will not
383 417work with inherently broken event loops such as L<Event> or L<Event::Lib>
384Example: exit on SIGINT 418(and not with L<POE> currently, as POE does it's own workaround with
385 419one-second latency). For those, you just have to suffer the delays.
386 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 });
387 420
388=head2 CHILD PROCESS WATCHERS 421=head2 CHILD PROCESS WATCHERS
389 422
423 $w = AnyEvent->child (pid => <process id>, cb => <callback>);
424
390You can also watch on a child process exit and catch its exit status. 425You can also watch on a child process exit and catch its exit status.
391 426
392The child process is specified by the C<pid> argument (if set to C<0>, it 427The child process is specified by the C<pid> argument (one some backends,
393watches for any child process exit). The watcher will triggered only when 428using C<0> watches for any child process exit, on others this will
394the child process has finished and an exit status is available, not on 429croak). The watcher will be triggered only when the child process has
395any trace events (stopped/continued). 430finished and an exit status is available, not on any trace events
431(stopped/continued).
396 432
397The callback will be called with the pid and exit status (as returned by 433The callback will be called with the pid and exit status (as returned by
398waitpid), so unlike other watcher types, you I<can> rely on child watcher 434waitpid), so unlike other watcher types, you I<can> rely on child watcher
399callback arguments. 435callback arguments.
400 436
441 # do something else, then wait for process exit 477 # do something else, then wait for process exit
442 $done->recv; 478 $done->recv;
443 479
444=head2 IDLE WATCHERS 480=head2 IDLE WATCHERS
445 481
482 $w = AnyEvent->idle (cb => <callback>);
483
446Sometimes there is a need to do something, but it is not so important 484Sometimes there is a need to do something, but it is not so important
447to do it instantly, but only when there is nothing better to do. This 485to do it instantly, but only when there is nothing better to do. This
448"nothing better to do" is usually defined to be "no other events need 486"nothing better to do" is usually defined to be "no other events need
449attention by the event loop". 487attention by the event loop".
450 488
476 }); 514 });
477 }); 515 });
478 516
479=head2 CONDITION VARIABLES 517=head2 CONDITION VARIABLES
480 518
519 $cv = AnyEvent->condvar;
520
521 $cv->send (<list>);
522 my @res = $cv->recv;
523
481If you are familiar with some event loops you will know that all of them 524If you are familiar with some event loops you will know that all of them
482require you to run some blocking "loop", "run" or similar function that 525require you to run some blocking "loop", "run" or similar function that
483will actively watch for new events and call your callbacks. 526will actively watch for new events and call your callbacks.
484 527
485AnyEvent is slightly different: it expects somebody else to run the event 528AnyEvent is slightly different: it expects somebody else to run the event
504Condition variables are similar to callbacks, except that you can 547Condition variables are similar to callbacks, except that you can
505optionally wait for them. They can also be called merge points - points 548optionally wait for them. They can also be called merge points - points
506in time where multiple outstanding events have been processed. And yet 549in time where multiple outstanding events have been processed. And yet
507another way to call them is transactions - each condition variable can be 550another way to call them is transactions - each condition variable can be
508used to represent a transaction, which finishes at some point and delivers 551used to represent a transaction, which finishes at some point and delivers
509a result. 552a result. And yet some people know them as "futures" - a promise to
553compute/deliver something that you can wait for.
510 554
511Condition variables are very useful to signal that something has finished, 555Condition variables are very useful to signal that something has finished,
512for example, if you write a module that does asynchronous http requests, 556for example, if you write a module that does asynchronous http requests,
513then a condition variable would be the ideal candidate to signal the 557then a condition variable would be the ideal candidate to signal the
514availability of results. The user can either act when the callback is 558availability of results. The user can either act when the callback is
746=item $cb = $cv->cb ($cb->($cv)) 790=item $cb = $cv->cb ($cb->($cv))
747 791
748This is a mutator function that returns the callback set and optionally 792This is a mutator function that returns the callback set and optionally
749replaces it before doing so. 793replaces it before doing so.
750 794
751The callback will be called when the condition becomes "true", i.e. when 795The callback will be called when the condition becomes (or already was)
752C<send> or C<croak> are called, with the only argument being the condition 796"true", i.e. when C<send> or C<croak> are called (or were called), with
753variable itself. Calling C<recv> inside the callback or at any later time 797the only argument being the condition variable itself. Calling C<recv>
754is guaranteed not to block. 798inside the callback or at any later time is guaranteed not to block.
755 799
756=back 800=back
757 801
758=head1 SUPPORTED EVENT LOOPS/BACKENDS 802=head1 SUPPORTED EVENT LOOPS/BACKENDS
759 803
762=over 4 806=over 4
763 807
764=item Backends that are autoprobed when no other event loop can be found. 808=item Backends that are autoprobed when no other event loop can be found.
765 809
766EV is the preferred backend when no other event loop seems to be in 810EV is the preferred backend when no other event loop seems to be in
767use. If EV is not installed, then AnyEvent will try Event, and, failing 811use. If EV is not installed, then AnyEvent will fall back to its own
768that, will fall back to its own pure-perl implementation, which is 812pure-perl implementation, which is available everywhere as it comes with
769available everywhere as it comes with AnyEvent itself. 813AnyEvent itself.
770 814
771 AnyEvent::Impl::EV based on EV (interface to libev, best choice). 815 AnyEvent::Impl::EV based on EV (interface to libev, best choice).
772 AnyEvent::Impl::Event based on Event, very stable, few glitches.
773 AnyEvent::Impl::Perl pure-perl implementation, fast and portable. 816 AnyEvent::Impl::Perl pure-perl implementation, fast and portable.
774 817
775=item Backends that are transparently being picked up when they are used. 818=item Backends that are transparently being picked up when they are used.
776 819
777These will be used when they are currently loaded when the first watcher 820These will be used when they are currently loaded when the first watcher
778is created, in which case it is assumed that the application is using 821is created, in which case it is assumed that the application is using
779them. This means that AnyEvent will automatically pick the right backend 822them. This means that AnyEvent will automatically pick the right backend
780when the main program loads an event module before anything starts to 823when the main program loads an event module before anything starts to
781create watchers. Nothing special needs to be done by the main program. 824create watchers. Nothing special needs to be done by the main program.
782 825
826 AnyEvent::Impl::Event based on Event, very stable, few glitches.
783 AnyEvent::Impl::Glib based on Glib, slow but very stable. 827 AnyEvent::Impl::Glib based on Glib, slow but very stable.
784 AnyEvent::Impl::Tk based on Tk, very broken. 828 AnyEvent::Impl::Tk based on Tk, very broken.
785 AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse. 829 AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse.
786 AnyEvent::Impl::POE based on POE, very slow, some limitations. 830 AnyEvent::Impl::POE based on POE, very slow, some limitations.
831 AnyEvent::Impl::Irssi used when running within irssi.
787 832
788=item Backends with special needs. 833=item Backends with special needs.
789 834
790Qt requires the Qt::Application to be instantiated first, but will 835Qt requires the Qt::Application to be instantiated first, but will
791otherwise be picked up automatically. As long as the main program 836otherwise be picked up automatically. As long as the main program
865event module detection too early, for example, L<AnyEvent::AIO> creates 910event 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 911and installs the global L<IO::AIO> watcher in a C<post_detect> block to
867avoid autodetecting the event module at load time. 912avoid autodetecting the event module at load time.
868 913
869If called in scalar or list context, then it creates and returns an object 914If called in scalar or list context, then it creates and returns an object
870that automatically removes the callback again when it is destroyed. See 915that automatically removes the callback again when it is destroyed (or
916C<undef> when the hook was immediately executed). See L<AnyEvent::AIO> for
871L<Coro::BDB> for a case where this is useful. 917a case where this is useful.
918
919Example: Create a watcher for the IO::AIO module and store it in
920C<$WATCHER>. Only do so after the event loop is initialised, though.
921
922 our WATCHER;
923
924 my $guard = AnyEvent::post_detect {
925 $WATCHER = AnyEvent->io (fh => IO::AIO::poll_fileno, poll => 'r', cb => \&IO::AIO::poll_cb);
926 };
927
928 # the ||= is important in case post_detect immediately runs the block,
929 # as to not clobber the newly-created watcher. assigning both watcher and
930 # post_detect guard to the same variable has the advantage of users being
931 # able to just C<undef $WATCHER> if the watcher causes them grief.
932
933 $WATCHER ||= $guard;
872 934
873=item @AnyEvent::post_detect 935=item @AnyEvent::post_detect
874 936
875If there are any code references in this array (you can C<push> to it 937If there are any code references in this array (you can C<push> to it
876before or after loading AnyEvent), then they will called directly after 938before or after loading AnyEvent), then they will called directly after
1041 1103
1042=cut 1104=cut
1043 1105
1044package AnyEvent; 1106package AnyEvent;
1045 1107
1108# basically a tuned-down version of common::sense
1109sub common_sense {
1046no warnings; 1110 # no warnings
1111 ${^WARNING_BITS} ^= ${^WARNING_BITS};
1047use strict qw(vars subs); 1112 # use strict vars subs
1113 $^H |= 0x00000600;
1114}
1115
1116BEGIN { AnyEvent::common_sense }
1048 1117
1049use Carp (); 1118use Carp ();
1050 1119
1051our $VERSION = 4.83; 1120our $VERSION = 4.92;
1052our $MODEL; 1121our $MODEL;
1053 1122
1054our $AUTOLOAD; 1123our $AUTOLOAD;
1055our @ISA; 1124our @ISA;
1056 1125
1081 for reverse split /\s*,\s*/, 1150 for reverse split /\s*,\s*/,
1082 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6"; 1151 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6";
1083} 1152}
1084 1153
1085my @models = ( 1154my @models = (
1086 [EV:: => AnyEvent::Impl::EV::], 1155 [EV:: => AnyEvent::Impl::EV:: , 1],
1087 [Event:: => AnyEvent::Impl::Event::],
1088 [AnyEvent::Impl::Perl:: => AnyEvent::Impl::Perl::], 1156 [AnyEvent::Impl::Perl:: => AnyEvent::Impl::Perl:: , 1],
1089 # everything below here will not be autoprobed 1157 # everything below here will not (normally) be autoprobed
1090 # as the pureperl backend should work everywhere 1158 # as the pureperl backend should work everywhere
1091 # and is usually faster 1159 # and is usually faster
1160 [Event:: => AnyEvent::Impl::Event::, 1],
1092 [Glib:: => AnyEvent::Impl::Glib::], # becomes extremely slow with many watchers 1161 [Glib:: => AnyEvent::Impl::Glib:: , 1], # becomes extremely slow with many watchers
1093 [Event::Lib:: => AnyEvent::Impl::EventLib::], # too buggy 1162 [Event::Lib:: => AnyEvent::Impl::EventLib::], # too buggy
1163 [Irssi:: => AnyEvent::Impl::Irssi::], # Irssi has a bogus "Event" package
1094 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles 1164 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles
1095 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program 1165 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program
1096 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 1166 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
1097 [Wx:: => AnyEvent::Impl::POE::], 1167 [Wx:: => AnyEvent::Impl::POE::],
1098 [Prima:: => AnyEvent::Impl::POE::], 1168 [Prima:: => AnyEvent::Impl::POE::],
1099 # IO::Async is just too broken - we would need workarounds for its 1169 # IO::Async is just too broken - we would need workarounds for its
1100 # byzantine signal and broken child handling, among others. 1170 # byzantine signal and broken child handling, among others.
1101 # IO::Async is rather hard to detect, as it doesn't have any 1171 # IO::Async is rather hard to detect, as it doesn't have any
1102 # obvious default class. 1172 # obvious default class.
1103# [IO::Async:: => AnyEvent::Impl::IOAsync::], # requires special main program 1173# [0, IO::Async:: => AnyEvent::Impl::IOAsync::], # requires special main program
1104# [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program 1174# [0, IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program
1105# [IO::Async::Notifier:: => AnyEvent::Impl::IOAsync::], # requires special main program 1175# [0, IO::Async::Notifier:: => AnyEvent::Impl::IOAsync::], # requires special main program
1106); 1176);
1107 1177
1108our %method = map +($_ => 1), 1178our %method = map +($_ => 1),
1109 qw(io timer time now now_update signal child idle condvar one_event DESTROY); 1179 qw(io timer time now now_update signal child idle condvar one_event DESTROY);
1110 1180
1114 my ($cb) = @_; 1184 my ($cb) = @_;
1115 1185
1116 if ($MODEL) { 1186 if ($MODEL) {
1117 $cb->(); 1187 $cb->();
1118 1188
1119 1 1189 undef
1120 } else { 1190 } else {
1121 push @post_detect, $cb; 1191 push @post_detect, $cb;
1122 1192
1123 defined wantarray 1193 defined wantarray
1124 ? bless \$cb, "AnyEvent::Util::postdetect" 1194 ? bless \$cb, "AnyEvent::Util::postdetect"
1130 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1200 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1131} 1201}
1132 1202
1133sub detect() { 1203sub detect() {
1134 unless ($MODEL) { 1204 unless ($MODEL) {
1135 no strict 'refs';
1136 local $SIG{__DIE__}; 1205 local $SIG{__DIE__};
1137 1206
1138 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1207 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {
1139 my $model = "AnyEvent::Impl::$1"; 1208 my $model = "AnyEvent::Impl::$1";
1140 if (eval "require $model") { 1209 if (eval "require $model") {
1157 } 1226 }
1158 } 1227 }
1159 } 1228 }
1160 1229
1161 unless ($MODEL) { 1230 unless ($MODEL) {
1162 # try to load a model 1231 # try to autoload a model
1163
1164 for (@REGISTRY, @models) { 1232 for (@REGISTRY, @models) {
1165 my ($package, $model) = @$_; 1233 my ($package, $model, $autoload) = @$_;
1234 if (
1235 $autoload
1166 if (eval "require $package" 1236 and eval "require $package"
1167 and ${"$package\::VERSION"} > 0 1237 and ${"$package\::VERSION"} > 0
1168 and eval "require $model") { 1238 and eval "require $model"
1239 ) {
1169 $MODEL = $model; 1240 $MODEL = $model;
1170 warn "AnyEvent: autoprobed model '$model', using it.\n" if $VERBOSE >= 2; 1241 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1171 last; 1242 last;
1172 } 1243 }
1173 } 1244 }
1174 1245
1175 $MODEL 1246 $MODEL
1214 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,"; 1285 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,";
1215 1286
1216 # we assume CLOEXEC is already set by perl in all important cases 1287 # we assume CLOEXEC is already set by perl in all important cases
1217 1288
1218 ($fh2, $rw) 1289 ($fh2, $rw)
1290}
1291
1292#############################################################################
1293# "new" API, currently only emulation of it
1294#############################################################################
1295
1296package AE;
1297
1298our $VERSION = $AnyEvent::VERSION;
1299
1300sub io($$$) {
1301 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1302}
1303
1304sub timer($$$) {
1305 AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2]);
1306}
1307
1308sub signal($$) {
1309 AnyEvent->signal (signal => $_[0], cb => $_[1]);
1310}
1311
1312sub child($$) {
1313 AnyEvent->child (pid => $_[0], cb => $_[1]);
1314}
1315
1316sub idle($) {
1317 AnyEvent->idle (cb => $_[0]);
1318}
1319
1320sub cv(;&) {
1321 AnyEvent->condvar (@_ ? (cb => $_[0]) : ())
1322}
1323
1324sub now() {
1325 AnyEvent->now
1326}
1327
1328sub now_update() {
1329 AnyEvent->now_update
1330}
1331
1332sub time() {
1333 AnyEvent->time
1219} 1334}
1220 1335
1221package AnyEvent::Base; 1336package AnyEvent::Base;
1222 1337
1223# default implementations for many methods 1338# default implementations for many methods
1247} 1362}
1248 1363
1249# default implementation for ->signal 1364# default implementation for ->signal
1250 1365
1251our $HAVE_ASYNC_INTERRUPT; 1366our $HAVE_ASYNC_INTERRUPT;
1367
1368sub _have_async_interrupt() {
1369 $HAVE_ASYNC_INTERRUPT = 1*(!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT}
1370 && eval "use Async::Interrupt 1.0 (); 1")
1371 unless defined $HAVE_ASYNC_INTERRUPT;
1372
1373 $HAVE_ASYNC_INTERRUPT
1374}
1375
1252our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1376our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1253our (%SIG_ASY, %SIG_ASY_W); 1377our (%SIG_ASY, %SIG_ASY_W);
1254our ($SIG_COUNT, $SIG_TW); 1378our ($SIG_COUNT, $SIG_TW);
1255 1379
1256sub _signal_exec { 1380sub _signal_exec {
1264 $_->() for values %{ $SIG_CB{$_} || {} }; 1388 $_->() for values %{ $SIG_CB{$_} || {} };
1265 } 1389 }
1266 } 1390 }
1267} 1391}
1268 1392
1393# install a dummy wakeup watcher to reduce signal catching latency
1269sub _signal { 1394sub _sig_add() {
1270 my (undef, %arg) = @_; 1395 unless ($SIG_COUNT++) {
1396 # try to align timer on a full-second boundary, if possible
1397 my $NOW = AE::now;
1271 1398
1272 my $signal = uc $arg{signal} 1399 $SIG_TW = AE::timer
1273 or Carp::croak "required option 'signal' is missing"; 1400 $MAX_SIGNAL_LATENCY - ($NOW - int $NOW),
1274 1401 $MAX_SIGNAL_LATENCY,
1275 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1402 sub { } # just for the PERL_ASYNC_CHECK
1276
1277 if ($HAVE_ASYNC_INTERRUPT) {
1278 # async::interrupt
1279
1280 $SIG_ASY{$signal} ||= do {
1281 my $asy = new Async::Interrupt
1282 cb => sub { undef $SIG_EV{$signal} },
1283 signal => $signal,
1284 pipe => [$SIGPIPE_R->filenos],
1285 ;
1286 $asy->pipe_autodrain (0);
1287
1288 $asy
1289 }; 1403 ;
1290
1291 } else {
1292 # pure perl
1293
1294 $SIG{$signal} ||= sub {
1295 local $!;
1296 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1297 undef $SIG_EV{$signal};
1298 };
1299
1300 # can't do signal processing without introducing races in pure perl,
1301 # so limit the signal latency.
1302 ++$SIG_COUNT;
1303 $SIG_TW ||= AnyEvent->timer (
1304 after => $MAX_SIGNAL_LATENCY,
1305 interval => $MAX_SIGNAL_LATENCY,
1306 cb => sub { }, # just for the PERL_ASYNC_CHECK
1307 );
1308 } 1404 }
1309
1310 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1311} 1405}
1312 1406
1313sub signal { 1407sub _sig_del {
1314 # probe for availability of Async::Interrupt
1315 if (!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} && eval "use Async::Interrupt 0.6 (); 1") {
1316 warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8;
1317
1318 $HAVE_ASYNC_INTERRUPT = 1;
1319 $SIGPIPE_R = new Async::Interrupt::EventPipe;
1320 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec);
1321
1322 } else {
1323 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1324
1325 require Fcntl;
1326
1327 if (AnyEvent::WIN32) {
1328 require AnyEvent::Util;
1329
1330 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1331 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R) if $SIGPIPE_R;
1332 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case
1333 } else {
1334 pipe $SIGPIPE_R, $SIGPIPE_W;
1335 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;
1336 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case
1337
1338 # not strictly required, as $^F is normally 2, but let's make sure...
1339 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1340 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1341 }
1342
1343 $SIGPIPE_R
1344 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1345
1346 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1347 }
1348
1349 *signal = \&_signal;
1350 &signal
1351}
1352
1353sub AnyEvent::Base::signal::DESTROY {
1354 my ($signal, $cb) = @{$_[0]};
1355
1356 undef $SIG_TW 1408 undef $SIG_TW
1357 unless --$SIG_COUNT; 1409 unless --$SIG_COUNT;
1410}
1358 1411
1412our $_sig_name_init; $_sig_name_init = sub {
1413 eval q{ # poor man's autoloading
1414 undef $_sig_name_init;
1415
1416 if (_have_async_interrupt) {
1417 *sig2num = \&Async::Interrupt::sig2num;
1418 *sig2name = \&Async::Interrupt::sig2name;
1419 } else {
1420 require Config;
1421
1422 my %signame2num;
1423 @signame2num{ split ' ', $Config::Config{sig_name} }
1424 = split ' ', $Config::Config{sig_num};
1425
1426 my @signum2name;
1427 @signum2name[values %signame2num] = keys %signame2num;
1428
1429 *sig2num = sub($) {
1430 $_[0] > 0 ? shift : $signame2num{+shift}
1431 };
1432 *sig2name = sub ($) {
1433 $_[0] > 0 ? $signum2name[+shift] : shift
1434 };
1435 }
1436 };
1437 die if $@;
1438};
1439
1440sub sig2num ($) { &$_sig_name_init; &sig2num }
1441sub sig2name($) { &$_sig_name_init; &sig2name }
1442
1443sub signal {
1444 eval q{ # poor man's autoloading {}
1445 # probe for availability of Async::Interrupt
1446 if (_have_async_interrupt) {
1447 warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8;
1448
1449 $SIGPIPE_R = new Async::Interrupt::EventPipe;
1450 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1451
1452 } else {
1453 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1454
1455 require Fcntl;
1456
1457 if (AnyEvent::WIN32) {
1458 require AnyEvent::Util;
1459
1460 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1461 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1462 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W, 1) if $SIGPIPE_W; # just in case
1463 } else {
1464 pipe $SIGPIPE_R, $SIGPIPE_W;
1465 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;
1466 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case
1467
1468 # not strictly required, as $^F is normally 2, but let's make sure...
1469 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1470 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1471 }
1472
1473 $SIGPIPE_R
1474 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1475
1476 $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec;
1477 }
1478
1479 *signal = sub {
1480 my (undef, %arg) = @_;
1481
1482 my $signal = uc $arg{signal}
1483 or Carp::croak "required option 'signal' is missing";
1484
1485 if ($HAVE_ASYNC_INTERRUPT) {
1486 # async::interrupt
1487
1488 $signal = sig2num $signal;
1489 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1490
1491 $SIG_ASY{$signal} ||= new Async::Interrupt
1492 cb => sub { undef $SIG_EV{$signal} },
1493 signal => $signal,
1494 pipe => [$SIGPIPE_R->filenos],
1495 pipe_autodrain => 0,
1496 ;
1497
1498 } else {
1499 # pure perl
1500
1501 # AE::Util has been loaded in signal
1502 $signal = sig2name $signal;
1503 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1504
1505 $SIG{$signal} ||= sub {
1506 local $!;
1507 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1508 undef $SIG_EV{$signal};
1509 };
1510
1511 # can't do signal processing without introducing races in pure perl,
1512 # so limit the signal latency.
1513 _sig_add;
1514 }
1515
1516 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1517 };
1518
1519 *AnyEvent::Base::signal::DESTROY = sub {
1520 my ($signal, $cb) = @{$_[0]};
1521
1522 _sig_del;
1523
1359 delete $SIG_CB{$signal}{$cb}; 1524 delete $SIG_CB{$signal}{$cb};
1360 1525
1526 $HAVE_ASYNC_INTERRUPT
1527 ? delete $SIG_ASY{$signal}
1361 # delete doesn't work with older perls - they then 1528 : # delete doesn't work with older perls - they then
1362 # print weird messages, or just unconditionally exit 1529 # print weird messages, or just unconditionally exit
1363 # instead of getting the default action. 1530 # instead of getting the default action.
1364 undef $SIG{$signal} 1531 undef $SIG{$signal}
1365 unless keys %{ $SIG_CB{$signal} }; 1532 unless keys %{ $SIG_CB{$signal} };
1533 };
1534 };
1535 die if $@;
1536 &signal
1366} 1537}
1367 1538
1368# default implementation for ->child 1539# default implementation for ->child
1369 1540
1370our %PID_CB; 1541our %PID_CB;
1371our $CHLD_W; 1542our $CHLD_W;
1372our $CHLD_DELAY_W; 1543our $CHLD_DELAY_W;
1373our $WNOHANG; 1544our $WNOHANG;
1374 1545
1546sub _emit_childstatus($$) {
1547 my (undef, $rpid, $rstatus) = @_;
1548
1549 $_->($rpid, $rstatus)
1550 for values %{ $PID_CB{$rpid} || {} },
1551 values %{ $PID_CB{0} || {} };
1552}
1553
1375sub _sigchld { 1554sub _sigchld {
1555 my $pid;
1556
1557 AnyEvent->_emit_childstatus ($pid, $?)
1376 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1558 while ($pid = waitpid -1, $WNOHANG) > 0;
1377 $_->($pid, $?)
1378 for values %{ $PID_CB{$pid} || {} },
1379 values %{ $PID_CB{0} || {} };
1380 }
1381} 1559}
1382 1560
1383sub child { 1561sub child {
1384 my (undef, %arg) = @_; 1562 my (undef, %arg) = @_;
1385 1563
1386 defined (my $pid = $arg{pid} + 0) 1564 defined (my $pid = $arg{pid} + 0)
1387 or Carp::croak "required option 'pid' is missing"; 1565 or Carp::croak "required option 'pid' is missing";
1388 1566
1389 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1567 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1390 1568
1569 # WNOHANG is almost cetrainly 1 everywhere
1570 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1571 ? 1
1391 $WNOHANG ||= eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1572 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1392 1573
1393 unless ($CHLD_W) { 1574 unless ($CHLD_W) {
1394 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1575 $CHLD_W = AE::signal CHLD => \&_sigchld;
1395 # child could be a zombie already, so make at least one round 1576 # child could be a zombie already, so make at least one round
1396 &_sigchld; 1577 &_sigchld;
1397 } 1578 }
1398 1579
1399 bless [$pid, $arg{cb}], "AnyEvent::Base::child" 1580 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1425 # never use more then 50% of the time for the idle watcher, 1606 # never use more then 50% of the time for the idle watcher,
1426 # within some limits 1607 # within some limits
1427 $w = 0.0001 if $w < 0.0001; 1608 $w = 0.0001 if $w < 0.0001;
1428 $w = 5 if $w > 5; 1609 $w = 5 if $w > 5;
1429 1610
1430 $w = AnyEvent->timer (after => $w, cb => $rcb); 1611 $w = AE::timer $w, 0, $rcb;
1431 } else { 1612 } else {
1432 # clean up... 1613 # clean up...
1433 undef $w; 1614 undef $w;
1434 undef $rcb; 1615 undef $rcb;
1435 } 1616 }
1436 }; 1617 };
1437 1618
1438 $w = AnyEvent->timer (after => 0.05, cb => $rcb); 1619 $w = AE::timer 0.05, 0, $rcb;
1439 1620
1440 bless \\$cb, "AnyEvent::Base::idle" 1621 bless \\$cb, "AnyEvent::Base::idle"
1441} 1622}
1442 1623
1443sub AnyEvent::Base::idle::DESTROY { 1624sub AnyEvent::Base::idle::DESTROY {
1448 1629
1449our @ISA = AnyEvent::CondVar::Base::; 1630our @ISA = AnyEvent::CondVar::Base::;
1450 1631
1451package AnyEvent::CondVar::Base; 1632package AnyEvent::CondVar::Base;
1452 1633
1453use overload 1634#use overload
1454 '&{}' => sub { my $self = shift; sub { $self->send (@_) } }, 1635# '&{}' => sub { my $self = shift; sub { $self->send (@_) } },
1455 fallback => 1; 1636# fallback => 1;
1637
1638# save 300+ kilobytes by dirtily hardcoding overloading
1639${"AnyEvent::CondVar::Base::OVERLOAD"}{dummy}++; # Register with magic by touching.
1640*{'AnyEvent::CondVar::Base::()'} = sub { }; # "Make it findable via fetchmethod."
1641*{'AnyEvent::CondVar::Base::(&{}'} = sub { my $self = shift; sub { $self->send (@_) } }; # &{}
1642${'AnyEvent::CondVar::Base::()'} = 1; # fallback
1456 1643
1457our $WAITING; 1644our $WAITING;
1458 1645
1459sub _send { 1646sub _send {
1460 # nop 1647 # nop
1491 Carp::croak $_[0]{_ae_croak} if $_[0]{_ae_croak}; 1678 Carp::croak $_[0]{_ae_croak} if $_[0]{_ae_croak};
1492 wantarray ? @{ $_[0]{_ae_sent} } : $_[0]{_ae_sent}[0] 1679 wantarray ? @{ $_[0]{_ae_sent} } : $_[0]{_ae_sent}[0]
1493} 1680}
1494 1681
1495sub cb { 1682sub cb {
1496 $_[0]{_ae_cb} = $_[1] if @_ > 1; 1683 my $cv = shift;
1684
1685 @_
1686 and $cv->{_ae_cb} = shift
1687 and $cv->{_ae_sent}
1688 and (delete $cv->{_ae_cb})->($cv);
1689
1497 $_[0]{_ae_cb} 1690 $cv->{_ae_cb}
1498} 1691}
1499 1692
1500sub begin { 1693sub begin {
1501 ++$_[0]{_ae_counter}; 1694 ++$_[0]{_ae_counter};
1502 $_[0]{_ae_end_cb} = $_[1] if @_ > 1; 1695 $_[0]{_ae_end_cb} = $_[1] if @_ > 1;
1551C<PERL_ANYEVENT_MODEL>. 1744C<PERL_ANYEVENT_MODEL>.
1552 1745
1553When set to C<2> or higher, cause AnyEvent to report to STDERR which event 1746When set to C<2> or higher, cause AnyEvent to report to STDERR which event
1554model it chooses. 1747model it chooses.
1555 1748
1749When set to C<8> or higher, then AnyEvent will report extra information on
1750which optional modules it loads and how it implements certain features.
1751
1556=item C<PERL_ANYEVENT_STRICT> 1752=item C<PERL_ANYEVENT_STRICT>
1557 1753
1558AnyEvent does not do much argument checking by default, as thorough 1754AnyEvent does not do much argument checking by default, as thorough
1559argument checking is very costly. Setting this variable to a true value 1755argument checking is very costly. Setting this variable to a true value
1560will cause AnyEvent to load C<AnyEvent::Strict> and then to thoroughly 1756will cause AnyEvent to load C<AnyEvent::Strict> and then to thoroughly
1561check the arguments passed to most method calls. If it finds any problems, 1757check the arguments passed to most method calls. If it finds any problems,
1562it will croak. 1758it will croak.
1563 1759
1564In other words, enables "strict" mode. 1760In other words, enables "strict" mode.
1565 1761
1566Unlike C<use strict>, it is definitely recommended to keep it off in 1762Unlike C<use strict> (or it's modern cousin, C<< use L<common::sense>
1567production. Keeping C<PERL_ANYEVENT_STRICT=1> in your environment while 1763>>, it is definitely recommended to keep it off in production. Keeping
1568developing programs can be very useful, however. 1764C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs
1765can be very useful, however.
1569 1766
1570=item C<PERL_ANYEVENT_MODEL> 1767=item C<PERL_ANYEVENT_MODEL>
1571 1768
1572This can be used to specify the event model to be used by AnyEvent, before 1769This can be used to specify the event model to be used by AnyEvent, before
1573auto detection and -probing kicks in. It must be a string consisting 1770auto detection and -probing kicks in. It must be a string consisting
1635 1832
1636When neither C<ca_file> nor C<ca_path> was specified during 1833When neither C<ca_file> nor C<ca_path> was specified during
1637L<AnyEvent::TLS> context creation, and either of these environment 1834L<AnyEvent::TLS> context creation, and either of these environment
1638variables exist, they will be used to specify CA certificate locations 1835variables exist, they will be used to specify CA certificate locations
1639instead of a system-dependent default. 1836instead of a system-dependent default.
1837
1838=item C<PERL_ANYEVENT_AVOID_GUARD> and C<PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT>
1839
1840When these are set to C<1>, then the respective modules are not
1841loaded. Mostly good for testing AnyEvent itself.
1640 1842
1641=back 1843=back
1642 1844
1643=head1 SUPPLYING YOUR OWN EVENT MODEL INTERFACE 1845=head1 SUPPLYING YOUR OWN EVENT MODEL INTERFACE
1644 1846
2231 2433
2232This slightly arcane module is used to implement fast signal handling: To 2434This slightly arcane module is used to implement fast signal handling: To
2233my knowledge, there is no way to do completely race-free and quick 2435my knowledge, there is no way to do completely race-free and quick
2234signal handling in pure perl. To ensure that signals still get 2436signal handling in pure perl. To ensure that signals still get
2235delivered, AnyEvent will start an interval timer to wake up perl (and 2437delivered, AnyEvent will start an interval timer to wake up perl (and
2236catch the signals) with soemd elay (default is 10 seconds, look for 2438catch the signals) with some delay (default is 10 seconds, look for
2237C<$AnyEvent::MAX_SIGNAL_LATENCY>). 2439C<$AnyEvent::MAX_SIGNAL_LATENCY>).
2238 2440
2239If this module is available, then it will be used to implement signal 2441If this module is available, then it will be used to implement signal
2240catching, which means that signals will not be delayed, and the event loop 2442catching, which means that signals will not be delayed, and the event loop
2241will not be interrupted regularly, which is more efficient (And good for 2443will not be interrupted regularly, which is more efficient (And good for
2242battery life on laptops). 2444battery life on laptops).
2243 2445
2244This affects not just the pure-perl event loop, but also other event loops 2446This affects not just the pure-perl event loop, but also other event loops
2245that have no signal handling on their own (e.g. Glib, Tk, Qt). 2447that have no signal handling on their own (e.g. Glib, Tk, Qt).
2448
2449Some event loops (POE, Event, Event::Lib) offer signal watchers natively,
2450and either employ their own workarounds (POE) or use AnyEvent's workaround
2451(using C<$AnyEvent::MAX_SIGNAL_LATENCY>). Installing L<Async::Interrupt>
2452does nothing for those backends.
2246 2453
2247=item L<EV> 2454=item L<EV>
2248 2455
2249This module isn't really "optional", as it is simply one of the backend 2456This module isn't really "optional", as it is simply one of the backend
2250event loops that AnyEvent can use. However, it is simply the best event 2457event loops that AnyEvent can use. However, it is simply the best event
2264 2471
2265=item L<JSON> and L<JSON::XS> 2472=item L<JSON> and L<JSON::XS>
2266 2473
2267This module is required when you want to read or write JSON data via 2474This module is required when you want to read or write JSON data via
2268L<AnyEvent::Handle>. It is also written in pure-perl, but can take 2475L<AnyEvent::Handle>. It is also written in pure-perl, but can take
2269advantage of the ulta-high-speed L<JSON::XS> module when it is installed. 2476advantage of the ultra-high-speed L<JSON::XS> module when it is installed.
2270 2477
2271In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is 2478In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2272installed. 2479installed.
2273 2480
2274=item L<Net::SSLeay> 2481=item L<Net::SSLeay>
2341L<Glib>, L<Tk>, L<Event::Lib>, L<Qt>, L<POE>. 2548L<Glib>, L<Tk>, L<Event::Lib>, L<Qt>, L<POE>.
2342 2549
2343Implementations: L<AnyEvent::Impl::EV>, L<AnyEvent::Impl::Event>, 2550Implementations: L<AnyEvent::Impl::EV>, L<AnyEvent::Impl::Event>,
2344L<AnyEvent::Impl::Glib>, L<AnyEvent::Impl::Tk>, L<AnyEvent::Impl::Perl>, 2551L<AnyEvent::Impl::Glib>, L<AnyEvent::Impl::Tk>, L<AnyEvent::Impl::Perl>,
2345L<AnyEvent::Impl::EventLib>, L<AnyEvent::Impl::Qt>, 2552L<AnyEvent::Impl::EventLib>, L<AnyEvent::Impl::Qt>,
2346L<AnyEvent::Impl::POE>, L<AnyEvent::Impl::IOAsync>. 2553L<AnyEvent::Impl::POE>, L<AnyEvent::Impl::IOAsync>, L<Anyevent::Impl::Irssi>.
2347 2554
2348Non-blocking file handles, sockets, TCP clients and 2555Non-blocking file handles, sockets, TCP clients and
2349servers: L<AnyEvent::Handle>, L<AnyEvent::Socket>, L<AnyEvent::TLS>. 2556servers: L<AnyEvent::Handle>, L<AnyEvent::Socket>, L<AnyEvent::TLS>.
2350 2557
2351Asynchronous DNS: L<AnyEvent::DNS>. 2558Asynchronous DNS: L<AnyEvent::DNS>.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines