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.208 by root, Sun Apr 26 18:12:53 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
… …
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.4; 936our $VERSION = 4.411;
936our $MODEL; 937our $MODEL;
937 938
938our $AUTOLOAD; 939our $AUTOLOAD;
939our @ISA; 940our @ISA;
940 941
… …
1141 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
1142 } else { 1143 } else {
1143 pipe $SIGPIPE_R, $SIGPIPE_W; 1144 pipe $SIGPIPE_R, $SIGPIPE_W;
1144 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;
1145 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;
1146 } 1151 }
1147 1152
1148 $SIGPIPE_R 1153 $SIGPIPE_R
1149 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";
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
1155 $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);
1156 } 1157 }
1157 1158
1158 my $signal = uc $arg{signal} 1159 my $signal = uc $arg{signal}
… …
1171sub AnyEvent::Base::signal::DESTROY { 1172sub AnyEvent::Base::signal::DESTROY {
1172 my ($signal, $cb) = @{$_[0]}; 1173 my ($signal, $cb) = @{$_[0]};
1173 1174
1174 delete $SIG_CB{$signal}{$cb}; 1175 delete $SIG_CB{$signal}{$cb};
1175 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.
1176 delete $SIG{$signal} unless keys %{ $SIG_CB{$signal} }; 1180 undef $SIG{$signal} unless keys %{ $SIG_CB{$signal} };
1177} 1181}
1178 1182
1179# default implementation for ->child 1183# default implementation for ->child
1180 1184
1181our %PID_CB; 1185our %PID_CB;
1182our $CHLD_W; 1186our $CHLD_W;
1183our $CHLD_DELAY_W; 1187our $CHLD_DELAY_W;
1184our $PID_IDLE;
1185our $WNOHANG; 1188our $WNOHANG;
1186 1189
1187sub _child_wait { 1190sub _sigchld {
1188 while (0 < (my $pid = waitpid -1, $WNOHANG)) { 1191 while (0 < (my $pid = waitpid -1, $WNOHANG)) {
1189 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }), 1192 $_->($pid, $?) for (values %{ $PID_CB{$pid} || {} }),
1190 (values %{ $PID_CB{0} || {} }); 1193 (values %{ $PID_CB{0} || {} });
1191 } 1194 }
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} 1195}
1203 1196
1204sub child { 1197sub child {
1205 my (undef, %arg) = @_; 1198 my (undef, %arg) = @_;
1206 1199
1207 defined (my $pid = $arg{pid} + 0) 1200 defined (my $pid = $arg{pid} + 0)
1208 or Carp::croak "required option 'pid' is missing"; 1201 or Carp::croak "required option 'pid' is missing";
1209 1202
1210 $PID_CB{$pid}{$arg{cb}} = $arg{cb}; 1203 $PID_CB{$pid}{$arg{cb}} = $arg{cb};
1211 1204
1212 unless ($WNOHANG) {
1213 $WNOHANG = eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1; 1205 $WNOHANG ||= eval { local $SIG{__DIE__}; require POSIX; &POSIX::WNOHANG } || 1;
1214 }
1215 1206
1216 unless ($CHLD_W) { 1207 unless ($CHLD_W) {
1217 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld); 1208 $CHLD_W = AnyEvent->signal (signal => 'CHLD', cb => \&_sigchld);
1218 # 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
1219 &_sigchld; 1210 &_sigchld;
… …
1230 1221
1231 undef $CHLD_W unless keys %PID_CB; 1222 undef $CHLD_W unless keys %PID_CB;
1232} 1223}
1233 1224
1234# idle emulation is done by simply using a timer, regardless 1225# idle emulation is done by simply using a timer, regardless
1235# of whether the proces sis idle or not, and not letting 1226# of whether the process is idle or not, and not letting
1236# the callback use more than 50% of the time. 1227# the callback use more than 50% of the time.
1237sub idle { 1228sub idle {
1238 my (undef, %arg) = @_; 1229 my (undef, %arg) = @_;
1239 1230
1240 my ($cb, $w, $rcb) = $arg{cb}; 1231 my ($cb, $w, $rcb) = $arg{cb};
… …
1962 use AnyEvent; 1953 use AnyEvent;
1963 1954
1964Similar considerations apply to $ENV{PERL_ANYEVENT_VERBOSE}, as that can 1955Similar considerations apply to $ENV{PERL_ANYEVENT_VERBOSE}, as that can
1965be 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
1966probably even less useful to an attacker than PERL_ANYEVENT_MODEL), and 1957probably even less useful to an attacker than PERL_ANYEVENT_MODEL), and
1967$ENV{PERL_ANYEGENT_STRICT}. 1958$ENV{PERL_ANYEVENT_STRICT}.
1968 1959
1969 1960
1970=head1 BUGS 1961=head1 BUGS
1971 1962
1972Perl 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

Diff Legend

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