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.248 by root, Sat Jul 18 22:27:10 2009 UTC vs.
Revision 1.277 by root, Sun Aug 9 13:27:23 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
375 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 }); 399 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 });
376 400
377=head3 Signal Races, Delays and Workarounds 401=head3 Signal Races, Delays and Workarounds
378 402
379Many event loops (e.g. Glib, Tk, Qt, IO::Async) do not support attaching 403Many event loops (e.g. Glib, Tk, Qt, IO::Async) do not support attaching
380callbacks to signals in a generic way, which is a pity, as you cannot do 404callbacks to signals in a generic way, which is a pity, as you cannot
381race-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,
382in 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
383be delayed is specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10 408specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10 seconds). This
384seconds). This variable can be changed only before the first signal 409variable can be changed only before the first signal watcher is created,
385watcher 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
386will 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
387saving. All these problems can be avoided by installing the optional 415All these problems can be avoided by installing the optional
388L<Async::Interrupt> module. This will not work with inherently broken 416L<Async::Interrupt> module, which works with most event loops. It will not
389event loops such as L<Event> or L<Event::Lib> (and not with L<POE> 417work with inherently broken event loops such as L<Event> or L<Event::Lib>
390currently, as POE does it's own workaround with one-second latency). With 418(and not with L<POE> currently, as POE does it's own workaround with
391those, you just have to suffer the delays. 419one-second latency). For those, you just have to suffer the delays.
392 420
393=head2 CHILD PROCESS WATCHERS 421=head2 CHILD PROCESS WATCHERS
394 422
423 $w = AnyEvent->child (pid => <process id>, cb => <callback>);
424
395You 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.
396 426
397The 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,
398watches for any child process exit). The watcher will triggered only when 428using C<0> watches for any child process exit, on others this will
399the child process has finished and an exit status is available, not on 429croak). The watcher will be triggered only when the child process has
400any trace events (stopped/continued). 430finished and an exit status is available, not on any trace events
431(stopped/continued).
401 432
402The 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
403waitpid), 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
404callback arguments. 435callback arguments.
405 436
446 # do something else, then wait for process exit 477 # do something else, then wait for process exit
447 $done->recv; 478 $done->recv;
448 479
449=head2 IDLE WATCHERS 480=head2 IDLE WATCHERS
450 481
482 $w = AnyEvent->idle (cb => <callback>);
483
451Sometimes 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
452to 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
453"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
454attention by the event loop". 487attention by the event loop".
455 488
481 }); 514 });
482 }); 515 });
483 516
484=head2 CONDITION VARIABLES 517=head2 CONDITION VARIABLES
485 518
519 $cv = AnyEvent->condvar;
520
521 $cv->send (<list>);
522 my @res = $cv->recv;
523
486If 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
487require you to run some blocking "loop", "run" or similar function that 525require you to run some blocking "loop", "run" or similar function that
488will actively watch for new events and call your callbacks. 526will actively watch for new events and call your callbacks.
489 527
490AnyEvent is slightly different: it expects somebody else to run the event 528AnyEvent is slightly different: it expects somebody else to run the event
509Condition variables are similar to callbacks, except that you can 547Condition variables are similar to callbacks, except that you can
510optionally wait for them. They can also be called merge points - points 548optionally wait for them. They can also be called merge points - points
511in time where multiple outstanding events have been processed. And yet 549in time where multiple outstanding events have been processed. And yet
512another way to call them is transactions - each condition variable can be 550another way to call them is transactions - each condition variable can be
513used to represent a transaction, which finishes at some point and delivers 551used to represent a transaction, which finishes at some point and delivers
514a result. 552a result. And yet some people know them as "futures" - a promise to
553compute/deliver something that you can wait for.
515 554
516Condition variables are very useful to signal that something has finished, 555Condition variables are very useful to signal that something has finished,
517for example, if you write a module that does asynchronous http requests, 556for example, if you write a module that does asynchronous http requests,
518then a condition variable would be the ideal candidate to signal the 557then a condition variable would be the ideal candidate to signal the
519availability of results. The user can either act when the callback is 558availability of results. The user can either act when the callback is
751=item $cb = $cv->cb ($cb->($cv)) 790=item $cb = $cv->cb ($cb->($cv))
752 791
753This is a mutator function that returns the callback set and optionally 792This is a mutator function that returns the callback set and optionally
754replaces it before doing so. 793replaces it before doing so.
755 794
756The callback will be called when the condition becomes "true", i.e. when 795The callback will be called when the condition becomes (or already was)
757C<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
758variable itself. Calling C<recv> inside the callback or at any later time 797the only argument being the condition variable itself. Calling C<recv>
759is guaranteed not to block. 798inside the callback or at any later time is guaranteed not to block.
760 799
761=back 800=back
762 801
763=head1 SUPPORTED EVENT LOOPS/BACKENDS 802=head1 SUPPORTED EVENT LOOPS/BACKENDS
764 803
767=over 4 806=over 4
768 807
769=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.
770 809
771EV 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
772use. 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
773that, will fall back to its own pure-perl implementation, which is 812pure-perl implementation, which is available everywhere as it comes with
774available everywhere as it comes with AnyEvent itself. 813AnyEvent itself.
775 814
776 AnyEvent::Impl::EV based on EV (interface to libev, best choice). 815 AnyEvent::Impl::EV based on EV (interface to libev, best choice).
777 AnyEvent::Impl::Event based on Event, very stable, few glitches.
778 AnyEvent::Impl::Perl pure-perl implementation, fast and portable. 816 AnyEvent::Impl::Perl pure-perl implementation, fast and portable.
779 817
780=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.
781 819
782These 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
783is 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
784them. This means that AnyEvent will automatically pick the right backend 822them. This means that AnyEvent will automatically pick the right backend
785when the main program loads an event module before anything starts to 823when the main program loads an event module before anything starts to
786create watchers. Nothing special needs to be done by the main program. 824create watchers. Nothing special needs to be done by the main program.
787 825
826 AnyEvent::Impl::Event based on Event, very stable, few glitches.
788 AnyEvent::Impl::Glib based on Glib, slow but very stable. 827 AnyEvent::Impl::Glib based on Glib, slow but very stable.
789 AnyEvent::Impl::Tk based on Tk, very broken. 828 AnyEvent::Impl::Tk based on Tk, very broken.
790 AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse. 829 AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse.
791 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.
792 832
793=item Backends with special needs. 833=item Backends with special needs.
794 834
795Qt requires the Qt::Application to be instantiated first, but will 835Qt requires the Qt::Application to be instantiated first, but will
796otherwise be picked up automatically. As long as the main program 836otherwise be picked up automatically. As long as the main program
870event module detection too early, for example, L<AnyEvent::AIO> creates 910event module detection too early, for example, L<AnyEvent::AIO> creates
871and 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
872avoid autodetecting the event module at load time. 912avoid autodetecting the event module at load time.
873 913
874If 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
875that 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
876L<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;
877 934
878=item @AnyEvent::post_detect 935=item @AnyEvent::post_detect
879 936
880If 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
881before or after loading AnyEvent), then they will called directly after 938before or after loading AnyEvent), then they will called directly after
1058 1115
1059BEGIN { AnyEvent::common_sense } 1116BEGIN { AnyEvent::common_sense }
1060 1117
1061use Carp (); 1118use Carp ();
1062 1119
1063our $VERSION = 4.85; 1120our $VERSION = 4.92;
1064our $MODEL; 1121our $MODEL;
1065 1122
1066our $AUTOLOAD; 1123our $AUTOLOAD;
1067our @ISA; 1124our @ISA;
1068 1125
1093 for reverse split /\s*,\s*/, 1150 for reverse split /\s*,\s*/,
1094 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6"; 1151 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6";
1095} 1152}
1096 1153
1097my @models = ( 1154my @models = (
1098 [EV:: => AnyEvent::Impl::EV::], 1155 [EV:: => AnyEvent::Impl::EV:: , 1],
1099 [Event:: => AnyEvent::Impl::Event::],
1100 [AnyEvent::Impl::Perl:: => AnyEvent::Impl::Perl::], 1156 [AnyEvent::Impl::Perl:: => AnyEvent::Impl::Perl:: , 1],
1101 # everything below here will not be autoprobed 1157 # everything below here will not (normally) be autoprobed
1102 # as the pureperl backend should work everywhere 1158 # as the pureperl backend should work everywhere
1103 # and is usually faster 1159 # and is usually faster
1160 [Event:: => AnyEvent::Impl::Event::, 1],
1104 [Glib:: => AnyEvent::Impl::Glib::], # becomes extremely slow with many watchers 1161 [Glib:: => AnyEvent::Impl::Glib:: , 1], # becomes extremely slow with many watchers
1105 [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
1106 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles 1164 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles
1107 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program 1165 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program
1108 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 1166 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
1109 [Wx:: => AnyEvent::Impl::POE::], 1167 [Wx:: => AnyEvent::Impl::POE::],
1110 [Prima:: => AnyEvent::Impl::POE::], 1168 [Prima:: => AnyEvent::Impl::POE::],
1111 # 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
1112 # byzantine signal and broken child handling, among others. 1170 # byzantine signal and broken child handling, among others.
1113 # 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
1114 # obvious default class. 1172 # obvious default class.
1115# [IO::Async:: => AnyEvent::Impl::IOAsync::], # requires special main program 1173 [IO::Async:: => AnyEvent::Impl::IOAsync::], # requires special main program
1116# [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program 1174 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program
1117# [IO::Async::Notifier:: => AnyEvent::Impl::IOAsync::], # requires special main program 1175 [IO::Async::Notifier:: => AnyEvent::Impl::IOAsync::], # requires special main program
1176 [AnyEvent::Impl::IOAsync:: => AnyEvent::Impl::IOAsync::], # requires special main program
1118); 1177);
1119 1178
1120our %method = map +($_ => 1), 1179our %method = map +($_ => 1),
1121 qw(io timer time now now_update signal child idle condvar one_event DESTROY); 1180 qw(io timer time now now_update signal child idle condvar one_event DESTROY);
1122 1181
1126 my ($cb) = @_; 1185 my ($cb) = @_;
1127 1186
1128 if ($MODEL) { 1187 if ($MODEL) {
1129 $cb->(); 1188 $cb->();
1130 1189
1131 1 1190 undef
1132 } else { 1191 } else {
1133 push @post_detect, $cb; 1192 push @post_detect, $cb;
1134 1193
1135 defined wantarray 1194 defined wantarray
1136 ? bless \$cb, "AnyEvent::Util::postdetect" 1195 ? bless \$cb, "AnyEvent::Util::postdetect"
1168 } 1227 }
1169 } 1228 }
1170 } 1229 }
1171 1230
1172 unless ($MODEL) { 1231 unless ($MODEL) {
1173 # try to load a model 1232 # try to autoload a model
1174
1175 for (@REGISTRY, @models) { 1233 for (@REGISTRY, @models) {
1176 my ($package, $model) = @$_; 1234 my ($package, $model, $autoload) = @$_;
1235 if (
1236 $autoload
1177 if (eval "require $package" 1237 and eval "require $package"
1178 and ${"$package\::VERSION"} > 0 1238 and ${"$package\::VERSION"} > 0
1179 and eval "require $model") { 1239 and eval "require $model"
1240 ) {
1180 $MODEL = $model; 1241 $MODEL = $model;
1181 warn "AnyEvent: autoprobed model '$model', using it.\n" if $VERBOSE >= 2; 1242 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1182 last; 1243 last;
1183 } 1244 }
1184 } 1245 }
1185 1246
1186 $MODEL 1247 $MODEL
1225 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,"; 1286 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,";
1226 1287
1227 # we assume CLOEXEC is already set by perl in all important cases 1288 # we assume CLOEXEC is already set by perl in all important cases
1228 1289
1229 ($fh2, $rw) 1290 ($fh2, $rw)
1291}
1292
1293#############################################################################
1294# "new" API, currently only emulation of it
1295#############################################################################
1296
1297package AE;
1298
1299our $VERSION = $AnyEvent::VERSION;
1300
1301sub io($$$) {
1302 AnyEvent->io (fh => $_[0], poll => $_[1] ? "w" : "r", cb => $_[2])
1303}
1304
1305sub timer($$$) {
1306 AnyEvent->timer (after => $_[0], interval => $_[1], cb => $_[2])
1307}
1308
1309sub signal($$) {
1310 AnyEvent->signal (signal => $_[0], cb => $_[1])
1311}
1312
1313sub child($$) {
1314 AnyEvent->child (pid => $_[0], cb => $_[1])
1315}
1316
1317sub idle($) {
1318 AnyEvent->idle (cb => $_[0])
1319}
1320
1321sub cv(;&) {
1322 AnyEvent->condvar (@_ ? (cb => $_[0]) : ())
1323}
1324
1325sub now() {
1326 AnyEvent->now
1327}
1328
1329sub now_update() {
1330 AnyEvent->now_update
1331}
1332
1333sub time() {
1334 AnyEvent->time
1230} 1335}
1231 1336
1232package AnyEvent::Base; 1337package AnyEvent::Base;
1233 1338
1234# default implementations for many methods 1339# default implementations for many methods
1258} 1363}
1259 1364
1260# default implementation for ->signal 1365# default implementation for ->signal
1261 1366
1262our $HAVE_ASYNC_INTERRUPT; 1367our $HAVE_ASYNC_INTERRUPT;
1368
1369sub _have_async_interrupt() {
1370 $HAVE_ASYNC_INTERRUPT = 1*(!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT}
1371 && eval "use Async::Interrupt 1.0 (); 1")
1372 unless defined $HAVE_ASYNC_INTERRUPT;
1373
1374 $HAVE_ASYNC_INTERRUPT
1375}
1376
1263our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1377our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1264our (%SIG_ASY, %SIG_ASY_W); 1378our (%SIG_ASY, %SIG_ASY_W);
1265our ($SIG_COUNT, $SIG_TW); 1379our ($SIG_COUNT, $SIG_TW);
1266 1380
1267sub _signal_exec { 1381sub _signal_exec {
1275 $_->() for values %{ $SIG_CB{$_} || {} }; 1389 $_->() for values %{ $SIG_CB{$_} || {} };
1276 } 1390 }
1277 } 1391 }
1278} 1392}
1279 1393
1280# install a dumym wakeupw atcher to reduce signal catching latency 1394# install a dummy wakeup watcher to reduce signal catching latency
1281sub _sig_add() { 1395sub _sig_add() {
1282 unless ($SIG_COUNT++) { 1396 unless ($SIG_COUNT++) {
1283 # try to align timer on a full-second boundary, if possible 1397 # try to align timer on a full-second boundary, if possible
1284 my $NOW = AnyEvent->now; 1398 my $NOW = AE::now;
1285 1399
1286 $SIG_TW = AnyEvent->timer ( 1400 $SIG_TW = AE::timer
1287 after => $MAX_SIGNAL_LATENCY - ($NOW - int $NOW), 1401 $MAX_SIGNAL_LATENCY - ($NOW - int $NOW),
1288 interval => $MAX_SIGNAL_LATENCY, 1402 $MAX_SIGNAL_LATENCY,
1289 cb => sub { }, # just for the PERL_ASYNC_CHECK 1403 sub { } # just for the PERL_ASYNC_CHECK
1290 ); 1404 ;
1291 } 1405 }
1292} 1406}
1293 1407
1294sub _sig_del { 1408sub _sig_del {
1295 undef $SIG_TW 1409 undef $SIG_TW
1296 unless --$SIG_COUNT; 1410 unless --$SIG_COUNT;
1297} 1411}
1298 1412
1413our $_sig_name_init; $_sig_name_init = sub {
1414 eval q{ # poor man's autoloading
1415 undef $_sig_name_init;
1416
1417 if (_have_async_interrupt) {
1418 *sig2num = \&Async::Interrupt::sig2num;
1419 *sig2name = \&Async::Interrupt::sig2name;
1420 } else {
1421 require Config;
1422
1423 my %signame2num;
1424 @signame2num{ split ' ', $Config::Config{sig_name} }
1425 = split ' ', $Config::Config{sig_num};
1426
1427 my @signum2name;
1428 @signum2name[values %signame2num] = keys %signame2num;
1429
1430 *sig2num = sub($) {
1431 $_[0] > 0 ? shift : $signame2num{+shift}
1432 };
1433 *sig2name = sub ($) {
1434 $_[0] > 0 ? $signum2name[+shift] : shift
1435 };
1436 }
1437 };
1438 die if $@;
1439};
1440
1441sub sig2num ($) { &$_sig_name_init; &sig2num }
1442sub sig2name($) { &$_sig_name_init; &sig2name }
1443
1299sub _signal { 1444sub signal {
1445 eval q{ # poor man's autoloading {}
1446 # probe for availability of Async::Interrupt
1447 if (_have_async_interrupt) {
1448 warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8;
1449
1450 $SIGPIPE_R = new Async::Interrupt::EventPipe;
1451 $SIG_IO = AE::io $SIGPIPE_R->fileno, 0, \&_signal_exec;
1452
1453 } else {
1454 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1455
1456 require Fcntl;
1457
1458 if (AnyEvent::WIN32) {
1459 require AnyEvent::Util;
1460
1461 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1462 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R, 1) if $SIGPIPE_R;
1463 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W, 1) if $SIGPIPE_W; # just in case
1464 } else {
1465 pipe $SIGPIPE_R, $SIGPIPE_W;
1466 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;
1467 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case
1468
1469 # not strictly required, as $^F is normally 2, but let's make sure...
1470 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1471 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1472 }
1473
1474 $SIGPIPE_R
1475 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1476
1477 $SIG_IO = AE::io $SIGPIPE_R, 0, \&_signal_exec;
1478 }
1479
1480 *signal = sub {
1300 my (undef, %arg) = @_; 1481 my (undef, %arg) = @_;
1301 1482
1302 my $signal = uc $arg{signal} 1483 my $signal = uc $arg{signal}
1303 or Carp::croak "required option 'signal' is missing"; 1484 or Carp::croak "required option 'signal' is missing";
1304 1485
1305 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1306
1307 if ($HAVE_ASYNC_INTERRUPT) { 1486 if ($HAVE_ASYNC_INTERRUPT) {
1308 # async::interrupt 1487 # async::interrupt
1309 1488
1310 $SIG_ASY{$signal} ||= do { 1489 $signal = sig2num $signal;
1311 my $asy = new Async::Interrupt 1490 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1491
1492 $SIG_ASY{$signal} ||= new Async::Interrupt
1312 cb => sub { undef $SIG_EV{$signal} }, 1493 cb => sub { undef $SIG_EV{$signal} },
1313 signal => $signal, 1494 signal => $signal,
1314 pipe => [$SIGPIPE_R->filenos], 1495 pipe => [$SIGPIPE_R->filenos],
1496 pipe_autodrain => 0,
1497 ;
1498
1499 } else {
1500 # pure perl
1501
1502 # AE::Util has been loaded in signal
1503 $signal = sig2name $signal;
1504 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1505
1506 $SIG{$signal} ||= sub {
1507 local $!;
1508 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1509 undef $SIG_EV{$signal};
1510 };
1511
1512 # can't do signal processing without introducing races in pure perl,
1513 # so limit the signal latency.
1514 _sig_add;
1315 ; 1515 }
1316 $asy->pipe_autodrain (0);
1317 1516
1318 $asy 1517 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1319 }; 1518 };
1320 1519
1321 } else { 1520 *AnyEvent::Base::signal::DESTROY = sub {
1322 # pure perl 1521 my ($signal, $cb) = @{$_[0]};
1323 1522
1324 $SIG{$signal} ||= sub { 1523 _sig_del;
1325 local $!; 1524
1326 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; 1525 delete $SIG_CB{$signal}{$cb};
1526
1527 $HAVE_ASYNC_INTERRUPT
1528 ? delete $SIG_ASY{$signal}
1529 : # delete doesn't work with older perls - they then
1530 # print weird messages, or just unconditionally exit
1531 # instead of getting the default action.
1327 undef $SIG_EV{$signal}; 1532 undef $SIG{$signal}
1533 unless keys %{ $SIG_CB{$signal} };
1328 }; 1534 };
1329
1330 # can't do signal processing without introducing races in pure perl,
1331 # so limit the signal latency.
1332 _sig_add;
1333 } 1535 };
1334 1536 die if $@;
1335 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1336}
1337
1338sub signal {
1339 # probe for availability of Async::Interrupt
1340 if (!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} && eval "use Async::Interrupt 0.6 (); 1") {
1341 warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8;
1342
1343 $HAVE_ASYNC_INTERRUPT = 1;
1344 $SIGPIPE_R = new Async::Interrupt::EventPipe;
1345 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec);
1346
1347 } else {
1348 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1349
1350 require Fcntl;
1351
1352 if (AnyEvent::WIN32) {
1353 require AnyEvent::Util;
1354
1355 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1356 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R) if $SIGPIPE_R;
1357 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case
1358 } else {
1359 pipe $SIGPIPE_R, $SIGPIPE_W;
1360 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;
1361 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case
1362
1363 # not strictly required, as $^F is normally 2, but let's make sure...
1364 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1365 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1366 }
1367
1368 $SIGPIPE_R
1369 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1370
1371 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1372 }
1373
1374 *signal = \&_signal;
1375 &signal 1537 &signal
1376}
1377
1378sub AnyEvent::Base::signal::DESTROY {
1379 my ($signal, $cb) = @{$_[0]};
1380
1381 _sig_del;
1382
1383 delete $SIG_CB{$signal}{$cb};
1384
1385 $HAVE_ASYNC_INTERRUPT
1386 ? delete $SIG_ASY{$signal}
1387 : # delete doesn't work with older perls - they then
1388 # print weird messages, or just unconditionally exit
1389 # instead of getting the default action.
1390 undef $SIG{$signal}
1391 unless keys %{ $SIG_CB{$signal} };
1392} 1538}
1393 1539
1394# default implementation for ->child 1540# default implementation for ->child
1395 1541
1396our %PID_CB; 1542our %PID_CB;
1397our $CHLD_W; 1543our $CHLD_W;
1398our $CHLD_DELAY_W; 1544our $CHLD_DELAY_W;
1399our $WNOHANG; 1545our $WNOHANG;
1400 1546
1547sub _emit_childstatus($$) {
1548 my (undef, $rpid, $rstatus) = @_;
1549
1550 $_->($rpid, $rstatus)
1551 for values %{ $PID_CB{$rpid} || {} },
1552 values %{ $PID_CB{0} || {} };
1553}
1554
1401sub _sigchld { 1555sub _sigchld {
1556 my $pid;
1557
1558 AnyEvent->_emit_childstatus ($pid, $?)
1402 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1559 while ($pid = waitpid -1, $WNOHANG) > 0;
1403 $_->($pid, $?)
1404 for values %{ $PID_CB{$pid} || {} },
1405 values %{ $PID_CB{0} || {} };
1406 }
1407} 1560}
1408 1561
1409sub child { 1562sub child {
1410 my (undef, %arg) = @_; 1563 my (undef, %arg) = @_;
1411 1564
1418 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/ 1571 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1419 ? 1 1572 ? 1
1420 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1573 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1421 1574
1422 unless ($CHLD_W) { 1575 unless ($CHLD_W) {
1423 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1576 $CHLD_W = AE::signal CHLD => \&_sigchld;
1424 # child could be a zombie already, so make at least one round 1577 # child could be a zombie already, so make at least one round
1425 &_sigchld; 1578 &_sigchld;
1426 } 1579 }
1427 1580
1428 bless [$pid, $arg{cb}], "AnyEvent::Base::child" 1581 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1454 # never use more then 50% of the time for the idle watcher, 1607 # never use more then 50% of the time for the idle watcher,
1455 # within some limits 1608 # within some limits
1456 $w = 0.0001 if $w < 0.0001; 1609 $w = 0.0001 if $w < 0.0001;
1457 $w = 5 if $w > 5; 1610 $w = 5 if $w > 5;
1458 1611
1459 $w = AnyEvent->timer (after => $w, cb => $rcb); 1612 $w = AE::timer $w, 0, $rcb;
1460 } else { 1613 } else {
1461 # clean up... 1614 # clean up...
1462 undef $w; 1615 undef $w;
1463 undef $rcb; 1616 undef $rcb;
1464 } 1617 }
1465 }; 1618 };
1466 1619
1467 $w = AnyEvent->timer (after => 0.05, cb => $rcb); 1620 $w = AE::timer 0.05, 0, $rcb;
1468 1621
1469 bless \\$cb, "AnyEvent::Base::idle" 1622 bless \\$cb, "AnyEvent::Base::idle"
1470} 1623}
1471 1624
1472sub AnyEvent::Base::idle::DESTROY { 1625sub AnyEvent::Base::idle::DESTROY {
1526 Carp::croak $_[0]{_ae_croak} if $_[0]{_ae_croak}; 1679 Carp::croak $_[0]{_ae_croak} if $_[0]{_ae_croak};
1527 wantarray ? @{ $_[0]{_ae_sent} } : $_[0]{_ae_sent}[0] 1680 wantarray ? @{ $_[0]{_ae_sent} } : $_[0]{_ae_sent}[0]
1528} 1681}
1529 1682
1530sub cb { 1683sub cb {
1531 $_[0]{_ae_cb} = $_[1] if @_ > 1; 1684 my $cv = shift;
1685
1686 @_
1687 and $cv->{_ae_cb} = shift
1688 and $cv->{_ae_sent}
1689 and (delete $cv->{_ae_cb})->($cv);
1690
1532 $_[0]{_ae_cb} 1691 $cv->{_ae_cb}
1533} 1692}
1534 1693
1535sub begin { 1694sub begin {
1536 ++$_[0]{_ae_counter}; 1695 ++$_[0]{_ae_counter};
1537 $_[0]{_ae_end_cb} = $_[1] if @_ > 1; 1696 $_[0]{_ae_end_cb} = $_[1] if @_ > 1;
2390L<Glib>, L<Tk>, L<Event::Lib>, L<Qt>, L<POE>. 2549L<Glib>, L<Tk>, L<Event::Lib>, L<Qt>, L<POE>.
2391 2550
2392Implementations: L<AnyEvent::Impl::EV>, L<AnyEvent::Impl::Event>, 2551Implementations: L<AnyEvent::Impl::EV>, L<AnyEvent::Impl::Event>,
2393L<AnyEvent::Impl::Glib>, L<AnyEvent::Impl::Tk>, L<AnyEvent::Impl::Perl>, 2552L<AnyEvent::Impl::Glib>, L<AnyEvent::Impl::Tk>, L<AnyEvent::Impl::Perl>,
2394L<AnyEvent::Impl::EventLib>, L<AnyEvent::Impl::Qt>, 2553L<AnyEvent::Impl::EventLib>, L<AnyEvent::Impl::Qt>,
2395L<AnyEvent::Impl::POE>, L<AnyEvent::Impl::IOAsync>. 2554L<AnyEvent::Impl::POE>, L<AnyEvent::Impl::IOAsync>, L<Anyevent::Impl::Irssi>.
2396 2555
2397Non-blocking file handles, sockets, TCP clients and 2556Non-blocking file handles, sockets, TCP clients and
2398servers: L<AnyEvent::Handle>, L<AnyEvent::Socket>, L<AnyEvent::TLS>. 2557servers: L<AnyEvent::Handle>, L<AnyEvent::Socket>, L<AnyEvent::TLS>.
2399 2558
2400Asynchronous DNS: L<AnyEvent::DNS>. 2559Asynchronous DNS: L<AnyEvent::DNS>.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines