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.240 by root, Fri Jul 17 14:57:03 2009 UTC vs.
Revision 1.242 by root, Fri Jul 17 22:05:12 2009 UTC

361invocation, and callback invocation will be synchronous. Synchronous means 361invocation, and callback invocation will be synchronous. Synchronous means
362that it might take a while until the signal gets handled by the process, 362that it might take a while until the signal gets handled by the process,
363but it is guaranteed not to interrupt any other callbacks. 363but it is guaranteed not to interrupt any other callbacks.
364 364
365The main advantage of using these watchers is that you can share a signal 365The main advantage of using these watchers is that you can share a signal
366between multiple watchers. 366between multiple watchers, and AnyEvent will ensure that signals will not
367interrupt your program at bad times.
367 368
368This watcher might use C<%SIG>, so programs overwriting those signals 369This watcher might use C<%SIG> (depending on the event loop used),
369directly will likely not work correctly. 370so programs overwriting those signals directly will likely not work
371correctly.
372
373Also note that many event loops (e.g. Glib, Tk, Qt, IO::Async) do not
374support attaching callbacks to signals, which is a pity, as you cannot do
375race-free signal handling in perl. AnyEvent will try to do it's best, but
376in some cases, signals will be delayed. The maximum time a signal might
377be delayed is specified in C<$AnyEvent::MAX_SIGNAL_LATENCY> (default: 10
378seconds). This variable can be changed only before the first signal
379watcher is created, and should be left alone otherwise. Higher values
380will cause fewer spurious wake-ups, which is better for power and CPU
381saving. All these problems can be avoided by installing the optional
382L<Async::Interrupt> module.
370 383
371Example: exit on SIGINT 384Example: exit on SIGINT
372 385
373 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 }); 386 my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 });
374 387
403 416
404This means you cannot create a child watcher as the very first 417This means you cannot create a child watcher as the very first
405thing in an AnyEvent program, you I<have> to create at least one 418thing in an AnyEvent program, you I<have> to create at least one
406watcher before you C<fork> the child (alternatively, you can call 419watcher before you C<fork> the child (alternatively, you can call
407C<AnyEvent::detect>). 420C<AnyEvent::detect>).
421
422As most event loops do not support waiting for child events, they will be
423emulated by AnyEvent in most cases, in which the latency and race problems
424mentioned in the description of signal watchers apply.
408 425
409Example: fork a process and wait for it 426Example: fork a process and wait for it
410 427
411 my $done = AnyEvent->condvar; 428 my $done = AnyEvent->condvar;
412 429
1039 1056
1040our @REGISTRY; 1057our @REGISTRY;
1041 1058
1042our $WIN32; 1059our $WIN32;
1043 1060
1061our $VERBOSE;
1062
1044BEGIN { 1063BEGIN {
1045 eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }"; 1064 eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }";
1046 eval "sub TAINT(){ " . (${^TAINT}*1) . " }"; 1065 eval "sub TAINT(){ " . (${^TAINT}*1) . " }";
1047 1066
1048 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV} 1067 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
1049 if ${^TAINT}; 1068 if ${^TAINT};
1050}
1051 1069
1052our $verbose = $ENV{PERL_ANYEVENT_VERBOSE}*1; 1070 $VERBOSE = $ENV{PERL_ANYEVENT_VERBOSE}*1;
1071
1072}
1073
1074our $MAX_SIGNAL_LATENCY = 10;
1053 1075
1054our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred 1076our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred
1055 1077
1056{ 1078{
1057 my $idx; 1079 my $idx;
1115 1137
1116 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) { 1138 if ($ENV{PERL_ANYEVENT_MODEL} =~ /^([a-zA-Z]+)$/) {
1117 my $model = "AnyEvent::Impl::$1"; 1139 my $model = "AnyEvent::Impl::$1";
1118 if (eval "require $model") { 1140 if (eval "require $model") {
1119 $MODEL = $model; 1141 $MODEL = $model;
1120 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $verbose > 1; 1142 warn "AnyEvent: loaded model '$model' (forced by \$ENV{PERL_ANYEVENT_MODEL}), using it.\n" if $VERBOSE >= 2;
1121 } else { 1143 } else {
1122 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $verbose; 1144 warn "AnyEvent: unable to load model '$model' (from \$ENV{PERL_ANYEVENT_MODEL}):\n$@" if $VERBOSE;
1123 } 1145 }
1124 } 1146 }
1125 1147
1126 # check for already loaded models 1148 # check for already loaded models
1127 unless ($MODEL) { 1149 unless ($MODEL) {
1128 for (@REGISTRY, @models) { 1150 for (@REGISTRY, @models) {
1129 my ($package, $model) = @$_; 1151 my ($package, $model) = @$_;
1130 if (${"$package\::VERSION"} > 0) { 1152 if (${"$package\::VERSION"} > 0) {
1131 if (eval "require $model") { 1153 if (eval "require $model") {
1132 $MODEL = $model; 1154 $MODEL = $model;
1133 warn "AnyEvent: autodetected model '$model', using it.\n" if $verbose > 1; 1155 warn "AnyEvent: autodetected model '$model', using it.\n" if $VERBOSE >= 2;
1134 last; 1156 last;
1135 } 1157 }
1136 } 1158 }
1137 } 1159 }
1138 1160
1143 my ($package, $model) = @$_; 1165 my ($package, $model) = @$_;
1144 if (eval "require $package" 1166 if (eval "require $package"
1145 and ${"$package\::VERSION"} > 0 1167 and ${"$package\::VERSION"} > 0
1146 and eval "require $model") { 1168 and eval "require $model") {
1147 $MODEL = $model; 1169 $MODEL = $model;
1148 warn "AnyEvent: autoprobed model '$model', using it.\n" if $verbose > 1; 1170 warn "AnyEvent: autoprobed model '$model', using it.\n" if $VERBOSE >= 2;
1149 last; 1171 last;
1150 } 1172 }
1151 } 1173 }
1152 1174
1153 $MODEL 1175 $MODEL
1184# allow only one watcher per fd, so we dup it to get a different one). 1206# allow only one watcher per fd, so we dup it to get a different one).
1185sub _dupfh($$;$$) { 1207sub _dupfh($$;$$) {
1186 my ($poll, $fh, $r, $w) = @_; 1208 my ($poll, $fh, $r, $w) = @_;
1187 1209
1188 # cygwin requires the fh mode to be matching, unix doesn't 1210 # cygwin requires the fh mode to be matching, unix doesn't
1189 my ($rw, $mode) = $poll eq "r" ? ($r, "<") : ($w, ">"); 1211 my ($rw, $mode) = $poll eq "r" ? ($r, "<&") : ($w, ">&");
1190 1212
1191 open my $fh2, "$mode&", $fh 1213 open my $fh2, $mode, $fh
1192 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,"; 1214 or die "AnyEvent->io: cannot dup() filehandle in mode '$poll': $!,";
1193 1215
1194 # we assume CLOEXEC is already set by perl in all important cases 1216 # we assume CLOEXEC is already set by perl in all important cases
1195 1217
1196 ($fh2, $rw) 1218 ($fh2, $rw)
1198 1220
1199package AnyEvent::Base; 1221package AnyEvent::Base;
1200 1222
1201# default implementations for many methods 1223# default implementations for many methods
1202 1224
1203BEGIN { 1225sub _time {
1226 # probe for availability of Time::HiRes
1204 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") { 1227 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1228 warn "AnyEvent: using Time::HiRes for sub-second timing accuracy.\n" if $VERBOSE >= 8;
1205 *_time = \&Time::HiRes::time; 1229 *_time = \&Time::HiRes::time;
1206 # if (eval "use POSIX (); (POSIX::times())... 1230 # if (eval "use POSIX (); (POSIX::times())...
1207 } else { 1231 } else {
1232 warn "AnyEvent: using built-in time(), WARNING, no sub-second resolution!\n" if $VERBOSE;
1208 *_time = sub { time }; # epic fail 1233 *_time = sub { time }; # epic fail
1209 } 1234 }
1235
1236 &_time
1210} 1237}
1211 1238
1212sub time { _time } 1239sub time { _time }
1213sub now { _time } 1240sub now { _time }
1214sub now_update { } 1241sub now_update { }
1219 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar" 1246 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
1220} 1247}
1221 1248
1222# default implementation for ->signal 1249# default implementation for ->signal
1223 1250
1251our $HAVE_ASYNC_INTERRUPT;
1224our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1252our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1253our (%SIG_ASY, %SIG_ASY_W);
1254our ($SIG_COUNT, $SIG_TW);
1225 1255
1226sub _signal_exec { 1256sub _signal_exec {
1257 $HAVE_ASYNC_INTERRUPT
1258 ? $SIGPIPE_R->drain
1227 sysread $SIGPIPE_R, my $dummy, 4; 1259 : sysread $SIGPIPE_R, my $dummy, 9;
1228 1260
1229 while (%SIG_EV) { 1261 while (%SIG_EV) {
1230 for (keys %SIG_EV) { 1262 for (keys %SIG_EV) {
1231 delete $SIG_EV{$_}; 1263 delete $SIG_EV{$_};
1232 $_->() for values %{ $SIG_CB{$_} || {} }; 1264 $_->() for values %{ $SIG_CB{$_} || {} };
1233 } 1265 }
1234 } 1266 }
1235} 1267}
1236 1268
1269sub _signal {
1270 my (undef, %arg) = @_;
1271
1272 my $signal = uc $arg{signal}
1273 or Carp::croak "required option 'signal' is missing";
1274
1275 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
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 };
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 }
1309
1310 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1311}
1312
1237sub signal { 1313sub signal {
1238 my (undef, %arg) = @_; 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;
1239 1317
1240 unless ($SIGPIPE_R) { 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
1241 require Fcntl; 1325 require Fcntl;
1242 1326
1243 if (AnyEvent::WIN32) { 1327 if (AnyEvent::WIN32) {
1244 require AnyEvent::Util; 1328 require AnyEvent::Util;
1245 1329
1260 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n"; 1344 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1261 1345
1262 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec); 1346 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1263 } 1347 }
1264 1348
1265 my $signal = uc $arg{signal} 1349 *signal = \&_signal;
1266 or Carp::croak "required option 'signal' is missing"; 1350 &signal
1267
1268 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1269 $SIG{$signal} ||= sub {
1270 local $!;
1271 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1272 undef $SIG_EV{$signal};
1273 };
1274
1275 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1276} 1351}
1277 1352
1278sub AnyEvent::Base::signal::DESTROY { 1353sub AnyEvent::Base::signal::DESTROY {
1279 my ($signal, $cb) = @{$_[0]}; 1354 my ($signal, $cb) = @{$_[0]};
1355
1356 undef $SIG_TW
1357 unless --$SIG_COUNT;
1280 1358
1281 delete $SIG_CB{$signal}{$cb}; 1359 delete $SIG_CB{$signal}{$cb};
1282 1360
1283 # delete doesn't work with older perls - they then 1361 # delete doesn't work with older perls - they then
1284 # print weird messages, or just unconditionally exit 1362 # print weird messages, or just unconditionally exit
1285 # instead of getting the default action. 1363 # instead of getting the default action.
1364 undef $SIG{$signal}
1286 undef $SIG{$signal} unless keys %{ $SIG_CB{$signal} }; 1365 unless keys %{ $SIG_CB{$signal} };
1287} 1366}
1288 1367
1289# default implementation for ->child 1368# default implementation for ->child
1290 1369
1291our %PID_CB; 1370our %PID_CB;
1293our $CHLD_DELAY_W; 1372our $CHLD_DELAY_W;
1294our $WNOHANG; 1373our $WNOHANG;
1295 1374
1296sub _sigchld { 1375sub _sigchld {
1297 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1376 while (0 < (my $pid = waitpid -1, $WNOHANG)) {
1377 $_->($pid, $?)
1298 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }), 1378 for values %{ $PID_CB{$pid} || {} },
1299 (values %{ $PID_CB{0} || {} }); 1379 values %{ $PID_CB{0} || {} };
1300 } 1380 }
1301} 1381}
1302 1382
1303sub child { 1383sub child {
1304 my (undef, %arg) = @_; 1384 my (undef, %arg) = @_;
2132 if $SIG{CHLD} eq 'IGNORE'; 2212 if $SIG{CHLD} eq 'IGNORE';
2133 2213
2134$SIG{PIPE} = sub { } 2214$SIG{PIPE} = sub { }
2135 unless defined $SIG{PIPE}; 2215 unless defined $SIG{PIPE};
2136 2216
2217=head1 RECOMMENDED/OPTIONAL MODULES
2218
2219One of AnyEvent's main goals is to be 100% Pure-Perl(tm): only perl (and
2220it's built-in modules) are required to use it.
2221
2222That does not mean that AnyEvent won't take advantage of some additional
2223modules if they are installed.
2224
2225This section epxlains which additional modules will be used, and how they
2226affect AnyEvent's operetion.
2227
2228=over 4
2229
2230=item L<Async::Interrupt>
2231
2232This slightly arcane module is used to implement fast signal handling: To
2233my knowledge, there is no way to do completely race-free and quick
2234signal handling in pure perl. To ensure that signals still get
2235delivered, AnyEvent will start an interval timer to wake up perl (and
2236catch the signals) with soemd elay (default is 10 seconds, look for
2237C<$AnyEvent::MAX_SIGNAL_LATENCY>).
2238
2239If 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
2241will not be interrupted regularly, which is more efficient (And good for
2242battery life on laptops).
2243
2244This 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).
2246
2247=item L<EV>
2248
2249This 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
2251loop available in terms of features, speed and stability: It supports
2252the AnyEvent API optimally, implements all the watcher types in XS, does
2253automatic timer adjustments even when no monotonic clock is available,
2254can take avdantage of advanced kernel interfaces such as C<epoll> and
2255C<kqueue>, and is the fastest backend I<by far>. You can even embed
2256L<Glib>/L<Gtk2> in it (or vice versa, see L<EV::Glib> and L<Glib::EV>).
2257
2258=item L<Guard>
2259
2260The guard module, when used, will be used to implement
2261C<AnyEvent::Util::guard>. This speeds up guards considerably (and uses a
2262lot less memory), but otherwise doesn't affect guard operation much. It is
2263purely used for performance.
2264
2265=item L<JSON> and L<JSON::XS>
2266
2267This 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
2269advantage of the ulta-high-speed L<JSON::XS> module when it is installed.
2270
2271In fact, L<AnyEvent::Handle> will use L<JSON::XS> by default if it is
2272installed.
2273
2274=item L<Net::SSLeay>
2275
2276Implementing TLS/SSL in Perl is certainly interesting, but not very
2277worthwhile: If this module is installed, then L<AnyEvent::Handle> (with
2278the help of L<AnyEvent::TLS>), gains the ability to do TLS/SSL.
2279
2280=item L<Time::HiRes>
2281
2282This module is part of perl since release 5.008. It will be used when the
2283chosen event library does not come with a timing source on it's own. The
2284pure-perl event loop (L<AnyEvent::Impl::Perl>) will additionally use it to
2285try to use a monotonic clock for timing stability.
2286
2287=back
2288
2289
2137=head1 FORK 2290=head1 FORK
2138 2291
2139Most event libraries are not fork-safe. The ones who are usually are 2292Most event libraries are not fork-safe. The ones who are usually are
2140because they rely on inefficient but fork-safe C<select> or C<poll> 2293because they rely on inefficient but fork-safe C<select> or C<poll>
2141calls. Only L<EV> is fully fork-aware. 2294calls. Only L<EV> is fully fork-aware.
2142 2295
2143If you have to fork, you must either do so I<before> creating your first 2296If you have to fork, you must either do so I<before> creating your first
2144watcher OR you must not use AnyEvent at all in the child. 2297watcher OR you must not use AnyEvent at all in the child OR you must do
2298something completely out of the scope of AnyEvent.
2145 2299
2146 2300
2147=head1 SECURITY CONSIDERATIONS 2301=head1 SECURITY CONSIDERATIONS
2148 2302
2149AnyEvent can be forced to load any event model via 2303AnyEvent can be forced to load any event model via

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines