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.190 by root, Wed Nov 5 02:21:27 2008 UTC vs.
Revision 1.208 by root, Sun Apr 26 18:12:53 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:
137These watchers are normal Perl objects with normal Perl lifetime. After 144These watchers are normal Perl objects with normal Perl lifetime. After
138creating a watcher it will immediately "watch" for events and invoke the 145creating a watcher it will immediately "watch" for events and invoke the
139callback when the event occurs (of course, only when the event model 146callback when the event occurs (of course, only when the event model
140is in control). 147is in control).
141 148
149Note that B<callbacks must not permanently change global variables>
150potentially in use by the event loop (such as C<$_> or C<$[>) and that B<<
151callbacks must not C<die> >>. The former is good programming practise in
152Perl and the latter stems from the fact that exception handling differs
153widely between event loops.
154
142To disable the watcher you have to destroy it (e.g. by setting the 155To 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 156variable you store it in to C<undef> or otherwise deleting all references
144to it). 157to it).
145 158
146All watchers are created by calling a method on the C<AnyEvent> class. 159All watchers are created by calling a method on the C<AnyEvent> class.
162=head2 I/O WATCHERS 175=head2 I/O WATCHERS
163 176
164You can create an I/O watcher by calling the C<< AnyEvent->io >> method 177You can create an I/O watcher by calling the C<< AnyEvent->io >> method
165with the following mandatory key-value pairs as arguments: 178with the following mandatory key-value pairs as arguments:
166 179
167C<fh> the Perl I<file handle> (I<not> file descriptor) to watch for events 180C<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> 181for events (AnyEvent might or might not keep a reference to this file
182handle). Note that only file handles pointing to things for which
183non-blocking operation makes sense are allowed. This includes sockets,
184most character devices, pipes, fifos and so on, but not for example files
185or block devices.
186
169must be a string that is either C<r> or C<w>, which creates a watcher 187C<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 188watcher waiting for "r"eadable or "w"ritable events, respectively.
189
171callback to invoke each time the file handle becomes ready. 190C<cb> is the callback to invoke each time the file handle becomes ready.
172 191
173Although the callback might get passed parameters, their value and 192Although the callback might get passed parameters, their value and
174presence is undefined and you cannot rely on them. Portable AnyEvent 193presence is undefined and you cannot rely on them. Portable AnyEvent
175callbacks cannot use arguments passed to I/O watcher callbacks. 194callbacks cannot use arguments passed to I/O watcher callbacks.
176 195
307 326
308In 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
309can 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
310difference between C<< AnyEvent->time >> and C<< AnyEvent->now >> into 329difference between C<< AnyEvent->time >> and C<< AnyEvent->now >> into
311account. 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.
312 346
313=back 347=back
314 348
315=head2 SIGNAL WATCHERS 349=head2 SIGNAL WATCHERS
316 350
383 ); 417 );
384 418
385 # do something else, then wait for process exit 419 # do something else, then wait for process exit
386 $done->recv; 420 $done->recv;
387 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
388=head2 CONDITION VARIABLES 457=head2 CONDITION VARIABLES
389 458
390If 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
391require you to run some blocking "loop", "run" or similar function that 460require you to run some blocking "loop", "run" or similar function that
392will actively watch for new events and call your callbacks. 461will actively watch for new events and call your callbacks.
861no warnings; 930no warnings;
862use strict qw(vars subs); 931use strict qw(vars subs);
863 932
864use Carp; 933use Carp;
865 934
866our $VERSION = 4.32; 935our $VERSION = 4.4;
867our $MODEL; 936our $MODEL;
868 937
869our $AUTOLOAD; 938our $AUTOLOAD;
870our @ISA; 939our @ISA;
871 940
903 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza 972 [POE::Kernel:: => AnyEvent::Impl::POE::], # lasciate ogni speranza
904 [Wx:: => AnyEvent::Impl::POE::], 973 [Wx:: => AnyEvent::Impl::POE::],
905 [Prima:: => AnyEvent::Impl::POE::], 974 [Prima:: => AnyEvent::Impl::POE::],
906); 975);
907 976
908our %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);
909 979
910our @post_detect; 980our @post_detect;
911 981
912sub post_detect(&) { 982sub post_detect(&) {
913 my ($cb) = @_; 983 my ($cb) = @_;
918 1 988 1
919 } else { 989 } else {
920 push @post_detect, $cb; 990 push @post_detect, $cb;
921 991
922 defined wantarray 992 defined wantarray
923 ? bless \$cb, "AnyEvent::Util::PostDetect" 993 ? bless \$cb, "AnyEvent::Util::postdetect"
924 : () 994 : ()
925 } 995 }
926} 996}
927 997
928sub AnyEvent::Util::PostDetect::DESTROY { 998sub AnyEvent::Util::postdetect::DESTROY {
929 @post_detect = grep $_ != ${$_[0]}, @post_detect; 999 @post_detect = grep $_ != ${$_[0]}, @post_detect;
930} 1000}
931 1001
932sub detect() { 1002sub detect() {
933 unless ($MODEL) { 1003 unless ($MODEL) {
970 last; 1040 last;
971 } 1041 }
972 } 1042 }
973 1043
974 $MODEL 1044 $MODEL
975 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";
976 } 1046 }
977 } 1047 }
978 1048
979 push @{"$MODEL\::ISA"}, "AnyEvent::Base"; 1049 push @{"$MODEL\::ISA"}, "AnyEvent::Base";
980 1050
1004# to support binding more than one watcher per filehandle (they usually 1074# to support binding more than one watcher per filehandle (they usually
1005# allow only one watcher per fd, so we dup it to get a different one). 1075# allow only one watcher per fd, so we dup it to get a different one).
1006sub _dupfh($$$$) { 1076sub _dupfh($$$$) {
1007 my ($poll, $fh, $r, $w) = @_; 1077 my ($poll, $fh, $r, $w) = @_;
1008 1078
1009 require Fcntl;
1010
1011 # cygwin requires the fh mode to be matching, unix doesn't 1079 # cygwin requires the fh mode to be matching, unix doesn't
1012 my ($rw, $mode) = $poll eq "r" ? ($r, "<") 1080 my ($rw, $mode) = $poll eq "r" ? ($r, "<")
1013 : $poll eq "w" ? ($w, ">") 1081 : $poll eq "w" ? ($w, ">")
1014 : 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'";
1015 1083
1016 open my $fh2, "$mode&" . fileno $fh 1084 open my $fh2, "$mode&" . fileno $fh
1017 or die "cannot dup() filehandle: $!"; 1085 or die "cannot dup() filehandle: $!,";
1018 1086
1019 # 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
1020 1088
1021 ($fh2, $rw) 1089 ($fh2, $rw)
1022} 1090}
1023 1091
1024package AnyEvent::Base; 1092package AnyEvent::Base;
1025 1093
1026# default implementation for now and time 1094# default implementations for many methods
1027 1095
1028BEGIN { 1096BEGIN {
1029 if (eval "use Time::HiRes (); time (); 1") { 1097 if (eval "use Time::HiRes (); Time::HiRes::time (); 1") {
1030 *_time = \&Time::HiRes::time; 1098 *_time = \&Time::HiRes::time;
1031 # if (eval "use POSIX (); (POSIX::times())... 1099 # if (eval "use POSIX (); (POSIX::times())...
1032 } else { 1100 } else {
1033 *_time = sub { time }; # epic fail 1101 *_time = sub { time }; # epic fail
1034 } 1102 }
1035} 1103}
1036 1104
1037sub time { _time } 1105sub time { _time }
1038sub now { _time } 1106sub now { _time }
1107sub now_update { }
1039 1108
1040# default implementation for ->condvar 1109# default implementation for ->condvar
1041 1110
1042sub condvar { 1111sub condvar {
1043 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, AnyEvent::CondVar:: 1112 bless { @_ == 3 ? (_ae_cb => $_[2]) : () }, "AnyEvent::CondVar"
1044} 1113}
1045 1114
1046# default implementation for ->signal 1115# default implementation for ->signal
1047 1116
1048our %SIG_CB; 1117our ($SIGPIPE_R, $SIGPIPE_W, %SIG_CB, %SIG_EV, $SIG_IO);
1118
1119sub _signal_exec {
1120 sysread $SIGPIPE_R, my $dummy, 4;
1121
1122 while (%SIG_EV) {
1123 for (keys %SIG_EV) {
1124 delete $SIG_EV{$_};
1125 $_->() for values %{ $SIG_CB{$_} || {} };
1126 }
1127 }
1128}
1049 1129
1050sub signal { 1130sub signal {
1051 my (undef, %arg) = @_; 1131 my (undef, %arg) = @_;
1052 1132
1133 unless ($SIGPIPE_R) {
1134 require Fcntl;
1135
1136 if (AnyEvent::WIN32) {
1137 require AnyEvent::Util;
1138
1139 ($SIGPIPE_R, $SIGPIPE_W) = AnyEvent::Util::portable_pipe ();
1140 AnyEvent::Util::fh_nonblocking ($SIGPIPE_R) if $SIGPIPE_R;
1141 AnyEvent::Util::fh_nonblocking ($SIGPIPE_W) if $SIGPIPE_W; # just in case
1142 } else {
1143 pipe $SIGPIPE_R, $SIGPIPE_W;
1144 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
1146 }
1147
1148 $SIGPIPE_R
1149 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
1155 $SIG_IO = AnyEvent->io (fh => $SIGPIPE_R, poll => "r", cb => \&_signal_exec);
1156 }
1157
1053 my $signal = uc $arg{signal} 1158 my $signal = uc $arg{signal}
1054 or Carp::croak "required option 'signal' is missing"; 1159 or Carp::croak "required option 'signal' is missing";
1055 1160
1056 $SIG_CB{$signal}{$arg{cb}} = $arg{cb}; 1161 $SIG_CB{$signal}{$arg{cb}} = $arg{cb};
1057 $SIG{$signal} ||= sub { 1162 $SIG{$signal} ||= sub {
1058 $_->() for values %{ $SIG_CB{$signal} || {} }; 1163 local $!;
1164 syswrite $SIGPIPE_W, "\x00", 1 unless %SIG_EV;
1165 undef $SIG_EV{$signal};
1059 }; 1166 };
1060 1167
1061 bless [$signal, $arg{cb}], "AnyEvent::Base::Signal" 1168 bless [$signal, $arg{cb}], "AnyEvent::Base::signal"
1062} 1169}
1063 1170
1064sub AnyEvent::Base::Signal::DESTROY { 1171sub AnyEvent::Base::signal::DESTROY {
1065 my ($signal, $cb) = @{$_[0]}; 1172 my ($signal, $cb) = @{$_[0]};
1066 1173
1067 delete $SIG_CB{$signal}{$cb}; 1174 delete $SIG_CB{$signal}{$cb};
1068 1175
1069 delete $SIG{$signal} unless keys %{ $SIG_CB{$signal} }; 1176 delete $SIG{$signal} unless keys %{ $SIG_CB{$signal} };
1110 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1217 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld);
1111 # child could be a zombie already, so make at least one round 1218 # child could be a zombie already, so make at least one round
1112 &_sigchld; 1219 &_sigchld;
1113 } 1220 }
1114 1221
1115 bless [$pid, $arg{cb}], "AnyEvent::Base::Child" 1222 bless [$pid, $arg{cb}], "AnyEvent::Base::child"
1116} 1223}
1117 1224
1118sub AnyEvent::Base::Child::DESTROY { 1225sub AnyEvent::Base::child::DESTROY {
1119 my ($pid, $cb) = @{$_[0]}; 1226 my ($pid, $cb) = @{$_[0]};
1120 1227
1121 delete $PID_CB{$pid}{$cb}; 1228 delete $PID_CB{$pid}{$cb};
1122 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} }; 1229 delete $PID_CB{$pid} unless keys %{ $PID_CB{$pid} };
1123 1230
1124 undef $CHLD_W unless keys %PID_CB; 1231 undef $CHLD_W unless keys %PID_CB;
1232}
1233
1234# idle emulation is done by simply using a timer, regardless
1235# of whether the proces sis idle or not, and not letting
1236# the callback use more than 50% of the time.
1237sub idle {
1238 my (undef, %arg) = @_;
1239
1240 my ($cb, $w, $rcb) = $arg{cb};
1241
1242 $rcb = sub {
1243 if ($cb) {
1244 $w = _time;
1245 &$cb;
1246 $w = _time - $w;
1247
1248 # never use more then 50% of the time for the idle watcher,
1249 # within some limits
1250 $w = 0.0001 if $w < 0.0001;
1251 $w = 5 if $w > 5;
1252
1253 $w = AnyEvent->timer (after => $w, cb => $rcb);
1254 } else {
1255 # clean up...
1256 undef $w;
1257 undef $rcb;
1258 }
1259 };
1260
1261 $w = AnyEvent->timer (after => 0.05, cb => $rcb);
1262
1263 bless \\$cb, "AnyEvent::Base::idle"
1264}
1265
1266sub AnyEvent::Base::idle::DESTROY {
1267 undef $${$_[0]};
1125} 1268}
1126 1269
1127package AnyEvent::CondVar; 1270package AnyEvent::CondVar;
1128 1271
1129our @ISA = AnyEvent::CondVar::Base::; 1272our @ISA = AnyEvent::CondVar::Base::;
1263used, and preference will be given to protocols mentioned earlier in the 1406used, and preference will be given to protocols mentioned earlier in the
1264list. 1407list.
1265 1408
1266This variable can effectively be used for denial-of-service attacks 1409This variable can effectively be used for denial-of-service attacks
1267against local programs (e.g. when setuid), although the impact is likely 1410against local programs (e.g. when setuid), although the impact is likely
1268small, as the program has to handle connection errors already- 1411small, as the program has to handle conenction and other failures anyways.
1269 1412
1270Examples: C<PERL_ANYEVENT_PROTOCOLS=ipv4,ipv6> - prefer IPv4 over IPv6, 1413Examples: C<PERL_ANYEVENT_PROTOCOLS=ipv4,ipv6> - prefer IPv4 over IPv6,
1271but support both and try to use both. C<PERL_ANYEVENT_PROTOCOLS=ipv4> 1414but support both and try to use both. C<PERL_ANYEVENT_PROTOCOLS=ipv4>
1272- only support IPv4, never try to resolve or contact IPv6 1415- only support IPv4, never try to resolve or contact IPv6
1273addresses. C<PERL_ANYEVENT_PROTOCOLS=ipv6,ipv4> support either IPv4 or 1416addresses. C<PERL_ANYEVENT_PROTOCOLS=ipv6,ipv4> support either IPv4 or
1827=head1 BUGS 1970=head1 BUGS
1828 1971
1829Perl 5.8 has numerous memleaks that sometimes hit this module and are hard 1972Perl 5.8 has numerous memleaks that sometimes hit this module and are hard
1830to work around. If you suffer from memleaks, first upgrade to Perl 5.10 1973to work around. If you suffer from memleaks, first upgrade to Perl 5.10
1831and check wether the leaks still show up. (Perl 5.10.0 has other annoying 1974and check wether the leaks still show up. (Perl 5.10.0 has other annoying
1832mamleaks, such as leaking on C<map> and C<grep> but it is usually not as 1975memleaks, such as leaking on C<map> and C<grep> but it is usually not as
1833pronounced). 1976pronounced).
1834 1977
1835 1978
1836=head1 SEE ALSO 1979=head1 SEE ALSO
1837 1980

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines