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.250 by root, Mon Jul 20 07:12:38 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 - events independent of event loop implementation 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
47 47
48There is a mailinglist for discussing all things AnyEvent, and an IRC 48There is a mailinglist for discussing all things AnyEvent, and an IRC
49channel, too. 49channel, too.
50 50
51See the AnyEvent project page at the B<Schmorpforge Ta-Sa Software 51See the AnyEvent project page at the B<Schmorpforge Ta-Sa Software
52Respository>, at L<http://anyevent.schmorp.de>, for more info. 52Repository>, at L<http://anyevent.schmorp.de>, for more info.
53 53
54=head1 WHY YOU SHOULD USE THIS MODULE (OR NOT) 54=head1 WHY YOU SHOULD USE THIS MODULE (OR NOT)
55 55
56Glib, POE, IO::Async, Event... CPAN offers event models by the dozen 56Glib, POE, IO::Async, Event... CPAN offers event models by the dozen
57nowadays. So what is different about AnyEvent? 57nowadays. So what is different about AnyEvent?
181my variables are only visible after the statement in which they are 181my variables are only visible after the statement in which they are
182declared. 182declared.
183 183
184=head2 I/O WATCHERS 184=head2 I/O WATCHERS
185 185
186 $w = AnyEvent->io (
187 fh => <filehandle_or_fileno>,
188 poll => <"r" or "w">,
189 cb => <callback>,
190 );
191
186You 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
187with the following mandatory key-value pairs as arguments: 193with the following mandatory key-value pairs as arguments:
188 194
189C<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
190for 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
219 undef $w; 225 undef $w;
220 }); 226 });
221 227
222=head2 TIME WATCHERS 228=head2 TIME WATCHERS
223 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
224You can create a time watcher by calling the C<< AnyEvent->timer >> 238You can create a time watcher by calling the C<< AnyEvent->timer >>
225method with the following mandatory arguments: 239method with the following mandatory arguments:
226 240
227C<after> specifies after how many seconds (fractional values are 241C<after> specifies after how many seconds (fractional values are
228supported) 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
355 369
356=back 370=back
357 371
358=head2 SIGNAL WATCHERS 372=head2 SIGNAL WATCHERS
359 373
374 $w = AnyEvent->signal (signal => <uppercase_signal_name>, cb => <callback>);
375
360You 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
361I<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
362callback to be invoked whenever a signal occurs. 378callback to be invoked whenever a signal occurs.
363 379
364Although the callback might get passed parameters, their value and 380Although the callback might get passed parameters, their value and
383 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 }); 399 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 });
384 400
385=head3 Signal Races, Delays and Workarounds 401=head3 Signal Races, Delays and Workarounds
386 402
387Many 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
388callbacks 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
389race-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,
390in 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
391be delayed is specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10 408specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10 seconds). This
392seconds). This variable can be changed only before the first signal 409variable can be changed only before the first signal watcher is created,
393watcher 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
394will 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
395saving. All these problems can be avoided by installing the optional 415All these problems can be avoided by installing the optional
396L<Async::Interrupt> module. This will not work with inherently broken 416L<Async::Interrupt> module, which works with most event loops. It will not
397event loops such as L<Event> or L<Event::Lib> (and not with L<POE> 417work with inherently broken event loops such as L<Event> or L<Event::Lib>
398currently, as POE does it's own workaround with one-second latency). With 418(and not with L<POE> currently, as POE does it's own workaround with
399those, you just have to suffer the delays. 419one-second latency). For those, you just have to suffer the delays.
400 420
401=head2 CHILD PROCESS WATCHERS 421=head2 CHILD PROCESS WATCHERS
402 422
423 $w = AnyEvent->child (pid => <process id>, cb => <callback>);
424
403You 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.
404 426
405The 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,
406watches for any child process exit). The watcher will triggered only when 428using C<0> watches for any child process exit, on others this will
407the child process has finished and an exit status is available, not on 429croak). The watcher will be triggered only when the child process has
408any trace events (stopped/continued). 430finished and an exit status is available, not on any trace events
431(stopped/continued).
409 432
410The 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
411waitpid), 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
412callback arguments. 435callback arguments.
413 436
454 # do something else, then wait for process exit 477 # do something else, then wait for process exit
455 $done->recv; 478 $done->recv;
456 479
457=head2 IDLE WATCHERS 480=head2 IDLE WATCHERS
458 481
482 $w = AnyEvent->idle (cb => <callback>);
483
459Sometimes 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
460to 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
461"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
462attention by the event loop". 487attention by the event loop".
463 488
489 }); 514 });
490 }); 515 });
491 516
492=head2 CONDITION VARIABLES 517=head2 CONDITION VARIABLES
493 518
519 $cv = AnyEvent->condvar;
520
521 $cv->send (<list>);
522 my @res = $cv->recv;
523
494If 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
495require you to run some blocking "loop", "run" or similar function that 525require you to run some blocking "loop", "run" or similar function that
496will actively watch for new events and call your callbacks. 526will actively watch for new events and call your callbacks.
497 527
498AnyEvent is slightly different: it expects somebody else to run the event 528AnyEvent is slightly different: it expects somebody else to run the event
760=item $cb = $cv->cb ($cb->($cv)) 790=item $cb = $cv->cb ($cb->($cv))
761 791
762This is a mutator function that returns the callback set and optionally 792This is a mutator function that returns the callback set and optionally
763replaces it before doing so. 793replaces it before doing so.
764 794
765The callback will be called when the condition becomes "true", i.e. when 795The callback will be called when the condition becomes (or already was)
766C<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
767variable itself. Calling C<recv> inside the callback or at any later time 797the only argument being the condition variable itself. Calling C<recv>
768is guaranteed not to block. 798inside the callback or at any later time is guaranteed not to block.
769 799
770=back 800=back
771 801
772=head1 SUPPORTED EVENT LOOPS/BACKENDS 802=head1 SUPPORTED EVENT LOOPS/BACKENDS
773 803
776=over 4 806=over 4
777 807
778=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.
779 809
780EV 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
781use. 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
782that, will fall back to its own pure-perl implementation, which is 812pure-perl implementation, which is available everywhere as it comes with
783available everywhere as it comes with AnyEvent itself. 813AnyEvent itself.
784 814
785 AnyEvent::Impl::EV based on EV (interface to libev, best choice). 815 AnyEvent::Impl::EV based on EV (interface to libev, best choice).
786 AnyEvent::Impl::Event based on Event, very stable, few glitches.
787 AnyEvent::Impl::Perl pure-perl implementation, fast and portable. 816 AnyEvent::Impl::Perl pure-perl implementation, fast and portable.
788 817
789=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.
790 819
791These 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
792is 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
793them. This means that AnyEvent will automatically pick the right backend 822them. This means that AnyEvent will automatically pick the right backend
794when the main program loads an event module before anything starts to 823when the main program loads an event module before anything starts to
795create watchers. Nothing special needs to be done by the main program. 824create watchers. Nothing special needs to be done by the main program.
796 825
826 AnyEvent::Impl::Event based on Event, very stable, few glitches.
797 AnyEvent::Impl::Glib based on Glib, slow but very stable. 827 AnyEvent::Impl::Glib based on Glib, slow but very stable.
798 AnyEvent::Impl::Tk based on Tk, very broken. 828 AnyEvent::Impl::Tk based on Tk, very broken.
799 AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse. 829 AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse.
800 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.
801 832
802=item Backends with special needs. 833=item Backends with special needs.
803 834
804Qt requires the Qt::Application to be instantiated first, but will 835Qt requires the Qt::Application to be instantiated first, but will
805otherwise be picked up automatically. As long as the main program 836otherwise be picked up automatically. As long as the main program
879event module detection too early, for example, L<AnyEvent::AIO> creates 910event module detection too early, for example, L<AnyEvent::AIO> creates
880and 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
881avoid autodetecting the event module at load time. 912avoid autodetecting the event module at load time.
882 913
883If 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
884that 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
885L<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;
886 934
887=item @AnyEvent::post_detect 935=item @AnyEvent::post_detect
888 936
889If 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
890before or after loading AnyEvent), then they will called directly after 938before or after loading AnyEvent), then they will called directly after
1067 1115
1068BEGIN { AnyEvent::common_sense } 1116BEGIN { AnyEvent::common_sense }
1069 1117
1070use Carp (); 1118use Carp ();
1071 1119
1072our $VERSION = 4.85; 1120our $VERSION = 4.92;
1073our $MODEL; 1121our $MODEL;
1074 1122
1075our $AUTOLOAD; 1123our $AUTOLOAD;
1076our @ISA; 1124our @ISA;
1077 1125
1102 for reverse split /\s*,\s*/, 1150 for reverse split /\s*,\s*/,
1103 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6"; 1151 $ENV{PERL_ANYEVENT_PROTOCOLS} || "ipv4,ipv6";
1104} 1152}
1105 1153
1106my @models = ( 1154my @models = (
1107 [EV:: => AnyEvent::Impl::EV::], 1155 [EV:: => AnyEvent::Impl::EV:: , 1],
1108 [Event:: => AnyEvent::Impl::Event::],
1109 [AnyEvent::Impl::Perl:: => AnyEvent::Impl::Perl::], 1156 [AnyEvent::Impl::Perl:: => AnyEvent::Impl::Perl:: , 1],
1110 # everything below here will not be autoprobed 1157 # everything below here will not (normally) be autoprobed
1111 # as the pureperl backend should work everywhere 1158 # as the pureperl backend should work everywhere
1112 # and is usually faster 1159 # and is usually faster
1160 [Event:: => AnyEvent::Impl::Event::, 1],
1113 [Glib:: => AnyEvent::Impl::Glib::], # becomes extremely slow with many watchers 1161 [Glib:: => AnyEvent::Impl::Glib:: , 1], # becomes extremely slow with many watchers
1114 [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
1115 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles 1164 [Tk:: => AnyEvent::Impl::Tk::], # crashes with many handles
1116 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program 1165 [Qt:: => AnyEvent::Impl::Qt::], # requires special main program
1117 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 1166 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
1118 [Wx:: => AnyEvent::Impl::POE::], 1167 [Wx:: => AnyEvent::Impl::POE::],
1119 [Prima:: => AnyEvent::Impl::POE::], 1168 [Prima:: => AnyEvent::Impl::POE::],
1120 # 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
1121 # byzantine signal and broken child handling, among others. 1170 # byzantine signal and broken child handling, among others.
1122 # 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
1123 # obvious default class. 1172 # obvious default class.
1124# [IO::Async:: => AnyEvent::Impl::IOAsync::], # requires special main program 1173 [IO::Async:: => AnyEvent::Impl::IOAsync::], # requires special main program
1125# [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program 1174 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program
1126# [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
1127); 1177);
1128 1178
1129our %method = map +($_ => 1), 1179our %method = map +($_ => 1),
1130 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);
1131 1181
1135 my ($cb) = @_; 1185 my ($cb) = @_;
1136 1186
1137 if ($MODEL) { 1187 if ($MODEL) {
1138 $cb->(); 1188 $cb->();
1139 1189
1140 1 1190 undef
1141 } else { 1191 } else {
1142 push @post_detect, $cb; 1192 push @post_detect, $cb;
1143 1193
1144 defined wantarray 1194 defined wantarray
1145 ? bless \$cb, "AnyEvent::Util::postdetect" 1195 ? bless \$cb, "AnyEvent::Util::postdetect"
1177 } 1227 }
1178 } 1228 }
1179 } 1229 }
1180 1230
1181 unless ($MODEL) { 1231 unless ($MODEL) {
1182 # try to load a model 1232 # try to autoload a model
1183
1184 for (@REGISTRY, @models) { 1233 for (@REGISTRY, @models) {
1185 my ($package, $model) = @$_; 1234 my ($package, $model, $autoload) = @$_;
1235 if (
1236 $autoload
1186 if (eval "require $package" 1237 and eval "require $package"
1187 and ${"$package\::VERSION"} > 0 1238 and ${"$package\::VERSION"} > 0
1188 and eval "require $model") { 1239 and eval "require $model"
1240 ) {
1189 $MODEL = $model; 1241 $MODEL = $model;
1190 warn "AnyEvent: autoprobed model '$model', using it.\n" if $VERBOSE >= 2; 1242 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1191 last; 1243 last;
1192 } 1244 }
1193 } 1245 }
1194 1246
1195 $MODEL 1247 $MODEL
1234 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,"; 1286 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,";
1235 1287
1236 # 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
1237 1289
1238 ($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
1239} 1335}
1240 1336
1241package AnyEvent::Base; 1337package AnyEvent::Base;
1242 1338
1243# default implementations for many methods 1339# default implementations for many methods
1267} 1363}
1268 1364
1269# default implementation for ->signal 1365# default implementation for ->signal
1270 1366
1271our $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
1272our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1377our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1273our (%SIG_ASY, %SIG_ASY_W); 1378our (%SIG_ASY, %SIG_ASY_W);
1274our ($SIG_COUNT, $SIG_TW); 1379our ($SIG_COUNT, $SIG_TW);
1275 1380
1276sub _signal_exec { 1381sub _signal_exec {
1284 $_->() for values %{ $SIG_CB{$_} || {} }; 1389 $_->() for values %{ $SIG_CB{$_} || {} };
1285 } 1390 }
1286 } 1391 }
1287} 1392}
1288 1393
1289# install a dumym wakeupw atcher to reduce signal catching latency 1394# install a dummy wakeup watcher to reduce signal catching latency
1290sub _sig_add() { 1395sub _sig_add() {
1291 unless ($SIG_COUNT++) { 1396 unless ($SIG_COUNT++) {
1292 # try to align timer on a full-second boundary, if possible 1397 # try to align timer on a full-second boundary, if possible
1293 my $NOW = AnyEvent->now; 1398 my $NOW = AE::now;
1294 1399
1295 $SIG_TW = AnyEvent->timer ( 1400 $SIG_TW = AE::timer
1296 after => $MAX_SIGNAL_LATENCY - ($NOW - int $NOW), 1401 $MAX_SIGNAL_LATENCY - ($NOW - int $NOW),
1297 interval => $MAX_SIGNAL_LATENCY, 1402 $MAX_SIGNAL_LATENCY,
1298 cb => sub { }, # just for the PERL_ASYNC_CHECK 1403 sub { } # just for the PERL_ASYNC_CHECK
1299 ); 1404 ;
1300 } 1405 }
1301} 1406}
1302 1407
1303sub _sig_del { 1408sub _sig_del {
1304 undef $SIG_TW 1409 undef $SIG_TW
1305 unless --$SIG_COUNT; 1410 unless --$SIG_COUNT;
1306} 1411}
1307 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
1308sub _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 {
1309 my (undef, %arg) = @_; 1481 my (undef, %arg) = @_;
1310 1482
1311 my $signal = uc $arg{signal} 1483 my $signal = uc $arg{signal}
1312 or Carp::croak "required option 'signal' is missing"; 1484 or Carp::croak "required option 'signal' is missing";
1313 1485
1314 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1315
1316 if ($HAVE_ASYNC_INTERRUPT) { 1486 if ($HAVE_ASYNC_INTERRUPT) {
1317 # async::interrupt 1487 # async::interrupt
1318 1488
1319 $SIG_ASY{$signal} ||= do { 1489 $signal = sig2num $signal;
1320 my $asy = new Async::Interrupt 1490 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1491
1492 $SIG_ASY{$signal} ||= new Async::Interrupt
1321 cb => sub { undef $SIG_EV{$signal} }, 1493 cb => sub { undef $SIG_EV{$signal} },
1322 signal => $signal, 1494 signal => $signal,
1323 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;
1324 ; 1515 }
1325 $asy->pipe_autodrain (0);
1326 1516
1327 $asy 1517 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1328 }; 1518 };
1329 1519
1330 } else { 1520 *AnyEvent::Base::signal::DESTROY = sub {
1331 # pure perl 1521 my ($signal, $cb) = @{$_[0]};
1332 1522
1333 $SIG{$signal} ||= sub { 1523 _sig_del;
1334 local $!; 1524
1335 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.
1336 undef $SIG_EV{$signal}; 1532 undef $SIG{$signal}
1533 unless keys %{ $SIG_CB{$signal} };
1337 }; 1534 };
1338
1339 # can't do signal processing without introducing races in pure perl,
1340 # so limit the signal latency.
1341 _sig_add;
1342 } 1535 };
1343 1536 die if $@;
1344 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1345}
1346
1347sub signal {
1348 # probe for availability of Async::Interrupt
1349 if (!$ENV{PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT} && eval "use Async::Interrupt 0.6 (); 1") {
1350 warn "AnyEvent: using Async::Interrupt for race-free signal handling.\n" if $VERBOSE >= 8;
1351
1352 $HAVE_ASYNC_INTERRUPT = 1;
1353 $SIGPIPE_R = new Async::Interrupt::EventPipe;
1354 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R->fileno, poll => "r", cb => \&_signal_exec);
1355
1356 } else {
1357 warn "AnyEvent: using emulated perl signal handling with latency timer.\n" if $VERBOSE >= 8;
1358
1359 require Fcntl;
1360
1361 if (AnyEvent::WIN32) {
1362 require AnyEvent::Util;
1363
1364 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1365 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R) if $SIGPIPE_R;
1366 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case
1367 } else {
1368 pipe $SIGPIPE_R, $SIGPIPE_W;
1369 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;
1370 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case
1371
1372 # not strictly required, as $^F is normally 2, but let's make sure...
1373 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1374 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1375 }
1376
1377 $SIGPIPE_R
1378 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1379
1380 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1381 }
1382
1383 *signal = \&_signal;
1384 &signal 1537 &signal
1385}
1386
1387sub AnyEvent::Base::signal::DESTROY {
1388 my ($signal, $cb) = @{$_[0]};
1389
1390 _sig_del;
1391
1392 delete $SIG_CB{$signal}{$cb};
1393
1394 $HAVE_ASYNC_INTERRUPT
1395 ? delete $SIG_ASY{$signal}
1396 : # delete doesn't work with older perls - they then
1397 # print weird messages, or just unconditionally exit
1398 # instead of getting the default action.
1399 undef $SIG{$signal}
1400 unless keys %{ $SIG_CB{$signal} };
1401} 1538}
1402 1539
1403# default implementation for ->child 1540# default implementation for ->child
1404 1541
1405our %PID_CB; 1542our %PID_CB;
1406our $CHLD_W; 1543our $CHLD_W;
1407our $CHLD_DELAY_W; 1544our $CHLD_DELAY_W;
1408our $WNOHANG; 1545our $WNOHANG;
1409 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
1410sub _sigchld { 1555sub _sigchld {
1556 my $pid;
1557
1558 AnyEvent->_emit_childstatus ($pid, $?)
1411 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1559 while ($pid = waitpid -1, $WNOHANG) > 0;
1412 $_->($pid, $?)
1413 for values %{ $PID_CB{$pid} || {} },
1414 values %{ $PID_CB{0} || {} };
1415 }
1416} 1560}
1417 1561
1418sub child { 1562sub child {
1419 my (undef, %arg) = @_; 1563 my (undef, %arg) = @_;
1420 1564
1427 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/ 1571 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1428 ? 1 1572 ? 1
1429 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1573 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1430 1574
1431 unless ($CHLD_W) { 1575 unless ($CHLD_W) {
1432 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1576 $CHLD_W = AE::signal CHLD => \&_sigchld;
1433 # 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
1434 &_sigchld; 1578 &_sigchld;
1435 } 1579 }
1436 1580
1437 bless [$pid, $arg{cb}], "AnyEvent::Base::child" 1581 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1463 # 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,
1464 # within some limits 1608 # within some limits
1465 $w = 0.0001 if $w < 0.0001; 1609 $w = 0.0001 if $w < 0.0001;
1466 $w = 5 if $w > 5; 1610 $w = 5 if $w > 5;
1467 1611
1468 $w = AnyEvent->timer (after => $w, cb => $rcb); 1612 $w = AE::timer $w, 0, $rcb;
1469 } else { 1613 } else {
1470 # clean up... 1614 # clean up...
1471 undef $w; 1615 undef $w;
1472 undef $rcb; 1616 undef $rcb;
1473 } 1617 }
1474 }; 1618 };
1475 1619
1476 $w = AnyEvent->timer (after => 0.05, cb => $rcb); 1620 $w = AE::timer 0.05, 0, $rcb;
1477 1621
1478 bless \\$cb, "AnyEvent::Base::idle" 1622 bless \\$cb, "AnyEvent::Base::idle"
1479} 1623}
1480 1624
1481sub AnyEvent::Base::idle::DESTROY { 1625sub AnyEvent::Base::idle::DESTROY {
1535 Carp::croak $_[0]{_ae_croak} if $_[0]{_ae_croak}; 1679 Carp::croak $_[0]{_ae_croak} if $_[0]{_ae_croak};
1536 wantarray ? @{ $_[0]{_ae_sent} } : $_[0]{_ae_sent}[0] 1680 wantarray ? @{ $_[0]{_ae_sent} } : $_[0]{_ae_sent}[0]
1537} 1681}
1538 1682
1539sub cb { 1683sub cb {
1540 $_[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
1541 $_[0]{_ae_cb} 1691 $cv->{_ae_cb}
1542} 1692}
1543 1693
1544sub begin { 1694sub begin {
1545 ++$_[0]{_ae_counter}; 1695 ++$_[0]{_ae_counter};
1546 $_[0]{_ae_end_cb} = $_[1] if @_ > 1; 1696 $_[0]{_ae_end_cb} = $_[1] if @_ > 1;
2399L<Glib>, L<Tk>, L<Event::Lib>, L<Qt>, L<POE>. 2549L<Glib>, L<Tk>, L<Event::Lib>, L<Qt>, L<POE>.
2400 2550
2401Implementations: L<AnyEvent::Impl::EV>, L<AnyEvent::Impl::Event>, 2551Implementations: L<AnyEvent::Impl::EV>, L<AnyEvent::Impl::Event>,
2402L<AnyEvent::Impl::Glib>, L<AnyEvent::Impl::Tk>, L<AnyEvent::Impl::Perl>, 2552L<AnyEvent::Impl::Glib>, L<AnyEvent::Impl::Tk>, L<AnyEvent::Impl::Perl>,
2403L<AnyEvent::Impl::EventLib>, L<AnyEvent::Impl::Qt>, 2553L<AnyEvent::Impl::EventLib>, L<AnyEvent::Impl::Qt>,
2404L<AnyEvent::Impl::POE>, L<AnyEvent::Impl::IOAsync>. 2554L<AnyEvent::Impl::POE>, L<AnyEvent::Impl::IOAsync>, L<Anyevent::Impl::Irssi>.
2405 2555
2406Non-blocking file handles, sockets, TCP clients and 2556Non-blocking file handles, sockets, TCP clients and
2407servers: L<AnyEvent::Handle>, L<AnyEvent::Socket>, L<AnyEvent::TLS>. 2557servers: L<AnyEvent::Handle>, L<AnyEvent::Socket>, L<AnyEvent::TLS>.
2408 2558
2409Asynchronous DNS: L<AnyEvent::DNS>. 2559Asynchronous DNS: L<AnyEvent::DNS>.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines