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.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
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 [IO::Async:: => AnyEvent::Impl::IOAsync::], # requires special main program
1104# [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program 1174 [IO::Async::Loop:: => AnyEvent::Impl::IOAsync::], # requires special main program
1105# [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
1106); 1177);
1107 1178
1108our %method = map +($_ => 1), 1179our %method = map +($_ => 1),
1109 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);
1110 1181
1114 my ($cb) = @_; 1185 my ($cb) = @_;
1115 1186
1116 if ($MODEL) { 1187 if ($MODEL) {
1117 $cb->(); 1188 $cb->();
1118 1189
1119 1 1190 undef
1120 } else { 1191 } else {
1121 push @post_detect, $cb; 1192 push @post_detect, $cb;
1122 1193
1123 defined wantarray 1194 defined wantarray
1124 ? bless \$cb, "AnyEvent::Util::postdetect" 1195 ? bless \$cb, "AnyEvent::Util::postdetect"
1130 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1201 @post_detect = grep $_ != ${$_[0]}, @post_detect;
1131} 1202}
1132 1203
1133sub detect() { 1204sub detect() {
1134 unless ($MODEL) { 1205 unless ($MODEL) {
1135 no strict 'refs';
1136 local $SIG{__DIE__}; 1206 local $SIG{__DIE__};
1137 1207
1138 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1208 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {
1139 my $model = "AnyEvent::Impl::$1"; 1209 my $model = "AnyEvent::Impl::$1";
1140 if (eval "require $model") { 1210 if (eval "require $model") {
1157 } 1227 }
1158 } 1228 }
1159 } 1229 }
1160 1230
1161 unless ($MODEL) { 1231 unless ($MODEL) {
1162 # try to load a model 1232 # try to autoload a model
1163
1164 for (@REGISTRY, @models) { 1233 for (@REGISTRY, @models) {
1165 my ($package, $model) = @$_; 1234 my ($package, $model, $autoload) = @$_;
1235 if (
1236 $autoload
1166 if (eval "require $package" 1237 and eval "require $package"
1167 and ${"$package\::VERSION"} > 0 1238 and ${"$package\::VERSION"} > 0
1168 and eval "require $model") { 1239 and eval "require $model"
1240 ) {
1169 $MODEL = $model; 1241 $MODEL = $model;
1170 warn "AnyEvent: autoprobed model '$model', using it.\n" if $VERBOSE >= 2; 1242 warn "AnyEvent: autoloaded model '$model', using it.\n" if $VERBOSE >= 2;
1171 last; 1243 last;
1172 } 1244 }
1173 } 1245 }
1174 1246
1175 $MODEL 1247 $MODEL
1214 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,"; 1286 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,";
1215 1287
1216 # 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
1217 1289
1218 ($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
1219} 1335}
1220 1336
1221package AnyEvent::Base; 1337package AnyEvent::Base;
1222 1338
1223# default implementations for many methods 1339# default implementations for many methods
1247} 1363}
1248 1364
1249# default implementation for ->signal 1365# default implementation for ->signal
1250 1366
1251our $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
1252our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1377our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1253our (%SIG_ASY, %SIG_ASY_W); 1378our (%SIG_ASY, %SIG_ASY_W);
1254our ($SIG_COUNT, $SIG_TW); 1379our ($SIG_COUNT, $SIG_TW);
1255 1380
1256sub _signal_exec { 1381sub _signal_exec {
1264 $_->() for values %{ $SIG_CB{$_} || {} }; 1389 $_->() for values %{ $SIG_CB{$_} || {} };
1265 } 1390 }
1266 } 1391 }
1267} 1392}
1268 1393
1394# install a dummy wakeup watcher to reduce signal catching latency
1269sub _signal { 1395sub _sig_add() {
1270 my (undef, %arg) = @_; 1396 unless ($SIG_COUNT++) {
1397 # try to align timer on a full-second boundary, if possible
1398 my $NOW = AE::now;
1271 1399
1272 my $signal = uc $arg{signal} 1400 $SIG_TW = AE::timer
1273 or Carp::croak "required option 'signal' is missing"; 1401 $MAX_SIGNAL_LATENCY - ($NOW - int $NOW),
1274 1402 $MAX_SIGNAL_LATENCY,
1275 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1403 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 }; 1404 ;
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 } 1405 }
1309
1310 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1311} 1406}
1312 1407
1313sub signal { 1408sub _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 1409 undef $SIG_TW
1357 unless --$SIG_COUNT; 1410 unless --$SIG_COUNT;
1411}
1358 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
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 {
1481 my (undef, %arg) = @_;
1482
1483 my $signal = uc $arg{signal}
1484 or Carp::croak "required option 'signal' is missing";
1485
1486 if ($HAVE_ASYNC_INTERRUPT) {
1487 # async::interrupt
1488
1489 $signal = sig2num $signal;
1490 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1491
1492 $SIG_ASY{$signal} ||= new Async::Interrupt
1493 cb => sub { undef $SIG_EV{$signal} },
1494 signal => $signal,
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;
1515 }
1516
1517 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1518 };
1519
1520 *AnyEvent::Base::signal::DESTROY = sub {
1521 my ($signal, $cb) = @{$_[0]};
1522
1523 _sig_del;
1524
1359 delete $SIG_CB{$signal}{$cb}; 1525 delete $SIG_CB{$signal}{$cb};
1360 1526
1527 $HAVE_ASYNC_INTERRUPT
1528 ? delete $SIG_ASY{$signal}
1361 # delete doesn't work with older perls - they then 1529 : # delete doesn't work with older perls - they then
1362 # print weird messages, or just unconditionally exit 1530 # print weird messages, or just unconditionally exit
1363 # instead of getting the default action. 1531 # instead of getting the default action.
1364 undef $SIG{$signal} 1532 undef $SIG{$signal}
1365 unless keys %{ $SIG_CB{$signal} }; 1533 unless keys %{ $SIG_CB{$signal} };
1534 };
1535 };
1536 die if $@;
1537 &signal
1366} 1538}
1367 1539
1368# default implementation for ->child 1540# default implementation for ->child
1369 1541
1370our %PID_CB; 1542our %PID_CB;
1371our $CHLD_W; 1543our $CHLD_W;
1372our $CHLD_DELAY_W; 1544our $CHLD_DELAY_W;
1373our $WNOHANG; 1545our $WNOHANG;
1374 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
1375sub _sigchld { 1555sub _sigchld {
1556 my $pid;
1557
1558 AnyEvent->_emit_childstatus ($pid, $?)
1376 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1559 while ($pid = waitpid -1, $WNOHANG) > 0;
1377 $_->($pid, $?)
1378 for values %{ $PID_CB{$pid} || {} },
1379 values %{ $PID_CB{0} || {} };
1380 }
1381} 1560}
1382 1561
1383sub child { 1562sub child {
1384 my (undef, %arg) = @_; 1563 my (undef, %arg) = @_;
1385 1564
1386 defined (my $pid = $arg{pid} + 0) 1565 defined (my $pid = $arg{pid} + 0)
1387 or Carp::croak "required option 'pid' is missing"; 1566 or Carp::croak "required option 'pid' is missing";
1388 1567
1389 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1568 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1390 1569
1570 # WNOHANG is almost cetrainly 1 everywhere
1571 $WNOHANG ||= $^O =~ /^(?:openbsd|netbsd|linux|freebsd|cygwin|MSWin32)$/
1572 ? 1
1391 $WNOHANG ||= eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1573 : eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1392 1574
1393 unless ($CHLD_W) { 1575 unless ($CHLD_W) {
1394 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1576 $CHLD_W = AE::signal CHLD => \&_sigchld;
1395 # 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
1396 &_sigchld; 1578 &_sigchld;
1397 } 1579 }
1398 1580
1399 bless [$pid, $arg{cb}], "AnyEvent::Base::child" 1581 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1425 # 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,
1426 # within some limits 1608 # within some limits
1427 $w = 0.0001 if $w < 0.0001; 1609 $w = 0.0001 if $w < 0.0001;
1428 $w = 5 if $w > 5; 1610 $w = 5 if $w > 5;
1429 1611
1430 $w = AnyEvent->timer (after => $w, cb => $rcb); 1612 $w = AE::timer $w, 0, $rcb;
1431 } else { 1613 } else {
1432 # clean up... 1614 # clean up...
1433 undef $w; 1615 undef $w;
1434 undef $rcb; 1616 undef $rcb;
1435 } 1617 }
1436 }; 1618 };
1437 1619
1438 $w = AnyEvent->timer (after => 0.05, cb => $rcb); 1620 $w = AE::timer 0.05, 0, $rcb;
1439 1621
1440 bless \\$cb, "AnyEvent::Base::idle" 1622 bless \\$cb, "AnyEvent::Base::idle"
1441} 1623}
1442 1624
1443sub AnyEvent::Base::idle::DESTROY { 1625sub AnyEvent::Base::idle::DESTROY {
1448 1630
1449our @ISA = AnyEvent::CondVar::Base::; 1631our @ISA = AnyEvent::CondVar::Base::;
1450 1632
1451package AnyEvent::CondVar::Base; 1633package AnyEvent::CondVar::Base;
1452 1634
1453use overload 1635#use overload
1454 '&{}' => sub { my $self = shift; sub { $self->send (@_) } }, 1636# '&{}' => sub { my $self = shift; sub { $self->send (@_) } },
1455 fallback => 1; 1637# fallback => 1;
1638
1639# save 300+ kilobytes by dirtily hardcoding overloading
1640${"AnyEvent::CondVar::Base::OVERLOAD"}{dummy}++; # Register with magic by touching.
1641*{'AnyEvent::CondVar::Base::()'} = sub { }; # "Make it findable via fetchmethod."
1642*{'AnyEvent::CondVar::Base::(&{}'} = sub { my $self = shift; sub { $self->send (@_) } }; # &{}
1643${'AnyEvent::CondVar::Base::()'} = 1; # fallback
1456 1644
1457our $WAITING; 1645our $WAITING;
1458 1646
1459sub _send { 1647sub _send {
1460 # nop 1648 # nop
1491 Carp::croak $_[0]{_ae_croak} if $_[0]{_ae_croak}; 1679 Carp::croak $_[0]{_ae_croak} if $_[0]{_ae_croak};
1492 wantarray ? @{ $_[0]{_ae_sent} } : $_[0]{_ae_sent}[0] 1680 wantarray ? @{ $_[0]{_ae_sent} } : $_[0]{_ae_sent}[0]
1493} 1681}
1494 1682
1495sub cb { 1683sub cb {
1496 $_[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
1497 $_[0]{_ae_cb} 1691 $cv->{_ae_cb}
1498} 1692}
1499 1693
1500sub begin { 1694sub begin {
1501 ++$_[0]{_ae_counter}; 1695 ++$_[0]{_ae_counter};
1502 $_[0]{_ae_end_cb} = $_[1] if @_ > 1; 1696 $_[0]{_ae_end_cb} = $_[1] if @_ > 1;
1551C<PERL_ANYEVENT_MODEL>. 1745C<PERL_ANYEVENT_MODEL>.
1552 1746
1553When set to C<2> or higher, cause AnyEvent to report to STDERR which event 1747When set to C<2> or higher, cause AnyEvent to report to STDERR which event
1554model it chooses. 1748model it chooses.
1555 1749
1750When set to C<8> or higher, then AnyEvent will report extra information on
1751which optional modules it loads and how it implements certain features.
1752
1556=item C<PERL_ANYEVENT_STRICT> 1753=item C<PERL_ANYEVENT_STRICT>
1557 1754
1558AnyEvent does not do much argument checking by default, as thorough 1755AnyEvent does not do much argument checking by default, as thorough
1559argument checking is very costly. Setting this variable to a true value 1756argument checking is very costly. Setting this variable to a true value
1560will cause AnyEvent to load C<AnyEvent::Strict> and then to thoroughly 1757will cause AnyEvent to load C<AnyEvent::Strict> and then to thoroughly
1561check the arguments passed to most method calls. If it finds any problems, 1758check the arguments passed to most method calls. If it finds any problems,
1562it will croak. 1759it will croak.
1563 1760
1564In other words, enables "strict" mode. 1761In other words, enables "strict" mode.
1565 1762
1566Unlike C<use strict>, it is definitely recommended to keep it off in 1763Unlike C<use strict> (or it's modern cousin, C<< use L<common::sense>
1567production. Keeping C<PERL_ANYEVENT_STRICT=1> in your environment while 1764>>, it is definitely recommended to keep it off in production. Keeping
1568developing programs can be very useful, however. 1765C<PERL_ANYEVENT_STRICT=1> in your environment while developing programs
1766can be very useful, however.
1569 1767
1570=item C<PERL_ANYEVENT_MODEL> 1768=item C<PERL_ANYEVENT_MODEL>
1571 1769
1572This can be used to specify the event model to be used by AnyEvent, before 1770This 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 1771auto detection and -probing kicks in. It must be a string consisting
1635 1833
1636When neither C<ca_file> nor C<ca_path> was specified during 1834When neither C<ca_file> nor C<ca_path> was specified during
1637L<AnyEvent::TLS> context creation, and either of these environment 1835L<AnyEvent::TLS> context creation, and either of these environment
1638variables exist, they will be used to specify CA certificate locations 1836variables exist, they will be used to specify CA certificate locations
1639instead of a system-dependent default. 1837instead of a system-dependent default.
1838
1839=item C<PERL_ANYEVENT_AVOID_GUARD> and C<PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT>
1840
1841When these are set to C<1>, then the respective modules are not
1842loaded. Mostly good for testing AnyEvent itself.
1640 1843
1641=back 1844=back
1642 1845
1643=head1 SUPPLYING YOUR OWN EVENT MODEL INTERFACE 1846=head1 SUPPLYING YOUR OWN EVENT MODEL INTERFACE
1644 1847
2231 2434
2232This slightly arcane module is used to implement fast signal handling: To 2435This slightly arcane module is used to implement fast signal handling: To
2233my knowledge, there is no way to do completely race-free and quick 2436my knowledge, there is no way to do completely race-free and quick
2234signal handling in pure perl. To ensure that signals still get 2437signal handling in pure perl. To ensure that signals still get
2235delivered, AnyEvent will start an interval timer to wake up perl (and 2438delivered, AnyEvent will start an interval timer to wake up perl (and
2236catch the signals) with soemd elay (default is 10 seconds, look for 2439catch the signals) with some delay (default is 10 seconds, look for
2237C<$AnyEvent::MAX_SIGNAL_LATENCY>). 2440C<$AnyEvent::MAX_SIGNAL_LATENCY>).
2238 2441
2239If this module is available, then it will be used to implement signal 2442If 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 2443catching, which means that signals will not be delayed, and the event loop
2241will not be interrupted regularly, which is more efficient (And good for 2444will not be interrupted regularly, which is more efficient (And good for
2242battery life on laptops). 2445battery life on laptops).
2243 2446
2244This affects not just the pure-perl event loop, but also other event loops 2447This 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). 2448that have no signal handling on their own (e.g. Glib, Tk, Qt).
2449
2450Some event loops (POE, Event, Event::Lib) offer signal watchers natively,
2451and either employ their own workarounds (POE) or use AnyEvent's workaround
2452(using C<$AnyEvent::MAX_SIGNAL_LATENCY>). Installing L<Async::Interrupt>
2453does nothing for those backends.
2246 2454
2247=item L<EV> 2455=item L<EV>
2248 2456
2249This module isn't really "optional", as it is simply one of the backend 2457This 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 2458event loops that AnyEvent can use. However, it is simply the best event
2264 2472
2265=item L<JSON> and L<JSON::XS> 2473=item L<JSON> and L<JSON::XS>
2266 2474
2267This module is required when you want to read or write JSON data via 2475This 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 2476L<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. 2477advantage of the ultra-high-speed L<JSON::XS> module when it is installed.
2270 2478
2271In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is 2479In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2272installed. 2480installed.
2273 2481
2274=item L<Net::SSLeay> 2482=item L<Net::SSLeay>
2341L<Glib>, L<Tk>, L<Event::Lib>, L<Qt>, L<POE>. 2549L<Glib>, L<Tk>, L<Event::Lib>, L<Qt>, L<POE>.
2342 2550
2343Implementations: L<AnyEvent::Impl::EV>, L<AnyEvent::Impl::Event>, 2551Implementations: L<AnyEvent::Impl::EV>, L<AnyEvent::Impl::Event>,
2344L<AnyEvent::Impl::Glib>, L<AnyEvent::Impl::Tk>, L<AnyEvent::Impl::Perl>, 2552L<AnyEvent::Impl::Glib>, L<AnyEvent::Impl::Tk>, L<AnyEvent::Impl::Perl>,
2345L<AnyEvent::Impl::EventLib>, L<AnyEvent::Impl::Qt>, 2553L<AnyEvent::Impl::EventLib>, L<AnyEvent::Impl::Qt>,
2346L<AnyEvent::Impl::POE>, L<AnyEvent::Impl::IOAsync>. 2554L<AnyEvent::Impl::POE>, L<AnyEvent::Impl::IOAsync>, L<Anyevent::Impl::Irssi>.
2347 2555
2348Non-blocking file handles, sockets, TCP clients and 2556Non-blocking file handles, sockets, TCP clients and
2349servers: L<AnyEvent::Handle>, L<AnyEvent::Socket>, L<AnyEvent::TLS>. 2557servers: L<AnyEvent::Handle>, L<AnyEvent::Socket>, L<AnyEvent::TLS>.
2350 2558
2351Asynchronous DNS: L<AnyEvent::DNS>. 2559Asynchronous DNS: L<AnyEvent::DNS>.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines