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.209 by root, Wed May 13 13:36:49 2009 UTC vs.
Revision 1.215 by root, Tue Jun 23 12:19:33 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
… …
930no warnings; 931no warnings;
931use strict qw(vars subs); 932use strict qw(vars subs);
932 933
933use Carp; 934use Carp;
934 935
935our $VERSION = 4.41; 936our $VERSION = 4.411;
936our $MODEL; 937our $MODEL;
937 938
938our $AUTOLOAD; 939our $AUTOLOAD;
939our @ISA; 940our @ISA;
940 941
941our @REGISTRY; 942our @REGISTRY;
942 943
943our $WIN32; 944our $WIN32;
944 945
945BEGIN { 946BEGIN {
946 my $win32 = ! ! ($^O =~ /mswin32/i); 947 eval "sub WIN32(){ " . (($^O =~ /mswin32/i)*1) ." }";
947 eval "sub WIN32(){ $win32 }"; 948 eval "sub TAINT(){ " . (${^TAINT}*1) . " }";
949
950 delete @ENV{grep /^PERL_ANYEVENT_/, keys %ENV}
951 if ${^TAINT};
948} 952}
949 953
950our $verbose = $ENV{PERL_ANYEVENT_VERBOSE}*1; 954our $verbose = $ENV{PERL_ANYEVENT_VERBOSE}*1;
951 955
952our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred 956our %PROTOCOL; # (ipv4|ipv6) => (1|2), higher numbers are preferred
… …
1141 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
1142 } else { 1146 } else {
1143 pipe $SIGPIPE_R, $SIGPIPE_W; 1147 pipe $SIGPIPE_R, $SIGPIPE_W;
1144 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;
1145 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;
1146 } 1154 }
1147 1155
1148 $SIGPIPE_R 1156 $SIGPIPE_R
1149 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";
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;
1154 1158
1155 $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);
1156 } 1160 }
1157 1161
1158 my $signal = uc $arg{signal} 1162 my $signal = uc $arg{signal}
… …
1171sub AnyEvent::Base::signal::DESTROY { 1175sub AnyEvent::Base::signal::DESTROY {
1172 my ($signal, $cb) = @{$_[0]}; 1176 my ($signal, $cb) = @{$_[0]};
1173 1177
1174 delete $SIG_CB{$signal}{$cb}; 1178 delete $SIG_CB{$signal}{$cb};
1175 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.
1176 $SIG{$signal} = 'DEFAULT' unless keys %{ $SIG_CB{$signal} }; 1183 undef $SIG{$signal} unless keys %{ $SIG_CB{$signal} };
1177} 1184}
1178 1185
1179# default implementation for ->child 1186# default implementation for ->child
1180 1187
1181our %PID_CB; 1188our %PID_CB;
1182our $CHLD_W; 1189our $CHLD_W;
1183our $CHLD_DELAY_W; 1190our $CHLD_DELAY_W;
1184our $PID_IDLE;
1185our $WNOHANG; 1191our $WNOHANG;
1186 1192
1187sub _child_wait { 1193sub _sigchld {
1188 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1194 while (0 < (my $pid = waitpid -1, $WNOHANG)) {
1189 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }), 1195 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }),
1190 (values %{ $PID_CB{0} || {} }); 1196 (values %{ $PID_CB{0} || {} });
1191 } 1197 }
1192
1193 undef $PID_IDLE;
1194}
1195
1196sub _sigchld {
1197 # make sure we deliver these changes "synchronous" with the event loop.
1198 $CHLD_DELAY_W ||= AnyEvent->timer (after => 0, cb => sub {
1199 undef $CHLD_DELAY_W;
1200 &_child_wait;
1201 });
1202} 1198}
1203 1199
1204sub child { 1200sub child {
1205 my (undef, %arg) = @_; 1201 my (undef, %arg) = @_;
1206 1202
1207 defined (my $pid = $arg{pid} + 0) 1203 defined (my $pid = $arg{pid} + 0)
1208 or Carp::croak "required option 'pid' is missing"; 1204 or Carp::croak "required option 'pid' is missing";
1209 1205
1210 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1206 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1211 1207
1212 unless ($WNOHANG) {
1213 $WNOHANG = eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1208 $WNOHANG ||= eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1214 }
1215 1209
1216 unless ($CHLD_W) { 1210 unless ($CHLD_W) {
1217 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1211 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld);
1218 # 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
1219 &_sigchld; 1213 &_sigchld;
… …
1230 1224
1231 undef $CHLD_W unless keys %PID_CB; 1225 undef $CHLD_W unless keys %PID_CB;
1232} 1226}
1233 1227
1234# idle emulation is done by simply using a timer, regardless 1228# idle emulation is done by simply using a timer, regardless
1235# of whether the proces sis idle or not, and not letting 1229# of whether the process is idle or not, and not letting
1236# the callback use more than 50% of the time. 1230# the callback use more than 50% of the time.
1237sub idle { 1231sub idle {
1238 my (undef, %arg) = @_; 1232 my (undef, %arg) = @_;
1239 1233
1240 my ($cb, $w, $rcb) = $arg{cb}; 1234 my ($cb, $w, $rcb) = $arg{cb};
… …
1346so on. 1340so on.
1347 1341
1348=head1 ENVIRONMENT VARIABLES 1342=head1 ENVIRONMENT VARIABLES
1349 1343
1350The following environment variables are used by this module or its 1344The following environment variables are used by this module or its
1351submodules: 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.
1352 1350
1353=over 4 1351=over 4
1354 1352
1355=item C<PERL_ANYEVENT_VERBOSE> 1353=item C<PERL_ANYEVENT_VERBOSE>
1356 1354
… …
1896=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
1897watchers, as the management overhead dominates. 1895watchers, as the management overhead dominates.
1898 1896
1899=back 1897=back
1900 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
1901 1951
1902=head1 SIGNALS 1952=head1 SIGNALS
1903 1953
1904AnyEvent currently installs handlers for these signals: 1954AnyEvent currently installs handlers for these signals:
1905 1955
… …
1962 use AnyEvent; 2012 use AnyEvent;
1963 2013
1964Similar considerations apply to $ENV{PERL_ANYEVENT_VERBOSE}, as that can 2014Similar considerations apply to $ENV{PERL_ANYEVENT_VERBOSE}, as that can
1965be used to probe what backend is used and gain other information (which is 2015be used to probe what backend is used and gain other information (which is
1966probably even less useful to an attacker than PERL_ANYEVENT_MODEL), and 2016probably even less useful to an attacker than PERL_ANYEVENT_MODEL), and
1967$ENV{PERL_ANYEGENT_STRICT}. 2017$ENV{PERL_ANYEVENT_STRICT}.
1968 2018
1969 2019
1970=head1 BUGS 2020=head1 BUGS
1971 2021
1972Perl 5.8 has numerous memleaks that sometimes hit this module and are hard 2022Perl 5.8 has numerous memleaks that sometimes hit this module and are hard

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines