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.195 by root, Wed Mar 25 17:33:11 2009 UTC vs.
Revision 1.213 by root, Sat Jun 20 07:14:35 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:
137These watchers are normal Perl objects with normal Perl lifetime. After 145These watchers are normal Perl objects with normal Perl lifetime. After
138creating a watcher it will immediately "watch" for events and invoke the 146creating a watcher it will immediately "watch" for events and invoke the
139callback when the event occurs (of course, only when the event model 147callback when the event occurs (of course, only when the event model
140is in control). 148is in control).
141 149
150Note that B<callbacks must not permanently change global variables>
151potentially in use by the event loop (such as C<$_> or C<$[>) and that B<<
152callbacks must not C<die> >>. The former is good programming practise in
153Perl and the latter stems from the fact that exception handling differs
154widely between event loops.
155
142To disable the watcher you have to destroy it (e.g. by setting the 156To disable the watcher you have to destroy it (e.g. by setting the
143variable you store it in to C<undef> or otherwise deleting all references 157variable you store it in to C<undef> or otherwise deleting all references
144to it). 158to it).
145 159
146All watchers are created by calling a method on the C<AnyEvent> class. 160All watchers are created by calling a method on the C<AnyEvent> class.
162=head2 I/O WATCHERS 176=head2 I/O WATCHERS
163 177
164You can create an I/O watcher by calling the C<< AnyEvent->io >> method 178You can create an I/O watcher by calling the C<< AnyEvent->io >> method
165with the following mandatory key-value pairs as arguments: 179with the following mandatory key-value pairs as arguments:
166 180
167C<fh> the Perl I<file handle> (I<not> file descriptor) to watch for events 181C<fh> is the Perl I<file handle> (I<not> file descriptor) to watch
168(AnyEvent might or might not keep a reference to this file handle). C<poll> 182for events (AnyEvent might or might not keep a reference to this file
183handle). Note that only file handles pointing to things for which
184non-blocking operation makes sense are allowed. This includes sockets,
185most character devices, pipes, fifos and so on, but not for example files
186or block devices.
187
169must be a string that is either C<r> or C<w>, which creates a watcher 188C<poll> must be a string that is either C<r> or C<w>, which creates a
170waiting for "r"eadable or "w"ritable events, respectively. C<cb> is the 189watcher waiting for "r"eadable or "w"ritable events, respectively.
190
171callback to invoke each time the file handle becomes ready. 191C<cb> is the callback to invoke each time the file handle becomes ready.
172 192
173Although the callback might get passed parameters, their value and 193Although the callback might get passed parameters, their value and
174presence is undefined and you cannot rely on them. Portable AnyEvent 194presence is undefined and you cannot rely on them. Portable AnyEvent
175callbacks cannot use arguments passed to I/O watcher callbacks. 195callbacks cannot use arguments passed to I/O watcher callbacks.
176 196
307 327
308In either case, if you care (and in most cases, you don't), then you 328In either case, if you care (and in most cases, you don't), then you
309can get whatever behaviour you want with any event loop, by taking the 329can get whatever behaviour you want with any event loop, by taking the
310difference between C<< AnyEvent->time >> and C<< AnyEvent->now >> into 330difference between C<< AnyEvent->time >> and C<< AnyEvent->now >> into
311account. 331account.
332
333=item AnyEvent->now_update
334
335Some event loops (such as L<EV> or L<AnyEvent::Impl::Perl>) cache
336the current time for each loop iteration (see the discussion of L<<
337AnyEvent->now >>, above).
338
339When a callback runs for a long time (or when the process sleeps), then
340this "current" time will differ substantially from the real time, which
341might affect timers and time-outs.
342
343When this is the case, you can call this method, which will update the
344event loop's idea of "current time".
345
346Note that updating the time I<might> cause some events to be handled.
312 347
313=back 348=back
314 349
315=head2 SIGNAL WATCHERS 350=head2 SIGNAL WATCHERS
316 351
383 ); 418 );
384 419
385 # do something else, then wait for process exit 420 # do something else, then wait for process exit
386 $done->recv; 421 $done->recv;
387 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
388=head2 CONDITION VARIABLES 458=head2 CONDITION VARIABLES
389 459
390If 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
391require you to run some blocking "loop", "run" or similar function that 461require you to run some blocking "loop", "run" or similar function that
392will actively watch for new events and call your callbacks. 462will actively watch for new events and call your callbacks.
861no warnings; 931no warnings;
862use strict qw(vars subs); 932use strict qw(vars subs);
863 933
864use Carp; 934use Carp;
865 935
866our $VERSION = 4.341; 936our $VERSION = 4.411;
867our $MODEL; 937our $MODEL;
868 938
869our $AUTOLOAD; 939our $AUTOLOAD;
870our @ISA; 940our @ISA;
871 941
903 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 973 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
904 [Wx:: => AnyEvent::Impl::POE::], 974 [Wx:: => AnyEvent::Impl::POE::],
905 [Prima:: => AnyEvent::Impl::POE::], 975 [Prima:: => AnyEvent::Impl::POE::],
906); 976);
907 977
908our %method = map +($_ => 1), qw(io timer time now signal child condvar one_event DESTROY); 978our %method = map +($_ => 1),
979 qw(io timer time now now_update signal child idle condvar one_event DESTROY);
909 980
910our @post_detect; 981our @post_detect;
911 982
912sub post_detect(&) { 983sub post_detect(&) {
913 my ($cb) = @_; 984 my ($cb) = @_;
918 1 989 1
919 } else { 990 } else {
920 push @post_detect, $cb; 991 push @post_detect, $cb;
921 992
922 defined wantarray 993 defined wantarray
923 ? bless \$cb, "AnyEvent::Util::PostDetect" 994 ? bless \$cb, "AnyEvent::Util::postdetect"
924 : () 995 : ()
925 } 996 }
926} 997}
927 998
928sub AnyEvent::Util::PostDetect::DESTROY { 999sub AnyEvent::Util::postdetect::DESTROY {
929 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1000 @post_detect = grep $_ != ${$_[0]}, @post_detect;
930} 1001}
931 1002
932sub detect() { 1003sub detect() {
933 unless ($MODEL) { 1004 unless ($MODEL) {
970 last; 1041 last;
971 } 1042 }
972 } 1043 }
973 1044
974 $MODEL 1045 $MODEL
975 or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib."; 1046 or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n";
976 } 1047 }
977 } 1048 }
978 1049
979 push @{"$MODEL\::ISA"}, "AnyEvent::Base"; 1050 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
980 1051
1010 my ($rw, $mode) = $poll eq "r" ? ($r, "<") 1081 my ($rw, $mode) = $poll eq "r" ? ($r, "<")
1011 : $poll eq "w" ? ($w, ">") 1082 : $poll eq "w" ? ($w, ">")
1012 : Carp::croak "AnyEvent->io requires poll set to either 'r' or 'w'"; 1083 : Carp::croak "AnyEvent->io requires poll set to either 'r' or 'w'";
1013 1084
1014 open my $fh2, "$mode&" . fileno $fh 1085 open my $fh2, "$mode&" . fileno $fh
1015 or die "cannot dup() filehandle: $!"; 1086 or die "cannot dup() filehandle: $!,";
1016 1087
1017 # we assume CLOEXEC is already set by perl in all important cases 1088 # we assume CLOEXEC is already set by perl in all important cases
1018 1089
1019 ($fh2, $rw) 1090 ($fh2, $rw)
1020} 1091}
1021 1092
1022package AnyEvent::Base; 1093package AnyEvent::Base;
1023 1094
1024# default implementation for now and time 1095# default implementations for many methods
1025 1096
1026BEGIN { 1097BEGIN {
1027 if (eval "use Time::HiRes (); time (); 1") { 1098 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1028 *_time = \&Time::HiRes::time; 1099 *_time = \&Time::HiRes::time;
1029 # if (eval "use POSIX (); (POSIX::times())... 1100 # if (eval "use POSIX (); (POSIX::times())...
1030 } else { 1101 } else {
1031 *_time = sub { time }; # epic fail 1102 *_time = sub { time }; # epic fail
1032 } 1103 }
1033} 1104}
1034 1105
1035sub time { _time } 1106sub time { _time }
1036sub now { _time } 1107sub now { _time }
1108sub now_update { }
1037 1109
1038# default implementation for ->condvar 1110# default implementation for ->condvar
1039 1111
1040sub condvar { 1112sub condvar {
1041 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, AnyEvent::CondVar:: 1113 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
1042} 1114}
1043 1115
1044# default implementation for ->signal 1116# default implementation for ->signal
1045 1117
1046our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1118our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1047 1119
1048sub _signal_exec { 1120sub _signal_exec {
1121 sysread $SIGPIPE_R, my $dummy, 4;
1122
1049 while (%SIG_EV) { 1123 while (%SIG_EV) {
1050 sysread $SIGPIPE_R, my $dummy, 4;
1051 for (keys %SIG_EV) { 1124 for (keys %SIG_EV) {
1052 delete $SIG_EV{$_}; 1125 delete $SIG_EV{$_};
1053 $_->() for values %{ $SIG_CB{$_} || {} }; 1126 $_->() for values %{ $SIG_CB{$_} || {} };
1054 } 1127 }
1055 } 1128 }
1057 1130
1058sub signal { 1131sub signal {
1059 my (undef, %arg) = @_; 1132 my (undef, %arg) = @_;
1060 1133
1061 unless ($SIGPIPE_R) { 1134 unless ($SIGPIPE_R) {
1135 require Fcntl;
1136
1062 if (AnyEvent::WIN32) { 1137 if (AnyEvent::WIN32) {
1138 require AnyEvent::Util;
1139
1063 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe (); 1140 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1064 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R) if $SIGPIPE_R; 1141 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R) if $SIGPIPE_R;
1065 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case 1142 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case
1066 } else { 1143 } else {
1067 pipe $SIGPIPE_R, $SIGPIPE_W; 1144 pipe $SIGPIPE_R, $SIGPIPE_W;
1068 require Fcntl;
1069 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R; 1145 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;
1070 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case 1146 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case
1147
1148 # not strictly required, as $^F is normally 2, but let's make sure...
1149 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1150 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1071 } 1151 }
1072 1152
1073 $SIGPIPE_R 1153 $SIGPIPE_R
1074 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n"; 1154 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1075 1155
1079 my $signal = uc $arg{signal} 1159 my $signal = uc $arg{signal}
1080 or Carp::croak "required option 'signal' is missing"; 1160 or Carp::croak "required option 'signal' is missing";
1081 1161
1082 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1162 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1083 $SIG{$signal} ||= sub { 1163 $SIG{$signal} ||= sub {
1164 local $!;
1084 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; 1165 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1085 undef $SIG_EV{$signal}; 1166 undef $SIG_EV{$signal};
1086 }; 1167 };
1087 1168
1088 bless [$signal, $arg{cb}], "AnyEvent::Base::Signal" 1169 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1089} 1170}
1090 1171
1091sub AnyEvent::Base::Signal::DESTROY { 1172sub AnyEvent::Base::signal::DESTROY {
1092 my ($signal, $cb) = @{$_[0]}; 1173 my ($signal, $cb) = @{$_[0]};
1093 1174
1094 delete $SIG_CB{$signal}{$cb}; 1175 delete $SIG_CB{$signal}{$cb};
1095 1176
1177 # delete doesn't work with older perls - they then
1178 # print weird messages, or just unconditionally exit
1179 # instead of getting the default action.
1096 delete $SIG{$signal} unless keys %{ $SIG_CB{$signal} }; 1180 undef $SIG{$signal} unless keys %{ $SIG_CB{$signal} };
1097} 1181}
1098 1182
1099# default implementation for ->child 1183# default implementation for ->child
1100 1184
1101our %PID_CB; 1185our %PID_CB;
1102our $CHLD_W; 1186our $CHLD_W;
1103our $CHLD_DELAY_W; 1187our $CHLD_DELAY_W;
1104our $PID_IDLE;
1105our $WNOHANG; 1188our $WNOHANG;
1106 1189
1107sub _child_wait { 1190sub _sigchld {
1108 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1191 while (0 < (my $pid = waitpid -1, $WNOHANG)) {
1109 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }), 1192 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }),
1110 (values %{ $PID_CB{0} || {} }); 1193 (values %{ $PID_CB{0} || {} });
1111 } 1194 }
1112
1113 undef $PID_IDLE;
1114}
1115
1116sub _sigchld {
1117 # make sure we deliver these changes "synchronous" with the event loop.
1118 $CHLD_DELAY_W ||= AnyEvent->timer (after => 0, cb => sub {
1119 undef $CHLD_DELAY_W;
1120 &_child_wait;
1121 });
1122} 1195}
1123 1196
1124sub child { 1197sub child {
1125 my (undef, %arg) = @_; 1198 my (undef, %arg) = @_;
1126 1199
1127 defined (my $pid = $arg{pid} + 0) 1200 defined (my $pid = $arg{pid} + 0)
1128 or Carp::croak "required option 'pid' is missing"; 1201 or Carp::croak "required option 'pid' is missing";
1129 1202
1130 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1203 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1131 1204
1132 unless ($WNOHANG) {
1133 $WNOHANG = eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1205 $WNOHANG ||= eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1134 }
1135 1206
1136 unless ($CHLD_W) { 1207 unless ($CHLD_W) {
1137 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1208 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld);
1138 # child could be a zombie already, so make at least one round 1209 # child could be a zombie already, so make at least one round
1139 &_sigchld; 1210 &_sigchld;
1140 } 1211 }
1141 1212
1142 bless [$pid, $arg{cb}], "AnyEvent::Base::Child" 1213 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1143} 1214}
1144 1215
1145sub AnyEvent::Base::Child::DESTROY { 1216sub AnyEvent::Base::child::DESTROY {
1146 my ($pid, $cb) = @{$_[0]}; 1217 my ($pid, $cb) = @{$_[0]};
1147 1218
1148 delete $PID_CB{$pid}{$cb}; 1219 delete $PID_CB{$pid}{$cb};
1149 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; 1220 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1150 1221
1151 undef $CHLD_W unless keys %PID_CB; 1222 undef $CHLD_W unless keys %PID_CB;
1223}
1224
1225# idle emulation is done by simply using a timer, regardless
1226# of whether the process is idle or not, and not letting
1227# the callback use more than 50% of the time.
1228sub idle {
1229 my (undef, %arg) = @_;
1230
1231 my ($cb, $w, $rcb) = $arg{cb};
1232
1233 $rcb = sub {
1234 if ($cb) {
1235 $w = _time;
1236 &$cb;
1237 $w = _time - $w;
1238
1239 # never use more then 50% of the time for the idle watcher,
1240 # within some limits
1241 $w = 0.0001 if $w < 0.0001;
1242 $w = 5 if $w > 5;
1243
1244 $w = AnyEvent->timer (after => $w, cb => $rcb);
1245 } else {
1246 # clean up...
1247 undef $w;
1248 undef $rcb;
1249 }
1250 };
1251
1252 $w = AnyEvent->timer (after => 0.05, cb => $rcb);
1253
1254 bless \\$cb, "AnyEvent::Base::idle"
1255}
1256
1257sub AnyEvent::Base::idle::DESTROY {
1258 undef $${$_[0]};
1152} 1259}
1153 1260
1154package AnyEvent::CondVar; 1261package AnyEvent::CondVar;
1155 1262
1156our @ISA = AnyEvent::CondVar::Base::; 1263our @ISA = AnyEvent::CondVar::Base::;
1846 use AnyEvent; 1953 use AnyEvent;
1847 1954
1848Similar considerations apply to $ENV{PERL_ANYEVENT_VERBOSE}, as that can 1955Similar considerations apply to $ENV{PERL_ANYEVENT_VERBOSE}, as that can
1849be used to probe what backend is used and gain other information (which is 1956be used to probe what backend is used and gain other information (which is
1850probably even less useful to an attacker than PERL_ANYEVENT_MODEL), and 1957probably even less useful to an attacker than PERL_ANYEVENT_MODEL), and
1851$ENV{PERL_ANYEGENT_STRICT}. 1958$ENV{PERL_ANYEVENT_STRICT}.
1852 1959
1853 1960
1854=head1 BUGS 1961=head1 BUGS
1855 1962
1856Perl 5.8 has numerous memleaks that sometimes hit this module and are hard 1963Perl 5.8 has numerous memleaks that sometimes hit this module and are hard
1857to work around. If you suffer from memleaks, first upgrade to Perl 5.10 1964to work around. If you suffer from memleaks, first upgrade to Perl 5.10
1858and check wether the leaks still show up. (Perl 5.10.0 has other annoying 1965and check wether the leaks still show up. (Perl 5.10.0 has other annoying
1859mamleaks, such as leaking on C<map> and C<grep> but it is usually not as 1966memleaks, such as leaking on C<map> and C<grep> but it is usually not as
1860pronounced). 1967pronounced).
1861 1968
1862 1969
1863=head1 SEE ALSO 1970=head1 SEE ALSO
1864 1971

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines