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.205 by root, Sun Apr 19 12:09:46 2009 UTC vs.
Revision 1.216 by root, Tue Jun 23 12:21:34 2009 UTC

1=head1 NAME 1=head1 NAME
2 2
3AnyEvent - provide framework for multiple event loops 3AnyEvent - provide framework for multiple event loops
4 4
5EV, Event, Glib, Tk, Perl, Event::Lib, Qt, POE - various supported event loops 5EV, Event, Glib, Tk, Perl, Event::Lib, Qt and POE are various supported
6event loops.
6 7
7=head1 SYNOPSIS 8=head1 SYNOPSIS
8 9
9 use AnyEvent; 10 use AnyEvent;
10 11
12 # file descriptor readable
11 my $w = AnyEvent->io (fh => $fh, poll => "r|w", cb => sub { ... }); 13 my $w = AnyEvent->io (fh => $fh, poll => "r", cb => sub { ... });
12 14
15 # one-shot or repeating timers
13 my $w = AnyEvent->timer (after => $seconds, cb => sub { ... }); 16 my $w = AnyEvent->timer (after => $seconds, cb => sub { ... });
14 my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ... 17 my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ...
15 18
16 print AnyEvent->now; # prints current event loop time 19 print AnyEvent->now; # prints current event loop time
17 print AnyEvent->time; # think Time::HiRes::time or simply CORE::time. 20 print AnyEvent->time; # think Time::HiRes::time or simply CORE::time.
18 21
22 # POSIX signal
19 my $w = AnyEvent->signal (signal => "TERM", cb => sub { ... }); 23 my $w = AnyEvent->signal (signal => "TERM", cb => sub { ... });
20 24
25 # child process exit
21 my $w = AnyEvent->child (pid => $pid, cb => sub { 26 my $w = AnyEvent->child (pid => $pid, cb => sub {
22 my ($pid, $status) = @_; 27 my ($pid, $status) = @_;
23 ... 28 ...
24 }); 29 });
30
31 # called when event loop idle (if applicable)
32 my $w = AnyEvent->idle (cb => sub { ... });
25 33
26 my $w = AnyEvent->condvar; # stores whether a condition was flagged 34 my $w = AnyEvent->condvar; # stores whether a condition was flagged
27 $w->send; # wake up current and all future recv's 35 $w->send; # wake up current and all future recv's
28 $w->recv; # enters "main loop" till $condvar gets ->send 36 $w->recv; # enters "main loop" till $condvar gets ->send
29 # use a condvar in callback mode: 37 # use a condvar in callback mode:
410 ); 418 );
411 419
412 # do something else, then wait for process exit 420 # do something else, then wait for process exit
413 $done->recv; 421 $done->recv;
414 422
423=head2 IDLE WATCHERS
424
425Sometimes there is a need to do something, but it is not so important
426to do it instantly, but only when there is nothing better to do. This
427"nothing better to do" is usually defined to be "no other events need
428attention by the event loop".
429
430Idle watchers ideally get invoked when the event loop has nothing
431better to do, just before it would block the process to wait for new
432events. Instead of blocking, the idle watcher is invoked.
433
434Most event loops unfortunately do not really support idle watchers (only
435EV, Event and Glib do it in a usable fashion) - for the rest, AnyEvent
436will simply call the callback "from time to time".
437
438Example: read lines from STDIN, but only process them when the
439program is otherwise idle:
440
441 my @lines; # read data
442 my $idle_w;
443 my $io_w = AnyEvent->io (fh => \*STDIN, poll => 'r', cb => sub {
444 push @lines, scalar <STDIN>;
445
446 # start an idle watcher, if not already done
447 $idle_w ||= AnyEvent->idle (cb => sub {
448 # handle only one line, when there are lines left
449 if (my $line = shift @lines) {
450 print "handled when idle: $line";
451 } else {
452 # otherwise disable the idle watcher again
453 undef $idle_w;
454 }
455 });
456 });
457
415=head2 CONDITION VARIABLES 458=head2 CONDITION VARIABLES
416 459
417If you are familiar with some event loops you will know that all of them 460If you are familiar with some event loops you will know that all of them
418require you to run some blocking "loop", "run" or similar function that 461require you to run some blocking "loop", "run" or similar function that
419will actively watch for new events and call your callbacks. 462will actively watch for new events and call your callbacks.
888no warnings; 931no warnings;
889use strict qw(vars subs); 932use strict qw(vars subs);
890 933
891use Carp; 934use Carp;
892 935
893our $VERSION = 4.351; 936our $VERSION = 4.411;
894our $MODEL; 937our $MODEL;
895 938
896our $AUTOLOAD; 939our $AUTOLOAD;
897our @ISA; 940our @ISA;
898 941
899our @REGISTRY; 942our @REGISTRY;
900 943
901our $WIN32; 944our $WIN32;
902 945
903BEGIN { 946BEGIN {
904 my $win32 = ! ! ($^O =~ /mswin32/i); 947 eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }";
905 eval "sub WIN32(){ $win32 }"; 948 eval "sub TAINT(){ " . (${^TAINT}*1) . " }";
949
950 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
951 if ${^TAINT};
906} 952}
907 953
908our $verbose = $ENV{PERL_ANYEVENT_VERBOSE}*1; 954our $verbose = $ENV{PERL_ANYEVENT_VERBOSE}*1;
909 955
910our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred 956our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred
931 [Wx:: => AnyEvent::Impl::POE::], 977 [Wx:: => AnyEvent::Impl::POE::],
932 [Prima:: => AnyEvent::Impl::POE::], 978 [Prima:: => AnyEvent::Impl::POE::],
933); 979);
934 980
935our %method = map +($_ => 1), 981our %method = map +($_ => 1),
936 qw(io timer time now now_update signal child condvar one_event DESTROY); 982 qw(io timer time now now_update signal child idle condvar one_event DESTROY);
937 983
938our @post_detect; 984our @post_detect;
939 985
940sub post_detect(&) { 986sub post_detect(&) {
941 my ($cb) = @_; 987 my ($cb) = @_;
946 1 992 1
947 } else { 993 } else {
948 push @post_detect, $cb; 994 push @post_detect, $cb;
949 995
950 defined wantarray 996 defined wantarray
951 ? bless \$cb, "AnyEvent::Util::PostDetect" 997 ? bless \$cb, "AnyEvent::Util::postdetect"
952 : () 998 : ()
953 } 999 }
954} 1000}
955 1001
956sub AnyEvent::Util::PostDetect::DESTROY { 1002sub AnyEvent::Util::postdetect::DESTROY {
957 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1003 @post_detect = grep $_ != ${$_[0]}, @post_detect;
958} 1004}
959 1005
960sub detect() { 1006sub detect() {
961 unless ($MODEL) { 1007 unless ($MODEL) {
1050package AnyEvent::Base; 1096package AnyEvent::Base;
1051 1097
1052# default implementations for many methods 1098# default implementations for many methods
1053 1099
1054BEGIN { 1100BEGIN {
1055 if (eval "use Time::HiRes (); time (); 1") { 1101 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1056 *_time = \&Time::HiRes::time; 1102 *_time = \&Time::HiRes::time;
1057 # if (eval "use POSIX (); (POSIX::times())... 1103 # if (eval "use POSIX (); (POSIX::times())...
1058 } else { 1104 } else {
1059 *_time = sub { time }; # epic fail 1105 *_time = sub { time }; # epic fail
1060 } 1106 }
1065sub now_update { } 1111sub now_update { }
1066 1112
1067# default implementation for ->condvar 1113# default implementation for ->condvar
1068 1114
1069sub condvar { 1115sub condvar {
1070 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, AnyEvent::CondVar:: 1116 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
1071} 1117}
1072 1118
1073# default implementation for ->signal 1119# default implementation for ->signal
1074 1120
1075our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1121our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1099 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case 1145 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case
1100 } else { 1146 } else {
1101 pipe $SIGPIPE_R, $SIGPIPE_W; 1147 pipe $SIGPIPE_R, $SIGPIPE_W;
1102 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R; 1148 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;
1103 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case 1149 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case
1150
1151 # not strictly required, as $^F is normally 2, but let's make sure...
1152 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1153 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1104 } 1154 }
1105 1155
1106 $SIGPIPE_R 1156 $SIGPIPE_R
1107 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n"; 1157 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1108
1109 # not strictly required, as $^F is normally 2, but let's make sure...
1110 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1111 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1112 1158
1113 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec); 1159 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1114 } 1160 }
1115 1161
1116 my $signal = uc $arg{signal} 1162 my $signal = uc $arg{signal}
1121 local $!; 1167 local $!;
1122 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; 1168 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1123 undef $SIG_EV{$signal}; 1169 undef $SIG_EV{$signal};
1124 }; 1170 };
1125 1171
1126 bless [$signal, $arg{cb}], "AnyEvent::Base::Signal" 1172 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1127} 1173}
1128 1174
1129sub AnyEvent::Base::Signal::DESTROY { 1175sub AnyEvent::Base::signal::DESTROY {
1130 my ($signal, $cb) = @{$_[0]}; 1176 my ($signal, $cb) = @{$_[0]};
1131 1177
1132 delete $SIG_CB{$signal}{$cb}; 1178 delete $SIG_CB{$signal}{$cb};
1133 1179
1180 # delete doesn't work with older perls - they then
1181 # print weird messages, or just unconditionally exit
1182 # instead of getting the default action.
1134 delete $SIG{$signal} unless keys %{ $SIG_CB{$signal} }; 1183 undef $SIG{$signal} unless keys %{ $SIG_CB{$signal} };
1135} 1184}
1136 1185
1137# default implementation for ->child 1186# default implementation for ->child
1138 1187
1139our %PID_CB; 1188our %PID_CB;
1140our $CHLD_W; 1189our $CHLD_W;
1141our $CHLD_DELAY_W; 1190our $CHLD_DELAY_W;
1142our $PID_IDLE;
1143our $WNOHANG; 1191our $WNOHANG;
1144 1192
1145sub _child_wait { 1193sub _sigchld {
1146 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1194 while (0 < (my $pid = waitpid -1, $WNOHANG)) {
1147 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }), 1195 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }),
1148 (values %{ $PID_CB{0} || {} }); 1196 (values %{ $PID_CB{0} || {} });
1149 } 1197 }
1150
1151 undef $PID_IDLE;
1152}
1153
1154sub _sigchld {
1155 # make sure we deliver these changes "synchronous" with the event loop.
1156 $CHLD_DELAY_W ||= AnyEvent->timer (after => 0, cb => sub {
1157 undef $CHLD_DELAY_W;
1158 &_child_wait;
1159 });
1160} 1198}
1161 1199
1162sub child { 1200sub child {
1163 my (undef, %arg) = @_; 1201 my (undef, %arg) = @_;
1164 1202
1165 defined (my $pid = $arg{pid} + 0) 1203 defined (my $pid = $arg{pid} + 0)
1166 or Carp::croak "required option 'pid' is missing"; 1204 or Carp::croak "required option 'pid' is missing";
1167 1205
1168 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1206 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1169 1207
1170 unless ($WNOHANG) {
1171 $WNOHANG = eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1208 $WNOHANG ||= eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1172 }
1173 1209
1174 unless ($CHLD_W) { 1210 unless ($CHLD_W) {
1175 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1211 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld);
1176 # child could be a zombie already, so make at least one round 1212 # child could be a zombie already, so make at least one round
1177 &_sigchld; 1213 &_sigchld;
1178 } 1214 }
1179 1215
1180 bless [$pid, $arg{cb}], "AnyEvent::Base::Child" 1216 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1181} 1217}
1182 1218
1183sub AnyEvent::Base::Child::DESTROY { 1219sub AnyEvent::Base::child::DESTROY {
1184 my ($pid, $cb) = @{$_[0]}; 1220 my ($pid, $cb) = @{$_[0]};
1185 1221
1186 delete $PID_CB{$pid}{$cb}; 1222 delete $PID_CB{$pid}{$cb};
1187 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; 1223 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1188 1224
1189 undef $CHLD_W unless keys %PID_CB; 1225 undef $CHLD_W unless keys %PID_CB;
1226}
1227
1228# idle emulation is done by simply using a timer, regardless
1229# of whether the process is idle or not, and not letting
1230# the callback use more than 50% of the time.
1231sub idle {
1232 my (undef, %arg) = @_;
1233
1234 my ($cb, $w, $rcb) = $arg{cb};
1235
1236 $rcb = sub {
1237 if ($cb) {
1238 $w = _time;
1239 &$cb;
1240 $w = _time - $w;
1241
1242 # never use more then 50% of the time for the idle watcher,
1243 # within some limits
1244 $w = 0.0001 if $w < 0.0001;
1245 $w = 5 if $w > 5;
1246
1247 $w = AnyEvent->timer (after => $w, cb => $rcb);
1248 } else {
1249 # clean up...
1250 undef $w;
1251 undef $rcb;
1252 }
1253 };
1254
1255 $w = AnyEvent->timer (after => 0.05, cb => $rcb);
1256
1257 bless \\$cb, "AnyEvent::Base::idle"
1258}
1259
1260sub AnyEvent::Base::idle::DESTROY {
1261 undef $${$_[0]};
1190} 1262}
1191 1263
1192package AnyEvent::CondVar; 1264package AnyEvent::CondVar;
1193 1265
1194our @ISA = AnyEvent::CondVar::Base::; 1266our @ISA = AnyEvent::CondVar::Base::;
1268so on. 1340so on.
1269 1341
1270=head1 ENVIRONMENT VARIABLES 1342=head1 ENVIRONMENT VARIABLES
1271 1343
1272The following environment variables are used by this module or its 1344The following environment variables are used by this module or its
1273submodules: 1345submodules.
1346
1347Note that AnyEvent will remove I<all> environment variables starting with
1348C<PERL_ANYEVENT_> from C<%ENV> when it is loaded while taint mode is
1349enabled.
1274 1350
1275=over 4 1351=over 4
1276 1352
1277=item C<PERL_ANYEVENT_VERBOSE> 1353=item C<PERL_ANYEVENT_VERBOSE>
1278 1354
1818=item * C-based event loops perform very well with small number of 1894=item * C-based event loops perform very well with small number of
1819watchers, as the management overhead dominates. 1895watchers, as the management overhead dominates.
1820 1896
1821=back 1897=back
1822 1898
1899=head2 THE IO::Lambda BENCHMARK
1900
1901Recently I was told about the benchmark in the IO::Lambda manpage, which
1902could be misinterpreted to make AnyEvent look bad. In fact, the benchmark
1903simply compares IO::Lambda with POE, and IO::Lambda looks better (which
1904shouldn't come as a surprise to anybody). As such, the benchmark is
1905fine, and shows that the AnyEvent backend from IO::Lambda isn't very
1906optimal. But how would AnyEvent compare when used without the extra
1907baggage? To explore this, I wrote the equivalent benchmark for AnyEvent.
1908
1909The benchmark itself creates an echo-server, and then, for 500 times,
1910connects to the echo server, sends a line, waits for the reply, and then
1911creates the next connection. This is a rather bad benchmark, as it doesn't
1912test the efficiency of the framework, but it is a benchmark nevertheless.
1913
1914 name runtime
1915 Lambda/select 0.330 sec
1916 + optimized 0.122 sec
1917 Lambda/AnyEvent 0.327 sec
1918 + optimized 0.138 sec
1919 Raw sockets/select 0.077 sec
1920 POE/select, components 0.662 sec
1921 POE/select, raw sockets 0.226 sec
1922 POE/select, optimized 0.404 sec
1923
1924 AnyEvent/select/nb 0.085 sec
1925 AnyEvent/EV/nb 0.068 sec
1926 +state machine 0.134 sec
1927
1928The benchmark is also a bit unfair (my fault) - the IO::Lambda
1929benchmarks actually make blocking connects and use 100% blocking I/O,
1930defeating the purpose of an event-based solution. All of the newly
1931written AnyEvent benchmarks use 100% non-blocking connects (using
1932AnyEvent::Socket::tcp_connect and the asynchronous pure perl DNS
1933resolver), so AnyEvent is at a disadvantage here as non-blocking connects
1934generally require a lot more bookkeeping and event handling than blocking
1935connects (which involve a single syscall only).
1936
1937The last AnyEvent benchmark additionally uses L<AnyEvent::Handle>, which
1938offers similar expressive power as POE and IO::Lambda (using conventional
1939Perl syntax), which means both the echo server and the client are 100%
1940non-blocking w.r.t. I/O, further placing it at a disadvantage.
1941
1942As you can see, AnyEvent + EV even beats the hand-optimised "raw sockets
1943benchmark", while AnyEvent + its pure perl backend easily beats
1944IO::Lambda and POE.
1945
1946And even the 100% non-blocking version written using the high-level (and
1947slow :) L<AnyEvent::Handle> abstraction beats both POE and IO::Lambda,
1948even thought it does all of DNS, tcp-connect and socket I/O in a
1949non-blocking way.
1950
1951The two AnyEvent benchmarks can be found as F<eg/ae0.pl> and F<eg/ae2.pl>
1952in the AnyEvent distribution, the remaining benchmarks are part of the
1953IO::lambda distribution and were used without any changes.
1954
1823 1955
1824=head1 SIGNALS 1956=head1 SIGNALS
1825 1957
1826AnyEvent currently installs handlers for these signals: 1958AnyEvent currently installs handlers for these signals:
1827 1959
1884 use AnyEvent; 2016 use AnyEvent;
1885 2017
1886Similar considerations apply to $ENV{PERL_ANYEVENT_VERBOSE}, as that can 2018Similar considerations apply to $ENV{PERL_ANYEVENT_VERBOSE}, as that can
1887be used to probe what backend is used and gain other information (which is 2019be used to probe what backend is used and gain other information (which is
1888probably even less useful to an attacker than PERL_ANYEVENT_MODEL), and 2020probably even less useful to an attacker than PERL_ANYEVENT_MODEL), and
1889$ENV{PERL_ANYEGENT_STRICT}. 2021$ENV{PERL_ANYEVENT_STRICT}.
1890 2022
1891 2023
1892=head1 BUGS 2024=head1 BUGS
1893 2025
1894Perl 5.8 has numerous memleaks that sometimes hit this module and are hard 2026Perl 5.8 has numerous memleaks that sometimes hit this module and are hard

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines