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.199 by root, Fri Mar 27 10:49:50 2009 UTC vs.
Revision 1.210 by root, Wed May 13 15:19:43 2009 UTC

… …
6 6
7=head1 SYNOPSIS 7=head1 SYNOPSIS
8 8
9 use AnyEvent; 9 use AnyEvent;
10 10
11 # file descriptor readable
11 my $w = AnyEvent->io (fh => $fh, poll => "r|w", cb => sub { ... }); 12 my $w = AnyEvent->io (fh => $fh, poll => "r", cb => sub { ... });
12 13
14 # one-shot or repeating timers
13 my $w = AnyEvent->timer (after => $seconds, cb => sub { ... }); 15 my $w = AnyEvent->timer (after => $seconds, cb => sub { ... });
14 my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ... 16 my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ...
15 17
16 print AnyEvent->now; # prints current event loop time 18 print AnyEvent->now; # prints current event loop time
17 print AnyEvent->time; # think Time::HiRes::time or simply CORE::time. 19 print AnyEvent->time; # think Time::HiRes::time or simply CORE::time.
18 20
21 # POSIX signal
19 my $w = AnyEvent->signal (signal => "TERM", cb => sub { ... }); 22 my $w = AnyEvent->signal (signal => "TERM", cb => sub { ... });
20 23
24 # child process exit
21 my $w = AnyEvent->child (pid => $pid, cb => sub { 25 my $w = AnyEvent->child (pid => $pid, cb => sub {
22 my ($pid, $status) = @_; 26 my ($pid, $status) = @_;
23 ... 27 ...
24 }); 28 });
29
30 # called when event loop idle (if applicable)
31 my $w = AnyEvent->idle (cb => sub { ... });
25 32
26 my $w = AnyEvent->condvar; # stores whether a condition was flagged 33 my $w = AnyEvent->condvar; # stores whether a condition was flagged
27 $w->send; # wake up current and all future recv's 34 $w->send; # wake up current and all future recv's
28 $w->recv; # enters "main loop" till $condvar gets ->send 35 $w->recv; # enters "main loop" till $condvar gets ->send
29 # use a condvar in callback mode: 36 # use a condvar in callback mode:
… …
319 326
320In either case, if you care (and in most cases, you don't), then you 327In 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 328can get whatever behaviour you want with any event loop, by taking the
322difference between C<< AnyEvent->time >> and C<< AnyEvent->now >> into 329difference between C<< AnyEvent->time >> and C<< AnyEvent->now >> into
323account. 330account.
331
332=item AnyEvent->now_update
333
334Some event loops (such as L<EV> or L<AnyEvent::Impl::Perl>) cache
335the current time for each loop iteration (see the discussion of L<<
336AnyEvent->now >>, above).
337
338When a callback runs for a long time (or when the process sleeps), then
339this "current" time will differ substantially from the real time, which
340might affect timers and time-outs.
341
342When this is the case, you can call this method, which will update the
343event loop's idea of "current time".
344
345Note that updating the time I<might> cause some events to be handled.
324 346
325=back 347=back
326 348
327=head2 SIGNAL WATCHERS 349=head2 SIGNAL WATCHERS
328 350
… …
395 ); 417 );
396 418
397 # do something else, then wait for process exit 419 # do something else, then wait for process exit
398 $done->recv; 420 $done->recv;
399 421
422=head2 IDLE WATCHERS
423
424Sometimes there is a need to do something, but it is not so important
425to do it instantly, but only when there is nothing better to do. This
426"nothing better to do" is usually defined to be "no other events need
427attention by the event loop".
428
429Idle watchers ideally get invoked when the event loop has nothing
430better to do, just before it would block the process to wait for new
431events. Instead of blocking, the idle watcher is invoked.
432
433Most event loops unfortunately do not really support idle watchers (only
434EV, Event and Glib do it in a usable fashion) - for the rest, AnyEvent
435will simply call the callback "from time to time".
436
437Example: read lines from STDIN, but only process them when the
438program is otherwise idle:
439
440 my @lines; # read data
441 my $idle_w;
442 my $io_w = AnyEvent->io (fh => \*STDIN, poll => 'r', cb => sub {
443 push @lines, scalar <STDIN>;
444
445 # start an idle watcher, if not already done
446 $idle_w ||= AnyEvent->idle (cb => sub {
447 # handle only one line, when there are lines left
448 if (my $line = shift @lines) {
449 print "handled when idle: $line";
450 } else {
451 # otherwise disable the idle watcher again
452 undef $idle_w;
453 }
454 });
455 });
456
400=head2 CONDITION VARIABLES 457=head2 CONDITION VARIABLES
401 458
402If you are familiar with some event loops you will know that all of them 459If 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 460require you to run some blocking "loop", "run" or similar function that
404will actively watch for new events and call your callbacks. 461will actively watch for new events and call your callbacks.
… …
873no warnings; 930no warnings;
874use strict qw(vars subs); 931use strict qw(vars subs);
875 932
876use Carp; 933use Carp;
877 934
878our $VERSION = 4.35; 935our $VERSION = 4.41;
879our $MODEL; 936our $MODEL;
880 937
881our $AUTOLOAD; 938our $AUTOLOAD;
882our @ISA; 939our @ISA;
883 940
… …
915 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 972 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
916 [Wx:: => AnyEvent::Impl::POE::], 973 [Wx:: => AnyEvent::Impl::POE::],
917 [Prima:: => AnyEvent::Impl::POE::], 974 [Prima:: => AnyEvent::Impl::POE::],
918); 975);
919 976
920our %method = map +($_ => 1), qw(io timer time now signal child condvar one_event DESTROY); 977our %method = map +($_ => 1),
978 qw(io timer time now now_update signal child idle condvar one_event DESTROY);
921 979
922our @post_detect; 980our @post_detect;
923 981
924sub post_detect(&) { 982sub post_detect(&) {
925 my ($cb) = @_; 983 my ($cb) = @_;
… …
930 1 988 1
931 } else { 989 } else {
932 push @post_detect, $cb; 990 push @post_detect, $cb;
933 991
934 defined wantarray 992 defined wantarray
935 ? bless \$cb, "AnyEvent::Util::PostDetect" 993 ? bless \$cb, "AnyEvent::Util::postdetect"
936 : () 994 : ()
937 } 995 }
938} 996}
939 997
940sub AnyEvent::Util::PostDetect::DESTROY { 998sub AnyEvent::Util::postdetect::DESTROY {
941 @post_detect = grep $_ != ${$_[0]}, @post_detect; 999 @post_detect = grep $_ != ${$_[0]}, @post_detect;
942} 1000}
943 1001
944sub detect() { 1002sub detect() {
945 unless ($MODEL) { 1003 unless ($MODEL) {
… …
982 last; 1040 last;
983 } 1041 }
984 } 1042 }
985 1043
986 $MODEL 1044 $MODEL
987 or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib."; 1045 or die "No event module selected for AnyEvent and autodetect failed. Install any one of these modules: EV, Event or Glib.\n";
988 } 1046 }
989 } 1047 }
990 1048
991 push @{"$MODEL\::ISA"}, "AnyEvent::Base"; 1049 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
992 1050
… …
1022 my ($rw, $mode) = $poll eq "r" ? ($r, "<") 1080 my ($rw, $mode) = $poll eq "r" ? ($r, "<")
1023 : $poll eq "w" ? ($w, ">") 1081 : $poll eq "w" ? ($w, ">")
1024 : Carp::croak "AnyEvent->io requires poll set to either 'r' or 'w'"; 1082 : Carp::croak "AnyEvent->io requires poll set to either 'r' or 'w'";
1025 1083
1026 open my $fh2, "$mode&" . fileno $fh 1084 open my $fh2, "$mode&" . fileno $fh
1027 or die "cannot dup() filehandle: $!"; 1085 or die "cannot dup() filehandle: $!,";
1028 1086
1029 # we assume CLOEXEC is already set by perl in all important cases 1087 # we assume CLOEXEC is already set by perl in all important cases
1030 1088
1031 ($fh2, $rw) 1089 ($fh2, $rw)
1032} 1090}
1033 1091
1034package AnyEvent::Base; 1092package AnyEvent::Base;
1035 1093
1036# default implementation for now and time 1094# default implementations for many methods
1037 1095
1038BEGIN { 1096BEGIN {
1039 if (eval "use Time::HiRes (); time (); 1") { 1097 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1040 *_time = \&Time::HiRes::time; 1098 *_time = \&Time::HiRes::time;
1041 # if (eval "use POSIX (); (POSIX::times())... 1099 # if (eval "use POSIX (); (POSIX::times())...
1042 } else { 1100 } else {
1043 *_time = sub { time }; # epic fail 1101 *_time = sub { time }; # epic fail
1044 } 1102 }
1045} 1103}
1046 1104
1047sub time { _time } 1105sub time { _time }
1048sub now { _time } 1106sub now { _time }
1107sub now_update { }
1049 1108
1050# default implementation for ->condvar 1109# default implementation for ->condvar
1051 1110
1052sub condvar { 1111sub condvar {
1053 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, AnyEvent::CondVar:: 1112 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
1054} 1113}
1055 1114
1056# default implementation for ->signal 1115# default implementation for ->signal
1057 1116
1058our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO); 1117our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
… …
1070 1129
1071sub signal { 1130sub signal {
1072 my (undef, %arg) = @_; 1131 my (undef, %arg) = @_;
1073 1132
1074 unless ($SIGPIPE_R) { 1133 unless ($SIGPIPE_R) {
1134 require Fcntl;
1135
1075 if (AnyEvent::WIN32) { 1136 if (AnyEvent::WIN32) {
1137 require AnyEvent::Util;
1138
1076 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe (); 1139 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1077 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R) if $SIGPIPE_R; 1140 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R) if $SIGPIPE_R;
1078 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case 1141 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case
1079 } else { 1142 } else {
1080 pipe $SIGPIPE_R, $SIGPIPE_W; 1143 pipe $SIGPIPE_R, $SIGPIPE_W;
1081 require Fcntl;
1082 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R; 1144 fcntl $SIGPIPE_R, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_R;
1083 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case 1145 fcntl $SIGPIPE_W, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK if $SIGPIPE_W; # just in case
1084 } 1146 }
1085 1147
1086 $SIGPIPE_R 1148 $SIGPIPE_R
1087 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n"; 1149 or Carp::croak "AnyEvent: unable to create a signal reporting pipe: $!\n";
1088 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
1089 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec); 1155 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1090 } 1156 }
1091 1157
1092 my $signal = uc $arg{signal} 1158 my $signal = uc $arg{signal}
1093 or Carp::croak "required option 'signal' is missing"; 1159 or Carp::croak "required option 'signal' is missing";
1094 1160
1095 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1161 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1096 $SIG{$signal} ||= sub { 1162 $SIG{$signal} ||= sub {
1163 local $!;
1097 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV; 1164 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1098 undef $SIG_EV{$signal}; 1165 undef $SIG_EV{$signal};
1099 }; 1166 };
1100 1167
1101 bless [$signal, $arg{cb}], "AnyEvent::Base::Signal" 1168 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1102} 1169}
1103 1170
1104sub AnyEvent::Base::Signal::DESTROY { 1171sub AnyEvent::Base::signal::DESTROY {
1105 my ($signal, $cb) = @{$_[0]}; 1172 my ($signal, $cb) = @{$_[0]};
1106 1173
1107 delete $SIG_CB{$signal}{$cb}; 1174 delete $SIG_CB{$signal}{$cb};
1108 1175
1176 # delete doesn't work with older perls - they then
1177 # print weird messages, or just unconditionally exit
1178 # instead of getting the default action.
1109 delete $SIG{$signal} unless keys %{ $SIG_CB{$signal} }; 1179 undef $SIG{$signal} unless keys %{ $SIG_CB{$signal} };
1110} 1180}
1111 1181
1112# default implementation for ->child 1182# default implementation for ->child
1113 1183
1114our %PID_CB; 1184our %PID_CB;
1115our $CHLD_W; 1185our $CHLD_W;
1116our $CHLD_DELAY_W; 1186our $CHLD_DELAY_W;
1117our $PID_IDLE;
1118our $WNOHANG; 1187our $WNOHANG;
1119 1188
1120sub _child_wait { 1189sub _sigchld {
1121 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1190 while (0 < (my $pid = waitpid -1, $WNOHANG)) {
1122 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }), 1191 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }),
1123 (values %{ $PID_CB{0} || {} }); 1192 (values %{ $PID_CB{0} || {} });
1124 } 1193 }
1125
1126 undef $PID_IDLE;
1127}
1128
1129sub _sigchld {
1130 # make sure we deliver these changes "synchronous" with the event loop.
1131 $CHLD_DELAY_W ||= AnyEvent->timer (after => 0, cb => sub {
1132 undef $CHLD_DELAY_W;
1133 &_child_wait;
1134 });
1135} 1194}
1136 1195
1137sub child { 1196sub child {
1138 my (undef, %arg) = @_; 1197 my (undef, %arg) = @_;
1139 1198
1140 defined (my $pid = $arg{pid} + 0) 1199 defined (my $pid = $arg{pid} + 0)
1141 or Carp::croak "required option 'pid' is missing"; 1200 or Carp::croak "required option 'pid' is missing";
1142 1201
1143 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1202 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1144 1203
1145 unless ($WNOHANG) {
1146 $WNOHANG = eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1204 $WNOHANG ||= eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1147 }
1148 1205
1149 unless ($CHLD_W) { 1206 unless ($CHLD_W) {
1150 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1207 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld);
1151 # child could be a zombie already, so make at least one round 1208 # child could be a zombie already, so make at least one round
1152 &_sigchld; 1209 &_sigchld;
1153 } 1210 }
1154 1211
1155 bless [$pid, $arg{cb}], "AnyEvent::Base::Child" 1212 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1156} 1213}
1157 1214
1158sub AnyEvent::Base::Child::DESTROY { 1215sub AnyEvent::Base::child::DESTROY {
1159 my ($pid, $cb) = @{$_[0]}; 1216 my ($pid, $cb) = @{$_[0]};
1160 1217
1161 delete $PID_CB{$pid}{$cb}; 1218 delete $PID_CB{$pid}{$cb};
1162 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; 1219 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1163 1220
1164 undef $CHLD_W unless keys %PID_CB; 1221 undef $CHLD_W unless keys %PID_CB;
1222}
1223
1224# idle emulation is done by simply using a timer, regardless
1225# of whether the process is idle or not, and not letting
1226# the callback use more than 50% of the time.
1227sub idle {
1228 my (undef, %arg) = @_;
1229
1230 my ($cb, $w, $rcb) = $arg{cb};
1231
1232 $rcb = sub {
1233 if ($cb) {
1234 $w = _time;
1235 &$cb;
1236 $w = _time - $w;
1237
1238 # never use more then 50% of the time for the idle watcher,
1239 # within some limits
1240 $w = 0.0001 if $w < 0.0001;
1241 $w = 5 if $w > 5;
1242
1243 $w = AnyEvent->timer (after => $w, cb => $rcb);
1244 } else {
1245 # clean up...
1246 undef $w;
1247 undef $rcb;
1248 }
1249 };
1250
1251 $w = AnyEvent->timer (after => 0.05, cb => $rcb);
1252
1253 bless \\$cb, "AnyEvent::Base::idle"
1254}
1255
1256sub AnyEvent::Base::idle::DESTROY {
1257 undef $${$_[0]};
1165} 1258}
1166 1259
1167package AnyEvent::CondVar; 1260package AnyEvent::CondVar;
1168 1261
1169our @ISA = AnyEvent::CondVar::Base::; 1262our @ISA = AnyEvent::CondVar::Base::;

Diff Legend

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