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.204 by root, Thu Apr 16 08:15:25 2009 UTC vs.
Revision 1.211 by root, Sat Jun 6 12:04:30 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:
… …
319 327
320In 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
321can 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
322difference between C<< AnyEvent->time >> and C<< AnyEvent->now >> into 330difference between C<< AnyEvent->time >> and C<< AnyEvent->now >> into
323account. 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.
324 347
325=back 348=back
326 349
327=head2 SIGNAL WATCHERS 350=head2 SIGNAL WATCHERS
328 351
… …
395 ); 418 );
396 419
397 # do something else, then wait for process exit 420 # do something else, then wait for process exit
398 $done->recv; 421 $done->recv;
399 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
400=head2 CONDITION VARIABLES 458=head2 CONDITION VARIABLES
401 459
402If 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
403require you to run some blocking "loop", "run" or similar function that 461require you to run some blocking "loop", "run" or similar function that
404will actively watch for new events and call your callbacks. 462will actively watch for new events and call your callbacks.
… …
873no warnings; 931no warnings;
874use strict qw(vars subs); 932use strict qw(vars subs);
875 933
876use Carp; 934use Carp;
877 935
878our $VERSION = 4.351; 936our $VERSION = 4.41;
879our $MODEL; 937our $MODEL;
880 938
881our $AUTOLOAD; 939our $AUTOLOAD;
882our @ISA; 940our @ISA;
883 941
… …
915 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 973 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
916 [Wx:: => AnyEvent::Impl::POE::], 974 [Wx:: => AnyEvent::Impl::POE::],
917 [Prima:: => AnyEvent::Impl::POE::], 975 [Prima:: => AnyEvent::Impl::POE::],
918); 976);
919 977
920our %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);
921 980
922our @post_detect; 981our @post_detect;
923 982
924sub post_detect(&) { 983sub post_detect(&) {
925 my ($cb) = @_; 984 my ($cb) = @_;
… …
930 1 989 1
931 } else { 990 } else {
932 push @post_detect, $cb; 991 push @post_detect, $cb;
933 992
934 defined wantarray 993 defined wantarray
935 ? bless \$cb, "AnyEvent::Util::PostDetect" 994 ? bless \$cb, "AnyEvent::Util::postdetect"
936 : () 995 : ()
937 } 996 }
938} 997}
939 998
940sub AnyEvent::Util::PostDetect::DESTROY { 999sub AnyEvent::Util::postdetect::DESTROY {
941 @post_detect = grep $_ != ${$_[0]}, @post_detect; 1000 @post_detect = grep $_ != ${$_[0]}, @post_detect;
942} 1001}
943 1002
944sub detect() { 1003sub detect() {
945 unless ($MODEL) { 1004 unless ($MODEL) {
… …
1031 ($fh2, $rw) 1090 ($fh2, $rw)
1032} 1091}
1033 1092
1034package AnyEvent::Base; 1093package AnyEvent::Base;
1035 1094
1036# default implementation for now and time 1095# default implementations for many methods
1037 1096
1038BEGIN { 1097BEGIN {
1039 if (eval "use Time::HiRes (); time (); 1") { 1098 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1040 *_time = \&Time::HiRes::time; 1099 *_time = \&Time::HiRes::time;
1041 # if (eval "use POSIX (); (POSIX::times())... 1100 # if (eval "use POSIX (); (POSIX::times())...
1042 } else { 1101 } else {
1043 *_time = sub { time }; # epic fail 1102 *_time = sub { time }; # epic fail
1044 } 1103 }
1045} 1104}
1046 1105
1047sub time { _time } 1106sub time { _time }
1048sub now { _time } 1107sub now { _time }
1108sub now_update { }
1049 1109
1050# default implementation for ->condvar 1110# default implementation for ->condvar
1051 1111
1052sub condvar { 1112sub condvar {
1053 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, AnyEvent::CondVar:: 1113 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
1054} 1114}
1055 1115
1056# default implementation for ->signal 1116# default implementation for ->signal
1057 1117
1058our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1118our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
… …
1082 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
1083 } else { 1143 } else {
1084 pipe $SIGPIPE_R, $SIGPIPE_W; 1144 pipe $SIGPIPE_R, $SIGPIPE_W;
1085 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;
1086 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;
1087 } 1151 }
1088 1152
1089 $SIGPIPE_R 1153 $SIGPIPE_R
1090 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";
1091
1092 # not strictly required, as $^F is normally 2, but let's make sure...
1093 fcntl $SIGPIPE_R, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1094 fcntl $SIGPIPE_W, &Fcntl::F_SETFD, &Fcntl::FD_CLOEXEC;
1095 1155
1096 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec); 1156 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1097 } 1157 }
1098 1158
1099 my $signal = uc $arg{signal} 1159 my $signal = uc $arg{signal}
… …
1104 local $!; 1164 local $!;
1105 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; 1165 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1106 undef $SIG_EV{$signal}; 1166 undef $SIG_EV{$signal};
1107 }; 1167 };
1108 1168
1109 bless [$signal, $arg{cb}], "AnyEvent::Base::Signal" 1169 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1110} 1170}
1111 1171
1112sub AnyEvent::Base::Signal::DESTROY { 1172sub AnyEvent::Base::signal::DESTROY {
1113 my ($signal, $cb) = @{$_[0]}; 1173 my ($signal, $cb) = @{$_[0]};
1114 1174
1115 delete $SIG_CB{$signal}{$cb}; 1175 delete $SIG_CB{$signal}{$cb};
1116 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.
1117 delete $SIG{$signal} unless keys %{ $SIG_CB{$signal} }; 1180 undef $SIG{$signal} unless keys %{ $SIG_CB{$signal} };
1118} 1181}
1119 1182
1120# default implementation for ->child 1183# default implementation for ->child
1121 1184
1122our %PID_CB; 1185our %PID_CB;
1123our $CHLD_W; 1186our $CHLD_W;
1124our $CHLD_DELAY_W; 1187our $CHLD_DELAY_W;
1125our $PID_IDLE;
1126our $WNOHANG; 1188our $WNOHANG;
1127 1189
1128sub _child_wait { 1190sub _sigchld {
1129 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1191 while (0 < (my $pid = waitpid -1, $WNOHANG)) {
1130 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }), 1192 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }),
1131 (values %{ $PID_CB{0} || {} }); 1193 (values %{ $PID_CB{0} || {} });
1132 } 1194 }
1133
1134 undef $PID_IDLE;
1135}
1136
1137sub _sigchld {
1138 # make sure we deliver these changes "synchronous" with the event loop.
1139 $CHLD_DELAY_W ||= AnyEvent->timer (after => 0, cb => sub {
1140 undef $CHLD_DELAY_W;
1141 &_child_wait;
1142 });
1143} 1195}
1144 1196
1145sub child { 1197sub child {
1146 my (undef, %arg) = @_; 1198 my (undef, %arg) = @_;
1147 1199
1148 defined (my $pid = $arg{pid} + 0) 1200 defined (my $pid = $arg{pid} + 0)
1149 or Carp::croak "required option 'pid' is missing"; 1201 or Carp::croak "required option 'pid' is missing";
1150 1202
1151 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1203 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1152 1204
1153 unless ($WNOHANG) {
1154 $WNOHANG = eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1205 $WNOHANG ||= eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1155 }
1156 1206
1157 unless ($CHLD_W) { 1207 unless ($CHLD_W) {
1158 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1208 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld);
1159 # 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
1160 &_sigchld; 1210 &_sigchld;
1161 } 1211 }
1162 1212
1163 bless [$pid, $arg{cb}], "AnyEvent::Base::Child" 1213 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1164} 1214}
1165 1215
1166sub AnyEvent::Base::Child::DESTROY { 1216sub AnyEvent::Base::child::DESTROY {
1167 my ($pid, $cb) = @{$_[0]}; 1217 my ($pid, $cb) = @{$_[0]};
1168 1218
1169 delete $PID_CB{$pid}{$cb}; 1219 delete $PID_CB{$pid}{$cb};
1170 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; 1220 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1171 1221
1172 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]};
1173} 1259}
1174 1260
1175package AnyEvent::CondVar; 1261package AnyEvent::CondVar;
1176 1262
1177our @ISA = AnyEvent::CondVar::Base::; 1263our @ISA = AnyEvent::CondVar::Base::;

Diff Legend

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