AnyEvent-7.17/0000755000000000000000000000000013540302027011673 5ustar rootrootAnyEvent-7.17/t/0000755000000000000000000000000013540302027012136 5ustar rootrootAnyEvent-7.17/t/65_event_07_io.t0000644000000000000000000000355712377641775015014 0ustar rootrootuse AnyEvent; use AnyEvent::Util; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Event;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Event not loadable\n}), exit 0) } $| = 1; print "1..18\n"; print "ok 1\n"; my ($a, $b) = AnyEvent::Util::portable_socketpair; print $a && $b ? "" : "not ", "ok 2 # $a,$b\n"; my ($cv, $t, $ra, $wa, $rb, $wb); $rb = AnyEvent->io (fh => $b, poll => "r", cb => sub { print "ok 6\n"; sysread $b, my $buf, 1; print "ok 7\n"; $wb = AnyEvent->io (fh => $b, poll => "w", cb => sub { print "ok 8\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 3\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 4\n"; $wa = AnyEvent->io (fh => $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 5\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 9\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 10\n"; $rb = AnyEvent->io (fh => fileno $b, poll => "r", cb => sub { print "ok 14\n"; sysread $b, my $buf, 1; print "ok 15\n"; $wb = AnyEvent->io (fh => fileno $b, poll => "w", cb => sub { print "ok 16\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 11\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 12\n"; $wa = AnyEvent->io (fh => fileno $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 13\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 17\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 18\n"; AnyEvent-7.17/t/61_fltk_05_dns.t0000644000000000000000000000141612377641775014772 0ustar rootroot# we avoid complicated tests here because some systems will # not have working DNS use AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::FLTK;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::FLTK not loadable\n}), exit 0) } use AnyEvent::DNS; $| = 1; print "1..5\n"; print "ok 1\n"; AnyEvent::DNS::resolver; print "ok 2\n"; # make sure we timeout faster AnyEvent::DNS::resolver->{timeout} = [0.5]; AnyEvent::DNS::resolver->_compile; print "ok 3\n"; my $cv = AnyEvent->condvar; AnyEvent::DNS::a "www.google.de", sub { print "ok 4 # www.google.de => @_\n"; $cv->send; }; $cv->recv; print "ok 5\n"; AnyEvent-7.17/t/69_ev_09_multi.t0000644000000000000000000000741212377641775015030 0ustar rootrootBEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 3 ? "" : "not ", "ok 2 # $s\n"; } # I/O read { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 }; my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 3 # $s\n"; syswrite $b, "x"; $cv = AE::cv; $wt = AE::timer 1, 0, $cv; $s = 0; $cv->begin; $cv->begin; $cv->recv; print $s == 3 ? "" : "not ", "ok 4 # $s\n"; sysread $a, my $dummy, 1; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 5 # $s\n"; } # signal { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 6 # $s\n"; kill INT => $$; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel? $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 7 # $s\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 8 # $s\n"; } # child { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $pid = fork; unless ($pid) { sleep 2; exit 1; } my ($apid, $bpid, $astatus, $bstatus); $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 9 # $s\n"; kill 9, $pid; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 10 # $s\n"; print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n"; print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 13 # $s\n"; } # timers (don't laugh, some event loops are more broken...) { my $cv = AE::cv; my $wt = AE::timer 1, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s |= 2 }; $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 }; $cv->recv; print $s == 7 ? "" : "not ", "ok 14 # $s\n"; } print "ok 15\n"; exit 0; AnyEvent-7.17/t/65_event_04_condvar.t0000644000000000000000000000374412377641775016034 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Event;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Event not loadable\n}), exit 0) } $| = 1; print "1..28\n"; print "ok 1\n"; { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 4\n"; my $x = $_[0]->recv; print $x == 7 ? "" : "not ", "ok 5 # $x == 7\n"; my @x = $_[0]->recv; print $x[1] == 5 ? "" : "not ", "ok 6 # $x[1] == 5\n"; my $y = $cv->recv; print $y == 7 ? "" : "not ", "ok 7 # $x == 7\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 3\n"; $cv->send (7, 5); }); print "ok 2\n"; $cv->recv; print "ok 8\n"; my @x = $cv->recv; print $x[1] == 5 ? "" : "not ", "ok 9 # $x[1] == 5\n"; } { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 12\n"; my $x = eval { $_[0]->recv }; print !defined $x ? "" : "not ", "ok 13\n"; print $@ =~ /^kill/ ? "" : "not ", "ok 14 # $@\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 11\n"; $cv->croak ("kill"); print "ok 15\n"; $cv->send (8, 6, 4); print "ok 16\n"; }); print "ok 10\n"; my @x = eval { $cv->recv }; print !@x ? "" : "not ", "ok 17 # @x\n"; print $@ =~ /^kill / ? "" : "not ", "ok 18 # $@\n"; } { my $cv = AnyEvent->condvar; print "ok 19\n"; my $t = AnyEvent->timer (after => 0, cb => $cv); print "ok 20\n"; $cv->recv; print "ok 21\n"; } { my $cv = AE::cv { print +($_[0]->recv)[0] == 6 ? "" : "not ", "ok 27\n"; }; print "ok 22\n"; $cv->begin (sub { print "ok 26\n"; $_[0](6); }); print "ok 23\n"; $cv->begin; print "ok 24\n"; $cv->end; print "ok 25\n"; $cv->end; print "ok 28\n"; } AnyEvent-7.17/t/64_glib_05_dns.t0000644000000000000000000000141612377641775014752 0ustar rootroot# we avoid complicated tests here because some systems will # not have working DNS use AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Glib;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Glib not loadable\n}), exit 0) } use AnyEvent::DNS; $| = 1; print "1..5\n"; print "ok 1\n"; AnyEvent::DNS::resolver; print "ok 2\n"; # make sure we timeout faster AnyEvent::DNS::resolver->{timeout} = [0.5]; AnyEvent::DNS::resolver->_compile; print "ok 3\n"; my $cv = AnyEvent->condvar; AnyEvent::DNS::a "www.google.de", sub { print "ok 4 # www.google.de => @_\n"; $cv->send; }; $cv->recv; print "ok 5\n"; AnyEvent-7.17/t/65_event_05_dns.t0000644000000000000000000000142012377641775015152 0ustar rootroot# we avoid complicated tests here because some systems will # not have working DNS use AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Event;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Event not loadable\n}), exit 0) } use AnyEvent::DNS; $| = 1; print "1..5\n"; print "ok 1\n"; AnyEvent::DNS::resolver; print "ok 2\n"; # make sure we timeout faster AnyEvent::DNS::resolver->{timeout} = [0.5]; AnyEvent::DNS::resolver->_compile; print "ok 3\n"; my $cv = AnyEvent->condvar; AnyEvent::DNS::a "www.google.de", sub { print "ok 4 # www.google.de => @_\n"; $cv->send; }; $cv->recv; print "ok 5\n"; AnyEvent-7.17/t/handle/0000755000000000000000000000000013540302027013371 5ustar rootrootAnyEvent-7.17/t/handle/04_listen.t0000644000000000000000000000226411625611213015365 0ustar rootroot#!/opt/perl/bin/perl use strict; use AnyEvent; BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } use AnyEvent::Handle; use AnyEvent::Socket; my $lbytes; my $rbytes; print "1..2\n"; my $cv = AnyEvent->condvar; my $hdl; my $port; my $w = tcp_server undef, undef, sub { my ($fh, $host, $port) = @_; $hdl = AnyEvent::Handle->new (fh => $fh, on_eof => sub { $cv->broadcast }); $hdl->push_read (chunk => 6, sub { my ($hdl, $data) = @_; if ($data eq "TEST\015\012") { print "ok 1 - server received client data\n"; } else { print "not ok 1 - server received bad client data\n"; } $hdl->push_write ("BLABLABLA\015\012"); }); }, sub { $port = $_[2]; 0 }; my $clhdl; $clhdl = AnyEvent::Handle->new ( connect => [localhost => $port], on_eof => sub { $cv->broadcast }, ); $clhdl->push_write ("TEST\015\012"); $clhdl->push_read (line => sub { my ($clhdl, $line) = @_; if ($line eq 'BLABLABLA') { print "ok 2 - client received response\n"; } else { print "not ok 2 - client received bad response\n"; } $cv->broadcast; }); $cv->wait; AnyEvent-7.17/t/handle/02_write.t0000644000000000000000000000325411625611266015227 0ustar rootroot#!perl use strict; use AnyEvent; BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } use AnyEvent::Util; use AnyEvent::Handle; use Socket; print "1..7\n"; my $cv = AnyEvent->condvar; my ($rd, $wr) = portable_socketpair; my $rd_ae = AnyEvent::Handle->new ( fh => $rd, on_eof => sub { warn "reader got EOF"; $cv->broadcast } ); my $wr_ae = AnyEvent::Handle->new ( fh => $wr, on_eof => sub { warn "writer got EOF\n"; $cv->broadcast } ); my $dat = ''; $rd_ae->push_read (chunk => 5132, sub { my ($rd_ae, $data) = @_; $dat = substr $data, 0, 2; $dat .= substr $data, -5; print "ok 4 - first read chunk\n"; my $n = 5; $wr_ae->push_write ("A" x 5000); $wr_ae->on_drain (sub { my ($wr_ae) = @_; $wr_ae->on_drain; print "ok " . $n++ . " - fourth write\n"; }); $rd_ae->push_read (chunk => 5000, sub { print "ok " . $n++ . " - second read chunk\n"; $cv->broadcast }); }); $wr_ae->push_write ("A" x 5000); $wr_ae->push_write ("X" x 130); # and now some extreme CPS action: $wr_ae->on_drain (sub { my ($wr_ae) = @_; $wr_ae->on_drain; print "ok 1 - first write\n"; $wr_ae->push_write ("Y"); $wr_ae->on_drain (sub { my ($wr_ae) = @_; $wr_ae->on_drain; print "ok 2 - second write\n"; $wr_ae->push_write ("Z"); $wr_ae->on_drain (sub { my ($wr_ae) = @_; $wr_ae->on_drain; print "ok 3 - third write\n"; }); }); }); $cv->wait; if ($dat eq "AAXXXYZ") { print "ok 7 - received data\n"; } else { warn "dat was '$dat'\n"; print "not ok 7 - received data\n"; } AnyEvent-7.17/t/handle/01_readline.t0000644000000000000000000000414411625611251015650 0ustar rootroot#!perl # actually tests a few other read/write types as well use strict; use AnyEvent; BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } use AnyEvent::Handle; use AnyEvent::Util; use Test::More tests => 8; use Socket; use Errno; { my $cv = AnyEvent->condvar; my ($rd, $wr) = portable_socketpair; my $rd_ae = AnyEvent::Handle->new ( fh => $rd, on_error => sub { ok ($! == &Errno::EPIPE); $cv->broadcast; }, on_eof => sub { ok (0, "got eof"); }, ); my $concat; $rd_ae->push_read (line => sub { is ($_[1], "A", 'A line was read correctly'); my $cb; $cb = sub { $concat .= $_[1]; $_[0]->push_read (line => $cb); }; $_[0]->push_read (line => $cb); }); syswrite $wr, "A\012BC\012DEF\012G\012" . ("X" x 113) . "\012"; close $wr; $cv->wait; is ($concat, "BCDEFG" . ("X" x 113), 'initial lines were read correctly'); } { my $cv = AnyEvent->condvar; my ($rd, $wr) = portable_socketpair; my $concat; my $rd_ae = AnyEvent::Handle->new ( fh => $rd, on_eof => sub { $cv->broadcast }, on_read => sub { $_[0]->push_read (line => sub { $concat .= "$_[1]:"; }); } ); my $wr_ae = new AnyEvent::Handle fh => $wr, on_eof => sub { die }; undef $wr; undef $rd; $wr_ae->push_write (netstring => "0:xx,,"); $wr_ae->push_write (netstring => ""); $wr_ae->push_write (storable => [4,3,2]); $wr_ae->push_write (packstring => "w", "hallole" x 99999); # try to exhaust socket buffer here $wr_ae->push_write ("A\012BC\012DEF\nG\012" . ("X" x 113) . "\012"); undef $wr_ae; $rd_ae->push_read (netstring => sub { is ($_[1], "0:xx,,") }); $rd_ae->push_read (netstring => sub { is ($_[1], "") }); $rd_ae->push_read (storable => "w", sub { is ("@{$_[1]}", "4 3 2") }); $rd_ae->push_read (packstring => "w", sub { is ($_[1], "hallole" x 99999) }); $cv->wait; is ($concat, "A:BC:DEF:G:" . ("X" x 113) . ":", 'second set of lines were read correctly'); } AnyEvent-7.17/t/handle/03_http_req.t0000644000000000000000000000215611737233440015722 0ustar rootroot#!/opt/perl/bin/perl use strict; use AnyEvent; BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } use AnyEvent::Socket; use AnyEvent::Handle; unless ($ENV{PERL_ANYEVENT_NET_TESTS}) { print "1..0 # Skip PERL_ANYEVENT_NET_TESTS environment variable not set\n"; exit 0; } print "1..2\n"; my $cv = AnyEvent->condvar; my $rbytes; my $hdl; $hdl = AnyEvent::Handle->new ( connect => ['www.google.com', 80], on_error => sub { warn "handle error: $_[2]"; $cv->broadcast; }, on_eof => sub { my ($hdl) = @_; if ($rbytes !~ /<\/html>/i) { print "not "; } print "ok 2 - received HTML page\n"; $cv->broadcast; } ); $hdl->push_read (chunk => 10, sub { my ($hdl, $data) = @_; unless (substr ($data, 0, 4) eq 'HTTP') { print "not "; } print "ok 1 - received 'HTTP'\n"; $hdl->on_read (sub { my ($hdl) = @_; $rbytes .= $hdl->rbuf; $hdl->rbuf = ''; return 1; }); }); $hdl->push_write ("GET http://www.google.com/ HTTP/1.0\015\012\015\012"); $cv->wait; AnyEvent-7.17/t/69_ev_02_signals.t0000644000000000000000000000147612377641775015333 0ustar rootrootBEGIN { unless (exists $SIG{USR1}) { print <condvar; my $error = AnyEvent->timer (after => 5, cb => sub { print <signal (signal => 'INT', cb => sub { print "ok 3\n"; $cv->broadcast; }); print "ok 2\n"; kill 'INT', $$; $cv->recv; undef $error; print "ok 4\n"; undef $sw; print "ok 5\n"; AnyEvent-7.17/t/69_ev_04_condvar.t0000644000000000000000000000373612377641775015332 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::EV;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::EV not loadable\n}), exit 0) } $| = 1; print "1..28\n"; print "ok 1\n"; { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 4\n"; my $x = $_[0]->recv; print $x == 7 ? "" : "not ", "ok 5 # $x == 7\n"; my @x = $_[0]->recv; print $x[1] == 5 ? "" : "not ", "ok 6 # $x[1] == 5\n"; my $y = $cv->recv; print $y == 7 ? "" : "not ", "ok 7 # $x == 7\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 3\n"; $cv->send (7, 5); }); print "ok 2\n"; $cv->recv; print "ok 8\n"; my @x = $cv->recv; print $x[1] == 5 ? "" : "not ", "ok 9 # $x[1] == 5\n"; } { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 12\n"; my $x = eval { $_[0]->recv }; print !defined $x ? "" : "not ", "ok 13\n"; print $@ =~ /^kill/ ? "" : "not ", "ok 14 # $@\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 11\n"; $cv->croak ("kill"); print "ok 15\n"; $cv->send (8, 6, 4); print "ok 16\n"; }); print "ok 10\n"; my @x = eval { $cv->recv }; print !@x ? "" : "not ", "ok 17 # @x\n"; print $@ =~ /^kill / ? "" : "not ", "ok 18 # $@\n"; } { my $cv = AnyEvent->condvar; print "ok 19\n"; my $t = AnyEvent->timer (after => 0, cb => $cv); print "ok 20\n"; $cv->recv; print "ok 21\n"; } { my $cv = AE::cv { print +($_[0]->recv)[0] == 6 ? "" : "not ", "ok 27\n"; }; print "ok 22\n"; $cv->begin (sub { print "ok 26\n"; $_[0](6); }); print "ok 23\n"; $cv->begin; print "ok 24\n"; $cv->end; print "ok 25\n"; $cv->end; print "ok 28\n"; } AnyEvent-7.17/t/61_fltk_03_child.t0000644000000000000000000000571312377641775015273 0ustar rootrootuse POSIX (); no warnings; BEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <timer (after => 2, cb => sub { }); my $cv = AnyEvent->condvar; unless ($pid) { print "ok ${it}2 # child $$\n"; # POE hits a race condition when the child dies too quickly # because it checks for child exit before installing the signal handler. # seen in version 1.352 - earlier versions had the same bug, but # polled for child exits regularly, so only caused a delay. sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 3; } my $w = AnyEvent->child (pid => $pid, cb => sub { print $pid == $_[0] ? "" : "not ", "ok ${it}3\ # $pid == $_[0]\n"; print 3 == ($_[1] >> 8) ? "" : "not ", "ok ${it}4 # 3 == $_[1] >> 8 ($_[1])\n"; $cv->broadcast; }); $cv->recv; my $pid2 = fork || do { sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 7; }; my $cv2 = AnyEvent->condvar; # Glib is the only model that doesn't support pid == 0 my $pid0 = $AnyEvent::MODEL eq "AnyEvent::Impl::Glib" ? $pid2 : 0; my $w2 = AnyEvent->child (pid => $pid0, cb => sub { print $pid2 == $_[0] ? "" : "not ", "ok ${it}5 # $pid2 == $_[0]\n"; print 7 == ($_[1] >> 8) ? "" : "not ", "ok ${it}6 # 7 == $_[1] >> 8 ($_[1])\n"; $cv2->broadcast; }); my $error = AnyEvent->timer (after => 5, cb => sub { print <recv; print "ok ${it}7\n"; print "ok ${it}8\n"; print "ok ${it}9\n"; print "ok ", $it*10+10, "\n"; } AnyEvent-7.17/t/64_glib_02_signals.t0000644000000000000000000000150212377641775015617 0ustar rootrootBEGIN { unless (exists $SIG{USR1}) { print <condvar; my $error = AnyEvent->timer (after => 5, cb => sub { print <signal (signal => 'INT', cb => sub { print "ok 3\n"; $cv->broadcast; }); print "ok 2\n"; kill 'INT', $$; $cv->recv; undef $error; print "ok 4\n"; undef $sw; print "ok 5\n"; AnyEvent-7.17/t/61_fltk_04_condvar.t0000644000000000000000000000374212377641775015645 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::FLTK;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::FLTK not loadable\n}), exit 0) } $| = 1; print "1..28\n"; print "ok 1\n"; { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 4\n"; my $x = $_[0]->recv; print $x == 7 ? "" : "not ", "ok 5 # $x == 7\n"; my @x = $_[0]->recv; print $x[1] == 5 ? "" : "not ", "ok 6 # $x[1] == 5\n"; my $y = $cv->recv; print $y == 7 ? "" : "not ", "ok 7 # $x == 7\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 3\n"; $cv->send (7, 5); }); print "ok 2\n"; $cv->recv; print "ok 8\n"; my @x = $cv->recv; print $x[1] == 5 ? "" : "not ", "ok 9 # $x[1] == 5\n"; } { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 12\n"; my $x = eval { $_[0]->recv }; print !defined $x ? "" : "not ", "ok 13\n"; print $@ =~ /^kill/ ? "" : "not ", "ok 14 # $@\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 11\n"; $cv->croak ("kill"); print "ok 15\n"; $cv->send (8, 6, 4); print "ok 16\n"; }); print "ok 10\n"; my @x = eval { $cv->recv }; print !@x ? "" : "not ", "ok 17 # @x\n"; print $@ =~ /^kill / ? "" : "not ", "ok 18 # $@\n"; } { my $cv = AnyEvent->condvar; print "ok 19\n"; my $t = AnyEvent->timer (after => 0, cb => $cv); print "ok 20\n"; $cv->recv; print "ok 21\n"; } { my $cv = AE::cv { print +($_[0]->recv)[0] == 6 ? "" : "not ", "ok 27\n"; }; print "ok 22\n"; $cv->begin (sub { print "ok 26\n"; $_[0](6); }); print "ok 23\n"; $cv->begin; print "ok 24\n"; $cv->end; print "ok 25\n"; $cv->end; print "ok 28\n"; } AnyEvent-7.17/t/68_poe_04_condvar.t0000644000000000000000000000375012377641775015476 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::POE;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::POE not loadable\n}), exit 0) } $^W = 0; $| = 1; print "1..28\n"; print "ok 1\n"; { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 4\n"; my $x = $_[0]->recv; print $x == 7 ? "" : "not ", "ok 5 # $x == 7\n"; my @x = $_[0]->recv; print $x[1] == 5 ? "" : "not ", "ok 6 # $x[1] == 5\n"; my $y = $cv->recv; print $y == 7 ? "" : "not ", "ok 7 # $x == 7\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 3\n"; $cv->send (7, 5); }); print "ok 2\n"; $cv->recv; print "ok 8\n"; my @x = $cv->recv; print $x[1] == 5 ? "" : "not ", "ok 9 # $x[1] == 5\n"; } { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 12\n"; my $x = eval { $_[0]->recv }; print !defined $x ? "" : "not ", "ok 13\n"; print $@ =~ /^kill/ ? "" : "not ", "ok 14 # $@\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 11\n"; $cv->croak ("kill"); print "ok 15\n"; $cv->send (8, 6, 4); print "ok 16\n"; }); print "ok 10\n"; my @x = eval { $cv->recv }; print !@x ? "" : "not ", "ok 17 # @x\n"; print $@ =~ /^kill / ? "" : "not ", "ok 18 # $@\n"; } { my $cv = AnyEvent->condvar; print "ok 19\n"; my $t = AnyEvent->timer (after => 0, cb => $cv); print "ok 20\n"; $cv->recv; print "ok 21\n"; } { my $cv = AE::cv { print +($_[0]->recv)[0] == 6 ? "" : "not ", "ok 27\n"; }; print "ok 22\n"; $cv->begin (sub { print "ok 26\n"; $_[0](6); }); print "ok 23\n"; $cv->begin; print "ok 24\n"; $cv->end; print "ok 25\n"; $cv->end; print "ok 28\n"; } AnyEvent-7.17/t/65_event_03_child.t0000644000000000000000000000571512377641775015462 0ustar rootrootuse POSIX (); no warnings; BEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <timer (after => 2, cb => sub { }); my $cv = AnyEvent->condvar; unless ($pid) { print "ok ${it}2 # child $$\n"; # POE hits a race condition when the child dies too quickly # because it checks for child exit before installing the signal handler. # seen in version 1.352 - earlier versions had the same bug, but # polled for child exits regularly, so only caused a delay. sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 3; } my $w = AnyEvent->child (pid => $pid, cb => sub { print $pid == $_[0] ? "" : "not ", "ok ${it}3\ # $pid == $_[0]\n"; print 3 == ($_[1] >> 8) ? "" : "not ", "ok ${it}4 # 3 == $_[1] >> 8 ($_[1])\n"; $cv->broadcast; }); $cv->recv; my $pid2 = fork || do { sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 7; }; my $cv2 = AnyEvent->condvar; # Glib is the only model that doesn't support pid == 0 my $pid0 = $AnyEvent::MODEL eq "AnyEvent::Impl::Glib" ? $pid2 : 0; my $w2 = AnyEvent->child (pid => $pid0, cb => sub { print $pid2 == $_[0] ? "" : "not ", "ok ${it}5 # $pid2 == $_[0]\n"; print 7 == ($_[1] >> 8) ? "" : "not ", "ok ${it}6 # 7 == $_[1] >> 8 ($_[1])\n"; $cv2->broadcast; }); my $error = AnyEvent->timer (after => 5, cb => sub { print <recv; print "ok ${it}7\n"; print "ok ${it}8\n"; print "ok ${it}9\n"; print "ok ", $it*10+10, "\n"; } AnyEvent-7.17/t/62_cocoa_04_condvar.t0000644000000000000000000000374412377641775015774 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Cocoa;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Cocoa not loadable\n}), exit 0) } $| = 1; print "1..28\n"; print "ok 1\n"; { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 4\n"; my $x = $_[0]->recv; print $x == 7 ? "" : "not ", "ok 5 # $x == 7\n"; my @x = $_[0]->recv; print $x[1] == 5 ? "" : "not ", "ok 6 # $x[1] == 5\n"; my $y = $cv->recv; print $y == 7 ? "" : "not ", "ok 7 # $x == 7\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 3\n"; $cv->send (7, 5); }); print "ok 2\n"; $cv->recv; print "ok 8\n"; my @x = $cv->recv; print $x[1] == 5 ? "" : "not ", "ok 9 # $x[1] == 5\n"; } { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 12\n"; my $x = eval { $_[0]->recv }; print !defined $x ? "" : "not ", "ok 13\n"; print $@ =~ /^kill/ ? "" : "not ", "ok 14 # $@\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 11\n"; $cv->croak ("kill"); print "ok 15\n"; $cv->send (8, 6, 4); print "ok 16\n"; }); print "ok 10\n"; my @x = eval { $cv->recv }; print !@x ? "" : "not ", "ok 17 # @x\n"; print $@ =~ /^kill / ? "" : "not ", "ok 18 # $@\n"; } { my $cv = AnyEvent->condvar; print "ok 19\n"; my $t = AnyEvent->timer (after => 0, cb => $cv); print "ok 20\n"; $cv->recv; print "ok 21\n"; } { my $cv = AE::cv { print +($_[0]->recv)[0] == 6 ? "" : "not ", "ok 27\n"; }; print "ok 22\n"; $cv->begin (sub { print "ok 26\n"; $_[0](6); }); print "ok 23\n"; $cv->begin; print "ok 24\n"; $cv->end; print "ok 25\n"; $cv->end; print "ok 28\n"; } AnyEvent-7.17/t/67_tk_05_dns.t0000644000000000000000000000141212377641775014452 0ustar rootroot# we avoid complicated tests here because some systems will # not have working DNS use AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Tk;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Tk not loadable\n}), exit 0) } use AnyEvent::DNS; $| = 1; print "1..5\n"; print "ok 1\n"; AnyEvent::DNS::resolver; print "ok 2\n"; # make sure we timeout faster AnyEvent::DNS::resolver->{timeout} = [0.5]; AnyEvent::DNS::resolver->_compile; print "ok 3\n"; my $cv = AnyEvent->condvar; AnyEvent::DNS::a "www.google.de", sub { print "ok 4 # www.google.de => @_\n"; $cv->send; }; $cv->recv; print "ok 5\n"; AnyEvent-7.17/t/62_cocoa_05_dns.t0000644000000000000000000000142012377641775015112 0ustar rootroot# we avoid complicated tests here because some systems will # not have working DNS use AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Cocoa;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Cocoa not loadable\n}), exit 0) } use AnyEvent::DNS; $| = 1; print "1..5\n"; print "ok 1\n"; AnyEvent::DNS::resolver; print "ok 2\n"; # make sure we timeout faster AnyEvent::DNS::resolver->{timeout} = [0.5]; AnyEvent::DNS::resolver->_compile; print "ok 3\n"; my $cv = AnyEvent->condvar; AnyEvent::DNS::a "www.google.de", sub { print "ok 4 # www.google.de => @_\n"; $cv->send; }; $cv->recv; print "ok 5\n"; AnyEvent-7.17/t/08_idna.t0000644000000000000000000000202311506522416013550 0ustar rootrootuse utf8; use AnyEvent; use AnyEvent::Util; $| = 1; print "1..11\n"; print "ok 1\n"; print "ko-eka" eq (AnyEvent::Util::punycode_encode "\x{f6}ko" ) ? "" : "not ", "ok 2\n"; print "wgv71a" eq (AnyEvent::Util::punycode_encode "\x{65e5}\x{672c}") ? "" : "not ", "ok 3\n"; print "\x{f6}ko" eq (AnyEvent::Util::punycode_decode "ko-eka") ? "" : "not ", "ok 4\n"; print "\x{65e5}\x{672c}" eq (AnyEvent::Util::punycode_decode "wgv71a") ? "" : "not ", "ok 5\n"; print "www.xn--ko-eka.eu" eq (AnyEvent::Util::idn_to_ascii "www.\x{f6}ko.eu" ) ? "" : "not ", "ok 6\n"; print "xn--1-jn6bt1b.co.jp" eq (AnyEvent::Util::idn_to_ascii "\x{65e5}\x{672c}1.co.jp" ) ? "" : "not ", "ok 7\n"; print "xn--tda.com" eq (AnyEvent::Util::idn_to_ascii "xn--tda.com" ) ? "" : "not ", "ok 8\n"; print "xn--a-ecp.ru" eq (AnyEvent::Util::idn_to_ascii "xn--a-ecp.ru") ? "" : "not ", "ok 9\n"; print "xn--wgv71a119e.jp" eq (AnyEvent::Util::idn_to_ascii "\x{65e5}\x{672c}\x{8a9e}\x{3002}\x{ff2a}\x{ff30}") ? "" : "not ", "ok 10\n"; print "ok 11\n"; AnyEvent-7.17/t/61_fltk_01_basic.t0000644000000000000000000000115512377641775015263 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::FLTK;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::FLTK not loadable\n}), exit 0) } $| = 1; print "1..6\n"; print "ok 1\n"; my $cv = AnyEvent->condvar; print "ok 2\n"; my $timer1 = AnyEvent->timer (after => 0.1, cb => sub { print "ok 5\n"; $cv->broadcast }); print "ok 3\n"; AnyEvent->timer (after => 0.01, cb => sub { print "not ok 5\n" }); print "ok 4\n"; $cv->wait; print "ok 6\n"; AnyEvent-7.17/t/61_fltk_09_multi.t0000644000000000000000000000741612377641775015352 0ustar rootrootBEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 3 ? "" : "not ", "ok 2 # $s\n"; } # I/O read { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 }; my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 3 # $s\n"; syswrite $b, "x"; $cv = AE::cv; $wt = AE::timer 1, 0, $cv; $s = 0; $cv->begin; $cv->begin; $cv->recv; print $s == 3 ? "" : "not ", "ok 4 # $s\n"; sysread $a, my $dummy, 1; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 5 # $s\n"; } # signal { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 6 # $s\n"; kill INT => $$; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel? $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 7 # $s\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 8 # $s\n"; } # child { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $pid = fork; unless ($pid) { sleep 2; exit 1; } my ($apid, $bpid, $astatus, $bstatus); $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 9 # $s\n"; kill 9, $pid; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 10 # $s\n"; print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n"; print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 13 # $s\n"; } # timers (don't laugh, some event loops are more broken...) { my $cv = AE::cv; my $wt = AE::timer 1, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s |= 2 }; $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 }; $cv->recv; print $s == 7 ? "" : "not ", "ok 14 # $s\n"; } print "ok 15\n"; exit 0; AnyEvent-7.17/t/66_ioasync_07_io.t0000644000000000000000000000356312377641775015336 0ustar rootrootuse AnyEvent; use AnyEvent::Util; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::IOAsync;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::IOAsync not loadable\n}), exit 0) } $| = 1; print "1..18\n"; print "ok 1\n"; my ($a, $b) = AnyEvent::Util::portable_socketpair; print $a && $b ? "" : "not ", "ok 2 # $a,$b\n"; my ($cv, $t, $ra, $wa, $rb, $wb); $rb = AnyEvent->io (fh => $b, poll => "r", cb => sub { print "ok 6\n"; sysread $b, my $buf, 1; print "ok 7\n"; $wb = AnyEvent->io (fh => $b, poll => "w", cb => sub { print "ok 8\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 3\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 4\n"; $wa = AnyEvent->io (fh => $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 5\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 9\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 10\n"; $rb = AnyEvent->io (fh => fileno $b, poll => "r", cb => sub { print "ok 14\n"; sysread $b, my $buf, 1; print "ok 15\n"; $wb = AnyEvent->io (fh => fileno $b, poll => "w", cb => sub { print "ok 16\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 11\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 12\n"; $wa = AnyEvent->io (fh => fileno $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 13\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 17\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 18\n"; AnyEvent-7.17/t/62_cocoa_09_multi.t0000644000000000000000000000742012377641775015472 0ustar rootrootBEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 3 ? "" : "not ", "ok 2 # $s\n"; } # I/O read { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 }; my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 3 # $s\n"; syswrite $b, "x"; $cv = AE::cv; $wt = AE::timer 1, 0, $cv; $s = 0; $cv->begin; $cv->begin; $cv->recv; print $s == 3 ? "" : "not ", "ok 4 # $s\n"; sysread $a, my $dummy, 1; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 5 # $s\n"; } # signal { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 6 # $s\n"; kill INT => $$; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel? $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 7 # $s\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 8 # $s\n"; } # child { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $pid = fork; unless ($pid) { sleep 2; exit 1; } my ($apid, $bpid, $astatus, $bstatus); $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 9 # $s\n"; kill 9, $pid; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 10 # $s\n"; print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n"; print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 13 # $s\n"; } # timers (don't laugh, some event loops are more broken...) { my $cv = AE::cv; my $wt = AE::timer 1, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s |= 2 }; $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 }; $cv->recv; print $s == 7 ? "" : "not ", "ok 14 # $s\n"; } print "ok 15\n"; exit 0; AnyEvent-7.17/t/70_uv_05_dns.t0000644000000000000000000000141212377641775014460 0ustar rootroot# we avoid complicated tests here because some systems will # not have working DNS use AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::UV;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::UV not loadable\n}), exit 0) } use AnyEvent::DNS; $| = 1; print "1..5\n"; print "ok 1\n"; AnyEvent::DNS::resolver; print "ok 2\n"; # make sure we timeout faster AnyEvent::DNS::resolver->{timeout} = [0.5]; AnyEvent::DNS::resolver->_compile; print "ok 3\n"; my $cv = AnyEvent->condvar; AnyEvent::DNS::a "www.google.de", sub { print "ok 4 # www.google.de => @_\n"; $cv->send; }; $cv->recv; print "ok 5\n"; AnyEvent-7.17/t/67_tk_04_condvar.t0000644000000000000000000000373612377641775015334 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Tk;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Tk not loadable\n}), exit 0) } $| = 1; print "1..28\n"; print "ok 1\n"; { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 4\n"; my $x = $_[0]->recv; print $x == 7 ? "" : "not ", "ok 5 # $x == 7\n"; my @x = $_[0]->recv; print $x[1] == 5 ? "" : "not ", "ok 6 # $x[1] == 5\n"; my $y = $cv->recv; print $y == 7 ? "" : "not ", "ok 7 # $x == 7\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 3\n"; $cv->send (7, 5); }); print "ok 2\n"; $cv->recv; print "ok 8\n"; my @x = $cv->recv; print $x[1] == 5 ? "" : "not ", "ok 9 # $x[1] == 5\n"; } { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 12\n"; my $x = eval { $_[0]->recv }; print !defined $x ? "" : "not ", "ok 13\n"; print $@ =~ /^kill/ ? "" : "not ", "ok 14 # $@\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 11\n"; $cv->croak ("kill"); print "ok 15\n"; $cv->send (8, 6, 4); print "ok 16\n"; }); print "ok 10\n"; my @x = eval { $cv->recv }; print !@x ? "" : "not ", "ok 17 # @x\n"; print $@ =~ /^kill / ? "" : "not ", "ok 18 # $@\n"; } { my $cv = AnyEvent->condvar; print "ok 19\n"; my $t = AnyEvent->timer (after => 0, cb => $cv); print "ok 20\n"; $cv->recv; print "ok 21\n"; } { my $cv = AE::cv { print +($_[0]->recv)[0] == 6 ? "" : "not ", "ok 27\n"; }; print "ok 22\n"; $cv->begin (sub { print "ok 26\n"; $_[0](6); }); print "ok 23\n"; $cv->begin; print "ok 24\n"; $cv->end; print "ok 25\n"; $cv->end; print "ok 28\n"; } AnyEvent-7.17/t/70_uv_01_basic.t0000644000000000000000000000115112377641775014751 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::UV;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::UV not loadable\n}), exit 0) } $| = 1; print "1..6\n"; print "ok 1\n"; my $cv = AnyEvent->condvar; print "ok 2\n"; my $timer1 = AnyEvent->timer (after => 0.1, cb => sub { print "ok 5\n"; $cv->broadcast }); print "ok 3\n"; AnyEvent->timer (after => 0.01, cb => sub { print "not ok 5\n" }); print "ok 4\n"; $cv->wait; print "ok 6\n"; AnyEvent-7.17/t/68_poe_07_io.t0000644000000000000000000000356312377641775014456 0ustar rootrootuse AnyEvent; use AnyEvent::Util; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::POE;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::POE not loadable\n}), exit 0) } $^W = 0; $| = 1; print "1..18\n"; print "ok 1\n"; my ($a, $b) = AnyEvent::Util::portable_socketpair; print $a && $b ? "" : "not ", "ok 2 # $a,$b\n"; my ($cv, $t, $ra, $wa, $rb, $wb); $rb = AnyEvent->io (fh => $b, poll => "r", cb => sub { print "ok 6\n"; sysread $b, my $buf, 1; print "ok 7\n"; $wb = AnyEvent->io (fh => $b, poll => "w", cb => sub { print "ok 8\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 3\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 4\n"; $wa = AnyEvent->io (fh => $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 5\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 9\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 10\n"; $rb = AnyEvent->io (fh => fileno $b, poll => "r", cb => sub { print "ok 14\n"; sysread $b, my $buf, 1; print "ok 15\n"; $wb = AnyEvent->io (fh => fileno $b, poll => "w", cb => sub { print "ok 16\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 11\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 12\n"; $wa = AnyEvent->io (fh => fileno $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 13\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 17\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 18\n"; AnyEvent-7.17/t/64_glib_03_child.t0000644000000000000000000000571312377641775015253 0ustar rootrootuse POSIX (); no warnings; BEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <timer (after => 2, cb => sub { }); my $cv = AnyEvent->condvar; unless ($pid) { print "ok ${it}2 # child $$\n"; # POE hits a race condition when the child dies too quickly # because it checks for child exit before installing the signal handler. # seen in version 1.352 - earlier versions had the same bug, but # polled for child exits regularly, so only caused a delay. sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 3; } my $w = AnyEvent->child (pid => $pid, cb => sub { print $pid == $_[0] ? "" : "not ", "ok ${it}3\ # $pid == $_[0]\n"; print 3 == ($_[1] >> 8) ? "" : "not ", "ok ${it}4 # 3 == $_[1] >> 8 ($_[1])\n"; $cv->broadcast; }); $cv->recv; my $pid2 = fork || do { sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 7; }; my $cv2 = AnyEvent->condvar; # Glib is the only model that doesn't support pid == 0 my $pid0 = $AnyEvent::MODEL eq "AnyEvent::Impl::Glib" ? $pid2 : 0; my $w2 = AnyEvent->child (pid => $pid0, cb => sub { print $pid2 == $_[0] ? "" : "not ", "ok ${it}5 # $pid2 == $_[0]\n"; print 7 == ($_[1] >> 8) ? "" : "not ", "ok ${it}6 # 7 == $_[1] >> 8 ($_[1])\n"; $cv2->broadcast; }); my $error = AnyEvent->timer (after => 5, cb => sub { print <recv; print "ok ${it}7\n"; print "ok ${it}8\n"; print "ok ${it}9\n"; print "ok ", $it*10+10, "\n"; } AnyEvent-7.17/t/68_poe_05_dns.t0000644000000000000000000000142412377641775014623 0ustar rootroot# we avoid complicated tests here because some systems will # not have working DNS use AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::POE;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::POE not loadable\n}), exit 0) } $^W = 0; use AnyEvent::DNS; $| = 1; print "1..5\n"; print "ok 1\n"; AnyEvent::DNS::resolver; print "ok 2\n"; # make sure we timeout faster AnyEvent::DNS::resolver->{timeout} = [0.5]; AnyEvent::DNS::resolver->_compile; print "ok 3\n"; my $cv = AnyEvent->condvar; AnyEvent::DNS::a "www.google.de", sub { print "ok 4 # www.google.de => @_\n"; $cv->send; }; $cv->recv; print "ok 5\n"; AnyEvent-7.17/t/io_common0000644000000000000000000000466111742042430014050 0ustar rootroot#! perl $| = 1; # not tested: symlink, readlink, link, utime, chown, chmod BEGIN { print "1..37\n"; print "ok 1 # MODEL=$AnyEvent::IO::MODEL\n"; } use AnyEvent; use AnyEvent::IO qw(:DEFAULT :flags); BEGIN { print "ok 2 # MODEL=$AnyEvent::IO::MODEL\n"; } our $t = 3; sub t { my $ok = shift; my $f = "aio_" . shift; $f->(@_, my $cv = AE::cv); my @res = $cv->recv; print !@res != !$ok ? "not " : "", "ok ", $t++, " # $f (@_) = (@res)\n"; wantarray ? @res : $res[0] } use File::Spec; our $TMP = File::Spec->tmpdir; our $DIR = "$TMP/ae_io_testdir_$$~"; t 1, mkdir => $DIR, 0777 or do { print "Bail out! Cannot mkdir $DIR, skipping test.\n"; exit 0 }; t 0, mkdir => $DIR, 0777; ############################################################################# # create file my $fh = t 1, open => "$DIR/test", O_CREAT | O_EXCL | O_WRONLY, 0666; t 0, open => "$DIR/test", O_CREAT | O_EXCL | O_WRONLY, 0666; t 0, rmdir => $DIR; t 1, write => $fh, "tes--"; t 1, write => $fh, "test2"; t 1, write => $fh, ""; t 1, seek => $fh, 3, 0; t 1, write => $fh, "t1"; #t 1, truncate => $fh, 5+5; # not available on windows t 1, stat => $fh; print -s _ != 10 ? "not " : "", "ok ", $t++, " # stat size\n"; t 1, close => $fh; t 1, stat => "$DIR/test"; print -s _ != 10 ? "not " : "", "ok ", $t++, " # stat size (", -s _,")\n"; t 1, lstat => "$DIR/test"; print -s _ != 10 ? "not " : "", "ok ", $t++, " # lstat size\n"; t 1, rename => "$DIR/test", "$DIR/test2"; ############################################################################# # test dir t 0, readdir => "$DIR/nonexistent"; my $res = t 1, readdir => $DIR; print @$res != 1 ? "not " : "", "ok ", $t++, " # res count\n"; print $res->[0] ne "test2" ? "not " : "", "ok ", $t++, " # res data (@$res)\n"; ############################################################################# # test file $fh = t 1, open => "$DIR/test2", O_RDONLY, 0; print +(t 1, read => $fh, 6) ne "test1t" ? "not " : "", "ok ", $t++, " # read 6\n"; print +(t 1, read => $fh, 7) ne "est2" ? "not " : "", "ok ", $t++, " # read 7\n"; print +(t 1, read => $fh, 8) ne "" ? "not " : "", "ok ", $t++, " # read 8\n"; t 1, close => $fh; print +(t 1, load => "$DIR/test2") ne "test1test2" ? "not " : "", "ok ", $t++, " # load\n"; ############################################################################# # cleanup t 0, unlink => "$DIR/test"; t 1, unlink => "$DIR/test2"; t 1, rmdir => $DIR; 1 AnyEvent-7.17/t/66_ioasync_03_child.t0000644000000000000000000000572112377641775016004 0ustar rootrootuse POSIX (); no warnings; BEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <timer (after => 2, cb => sub { }); my $cv = AnyEvent->condvar; unless ($pid) { print "ok ${it}2 # child $$\n"; # POE hits a race condition when the child dies too quickly # because it checks for child exit before installing the signal handler. # seen in version 1.352 - earlier versions had the same bug, but # polled for child exits regularly, so only caused a delay. sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 3; } my $w = AnyEvent->child (pid => $pid, cb => sub { print $pid == $_[0] ? "" : "not ", "ok ${it}3\ # $pid == $_[0]\n"; print 3 == ($_[1] >> 8) ? "" : "not ", "ok ${it}4 # 3 == $_[1] >> 8 ($_[1])\n"; $cv->broadcast; }); $cv->recv; my $pid2 = fork || do { sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 7; }; my $cv2 = AnyEvent->condvar; # Glib is the only model that doesn't support pid == 0 my $pid0 = $AnyEvent::MODEL eq "AnyEvent::Impl::Glib" ? $pid2 : 0; my $w2 = AnyEvent->child (pid => $pid0, cb => sub { print $pid2 == $_[0] ? "" : "not ", "ok ${it}5 # $pid2 == $_[0]\n"; print 7 == ($_[1] >> 8) ? "" : "not ", "ok ${it}6 # 7 == $_[1] >> 8 ($_[1])\n"; $cv2->broadcast; }); my $error = AnyEvent->timer (after => 5, cb => sub { print <recv; print "ok ${it}7\n"; print "ok ${it}8\n"; print "ok ${it}9\n"; print "ok ", $it*10+10, "\n"; } AnyEvent-7.17/t/67_tk_01_basic.t0000644000000000000000000000115112377641775014743 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Tk;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Tk not loadable\n}), exit 0) } $| = 1; print "1..6\n"; print "ok 1\n"; my $cv = AnyEvent->condvar; print "ok 2\n"; my $timer1 = AnyEvent->timer (after => 0.1, cb => sub { print "ok 5\n"; $cv->broadcast }); print "ok 3\n"; AnyEvent->timer (after => 0.01, cb => sub { print "not ok 5\n" }); print "ok 4\n"; $cv->wait; print "ok 6\n"; AnyEvent-7.17/t/62_cocoa_03_child.t0000644000000000000000000000571512377641775015422 0ustar rootrootuse POSIX (); no warnings; BEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <timer (after => 2, cb => sub { }); my $cv = AnyEvent->condvar; unless ($pid) { print "ok ${it}2 # child $$\n"; # POE hits a race condition when the child dies too quickly # because it checks for child exit before installing the signal handler. # seen in version 1.352 - earlier versions had the same bug, but # polled for child exits regularly, so only caused a delay. sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 3; } my $w = AnyEvent->child (pid => $pid, cb => sub { print $pid == $_[0] ? "" : "not ", "ok ${it}3\ # $pid == $_[0]\n"; print 3 == ($_[1] >> 8) ? "" : "not ", "ok ${it}4 # 3 == $_[1] >> 8 ($_[1])\n"; $cv->broadcast; }); $cv->recv; my $pid2 = fork || do { sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 7; }; my $cv2 = AnyEvent->condvar; # Glib is the only model that doesn't support pid == 0 my $pid0 = $AnyEvent::MODEL eq "AnyEvent::Impl::Glib" ? $pid2 : 0; my $w2 = AnyEvent->child (pid => $pid0, cb => sub { print $pid2 == $_[0] ? "" : "not ", "ok ${it}5 # $pid2 == $_[0]\n"; print 7 == ($_[1] >> 8) ? "" : "not ", "ok ${it}6 # 7 == $_[1] >> 8 ($_[1])\n"; $cv2->broadcast; }); my $error = AnyEvent->timer (after => 5, cb => sub { print <recv; print "ok ${it}7\n"; print "ok ${it}8\n"; print "ok ${it}9\n"; print "ok ", $it*10+10, "\n"; } AnyEvent-7.17/t/65_event_02_signals.t0000644000000000000000000000150412377641775016026 0ustar rootrootBEGIN { unless (exists $SIG{USR1}) { print <condvar; my $error = AnyEvent->timer (after => 5, cb => sub { print <signal (signal => 'INT', cb => sub { print "ok 3\n"; $cv->broadcast; }); print "ok 2\n"; kill 'INT', $$; $cv->recv; undef $error; print "ok 4\n"; undef $sw; print "ok 5\n"; AnyEvent-7.17/t/70_uv_04_condvar.t0000644000000000000000000000373612377641775015342 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::UV;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::UV not loadable\n}), exit 0) } $| = 1; print "1..28\n"; print "ok 1\n"; { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 4\n"; my $x = $_[0]->recv; print $x == 7 ? "" : "not ", "ok 5 # $x == 7\n"; my @x = $_[0]->recv; print $x[1] == 5 ? "" : "not ", "ok 6 # $x[1] == 5\n"; my $y = $cv->recv; print $y == 7 ? "" : "not ", "ok 7 # $x == 7\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 3\n"; $cv->send (7, 5); }); print "ok 2\n"; $cv->recv; print "ok 8\n"; my @x = $cv->recv; print $x[1] == 5 ? "" : "not ", "ok 9 # $x[1] == 5\n"; } { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 12\n"; my $x = eval { $_[0]->recv }; print !defined $x ? "" : "not ", "ok 13\n"; print $@ =~ /^kill/ ? "" : "not ", "ok 14 # $@\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 11\n"; $cv->croak ("kill"); print "ok 15\n"; $cv->send (8, 6, 4); print "ok 16\n"; }); print "ok 10\n"; my @x = eval { $cv->recv }; print !@x ? "" : "not ", "ok 17 # @x\n"; print $@ =~ /^kill / ? "" : "not ", "ok 18 # $@\n"; } { my $cv = AnyEvent->condvar; print "ok 19\n"; my $t = AnyEvent->timer (after => 0, cb => $cv); print "ok 20\n"; $cv->recv; print "ok 21\n"; } { my $cv = AE::cv { print +($_[0]->recv)[0] == 6 ? "" : "not ", "ok 27\n"; }; print "ok 22\n"; $cv->begin (sub { print "ok 26\n"; $_[0](6); }); print "ok 23\n"; $cv->begin; print "ok 24\n"; $cv->end; print "ok 25\n"; $cv->end; print "ok 28\n"; } AnyEvent-7.17/t/68_poe_02_signals.t0000644000000000000000000000151012377641775015470 0ustar rootrootBEGIN { unless (exists $SIG{USR1}) { print <condvar; my $error = AnyEvent->timer (after => 5, cb => sub { print <signal (signal => 'INT', cb => sub { print "ok 3\n"; $cv->broadcast; }); print "ok 2\n"; kill 'INT', $$; $cv->recv; undef $error; print "ok 4\n"; undef $sw; print "ok 5\n"; AnyEvent-7.17/t/61_fltk_07_io.t0000644000000000000000000000355512377641775014625 0ustar rootrootuse AnyEvent; use AnyEvent::Util; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::FLTK;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::FLTK not loadable\n}), exit 0) } $| = 1; print "1..18\n"; print "ok 1\n"; my ($a, $b) = AnyEvent::Util::portable_socketpair; print $a && $b ? "" : "not ", "ok 2 # $a,$b\n"; my ($cv, $t, $ra, $wa, $rb, $wb); $rb = AnyEvent->io (fh => $b, poll => "r", cb => sub { print "ok 6\n"; sysread $b, my $buf, 1; print "ok 7\n"; $wb = AnyEvent->io (fh => $b, poll => "w", cb => sub { print "ok 8\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 3\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 4\n"; $wa = AnyEvent->io (fh => $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 5\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 9\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 10\n"; $rb = AnyEvent->io (fh => fileno $b, poll => "r", cb => sub { print "ok 14\n"; sysread $b, my $buf, 1; print "ok 15\n"; $wb = AnyEvent->io (fh => fileno $b, poll => "w", cb => sub { print "ok 16\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 11\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 12\n"; $wa = AnyEvent->io (fh => fileno $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 13\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 17\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 18\n"; AnyEvent-7.17/t/80_ssltest.t0000644000000000000000000001622711753566372014366 0ustar rootroot#!/usr/bin/perl BEGIN { eval "use Net::SSLeay 1.33 (); 1" or ((print "1..0 # SKIP no usable Net::SSLeay\n"), exit 0) } use Test::More tests => 415; no warnings; use strict qw(vars subs); use AnyEvent::Socket; use AnyEvent::Handle; use AnyEvent::TLS; my $ctx = new AnyEvent::TLS cert_file => $0; for my $mode (1..5) { ok (1, "mode $mode"); my $server_done = AnyEvent->condvar; my $client_done = AnyEvent->condvar; my $server_port = AnyEvent->condvar; tcp_server "127.0.0.1", undef, sub { my ($fh, $host, $port) = @_; die unless $host eq "127.0.0.1"; ok (1, "server_connect $mode"); my $hd; $hd = new AnyEvent::Handle tls => "accept", tls_ctx => $ctx, fh => $fh, timeout => 8, on_error => sub { ok (0, "server_error <$_[2]>"); $server_done->send; undef $hd; }, on_eof => sub { ok (1, "server_eof"); $server_done->send; undef $hd; }; if ($mode == 1) { $hd->push_read (line => sub { ok ($_[1] eq "1", "line 1 <$_[1]>"); }); } elsif ($mode == 2) { $hd->push_write ("2\n"); $hd->on_drain (sub { ok (1, "server_drain"); $server_done->send; undef $hd; }); } elsif ($mode == 3) { $hd->push_read (line => sub { ok ($_[1] eq "3", "line 3 <$_[1]>"); $hd->push_write ("4\n"); $hd->on_drain (sub { ok (1, "server_drain"); $server_done->send; undef $hd; }); }); } elsif ($mode == 4) { $hd->push_write ("5\n"); $hd->push_read (line => sub { ok ($_[1] eq "6", "line 6 <$_[1]>"); }); } elsif ($mode == 5) { $hd->on_read (sub { ok (1, "on_read"); $hd->push_read (line => sub { my $len = $_[1]; ok (1, "push_read $len"); $hd->push_read (packstring => "N", sub { ok ($len == length $_[1], "block server $len"); $hd->push_write ("$len\n"); $hd->push_write (packstring => "N", $_[1]); }); }); }); } }, sub { $server_port->send ($_[2]); }; my $hd; $hd = new AnyEvent::Handle connect => ["127.0.0.1", $server_port->recv], tls => "connect", tls_ctx => $ctx, timeout => 8, on_connect => sub { ok (1, "client_connect $mode"); }, on_error => sub { ok (0, "client_error <$_[2]>"); $client_done->send; undef $hd; }, on_eof => sub { ok (1, "client_eof"); $client_done->send; undef $hd; }; if ($mode == 1) { $hd->push_write ("1\n"); $hd->on_drain (sub { ok (1, "client_drain"); $client_done->send; undef $hd; }); } elsif ($mode == 2) { $hd->push_read (line => sub { ok ($_[1] eq "2", "line 2 <$_[1]>"); }); } elsif ($mode == 3) { $hd->push_write ("3\n"); $hd->push_read (line => sub { ok ($_[1] eq "4", "line 4 <$_[1]>"); }); } elsif ($mode == 4) { $hd->push_read (line => sub { ok ($_[1] eq "5", "line 5 <$_[1]>"); $hd->push_write ("6\n"); $hd->on_drain (sub { ok (1, "client_drain"); $client_done->send; undef $hd; }); }); } elsif ($mode == 5) { # some randomly-sized blocks srand 0; my $cnt = 64; my $block; $block = sub { my $len = (16 << int rand 14) - 16 + int rand 32; ok (1, "write $len"); $hd->push_write ("$len\n"); $hd->push_write (packstring => "N", "\x00" x $len); }; for my $i (1..$cnt) { $hd->push_read (line => sub { my ($i, $cnt, $block) = ($i, $cnt, $block); # 5.8.9. bug workaround my $len = $_[1]; ok (1, "client block $len/1"); $hd->unshift_read (packstring => "N", sub { ok ($len == length $_[1], "client block $len/2"); if ($i != $cnt) { $block->(); } else { ok (1, "client_drain 5"); $client_done->send; undef $hd; } }); }); } $block->(); } $server_done->recv; $client_done->recv; } __END__ -----BEGIN RSA PRIVATE KEY----- MIIEpAIBAAKCAQEA02VwAqlQzCrPenkxUjawHcXzJreJ9LDhX7Bkg3E/RB6Ilm4D LBeilCmzkY7avp57+WCiVw2qkg+kH4Ef2sd+r10UCGPh/1diLehRAzp3Ho1bixyg w+zkDm79OnN3uHxuKigkAxx3GGz9HhQA83U+RUns+39/OnFh0RY6/f5rV2ziA9jD 6HK3Mnsuxocd46YbVdiqlQK430CgiGj8dV44JG6+R6x3r5qXDbbRtGubC29kQOUq kYslbpTo7ml8ShyqAP6qa8BpeSIaNG1CQQ/7JkAdxSWyFHqMQ0HR3BUiaEfUElZt DFgXcCkKB5F8jx+wYoLzlPHHZaUvfP2nueYjcwIDAQABAoIBAQCtRDMuu0ByV5R/ Od5nGFP500mcrkrwuBnBqH56DdRhLPWe9sS62xRyhEuePoykOJo8qCvnVlg8J33K JLfLRkBb09qbleKiuyjJn+Tm1IDWFd62gtxyOjQicG41/nZeS/6vpv79XdNvvcUp ZhPxeGN1v0XyTWomqNAX5DSuAl5Q5HxkaRYNeuLZaPYkqmEVTgYqNSes/wRLKUb6 MaVrZ9AA/oHJMmmV4evf06s7l7ICjxAWeas7CI6UGkEz8ZFoVRJsLk5xtTsnZLgf f24/pqHz1vApPs7CsJhK2HsLZcxMPD+hmTNI/Njl51WoH8zGhkv+p88vDzybpNSF Hpkl+ZlBAoGBAOyfjVLD0OznJKSFksoCZKS4dlPHgXUb47Qb/XchIySQ/DNO6ff9 AA6r6doDFp51A8N1GRtGQN4LKujFPOdZ5ah7zbc2PfuOJGHku0Oby+ydgHJ19eW4 s3CIM20TuzLndFPrEGFgOrt+i5qKisti2OOZhjsDwfd48vsBm9U20lUpAoGBAOS1 Chm+vA7JevPzl+acbDSiyELaNRAXZ73CX4NIxJURjsgDeOurnBtLQEQyagZbNHcx W4pc59Ql5KDLzu/Sne8oC3pxhaWeIPhc2d3cd/8UyGtQLtN2QnilwkjHgi3x1JGb RPRsgAV6nwn10qUrze1XLkHsTCRI4QYD/k0uXcs7AoGBAMStJaFag2i2Ax4ArG7e KFtFu4yNckwtv0kwTrBbScOWAxp+iDiJASgwunJsSLuylUs8JH8oGLi23ZaWgrXl Yd918BpNqp1Rm2oG3aQndguZKm95Hscvi26Itv39/YYlHeq2omndu1OmrlDowM6m vZIIRKr+x5Vz4brCro09QPxpAoGARJAdghBTEl/Gc2HgdOsJ6VGvlZMS+0r498NQ nOvwuvuzgTTBSG1+9BPAJXGzpUosVVs/pSArA8eEXcwbsnvCixLHNiLYPQlFuw8i 5UcV1iul1b4I+63lSYPv1Z+x4BIydqBEsL3iN0JGcVb3mjqilndfT7YGMY6DnykN UJgI2EcCgYAMfZHnD06XFM8ny+NsFILItpGqjCmAhkEPGwl1Zhy5Hx16CFDPDwGt CmIbxNSLsDyiiK+i5tuSUFhV2Bw/iT539979INTIdNL1ughfhATR8MVNiOKCvZBa uoEeE19szmG7Mj2eV2IDH0e8iaikjRFcfN89s39tNn1AjBNmEccUJA== -----END RSA PRIVATE KEY----- ----- -----BEGIN CERTIFICATE----- MIIDHTCCAgWgAwIBAgIJAPASTbY2HCx0MA0GCSqGSIb3DQEBBQUAMBMxETAPBgNV BAMTCEFueUV2ZW50MB4XDTEyMDQwNTA1NTk1MFoXDTM3MDQwNTA1NTk1MFowEzER MA8GA1UEAxMIQW55RXZlbnQwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIB AQDTZXACqVDMKs96eTFSNrAdxfMmt4n0sOFfsGSDcT9EHoiWbgMsF6KUKbORjtq+ nnv5YKJXDaqSD6QfgR/ax36vXRQIY+H/V2It6FEDOncejVuLHKDD7OQObv06c3e4 fG4qKCQDHHcYbP0eFADzdT5FSez7f386cWHRFjr9/mtXbOID2MPocrcyey7Ghx3j phtV2KqVArjfQKCIaPx1Xjgkbr5HrHevmpcNttG0a5sLb2RA5SqRiyVulOjuaXxK HKoA/qprwGl5Iho0bUJBD/smQB3FJbIUeoxDQdHcFSJoR9QSVm0MWBdwKQoHkXyP H7BigvOU8cdlpS98/ae55iNzAgMBAAGjdDByMB0GA1UdDgQWBBTHphJ9Il0PtIWD DI9aueToXo9DYzBDBgNVHSMEPDA6gBTHphJ9Il0PtIWDDI9aueToXo9DY6EXpBUw EzERMA8GA1UEAxMIQW55RXZlbnSCCQDwEk22NhwsdDAMBgNVHRMEBTADAQH/MA0G CSqGSIb3DQEBBQUAA4IBAQA/vY+qg2xjNeOuDySW/VOsStEwcaiAm/t24z3TYoZG 2ZzyKuvFXolhXsalCahNPcyUxZqDAekODPRaq+geFaZrOn41cq/LABTKv5Theukv H7IruIFARBo1pTPFCKMnDqESBdHvV1xTOcKGxGH5I9iMgiUrd/NnlAaloT/cCNFI OwhEPsF9kBsZwJBGWrjjVttU2lzMzizS7vaSIWLBuEDObWbSXiU+IdG+nODOe2Dv W7PL43yd4fz4HQvN4IaZrtwkd7XiKodRR1gWjLjW/3y5kuXL+DA/jkTjrRgiH8K7 lVjm7gvkULRV2POQqtc2DUVXLubQmmGSjmQmxSwFX65t -----END CERTIFICATE----- AnyEvent-7.17/t/11_io_perl.t0000644000000000000000000000006111734672707014274 0ustar rootrootuse AnyEvent::IO::Perl; require "./t/io_common"; AnyEvent-7.17/t/61_fltk_02_signals.t0000644000000000000000000000150212377641775015637 0ustar rootrootBEGIN { unless (exists $SIG{USR1}) { print <condvar; my $error = AnyEvent->timer (after => 5, cb => sub { print <signal (signal => 'INT', cb => sub { print "ok 3\n"; $cv->broadcast; }); print "ok 2\n"; kill 'INT', $$; $cv->recv; undef $error; print "ok 4\n"; undef $sw; print "ok 5\n"; AnyEvent-7.17/t/70_uv_07_io.t0000644000000000000000000000355112377641775014313 0ustar rootrootuse AnyEvent; use AnyEvent::Util; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::UV;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::UV not loadable\n}), exit 0) } $| = 1; print "1..18\n"; print "ok 1\n"; my ($a, $b) = AnyEvent::Util::portable_socketpair; print $a && $b ? "" : "not ", "ok 2 # $a,$b\n"; my ($cv, $t, $ra, $wa, $rb, $wb); $rb = AnyEvent->io (fh => $b, poll => "r", cb => sub { print "ok 6\n"; sysread $b, my $buf, 1; print "ok 7\n"; $wb = AnyEvent->io (fh => $b, poll => "w", cb => sub { print "ok 8\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 3\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 4\n"; $wa = AnyEvent->io (fh => $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 5\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 9\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 10\n"; $rb = AnyEvent->io (fh => fileno $b, poll => "r", cb => sub { print "ok 14\n"; sysread $b, my $buf, 1; print "ok 15\n"; $wb = AnyEvent->io (fh => fileno $b, poll => "w", cb => sub { print "ok 16\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 11\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 12\n"; $wa = AnyEvent->io (fh => fileno $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 13\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 17\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 18\n"; AnyEvent-7.17/t/00_load.t0000644000000000000000000000120711161333137013544 0ustar rootroot$|=1; BEGIN { print "1..13\n" } require AnyEvent; print "ok 1\n"; require AnyEvent::Impl::Perl; print "ok 2\n"; require AnyEvent::Util; print "ok 3\n"; require AnyEvent::Handle; print "ok 4\n"; require AnyEvent::DNS; print "ok 5\n"; 0 && require AnyEvent::Impl::EV; print "ok 6\n"; 0 && require AnyEvent::Impl::Event; print "ok 7\n"; 0 && require AnyEvent::Impl::EventLib; print "ok 8\n"; 0 && require AnyEvent::Impl::Glib; print "ok 9\n"; 0 && require AnyEvent::Impl::Tk; print "ok 10\n"; 1 && require AnyEvent::Impl::Perl; print "ok 11\n"; 0 && require AnyEvent::Impl::POE; print "ok 12\n"; 0 && require AnyEvent::Impl::Qt; print "ok 13\n"; AnyEvent-7.17/t/69_ev_07_io.t0000644000000000000000000000355112377641775014303 0ustar rootrootuse AnyEvent; use AnyEvent::Util; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::EV;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::EV not loadable\n}), exit 0) } $| = 1; print "1..18\n"; print "ok 1\n"; my ($a, $b) = AnyEvent::Util::portable_socketpair; print $a && $b ? "" : "not ", "ok 2 # $a,$b\n"; my ($cv, $t, $ra, $wa, $rb, $wb); $rb = AnyEvent->io (fh => $b, poll => "r", cb => sub { print "ok 6\n"; sysread $b, my $buf, 1; print "ok 7\n"; $wb = AnyEvent->io (fh => $b, poll => "w", cb => sub { print "ok 8\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 3\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 4\n"; $wa = AnyEvent->io (fh => $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 5\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 9\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 10\n"; $rb = AnyEvent->io (fh => fileno $b, poll => "r", cb => sub { print "ok 14\n"; sysread $b, my $buf, 1; print "ok 15\n"; $wb = AnyEvent->io (fh => fileno $b, poll => "w", cb => sub { print "ok 16\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 11\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 12\n"; $wa = AnyEvent->io (fh => fileno $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 13\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 17\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 18\n"; AnyEvent-7.17/t/64_glib_09_multi.t0000644000000000000000000000741612377641775015332 0ustar rootrootBEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 3 ? "" : "not ", "ok 2 # $s\n"; } # I/O read { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 }; my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 3 # $s\n"; syswrite $b, "x"; $cv = AE::cv; $wt = AE::timer 1, 0, $cv; $s = 0; $cv->begin; $cv->begin; $cv->recv; print $s == 3 ? "" : "not ", "ok 4 # $s\n"; sysread $a, my $dummy, 1; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 5 # $s\n"; } # signal { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 6 # $s\n"; kill INT => $$; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel? $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 7 # $s\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 8 # $s\n"; } # child { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $pid = fork; unless ($pid) { sleep 2; exit 1; } my ($apid, $bpid, $astatus, $bstatus); $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 9 # $s\n"; kill 9, $pid; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 10 # $s\n"; print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n"; print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 13 # $s\n"; } # timers (don't laugh, some event loops are more broken...) { my $cv = AE::cv; my $wt = AE::timer 1, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s |= 2 }; $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 }; $cv->recv; print $s == 7 ? "" : "not ", "ok 14 # $s\n"; } print "ok 15\n"; exit 0; AnyEvent-7.17/t/13_weaken.t0000644000000000000000000000110313540267331014103 0ustar rootrootuse Scalar::Util qw(weaken); use AnyEvent; BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } $| = 1; print "1..7\n"; print "ok 1\n"; my $c1 = AnyEvent->condvar; my $c2 = AE::cv; my $t1 = AnyEvent->timer (after => 0.1, cb => sub { print "ok 3\n"; $c1->() }); my $t2 = AnyEvent->timer (after => 0.5, cb => sub { print "not ok 6\n" }); my $t3 = AnyEvent->timer (after => 0.9, cb => sub { print "ok 6\n"; $c2->send }); print "ok 2\n"; $c1->wait; print "ok 4\n"; Scalar::Util::weaken $t2; print $t2 ? "not " : "", "ok 5\n"; $c2->wait; print "ok 7\n"; AnyEvent-7.17/t/65_event_01_basic.t0000644000000000000000000000115712377641775015452 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Event;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Event not loadable\n}), exit 0) } $| = 1; print "1..6\n"; print "ok 1\n"; my $cv = AnyEvent->condvar; print "ok 2\n"; my $timer1 = AnyEvent->timer (after => 0.1, cb => sub { print "ok 5\n"; $cv->broadcast }); print "ok 3\n"; AnyEvent->timer (after => 0.01, cb => sub { print "not ok 5\n" }); print "ok 4\n"; $cv->wait; print "ok 6\n"; AnyEvent-7.17/t/09_multi.t0000644000000000000000000000705712012340265013775 0ustar rootrootBEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 3 ? "" : "not ", "ok 2 # $s\n"; } # I/O read { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 }; my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 3 # $s\n"; syswrite $b, "x"; $cv = AE::cv; $wt = AE::timer 1, 0, $cv; $s = 0; $cv->begin; $cv->begin; $cv->recv; print $s == 3 ? "" : "not ", "ok 4 # $s\n"; sysread $a, my $dummy, 1; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 5 # $s\n"; } # signal { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 6 # $s\n"; kill INT => $$; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel? $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 7 # $s\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 8 # $s\n"; } # child { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $pid = fork; unless ($pid) { sleep 2; exit 1; } my ($apid, $bpid, $astatus, $bstatus); $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 9 # $s\n"; kill 9, $pid; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 10 # $s\n"; print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n"; print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 13 # $s\n"; } # timers (don't laugh, some event loops are more broken...) { my $cv = AE::cv; my $wt = AE::timer 1, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s |= 2 }; $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 }; $cv->recv; print $s == 7 ? "" : "not ", "ok 14 # $s\n"; } print "ok 15\n"; exit 0; AnyEvent-7.17/t/67_tk_07_io.t0000644000000000000000000000355112377641775014305 0ustar rootrootuse AnyEvent; use AnyEvent::Util; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Tk;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Tk not loadable\n}), exit 0) } $| = 1; print "1..18\n"; print "ok 1\n"; my ($a, $b) = AnyEvent::Util::portable_socketpair; print $a && $b ? "" : "not ", "ok 2 # $a,$b\n"; my ($cv, $t, $ra, $wa, $rb, $wb); $rb = AnyEvent->io (fh => $b, poll => "r", cb => sub { print "ok 6\n"; sysread $b, my $buf, 1; print "ok 7\n"; $wb = AnyEvent->io (fh => $b, poll => "w", cb => sub { print "ok 8\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 3\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 4\n"; $wa = AnyEvent->io (fh => $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 5\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 9\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 10\n"; $rb = AnyEvent->io (fh => fileno $b, poll => "r", cb => sub { print "ok 14\n"; sysread $b, my $buf, 1; print "ok 15\n"; $wb = AnyEvent->io (fh => fileno $b, poll => "w", cb => sub { print "ok 16\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 11\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 12\n"; $wa = AnyEvent->io (fh => fileno $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 13\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 17\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 18\n"; AnyEvent-7.17/t/68_poe_03_child.t0000644000000000000000000000572112377641775015124 0ustar rootrootuse POSIX (); no warnings; BEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <timer (after => 2, cb => sub { }); my $cv = AnyEvent->condvar; unless ($pid) { print "ok ${it}2 # child $$\n"; # POE hits a race condition when the child dies too quickly # because it checks for child exit before installing the signal handler. # seen in version 1.352 - earlier versions had the same bug, but # polled for child exits regularly, so only caused a delay. sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 3; } my $w = AnyEvent->child (pid => $pid, cb => sub { print $pid == $_[0] ? "" : "not ", "ok ${it}3\ # $pid == $_[0]\n"; print 3 == ($_[1] >> 8) ? "" : "not ", "ok ${it}4 # 3 == $_[1] >> 8 ($_[1])\n"; $cv->broadcast; }); $cv->recv; my $pid2 = fork || do { sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 7; }; my $cv2 = AnyEvent->condvar; # Glib is the only model that doesn't support pid == 0 my $pid0 = $AnyEvent::MODEL eq "AnyEvent::Impl::Glib" ? $pid2 : 0; my $w2 = AnyEvent->child (pid => $pid0, cb => sub { print $pid2 == $_[0] ? "" : "not ", "ok ${it}5 # $pid2 == $_[0]\n"; print 7 == ($_[1] >> 8) ? "" : "not ", "ok ${it}6 # 7 == $_[1] >> 8 ($_[1])\n"; $cv2->broadcast; }); my $error = AnyEvent->timer (after => 5, cb => sub { print <recv; print "ok ${it}7\n"; print "ok ${it}8\n"; print "ok ${it}9\n"; print "ok ", $it*10+10, "\n"; } AnyEvent-7.17/t/67_tk_02_signals.t0000644000000000000000000000147612377641775015335 0ustar rootrootBEGIN { unless (exists $SIG{USR1}) { print <condvar; my $error = AnyEvent->timer (after => 5, cb => sub { print <signal (signal => 'INT', cb => sub { print "ok 3\n"; $cv->broadcast; }); print "ok 2\n"; kill 'INT', $$; $cv->recv; undef $error; print "ok 4\n"; undef $sw; print "ok 5\n"; AnyEvent-7.17/t/64_glib_01_basic.t0000644000000000000000000000115512377641775015243 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Glib;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Glib not loadable\n}), exit 0) } $| = 1; print "1..6\n"; print "ok 1\n"; my $cv = AnyEvent->condvar; print "ok 2\n"; my $timer1 = AnyEvent->timer (after => 0.1, cb => sub { print "ok 5\n"; $cv->broadcast }); print "ok 3\n"; AnyEvent->timer (after => 0.01, cb => sub { print "not ok 5\n" }); print "ok 4\n"; $cv->wait; print "ok 6\n"; AnyEvent-7.17/t/69_ev_03_child.t0000644000000000000000000000570712377641775014760 0ustar rootrootuse POSIX (); no warnings; BEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <timer (after => 2, cb => sub { }); my $cv = AnyEvent->condvar; unless ($pid) { print "ok ${it}2 # child $$\n"; # POE hits a race condition when the child dies too quickly # because it checks for child exit before installing the signal handler. # seen in version 1.352 - earlier versions had the same bug, but # polled for child exits regularly, so only caused a delay. sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 3; } my $w = AnyEvent->child (pid => $pid, cb => sub { print $pid == $_[0] ? "" : "not ", "ok ${it}3\ # $pid == $_[0]\n"; print 3 == ($_[1] >> 8) ? "" : "not ", "ok ${it}4 # 3 == $_[1] >> 8 ($_[1])\n"; $cv->broadcast; }); $cv->recv; my $pid2 = fork || do { sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 7; }; my $cv2 = AnyEvent->condvar; # Glib is the only model that doesn't support pid == 0 my $pid0 = $AnyEvent::MODEL eq "AnyEvent::Impl::Glib" ? $pid2 : 0; my $w2 = AnyEvent->child (pid => $pid0, cb => sub { print $pid2 == $_[0] ? "" : "not ", "ok ${it}5 # $pid2 == $_[0]\n"; print 7 == ($_[1] >> 8) ? "" : "not ", "ok ${it}6 # 7 == $_[1] >> 8 ($_[1])\n"; $cv2->broadcast; }); my $error = AnyEvent->timer (after => 5, cb => sub { print <recv; print "ok ${it}7\n"; print "ok ${it}8\n"; print "ok ${it}9\n"; print "ok ", $it*10+10, "\n"; } AnyEvent-7.17/t/02_signals.t0000644000000000000000000000114311616053637014277 0ustar rootrootBEGIN { unless (exists $SIG{USR1}) { print <condvar; my $error = AnyEvent->timer (after => 5, cb => sub { print <signal (signal => 'INT', cb => sub { print "ok 3\n"; $cv->broadcast; }); print "ok 2\n"; kill 'INT', $$; $cv->recv; undef $error; print "ok 4\n"; undef $sw; print "ok 5\n"; AnyEvent-7.17/t/03_child.t0000644000000000000000000000535411735232632013727 0ustar rootrootuse POSIX (); no warnings; BEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <timer (after => 2, cb => sub { }); my $cv = AnyEvent->condvar; unless ($pid) { print "ok ${it}2 # child $$\n"; # POE hits a race condition when the child dies too quickly # because it checks for child exit before installing the signal handler. # seen in version 1.352 - earlier versions had the same bug, but # polled for child exits regularly, so only caused a delay. sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 3; } my $w = AnyEvent->child (pid => $pid, cb => sub { print $pid == $_[0] ? "" : "not ", "ok ${it}3\ # $pid == $_[0]\n"; print 3 == ($_[1] >> 8) ? "" : "not ", "ok ${it}4 # 3 == $_[1] >> 8 ($_[1])\n"; $cv->broadcast; }); $cv->recv; my $pid2 = fork || do { sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 7; }; my $cv2 = AnyEvent->condvar; # Glib is the only model that doesn't support pid == 0 my $pid0 = $AnyEvent::MODEL eq "AnyEvent::Impl::Glib" ? $pid2 : 0; my $w2 = AnyEvent->child (pid => $pid0, cb => sub { print $pid2 == $_[0] ? "" : "not ", "ok ${it}5 # $pid2 == $_[0]\n"; print 7 == ($_[1] >> 8) ? "" : "not ", "ok ${it}6 # 7 == $_[1] >> 8 ($_[1])\n"; $cv2->broadcast; }); my $error = AnyEvent->timer (after => 5, cb => sub { print <recv; print "ok ${it}7\n"; print "ok ${it}8\n"; print "ok ${it}9\n"; print "ok ", $it*10+10, "\n"; } AnyEvent-7.17/t/70_uv_02_signals.t0000644000000000000000000000147612377641775015343 0ustar rootrootBEGIN { unless (exists $SIG{USR1}) { print <condvar; my $error = AnyEvent->timer (after => 5, cb => sub { print <signal (signal => 'INT', cb => sub { print "ok 3\n"; $cv->broadcast; }); print "ok 2\n"; kill 'INT', $$; $cv->recv; undef $error; print "ok 4\n"; undef $sw; print "ok 5\n"; AnyEvent-7.17/t/70_uv_09_multi.t0000644000000000000000000000741212377641775015040 0ustar rootrootBEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 3 ? "" : "not ", "ok 2 # $s\n"; } # I/O read { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 }; my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 3 # $s\n"; syswrite $b, "x"; $cv = AE::cv; $wt = AE::timer 1, 0, $cv; $s = 0; $cv->begin; $cv->begin; $cv->recv; print $s == 3 ? "" : "not ", "ok 4 # $s\n"; sysread $a, my $dummy, 1; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 5 # $s\n"; } # signal { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 6 # $s\n"; kill INT => $$; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel? $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 7 # $s\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 8 # $s\n"; } # child { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $pid = fork; unless ($pid) { sleep 2; exit 1; } my ($apid, $bpid, $astatus, $bstatus); $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 9 # $s\n"; kill 9, $pid; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 10 # $s\n"; print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n"; print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 13 # $s\n"; } # timers (don't laugh, some event loops are more broken...) { my $cv = AE::cv; my $wt = AE::timer 1, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s |= 2 }; $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 }; $cv->recv; print $s == 7 ? "" : "not ", "ok 14 # $s\n"; } print "ok 15\n"; exit 0; AnyEvent-7.17/t/10_loadall.t0000644000000000000000000000067111734442712014250 0ustar rootroot$| = 1; print "1..24\n"; my $i = 0; for (qw( AnyEvent AnyEvent::Util AnyEvent::DNS AnyEvent::Socket AnyEvent::Loop AnyEvent::Strict AnyEvent::Debug AnyEvent::Handle AnyEvent::Log AnyEvent::Impl::Perl AnyEvent::IO::Perl AnyEvent::IO )) { print +(eval "require $_" ) ? "" : "not ", "ok ", ++$i, " # $_ require $@\n"; print +(eval "import $_; 1") ? "" : "not ", "ok ", ++$i, " # $_ import $@\n"; } AnyEvent-7.17/t/04_condvar.t0000644000000000000000000000340311623251250014263 0ustar rootrootuse AnyEvent; BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } $| = 1; print "1..28\n"; print "ok 1\n"; { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 4\n"; my $x = $_[0]->recv; print $x == 7 ? "" : "not ", "ok 5 # $x == 7\n"; my @x = $_[0]->recv; print $x[1] == 5 ? "" : "not ", "ok 6 # $x[1] == 5\n"; my $y = $cv->recv; print $y == 7 ? "" : "not ", "ok 7 # $x == 7\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 3\n"; $cv->send (7, 5); }); print "ok 2\n"; $cv->recv; print "ok 8\n"; my @x = $cv->recv; print $x[1] == 5 ? "" : "not ", "ok 9 # $x[1] == 5\n"; } { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 12\n"; my $x = eval { $_[0]->recv }; print !defined $x ? "" : "not ", "ok 13\n"; print $@ =~ /^kill/ ? "" : "not ", "ok 14 # $@\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 11\n"; $cv->croak ("kill"); print "ok 15\n"; $cv->send (8, 6, 4); print "ok 16\n"; }); print "ok 10\n"; my @x = eval { $cv->recv }; print !@x ? "" : "not ", "ok 17 # @x\n"; print $@ =~ /^kill / ? "" : "not ", "ok 18 # $@\n"; } { my $cv = AnyEvent->condvar; print "ok 19\n"; my $t = AnyEvent->timer (after => 0, cb => $cv); print "ok 20\n"; $cv->recv; print "ok 21\n"; } { my $cv = AE::cv { print +($_[0]->recv)[0] == 6 ? "" : "not ", "ok 27\n"; }; print "ok 22\n"; $cv->begin (sub { print "ok 26\n"; $_[0](6); }); print "ok 23\n"; $cv->begin; print "ok 24\n"; $cv->end; print "ok 25\n"; $cv->end; print "ok 28\n"; } AnyEvent-7.17/t/66_ioasync_01_basic.t0000644000000000000000000000116312377641775015774 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::IOAsync;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::IOAsync not loadable\n}), exit 0) } $| = 1; print "1..6\n"; print "ok 1\n"; my $cv = AnyEvent->condvar; print "ok 2\n"; my $timer1 = AnyEvent->timer (after => 0.1, cb => sub { print "ok 5\n"; $cv->broadcast }); print "ok 3\n"; AnyEvent->timer (after => 0.01, cb => sub { print "not ok 5\n" }); print "ok 4\n"; $cv->wait; print "ok 6\n"; AnyEvent-7.17/t/07_io.t0000644000000000000000000000321611616053653013254 0ustar rootrootuse AnyEvent; use AnyEvent::Util; BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } $| = 1; print "1..18\n"; print "ok 1\n"; my ($a, $b) = AnyEvent::Util::portable_socketpair; print $a && $b ? "" : "not ", "ok 2 # $a,$b\n"; my ($cv, $t, $ra, $wa, $rb, $wb); $rb = AnyEvent->io (fh => $b, poll => "r", cb => sub { print "ok 6\n"; sysread $b, my $buf, 1; print "ok 7\n"; $wb = AnyEvent->io (fh => $b, poll => "w", cb => sub { print "ok 8\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 3\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 4\n"; $wa = AnyEvent->io (fh => $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 5\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 9\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 10\n"; $rb = AnyEvent->io (fh => fileno $b, poll => "r", cb => sub { print "ok 14\n"; sysread $b, my $buf, 1; print "ok 15\n"; $wb = AnyEvent->io (fh => fileno $b, poll => "w", cb => sub { print "ok 16\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 11\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 12\n"; $wa = AnyEvent->io (fh => fileno $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 13\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 17\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 18\n"; AnyEvent-7.17/t/68_poe_09_multi.t0000644000000000000000000000742412377641775015203 0ustar rootrootBEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 3 ? "" : "not ", "ok 2 # $s\n"; } # I/O read { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 }; my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 3 # $s\n"; syswrite $b, "x"; $cv = AE::cv; $wt = AE::timer 1, 0, $cv; $s = 0; $cv->begin; $cv->begin; $cv->recv; print $s == 3 ? "" : "not ", "ok 4 # $s\n"; sysread $a, my $dummy, 1; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 5 # $s\n"; } # signal { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 6 # $s\n"; kill INT => $$; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel? $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 7 # $s\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 8 # $s\n"; } # child { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $pid = fork; unless ($pid) { sleep 2; exit 1; } my ($apid, $bpid, $astatus, $bstatus); $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 9 # $s\n"; kill 9, $pid; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 10 # $s\n"; print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n"; print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 13 # $s\n"; } # timers (don't laugh, some event loops are more broken...) { my $cv = AE::cv; my $wt = AE::timer 1, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s |= 2 }; $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 }; $cv->recv; print $s == 7 ? "" : "not ", "ok 14 # $s\n"; } print "ok 15\n"; exit 0; AnyEvent-7.17/t/67_tk_03_child.t0000644000000000000000000000570712377641775014762 0ustar rootrootuse POSIX (); no warnings; BEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <timer (after => 2, cb => sub { }); my $cv = AnyEvent->condvar; unless ($pid) { print "ok ${it}2 # child $$\n"; # POE hits a race condition when the child dies too quickly # because it checks for child exit before installing the signal handler. # seen in version 1.352 - earlier versions had the same bug, but # polled for child exits regularly, so only caused a delay. sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 3; } my $w = AnyEvent->child (pid => $pid, cb => sub { print $pid == $_[0] ? "" : "not ", "ok ${it}3\ # $pid == $_[0]\n"; print 3 == ($_[1] >> 8) ? "" : "not ", "ok ${it}4 # 3 == $_[1] >> 8 ($_[1])\n"; $cv->broadcast; }); $cv->recv; my $pid2 = fork || do { sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 7; }; my $cv2 = AnyEvent->condvar; # Glib is the only model that doesn't support pid == 0 my $pid0 = $AnyEvent::MODEL eq "AnyEvent::Impl::Glib" ? $pid2 : 0; my $w2 = AnyEvent->child (pid => $pid0, cb => sub { print $pid2 == $_[0] ? "" : "not ", "ok ${it}5 # $pid2 == $_[0]\n"; print 7 == ($_[1] >> 8) ? "" : "not ", "ok ${it}6 # 7 == $_[1] >> 8 ($_[1])\n"; $cv2->broadcast; }); my $error = AnyEvent->timer (after => 5, cb => sub { print <recv; print "ok ${it}7\n"; print "ok ${it}8\n"; print "ok ${it}9\n"; print "ok ", $it*10+10, "\n"; } AnyEvent-7.17/t/81_hosts.t0000644000000000000000000000146412206633610014003 0ustar rootrootuse File::Temp qw(tempfile); use Test::More tests => 2; my $test_host = 'test.invalid.'; my $test_addr = '127.9.9.9'; my ($hosts_fh, $hosts_file) = tempfile UNLINK => 1; print $hosts_fh "$test_addr $test_host\n"; close $hosts_fh; $ENV{PERL_ANYEVENT_HOSTS} = $hosts_file; require AnyEvent; require AnyEvent::Socket; sub resolved($) { my $cv = AnyEvent->condvar; AnyEvent::Socket::resolve_sockaddr (shift, 80, undef, undef, undef, sub { return $cv->send unless @_; my $sockaddr = $_[0][-1]; my $address = (AnyEvent::Socket::unpack_sockaddr ($sockaddr))[1]; return $cv->send (AnyEvent::Socket::format_address ($address)); }); return $cv->recv; } is resolved $test_host, $test_addr, 'resolved on first attempt'; is resolved $test_host, $test_addr, 'resolved on second attempt'; AnyEvent-7.17/t/05_dns.t0000644000000000000000000000105711506522416013424 0ustar rootroot# we avoid complicated tests here because some systems will # not have working DNS use AnyEvent; BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } use AnyEvent::DNS; $| = 1; print "1..5\n"; print "ok 1\n"; AnyEvent::DNS::resolver; print "ok 2\n"; # make sure we timeout faster AnyEvent::DNS::resolver->{timeout} = [0.5]; AnyEvent::DNS::resolver->_compile; print "ok 3\n"; my $cv = AnyEvent->condvar; AnyEvent::DNS::a "www.google.de", sub { print "ok 4 # www.google.de => @_\n"; $cv->send; }; $cv->recv; print "ok 5\n"; AnyEvent-7.17/t/66_ioasync_05_dns.t0000644000000000000000000000142412377641775015503 0ustar rootroot# we avoid complicated tests here because some systems will # not have working DNS use AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::IOAsync;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::IOAsync not loadable\n}), exit 0) } use AnyEvent::DNS; $| = 1; print "1..5\n"; print "ok 1\n"; AnyEvent::DNS::resolver; print "ok 2\n"; # make sure we timeout faster AnyEvent::DNS::resolver->{timeout} = [0.5]; AnyEvent::DNS::resolver->_compile; print "ok 3\n"; my $cv = AnyEvent->condvar; AnyEvent::DNS::a "www.google.de", sub { print "ok 4 # www.google.de => @_\n"; $cv->send; }; $cv->recv; print "ok 5\n"; AnyEvent-7.17/t/06_socket.t0000644000000000000000000000176611230205472014132 0ustar rootroot$| = 1; print "1..19\n"; no warnings; # nazis use AnyEvent::Socket; print "ok 1\n"; sub ph { my ($id, $str, $dport, $host, $port) = @_; $str =~ s/_/ /g unless ref $str; my ($h, $p) = parse_hostport ref $str ? $$str : $str, $dport; print $h eq $host && $p eq $port ? "" : "not ", "ok $id # '$str,$dport' => '$h,$p' eq '$host,$port'\n"; } ph 2, ""; ph 3, "localhost"; ph 4, qw(localhost 443 localhost 443); ph 5, qw(localhost:444 443 localhost 444); ph 6, qw(10.0.0.1 443 10.0.0.1 443); ph 7, qw(10.1:80 443 10.1 80); ph 8, qw(::1 443 ::1 443); ph 9, qw(::1:80 443 ::1:80 443); ph 10, qw([::1]:80 443 ::1 80); ph 11, qw([::1]_80 443 ::1 80); ph 12, qw([::1]_: 443); ph 13, qw([::1]: 443); ph 14, qw(::1_smtp 443 ::1 smtp); ph 15, qw([www.linux.org]_80 443 www.linux.org 80); ph 16, qw([10.1]:80 443 10.1 80); ph 17, qw(10.1_80 443 10.1 80); my $var = "2002:58c6:438b::10.0.0.17"; ph 18, \$var, qw(443 2002:58c6:438b::10.0.0.17 443); ph 19, \$var, qw(443 2002:58c6:438b::10.0.0.17 443); AnyEvent-7.17/t/62_cocoa_01_basic.t0000644000000000000000000000115712377641775015412 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Cocoa;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Cocoa not loadable\n}), exit 0) } $| = 1; print "1..6\n"; print "ok 1\n"; my $cv = AnyEvent->condvar; print "ok 2\n"; my $timer1 = AnyEvent->timer (after => 0.1, cb => sub { print "ok 5\n"; $cv->broadcast }); print "ok 3\n"; AnyEvent->timer (after => 0.01, cb => sub { print "not ok 5\n" }); print "ok 4\n"; $cv->wait; print "ok 6\n"; AnyEvent-7.17/t/62_cocoa_02_signals.t0000644000000000000000000000150412377641775015766 0ustar rootrootBEGIN { unless (exists $SIG{USR1}) { print <condvar; my $error = AnyEvent->timer (after => 5, cb => sub { print <signal (signal => 'INT', cb => sub { print "ok 3\n"; $cv->broadcast; }); print "ok 2\n"; kill 'INT', $$; $cv->recv; undef $error; print "ok 4\n"; undef $sw; print "ok 5\n"; AnyEvent-7.17/t/66_ioasync_09_multi.t0000644000000000000000000000742412377641775016063 0ustar rootrootBEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 3 ? "" : "not ", "ok 2 # $s\n"; } # I/O read { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 }; my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 3 # $s\n"; syswrite $b, "x"; $cv = AE::cv; $wt = AE::timer 1, 0, $cv; $s = 0; $cv->begin; $cv->begin; $cv->recv; print $s == 3 ? "" : "not ", "ok 4 # $s\n"; sysread $a, my $dummy, 1; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 5 # $s\n"; } # signal { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 6 # $s\n"; kill INT => $$; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel? $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 7 # $s\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 8 # $s\n"; } # child { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $pid = fork; unless ($pid) { sleep 2; exit 1; } my ($apid, $bpid, $astatus, $bstatus); $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 9 # $s\n"; kill 9, $pid; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 10 # $s\n"; print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n"; print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 13 # $s\n"; } # timers (don't laugh, some event loops are more broken...) { my $cv = AE::cv; my $wt = AE::timer 1, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s |= 2 }; $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 }; $cv->recv; print $s == 7 ? "" : "not ", "ok 14 # $s\n"; } print "ok 15\n"; exit 0; AnyEvent-7.17/t/01_basic.t0000644000000000000000000000061613540260602013711 0ustar rootrootuse AnyEvent; BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} } $| = 1; print "1..6\n"; print "ok 1\n"; my $cv = AnyEvent->condvar; print "ok 2\n"; my $timer1 = AnyEvent->timer (after => 0.1, cb => sub { print "ok 5\n"; $cv->broadcast }); print "ok 3\n"; AnyEvent->timer (after => 0.01, cb => sub { print "not ok 5\n" }); print "ok 4\n"; $cv->wait; print "ok 6\n"; AnyEvent-7.17/t/62_cocoa_07_io.t0000644000000000000000000000355712377641775014754 0ustar rootrootuse AnyEvent; use AnyEvent::Util; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Cocoa;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Cocoa not loadable\n}), exit 0) } $| = 1; print "1..18\n"; print "ok 1\n"; my ($a, $b) = AnyEvent::Util::portable_socketpair; print $a && $b ? "" : "not ", "ok 2 # $a,$b\n"; my ($cv, $t, $ra, $wa, $rb, $wb); $rb = AnyEvent->io (fh => $b, poll => "r", cb => sub { print "ok 6\n"; sysread $b, my $buf, 1; print "ok 7\n"; $wb = AnyEvent->io (fh => $b, poll => "w", cb => sub { print "ok 8\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 3\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 4\n"; $wa = AnyEvent->io (fh => $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 5\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 9\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 10\n"; $rb = AnyEvent->io (fh => fileno $b, poll => "r", cb => sub { print "ok 14\n"; sysread $b, my $buf, 1; print "ok 15\n"; $wb = AnyEvent->io (fh => fileno $b, poll => "w", cb => sub { print "ok 16\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 11\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 12\n"; $wa = AnyEvent->io (fh => fileno $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 13\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 17\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 18\n"; AnyEvent-7.17/t/68_poe_01_basic.t0000644000000000000000000000116312377641775015114 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::POE;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::POE not loadable\n}), exit 0) } $^W = 0; $| = 1; print "1..6\n"; print "ok 1\n"; my $cv = AnyEvent->condvar; print "ok 2\n"; my $timer1 = AnyEvent->timer (after => 0.1, cb => sub { print "ok 5\n"; $cv->broadcast }); print "ok 3\n"; AnyEvent->timer (after => 0.01, cb => sub { print "not ok 5\n" }); print "ok 4\n"; $cv->wait; print "ok 6\n"; AnyEvent-7.17/t/67_tk_09_multi.t0000644000000000000000000000741212377641775015032 0ustar rootrootBEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 3 ? "" : "not ", "ok 2 # $s\n"; } # I/O read { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 }; my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 3 # $s\n"; syswrite $b, "x"; $cv = AE::cv; $wt = AE::timer 1, 0, $cv; $s = 0; $cv->begin; $cv->begin; $cv->recv; print $s == 3 ? "" : "not ", "ok 4 # $s\n"; sysread $a, my $dummy, 1; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 5 # $s\n"; } # signal { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 6 # $s\n"; kill INT => $$; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel? $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 7 # $s\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 8 # $s\n"; } # child { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $pid = fork; unless ($pid) { sleep 2; exit 1; } my ($apid, $bpid, $astatus, $bstatus); $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 9 # $s\n"; kill 9, $pid; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 10 # $s\n"; print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n"; print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 13 # $s\n"; } # timers (don't laugh, some event loops are more broken...) { my $cv = AE::cv; my $wt = AE::timer 1, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s |= 2 }; $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 }; $cv->recv; print $s == 7 ? "" : "not ", "ok 14 # $s\n"; } print "ok 15\n"; exit 0; AnyEvent-7.17/t/66_ioasync_02_signals.t0000644000000000000000000000151012377641775016350 0ustar rootrootBEGIN { unless (exists $SIG{USR1}) { print <condvar; my $error = AnyEvent->timer (after => 5, cb => sub { print <signal (signal => 'INT', cb => sub { print "ok 3\n"; $cv->broadcast; }); print "ok 2\n"; kill 'INT', $$; $cv->recv; undef $error; print "ok 4\n"; undef $sw; print "ok 5\n"; AnyEvent-7.17/t/66_ioasync_04_condvar.t0000644000000000000000000000375012377641775016356 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::IOAsync;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::IOAsync not loadable\n}), exit 0) } $| = 1; print "1..28\n"; print "ok 1\n"; { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 4\n"; my $x = $_[0]->recv; print $x == 7 ? "" : "not ", "ok 5 # $x == 7\n"; my @x = $_[0]->recv; print $x[1] == 5 ? "" : "not ", "ok 6 # $x[1] == 5\n"; my $y = $cv->recv; print $y == 7 ? "" : "not ", "ok 7 # $x == 7\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 3\n"; $cv->send (7, 5); }); print "ok 2\n"; $cv->recv; print "ok 8\n"; my @x = $cv->recv; print $x[1] == 5 ? "" : "not ", "ok 9 # $x[1] == 5\n"; } { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 12\n"; my $x = eval { $_[0]->recv }; print !defined $x ? "" : "not ", "ok 13\n"; print $@ =~ /^kill/ ? "" : "not ", "ok 14 # $@\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 11\n"; $cv->croak ("kill"); print "ok 15\n"; $cv->send (8, 6, 4); print "ok 16\n"; }); print "ok 10\n"; my @x = eval { $cv->recv }; print !@x ? "" : "not ", "ok 17 # @x\n"; print $@ =~ /^kill / ? "" : "not ", "ok 18 # $@\n"; } { my $cv = AnyEvent->condvar; print "ok 19\n"; my $t = AnyEvent->timer (after => 0, cb => $cv); print "ok 20\n"; $cv->recv; print "ok 21\n"; } { my $cv = AE::cv { print +($_[0]->recv)[0] == 6 ? "" : "not ", "ok 27\n"; }; print "ok 22\n"; $cv->begin (sub { print "ok 26\n"; $_[0](6); }); print "ok 23\n"; $cv->begin; print "ok 24\n"; $cv->end; print "ok 25\n"; $cv->end; print "ok 28\n"; } AnyEvent-7.17/t/64_glib_04_condvar.t0000644000000000000000000000374212377641775015625 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Glib;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Glib not loadable\n}), exit 0) } $| = 1; print "1..28\n"; print "ok 1\n"; { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 4\n"; my $x = $_[0]->recv; print $x == 7 ? "" : "not ", "ok 5 # $x == 7\n"; my @x = $_[0]->recv; print $x[1] == 5 ? "" : "not ", "ok 6 # $x[1] == 5\n"; my $y = $cv->recv; print $y == 7 ? "" : "not ", "ok 7 # $x == 7\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 3\n"; $cv->send (7, 5); }); print "ok 2\n"; $cv->recv; print "ok 8\n"; my @x = $cv->recv; print $x[1] == 5 ? "" : "not ", "ok 9 # $x[1] == 5\n"; } { my $cv = AnyEvent->condvar; $cv->cb (sub { print $_[0]->ready ? "" : "not ", "ok 12\n"; my $x = eval { $_[0]->recv }; print !defined $x ? "" : "not ", "ok 13\n"; print $@ =~ /^kill/ ? "" : "not ", "ok 14 # $@\n"; }); my $t = AnyEvent->timer (after => 0, cb => sub { print "ok 11\n"; $cv->croak ("kill"); print "ok 15\n"; $cv->send (8, 6, 4); print "ok 16\n"; }); print "ok 10\n"; my @x = eval { $cv->recv }; print !@x ? "" : "not ", "ok 17 # @x\n"; print $@ =~ /^kill / ? "" : "not ", "ok 18 # $@\n"; } { my $cv = AnyEvent->condvar; print "ok 19\n"; my $t = AnyEvent->timer (after => 0, cb => $cv); print "ok 20\n"; $cv->recv; print "ok 21\n"; } { my $cv = AE::cv { print +($_[0]->recv)[0] == 6 ? "" : "not ", "ok 27\n"; }; print "ok 22\n"; $cv->begin (sub { print "ok 26\n"; $_[0](6); }); print "ok 23\n"; $cv->begin; print "ok 24\n"; $cv->end; print "ok 25\n"; $cv->end; print "ok 28\n"; } AnyEvent-7.17/t/65_event_09_multi.t0000644000000000000000000000742012377641775015532 0ustar rootrootBEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <begin; my $wa = AE::io $a, 1, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::io $a, 1, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 3 ? "" : "not ", "ok 2 # $s\n"; } # I/O read { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $wa = AE::io $a, 0, sub { $cv->end; $s |= 1 }; my $wb = AE::io $a, 0, sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 3 # $s\n"; syswrite $b, "x"; $cv = AE::cv; $wt = AE::timer 1, 0, $cv; $s = 0; $cv->begin; $cv->begin; $cv->recv; print $s == 3 ? "" : "not ", "ok 4 # $s\n"; sysread $a, my $dummy, 1; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 5 # $s\n"; } # signal { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::signal INT => sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::signal INT => sub { $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 6 # $s\n"; kill INT => $$; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # maybe OS X needs more time here? or maybe some buggy arm kernel? $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 7 # $s\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 8 # $s\n"; } # child { my $cv = AE::cv; my $wt = AE::timer 0.01, 0, $cv; my $s = 0; my $pid = fork; unless ($pid) { sleep 2; exit 1; } my ($apid, $bpid, $astatus, $bstatus); $cv->begin; my $wa = AE::child $pid, sub { ($apid, $astatus) = @_; $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::child $pid, sub { ($bpid, $bstatus) = @_; $cv->end; $s |= 2 }; $cv->recv; print $s == 0 ? "" : "not ", "ok 9 # $s\n"; kill 9, $pid; $cv = AE::cv; $wt = AE::timer 0.2, 0, $cv; # cygwin needs ages for this $s = 0; $cv->recv; print $s == 3 ? "" : "not ", "ok 10 # $s\n"; print $apid == $pid && $bpid == $pid ? "" : "not ", "ok 11 # $apid == $bpid == $pid\n"; print $astatus == 9 && $bstatus == 9 ? "" : "not ", "ok 12 # $astatus == $bstatus == 9\n"; $cv = AE::cv; $wt = AE::timer 0.01, 0, $cv; $s = 0; $cv->recv; print $s == 0 ? "" : "not ", "ok 13 # $s\n"; } # timers (don't laugh, some event loops are more broken...) { my $cv = AE::cv; my $wt = AE::timer 1, 0, $cv; my $s = 0; $cv->begin; my $wa = AE::timer 0 , 0, sub { $cv->end; $s |= 1 }; $cv->begin; my $wb = AE::timer 0 , 0, sub { $cv->end; $s |= 2 }; $cv->begin; my $wc = AE::timer 0.01, 0, sub { $cv->end; $s |= 4 }; $cv->recv; print $s == 7 ? "" : "not ", "ok 14 # $s\n"; } print "ok 15\n"; exit 0; AnyEvent-7.17/t/70_uv_03_child.t0000644000000000000000000000570712377641775014770 0ustar rootrootuse POSIX (); no warnings; BEGIN { # check for broken perls if ($^O =~ /mswin32/i) { my $ok; local $SIG{CHLD} = sub { $ok = 1 }; kill 'CHLD', 0; unless ($ok) { print <timer (after => 2, cb => sub { }); my $cv = AnyEvent->condvar; unless ($pid) { print "ok ${it}2 # child $$\n"; # POE hits a race condition when the child dies too quickly # because it checks for child exit before installing the signal handler. # seen in version 1.352 - earlier versions had the same bug, but # polled for child exits regularly, so only caused a delay. sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 3; } my $w = AnyEvent->child (pid => $pid, cb => sub { print $pid == $_[0] ? "" : "not ", "ok ${it}3\ # $pid == $_[0]\n"; print 3 == ($_[1] >> 8) ? "" : "not ", "ok ${it}4 # 3 == $_[1] >> 8 ($_[1])\n"; $cv->broadcast; }); $cv->recv; my $pid2 = fork || do { sleep 1 if $AnyEvent::MODEL eq "AnyEvent::Impl::POE"; POSIX::_exit 7; }; my $cv2 = AnyEvent->condvar; # Glib is the only model that doesn't support pid == 0 my $pid0 = $AnyEvent::MODEL eq "AnyEvent::Impl::Glib" ? $pid2 : 0; my $w2 = AnyEvent->child (pid => $pid0, cb => sub { print $pid2 == $_[0] ? "" : "not ", "ok ${it}5 # $pid2 == $_[0]\n"; print 7 == ($_[1] >> 8) ? "" : "not ", "ok ${it}6 # 7 == $_[1] >> 8 ($_[1])\n"; $cv2->broadcast; }); my $error = AnyEvent->timer (after => 5, cb => sub { print <recv; print "ok ${it}7\n"; print "ok ${it}8\n"; print "ok ${it}9\n"; print "ok ", $it*10+10, "\n"; } AnyEvent-7.17/t/69_ev_01_basic.t0000644000000000000000000000115112377641775014741 0ustar rootrootuse AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::EV;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::EV not loadable\n}), exit 0) } $| = 1; print "1..6\n"; print "ok 1\n"; my $cv = AnyEvent->condvar; print "ok 2\n"; my $timer1 = AnyEvent->timer (after => 0.1, cb => sub { print "ok 5\n"; $cv->broadcast }); print "ok 3\n"; AnyEvent->timer (after => 0.01, cb => sub { print "not ok 5\n" }); print "ok 4\n"; $cv->wait; print "ok 6\n"; AnyEvent-7.17/t/12_io_ioaio.t0000644000000000000000000000021511734710010014410 0ustar rootrootBEGIN { eval q{use AnyEvent::IO::IOAIO;1} or ((print qq{1..0 # SKIP AnyEvent::IO::IOAIO not loadable\n}), exit 0) } require "./t/io_common"; AnyEvent-7.17/t/69_ev_05_dns.t0000644000000000000000000000141212377641775014450 0ustar rootroot# we avoid complicated tests here because some systems will # not have working DNS use AnyEvent; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::EV;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::EV not loadable\n}), exit 0) } use AnyEvent::DNS; $| = 1; print "1..5\n"; print "ok 1\n"; AnyEvent::DNS::resolver; print "ok 2\n"; # make sure we timeout faster AnyEvent::DNS::resolver->{timeout} = [0.5]; AnyEvent::DNS::resolver->_compile; print "ok 3\n"; my $cv = AnyEvent->condvar; AnyEvent::DNS::a "www.google.de", sub { print "ok 4 # www.google.de => @_\n"; $cv->send; }; $cv->recv; print "ok 5\n"; AnyEvent-7.17/t/64_glib_07_io.t0000644000000000000000000000355512377641775014605 0ustar rootrootuse AnyEvent; use AnyEvent::Util; BEGIN { $^W = 0 } BEGIN { $ENV{PERL_ANYEVENT_LOOP_TESTS} or ((print qq{1..0 # SKIP PERL_ANYEVENT_LOOP_TESTS not true\n}), exit 0) } BEGIN { eval q{use AnyEvent::Impl::Glib;1} or ((print qq{1..0 # SKIP AnyEvent::Impl::Glib not loadable\n}), exit 0) } $| = 1; print "1..18\n"; print "ok 1\n"; my ($a, $b) = AnyEvent::Util::portable_socketpair; print $a && $b ? "" : "not ", "ok 2 # $a,$b\n"; my ($cv, $t, $ra, $wa, $rb, $wb); $rb = AnyEvent->io (fh => $b, poll => "r", cb => sub { print "ok 6\n"; sysread $b, my $buf, 1; print "ok 7\n"; $wb = AnyEvent->io (fh => $b, poll => "w", cb => sub { print "ok 8\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 3\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 4\n"; $wa = AnyEvent->io (fh => $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 5\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 9\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 10\n"; $rb = AnyEvent->io (fh => fileno $b, poll => "r", cb => sub { print "ok 14\n"; sysread $b, my $buf, 1; print "ok 15\n"; $wb = AnyEvent->io (fh => fileno $b, poll => "w", cb => sub { print "ok 16\n"; undef $wb; syswrite $b, "1"; }); }); print "ok 11\n"; { my $cv = AnyEvent->condvar; $t = AnyEvent->timer (after => 0.05, cb => sub { $cv->send }); $cv->recv } print "ok 12\n"; $wa = AnyEvent->io (fh => fileno $a, poll => "w", cb => sub { syswrite $a, "0"; undef $wa; print "ok 13\n"; }); $ra = AnyEvent->io (fh => $a, poll => "r", cb => sub { sysread $a, my $buf, 1; print "ok 17\n"; $cv->send; }); $cv = AnyEvent->condvar; $cv->recv; print "ok 18\n"; AnyEvent-7.17/eg/0000755000000000000000000000000013540302027012266 5ustar rootrootAnyEvent-7.17/eg/runbench0000755000000000000000000000154611004511422014020 0ustar rootroot#!/bin/bash rm -rf res; mkdir res tst() { res=$((res + 1)) echo echo res/$res PERL_ANYEVENT_MODEL=$1 perl $4 bench $2 "$3" $1/$3 | tee res/$res } export PERL_ANYEVENT_VERBOSE=1 tst EV 50000 EV tst EV 50000 Any tst CoroEV 50000 Any tst Perl 50000 Any tst Event 8000 Event tst Event 8000 Any tst Glib 8000 Any tst Tk 1000 Any tst POE 1000 Any "-MEvent -MPOE=Loop::Event" tst POE 1000 Any "-MPOE=Loop::Select" echo echo echo echo for ((i=2;i<=res;++i)); do join res/1 res/$i >res/x && mv res/x res/1 done { "; push @a, [split /\s+/] while <>; for my $x (0 .. $#{$a[0]}) { print ""; for my $y (0 .. $#a) { print "", $a[$y][$x], ""; } print ""; } print ""; ' } >res/1.html links -dump res/1.html AnyEvent-7.17/eg/runbench20000755000000000000000000000134711004511422014101 0ustar rootroot#!/bin/bash rm -rf res; mkdir res tst() { res=$((res + 1)) echo echo res/$res PERL_ANYEVENT_MODEL=$1 perl $4 bench2 $2 $3 | tee res/$res } export PERL_ANYEVENT_VERBOSE=1 a=8 b=3 tst EV $a $b tst Perl $a $b tst Event $a $b tst Glib $a $b tst POE $a $b "-MEvent -MPOE=Loop::Event" echo echo echo echo for ((i=2;i<=res;++i)); do join res/1 res/$i >res/x && mv res/x res/1 done { "; push @a, [split /\s+/] while <>; for my $x (0 .. $#{$a[0]}) { print ""; for my $y (0 .. $#a) { print "", $a[$y][$x], ""; } print ""; } print ""; ' } >res/1.html links -dump res/1.html AnyEvent-7.17/eg/bench20000755000000000000000000000221511004511422013347 0ustar rootroot#!/opt/bin/perl # ugly code, don't look at it # ulimit -n 500000 # $0 use strict; use Event; use EV; use Socket; use AnyEvent; use Time::HiRes 'time'; my $nr = $ARGV[0] || 1000; $| = 1; print "name $ENV{PERL_ANYEVENT_MODEL}\n"; print "sockets ", $nr * 2, "\n"; my $count; AnyEvent::detect; my $c = time; my @conn; @conn = map { socketpair my $a, my $b, AF_UNIX, SOCK_STREAM, PF_UNSPEC or die "$!"; my $self; $self = { r => $a, w => $b, rw => AnyEvent->io (fh => $a, poll => "r", cb => sub { ++$count; sysread $a, my $buf, 1; syswrite $conn[rand @conn]{w}, $buf, 1; $self->{to} = AnyEvent->timer (after => 3600, cb => sub { die }); }), to => AnyEvent->timer (after => 3600, cb => sub { die }), }; $self } 1 .. $nr; $c = (time - $c) / $nr * 1e6; printf "create %.2f\n", $c; for (1 .. $ARGV[1] || $nr * 0.01) { syswrite $conn[rand @conn]{w}, $_, 1; } my $i = time; my $stop = AnyEvent->timer (after => 1, cb => sub { $i = (time - $i) / $count * 1e6; printf "request %.2f\n", $i; exit; }); AnyEvent->condvar->wait; AnyEvent-7.17/eg/ae2.pl0000644000000000000000000000160111236561004013272 0ustar rootroot# $Id: ae2.pl,v 1.2 2009-08-06 14:00:36 root Exp $ # An echo client-server benchmark. use warnings; use strict; use Time::HiRes qw(time); use AnyEvent; use AnyEvent::Impl::Perl; use AnyEvent::Socket; my $CYCLES = 500; my $port = 11212; tcp_server undef, $port, sub { my ($fh) = @_ or die "tcp_server: $!"; my $hdl = new AnyEvent::Handle fh => $fh; $hdl->push_read (line => sub { $hdl->push_write ("$_[1]\n"); undef $hdl; }); }; my $t = time; for my $connections (1..$CYCLES) { my $cv = AE::cv; tcp_connect "127.0.0.1", $port, sub { my ($fh) = @_ or die "tcp_connect: $!"; my $hdl = new AnyEvent::Handle fh => $fh; $hdl->push_write ("can write $connections\n"); $hdl->push_read (line => sub { undef $hdl; $cv->send; }); }; $cv->recv; }; $t = time - $t; printf "%.3f sec\n", $t; exit; AnyEvent-7.17/eg/handle0000755000000000000000000000122411236560616013460 0ustar rootroot#!/opt/bin/perl # This small example script shows how to do non-blocking # reads from a file handle. use AnyEvent::Handle; my $cv = AnyEvent->condvar; my $ae_fh = AnyEvent::Handle->new ( fh => \*STDIN, on_error => sub { $cv->broadcast } ); $ae_fh->push_read (line => sub { my ($ae_fh, $line) = @_; print "Got line [$line]\n"; $ae_fh->push_read (sub { my ($ae_fh) = @_; print "Got additional data:[\n".$ae_fh->rbuf."]\n"; if ($ae_fh->rbuf =~ s/^.*\bend\b//s) { print "'end' detected, stopping program\n"; $cv->broadcast; return 1; } return 0; }); }); $cv->wait; AnyEvent-7.17/eg/bench0000755000000000000000000000257611236560601013311 0ustar rootroot#!/opt/bin/perl # ugly code, don't look at it # ulimit -n 500000 use strict; use Event; use EV; use Socket; use AnyEvent; use Time::HiRes 'time'; my $nr = $ARGV[0] || 1000; my $M = $ARGV[1] || "AnyEvent"; #$nr *= .01; my $todo; my $cv; my (@io, @timer); AnyEvent::detect; my $cb = sub { $cv->broadcast unless --$todo; }; $| = 1; print "name $ARGV[2]\n"; print "watchers ", $nr * 2, "\n"; my $m = qx; my $c = time; my $fh = \*STDOUT; for (1..$nr) { if ($M eq "EV") { push @io, EV::io $fh, EV::WRITE, $cb; push @timer, EV::timer 0, 0, $cb; } elsif ($M eq "Event") { push @io, Event->io (fd => $fh, poll => "w", cb => $cb); push @timer, Event->timer (after => 0, cb => $cb); } else { push @io, AnyEvent->io (fh => $fh, poll => "w", cb => $cb); push @timer, AnyEvent->timer (after => 0, cb => $cb); } } $c = (time - $c) / $nr / 2 * 1e6; $m = int 0.5 + (qx - $m) * 1024 / $nr / 2; printf "bytes %d\n", $m; printf "create %.2f\n", $c; $cv = AnyEvent->condvar; $todo = $nr * 2; my $i = time; $cv->wait; $i = (time - $i) / $nr / 2 * 1e6; printf "invoke %.2f\n", $i; my $d = time; if ($M eq "Event") { $_->cancel for (@io, @timer); } @io = @timer = (); { my $w = AnyEvent->timer (after => 0, cb => sub { }); AnyEvent->one_event; } $d = (time - $d) / $nr / 2 * 1e6; printf "destroy %.2f\n", $d; AnyEvent-7.17/eg/listen0000755000000000000000000000146411161333137013522 0ustar rootroot#!/opt/perl/bin/perl use strict; use Socket; use IO::Socket::INET; use AnyEvent::Socket; use AnyEvent::Handle; my $cv = AnyEvent->condvar; my $hdl; warn "listening on port 34832...\n"; AnyEvent::Socket::tcp_server undef, 34832, sub { my ($clsock, $host, $port) = @_; print "Got new client connection: $host:$port\n"; $hdl = AnyEvent::Handle->new ( fh => $clsock, on_eof => sub { print "client connection $host:$port: eof\n" }, on_error => sub { print "Client connection error: $host:$port: $!\n" } ); $hdl->push_write ("Hello!\015\012"); $hdl->push_read (line => sub { my (undef, $line) = @_; print "Yay, got line: $line\n"; $hdl->push_write ("Bye\015\012"); $hdl->on_drain (sub { $hdl->fh->close; undef $hdl }); }); }; $cv->wait; AnyEvent-7.17/eg/ae0.pl0000644000000000000000000000214411236561004013273 0ustar rootroot# $Id: ae0.pl,v 1.2 2009-08-06 14:00:36 root Exp $ # An echo client-server benchmark. use warnings; use strict; use Time::HiRes qw(time); use AnyEvent; use AnyEvent::Impl::Perl; use AnyEvent::Socket; use IO::Socket::INET; my $CYCLES = 500; my $port = 11212; my $serv_sock = IO::Socket::INET-> new( Listen => 5, LocalPort => $port, Proto => 'tcp', ReuseAddr => 1, ); my $serv_w = AE::io $serv_sock, 0, sub { accept my $fh, $serv_sock or return; sysread $serv_sock, my $buf, 512; syswrite $serv_sock, $buf; }; my $t = time; my $connections; sub _make_connection { if ($connections++ < $CYCLES) { tcp_connect "127.0.0.1", $port, sub { my ($fh) = @_ or die "tcp_connect: $!"; syswrite $fh, "can write $connections\n"; my $w; $w = AE::io $fh, 0, sub { sysread $fh, my $buf, 512; undef $fh; undef $w; &_make_connection; }; }; } else { $t = time - $t; printf "%.3f sec\n", $t; exit; } }; _make_connection; AnyEvent->condvar->recv; AnyEvent-7.17/eg/connect0000755000000000000000000000123011161333137013644 0ustar rootroot#!/opt/perl/bin/perl use IO::Socket::INET; use AnyEvent::Socket; use AnyEvent::Handle; my $cv = AnyEvent->condvar; my $hdl; my $watchobj = AnyEvent::Socket::tcp_connect ("www.google.com", 80, sub { my ($sock) = @_; unless ($sock) { warn "couldn't connect: $!"; return; } $hdl = AnyEvent::Handle->new ( fh => $sock, on_eof => sub { print "received eof\n"; undef $hdl } ); $hdl->push_write ("GET / HTTP/1.0\015\012\015\012"); $hdl->push_read (line => sub { my ($hdl, $line) = @_; print "Yay, got line: $line\n"; $cv->broadcast; }); }, sub { 10 # the timeout }); $cv->wait; AnyEvent-7.17/lib/0000755000000000000000000000000013540302027012441 5ustar rootrootAnyEvent-7.17/lib/AnyEvent/0000755000000000000000000000000013540302027014172 5ustar rootrootAnyEvent-7.17/lib/AnyEvent/Socket.pm0000644000000000000000000011775213143430713016000 0ustar rootroot=head1 NAME AnyEvent::Socket - useful IPv4 and IPv6 stuff. also unix domain sockets. and stuff. =head1 SYNOPSIS use AnyEvent::Socket; tcp_connect "gameserver.deliantra.net", 13327, sub { my ($fh) = @_ or die "gameserver.deliantra.net connect failed: $!"; # enjoy your filehandle }; # a simple tcp server tcp_server undef, 8888, sub { my ($fh, $host, $port) = @_; syswrite $fh, "The internet is full, $host:$port. Go away!\015\012"; }; =head1 DESCRIPTION This module implements various utility functions for handling internet protocol addresses and sockets, in an as transparent and simple way as possible. All functions documented without C prefix are exported by default. =over 4 =cut package AnyEvent::Socket; use Carp (); use Errno (); use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR); use AnyEvent (); BEGIN { AnyEvent::common_sense } use AnyEvent::Util qw(guard AF_INET6); use AnyEvent::DNS (); use base 'Exporter'; our @EXPORT = qw( getprotobyname parse_hostport format_hostport parse_ipv4 parse_ipv6 parse_ip parse_address format_ipv4 format_ipv6 format_ip format_address address_family inet_aton tcp_server tcp_connect ); our $VERSION = $AnyEvent::VERSION; =item $ipn = parse_ipv4 $dotted_quad Tries to parse the given dotted quad IPv4 address and return it in octet form (or undef when it isn't in a parsable format). Supports all forms specified by POSIX (e.g. C<10.0.0.1>, C<10.1>, C<10.0x020304>, C<0x12345678> or C<0377.0377.0377.0377>). =cut sub parse_ipv4($) { $_[0] =~ /^ (?: 0x[0-9a-fA-F]+ | 0[0-7]* | [1-9][0-9]* ) (?:\. (?: 0x[0-9a-fA-F]+ | 0[0-7]* | [1-9][0-9]* ) ){0,3}$/x or return undef; @_ = map /^0/ ? oct : $_, split /\./, $_[0]; # check leading parts against range return undef if grep $_ >= 256, @_[0 .. @_ - 2]; # check trailing part against range return undef if $_[-1] >= 2 ** (8 * (4 - $#_)); pack "N", (pop) + ($_[0] << 24) + ($_[1] << 16) + ($_[2] << 8); } =item $ipn = parse_ipv6 $textual_ipv6_address Tries to parse the given IPv6 address and return it in octet form (or undef when it isn't in a parsable format). Should support all forms specified by RFC 2373 (and additionally all IPv4 forms supported by parse_ipv4). Note that scope-id's are not supported (and will not parse). This function works similarly to C. Example: print unpack "H*", parse_ipv6 "2002:5345::10.0.0.1"; # => 2002534500000000000000000a000001 print unpack "H*", parse_ipv6 "192.89.98.1"; # => 00000000000000000000ffffc0596201 =cut sub parse_ipv6($) { # quick test to avoid longer processing my $n = $_[0] =~ y/://; if ($n < 2 || $n > 8) { if (!$n && (my $ipn = parse_ipv4 $_[0])) { return "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff$ipn"; } return undef; } my ($h, $t) = split /::/, $_[0], 2; unless (defined $t) { ($h, $t) = (undef, $h); } my @h = split /:/, $h, -1; my @t = split /:/, $t, -1; # check for ipv4 tail if (@t && $t[-1]=~ /\./) { return undef if $n > 6; my $ipn = parse_ipv4 pop @t or return undef; push @t, map +(sprintf "%x", $_), unpack "nn", $ipn; } # no :: then we need to have exactly 8 components return undef unless @h + @t == 8 || $_[0] =~ /::/; # now check all parts for validity return undef if grep !/^[0-9a-fA-F]{1,4}$/, @h, @t; # now pad... push @h, 0 while @h + @t < 8; # and done pack "n*", map hex, @h, @t } =item $token = parse_unix $hostname This function exists mainly for symmetry to the other C functions - it takes a hostname and, if it is C, it returns a special address token, otherwise C. The only use for this function is probably to detect whether a hostname matches whatever AnyEvent uses for unix domain sockets. =cut sub parse_unix($) { $_[0] eq "unix/" ? pack "S", AF_UNIX : undef } =item $ipn = parse_address $ip Combines C, C and C in one function. The address here refers to the host address (not socket address) in network form (binary). If the C<$text> is C, then this function returns a special token recognised by the other functions in this module to mean "UNIX domain socket". If the C<$text> to parse is a plain IPv4 or mapped IPv4 in IPv6 address (:ffff::), then it will be treated as an IPv4 address and four octets will be returned. If you don't want that, you have to call C and/or C manually (the latter always returning a 16 octet IPv6 address for mapped IPv4 addresses). Example: print unpack "H*", parse_address "10.1.2.3"; # => 0a010203 =item $ipn = AnyEvent::Socket::aton $ip Same as C, but not exported (think C but I name resolution). =cut sub parse_address($) { for (&parse_ipv6) { if ($_) { s/^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff//; return $_ } else { return &parse_unix } } } *aton = \&parse_address; =item ($name, $aliases, $proto) = getprotobyname $name Works like the builtin function of the same name, except it tries hard to work even on broken platforms (well, that's windows), where getprotobyname is traditionally very unreliable. Example: get the protocol number for TCP (usually 6) my $proto = getprotobyname "tcp"; =cut # microsoft can't even get getprotobyname working (the etc/protocols file # gets lost fairly often on windows), so we have to hardcode some common # protocol numbers ourselves. our %PROTO_BYNAME; $PROTO_BYNAME{tcp} = Socket::IPPROTO_TCP () if defined &Socket::IPPROTO_TCP; $PROTO_BYNAME{udp} = Socket::IPPROTO_UDP () if defined &Socket::IPPROTO_UDP; $PROTO_BYNAME{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP; sub getprotobyname($) { my $name = lc shift; defined (my $proton = $PROTO_BYNAME{$name} || (getprotobyname $name)[2]) or return; ($name, uc $name, $proton) } =item ($host, $service) = parse_hostport $string[, $default_service] Splitting a string of the form C is a common problem. Unfortunately, just splitting on the colon makes it hard to specify IPv6 addresses and doesn't support the less common but well standardised C<[ip literal]> syntax. This function tries to do this job in a better way, it supports (at least) the following formats, where C can be a numerical port number of a service name, or a C string, and the C< port> and C<:port> parts are optional. Also, everywhere where an IP address is supported a hostname or unix domain socket address is also supported (see C), and strings starting with C will also be interpreted as unix domain sockets. hostname:port e.g. "www.linux.org", "www.x.de:443", "www.x.de:https=443", ipv4:port e.g. "198.182.196.56", "127.1:22" ipv6 e.g. "::1", "affe::1" [ipv4or6]:port e.g. "[::1]", "[10.0.1]:80" [ipv4or6] port e.g. "[127.0.0.1]", "[www.x.org] 17" ipv4or6 port e.g. "::1 443", "10.0.0.1 smtp" unix/:path e.g. "unix/:/path/to/socket" /path e.g. "/path/to/socket" It also supports defaulting the service name in a simple way by using C<$default_service> if no service was detected. If neither a service was detected nor a default was specified, then this function returns the empty list. The same happens when a parse error was detected, such as a hostname with a colon in it (the function is rather forgiving, though). Example: print join ",", parse_hostport "localhost:443"; # => "localhost,443" print join ",", parse_hostport "localhost", "https"; # => "localhost,https" print join ",", parse_hostport "[::1]"; # => "," (empty list) print join ",", parse_hostport "/tmp/debug.sock"; # => "unix/", "/tmp/debug.sock" =cut sub parse_hostport($;$) { my ($host, $port); for ("$_[0]") { # work on a copy, just in case, and also reset pos # shortcut for /path return ("unix/", $_) if m%^/%; # parse host, special cases: "ipv6" or "ipv6[#p ]port" unless ( ($host) = /^\s* ([0-9a-fA-F:]*:[0-9a-fA-F:]*:[0-9a-fA-F\.:]*)/xgc and parse_ipv6 $host ) { /^\s*/xgc; if (/^ \[ ([^\[\]]+) \]/xgc) { $host = $1; } elsif (/^ ([^\[\]:\ ]+) /xgc) { $host = $1; } else { return; } } # parse port if (/\G (?:\s+|:|\#) ([^:[:space:]]+) \s*$/xgc) { $port = $1; } elsif (/\G\s*$/gc && length $_[1]) { $port = $_[1]; } else { return; } } # hostnames must not contain :'s return if $host =~ /:/ && !parse_ipv6 $host; ($host, $port) } =item $string = format_hostport $host, $port Takes a host (in textual form) and a port and formats in unambigiously in a way that C can parse it again. C<$port> can be C. =cut sub format_hostport($;$) { my ($host, $port) = @_; $port = ":$port" if length $port; $host = "[$host]" if $host =~ /:/; "$host$port" } =item $sa_family = address_family $ipn Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :) of the given host address in network format. =cut sub address_family($) { 4 == length $_[0] ? AF_INET : 16 == length $_[0] ? AF_INET6 : unpack "S", $_[0] } =item $text = format_ipv4 $ipn Expects a four octet string representing a binary IPv4 address and returns its textual format. Rarely used, see C for a nicer interface. =item $text = format_ipv6 $ipn Expects a sixteen octet string representing a binary IPv6 address and returns its textual format. Rarely used, see C for a nicer interface. =item $text = format_address $ipn Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16 octets for IPv6) and convert it into textual form. Returns C for UNIX domain sockets. This function works similarly to C, except it automatically detects the address type. Returns C if it cannot detect the type. If the C<$ipn> is a mapped IPv4 in IPv6 address (:ffff::), then just the contained IPv4 address will be returned. If you do not want that, you have to call C manually. Example: print format_address "\x01\x02\x03\x05"; => 1.2.3.5 =item $text = AnyEvent::Socket::ntoa $ipn Same as format_address, but not exported (think C). =cut sub format_ipv4($) { join ".", unpack "C4", $_[0] } sub format_ipv6($) { if ($_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00/) { if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) { return "::"; } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) { return "::1"; } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) { # v4compatible return "::" . format_ipv4 substr $_[0], 12; } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { # v4mapped return "::ffff:" . format_ipv4 substr $_[0], 12; } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) { # v4translated return "::ffff:0:" . format_ipv4 substr $_[0], 12; } } my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; # this is admittedly rather sucky $ip =~ s/(?:^|:) 0:0:0:0:0:0:0 (?:$|:)/::/x or $ip =~ s/(?:^|:) 0:0:0:0:0:0 (?:$|:)/::/x or $ip =~ s/(?:^|:) 0:0:0:0:0 (?:$|:)/::/x or $ip =~ s/(?:^|:) 0:0:0:0 (?:$|:)/::/x or $ip =~ s/(?:^|:) 0:0:0 (?:$|:)/::/x or $ip =~ s/(?:^|:) 0:0 (?:$|:)/::/x; $ip } sub format_address($) { if (4 == length $_[0]) { return &format_ipv4; } elsif (16 == length $_[0]) { return $_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff(....)$/s ? format_ipv4 $1 : &format_ipv6; } elsif (AF_UNIX == address_family $_[0]) { return "unix/" } else { return undef } } *ntoa = \&format_address; =item inet_aton $name_or_address, $cb->(@addresses) Works similarly to its Socket counterpart, except that it uses a callback. Use the length to distinguish between ipv4 and ipv6 (4 octets for IPv4, 16 for IPv6), or use C to convert it to a more readable format. Note that C, while initially a more complex interface, resolves host addresses, IDNs, service names and SRV records and gives you an ordered list of socket addresses to try and should be preferred over C. Example. inet_aton "www.google.com", my $cv = AE::cv; say unpack "H*", $_ for $cv->recv; # => d155e363 # => d155e367 etc. inet_aton "ipv6.google.com", my $cv = AE::cv; say unpack "H*", $_ for $cv->recv; # => 20014860a00300000000000000000068 =cut sub inet_aton { my ($name, $cb) = @_; if (my $ipn = &parse_ipv4) { $cb->($ipn); } elsif (my $ipn = &parse_ipv6) { $cb->($ipn); } elsif ($name eq "localhost") { # rfc2606 et al. $cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1); } else { require AnyEvent::DNS unless $AnyEvent::DNS::VERSION; my $ipv4 = $AnyEvent::PROTOCOL{ipv4}; my $ipv6 = $AnyEvent::PROTOCOL{ipv6}; my @res; my $cv = AE::cv { $cb->(map @$_, reverse @res); }; $cv->begin; if ($ipv4) { $cv->begin; AnyEvent::DNS::a ($name, sub { $res[$ipv4] = [map { parse_ipv4 $_ } @_]; $cv->end; }); }; if ($ipv6) { $cv->begin; AnyEvent::DNS::aaaa ($name, sub { $res[$ipv6] = [map { parse_ipv6 $_ } @_]; $cv->end; }); }; $cv->end; } } BEGIN { *sockaddr_family = $Socket::VERSION >= 1.75 ? \&Socket::sockaddr_family : # for 5.6.x, we need to do something much more horrible (Socket::pack_sockaddr_in 0x5555, "\x55\x55\x55\x55" | eval { Socket::pack_sockaddr_un "U" }) =~ /^\x00/ ? sub { unpack "xC", $_[0] } : sub { unpack "S" , $_[0] }; } # check for broken platforms with an extra field in sockaddr structure # kind of a rfc vs. bsd issue, as usual (ok, normally it's a # unix vs. bsd issue, a iso C vs. bsd issue or simply a # correctness vs. bsd issue.) my $pack_family = 0x55 == sockaddr_family ("\x55\x55") ? "xC" : "S"; =item $sa = AnyEvent::Socket::pack_sockaddr $service, $host Pack the given port/host combination into a binary sockaddr structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX domain sockets (C<$host> == C and C<$service> == absolute pathname). Example: my $bind = AnyEvent::Socket::pack_sockaddr 43, v195.234.53.120; bind $socket, $bind or die "bind: $!"; =cut sub pack_sockaddr($$) { my $af = address_family $_[1]; if ($af == AF_INET) { Socket::pack_sockaddr_in $_[0], $_[1] } elsif ($af == AF_INET6) { pack "$pack_family nL a16 L", AF_INET6, $_[0], # port 0, # flowinfo $_[1], # addr 0 # scope id } elsif ($af == AF_UNIX) { Socket::pack_sockaddr_un $_[0] } else { Carp::croak "pack_sockaddr: invalid host"; } } =item ($service, $host) = AnyEvent::Socket::unpack_sockaddr $sa Unpack the given binary sockaddr structure (as used by bind, getpeername etc.) into a C<$service, $host> combination. For IPv4 and IPv6, C<$service> is the port number and C<$host> the host address in network format (binary). For UNIX domain sockets, C<$service> is the absolute pathname and C<$host> is a special token that is understood by the other functions in this module (C converts it to C). =cut # perl contains a bug (imho) where it requires that the kernel always returns # sockaddr_un structures of maximum length (which is not, AFAICS, required # by any standard). try to 0-pad structures for the benefit of those platforms. # unfortunately, the IO::Async author chose to break Socket again in version # 2.011 - it now contains a bogus length check, so we disable the workaround. my $sa_un_zero = $Socket::VERSION >= 2.011 ? "" : eval { Socket::pack_sockaddr_un "" }; $sa_un_zero ^= $sa_un_zero; sub unpack_sockaddr($) { my $af = sockaddr_family $_[0]; if ($af == AF_INET) { Socket::unpack_sockaddr_in $_[0] } elsif ($af == AF_INET6) { unpack "x2 n x4 a16", $_[0] } elsif ($af == AF_UNIX) { ((Socket::unpack_sockaddr_un $_[0] ^ $sa_un_zero), pack "S", AF_UNIX) } else { Carp::croak "unpack_sockaddr: unsupported protocol family $af"; } } =item AnyEvent::Socket::resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...) Tries to resolve the given nodename and service name into protocol families and sockaddr structures usable to connect to this node and service in a protocol-independent way. It works remotely similar to the getaddrinfo posix function. For internet addresses, C<$node> is either an IPv4 or IPv6 address, an internet hostname (DNS domain name or IDN), and C<$service> is either a service name (port name from F) or a numerical port number. If both C<$node> and C<$service> are names, then SRV records will be consulted to find the real service, otherwise they will be used as-is. If you know that the service name is not in your services database, then you can specify the service in the format C (e.g. C). If a host cannot be found via DNS, then it will be looked up in F (or the file specified via C<< $ENV{PERL_ANYEVENT_HOSTS} >>). If they are found, the addresses there will be used. The effect is as if entries from F would yield C and C records for the host name unless DNS already had records for them. For UNIX domain sockets, C<$node> must be the string C and C<$service> must be the absolute pathname of the socket. In this case, C<$proto> will be ignored. C<$proto> must be a protocol name, currently C, C or C. The default is currently C, but in the future, this function might try to use other protocols such as C, depending on the socket type and any SRV records it might find. C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use only IPv4) or C<6> (use only IPv6). The default is influenced by C<$ENV{PERL_ANYEVENT_PROTOCOLS}>. C<$type> must be C, C or C (or C in which case it gets automatically chosen to be C unless C<$proto> is C). The callback will receive zero or more array references that contain C<$family, $type, $proto> for use in C and a binary C<$sockaddr> for use in C (or C). The application should try these in the order given. Example: resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... }; =cut our %HOSTS; # $HOSTS{$nodename}[$ipv6] = [@aliases...] our @HOSTS_CHECKING; # callbacks to call when hosts have been loaded our $HOSTS_MTIME; sub _parse_hosts($) { %HOSTS = (); for (split /\n/, $_[0]) { s/#.*$//; s/^[ \t]+//; y/A-Z/a-z/; my ($addr, @aliases) = split /[ \t]+/; next unless @aliases; if (my $ip = parse_ipv4 $addr) { ($ip) = $ip =~ /^(.*)$/s if AnyEvent::TAINT; push @{ $HOSTS{$_}[0] }, $ip for @aliases; } elsif (my $ip = parse_ipv6 $addr) { ($ip) = $ip =~ /^(.*)$/s if AnyEvent::TAINT; push @{ $HOSTS{$_}[1] }, $ip for @aliases; } } } # helper function - unless dns delivered results, check and parse hosts, then call continuation code sub _load_hosts_unless(&$@) { my ($cont, $cv, @dns) = @_; if (@dns) { $cv->end; } else { my $etc_hosts = length $ENV{PERL_ANYEVENT_HOSTS} ? $ENV{PERL_ANYEVENT_HOSTS} : AnyEvent::WIN32 ? "$ENV{SystemRoot}/system32/drivers/etc/hosts" : "/etc/hosts"; push @HOSTS_CHECKING, sub { $cont->(); $cv->end; }; unless ($#HOSTS_CHECKING) { # we are not the first, so we actually have to do the work require AnyEvent::IO; AnyEvent::IO::aio_stat ($etc_hosts, sub { if ((stat _)[9] ne $HOSTS_MTIME) { AE::log 8 => "(re)loading $etc_hosts."; $HOSTS_MTIME = (stat _)[9]; # we might load a newer version of hosts,but that's a harmless race, # as the next call will just load it again. AnyEvent::IO::aio_load ($etc_hosts, sub { _parse_hosts $_[0]; (shift @HOSTS_CHECKING)->() while @HOSTS_CHECKING; }); } else { (shift @HOSTS_CHECKING)->() while @HOSTS_CHECKING; } }); } } } sub resolve_sockaddr($$$$$$) { my ($node, $service, $proto, $family, $type, $cb) = @_; if ($node eq "unix/") { return $cb->() if $family || $service !~ /^\//; # no can do return $cb->([AF_UNIX, defined $type ? $type : SOCK_STREAM, 0, Socket::pack_sockaddr_un $service]); } unless (AF_INET6) { $family != 6 or return $cb->(); $family = 4; } $cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4}; $cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6}; $family ||= 4 unless $AnyEvent::PROTOCOL{ipv6}; $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4}; $proto ||= "tcp"; $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM; my $proton = AnyEvent::Socket::getprotobyname $proto or Carp::croak "$proto: protocol unknown"; my $port; if ($service =~ /^(\S+)=(\d+)$/) { ($service, $port) = ($1, $2); } elsif ($service =~ /^\d+$/) { ($service, $port) = (undef, $service); } else { $port = (getservbyname $service, $proto)[2] or Carp::croak "$service/$proto: service unknown"; } # resolve a records / provide sockaddr structures my $resolve = sub { my @target = @_; my @res; my $cv = AE::cv { $cb->( map $_->[2], sort { $AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]} or $a->[0] <=> $b->[0] } @res ) }; $cv->begin; for my $idx (0 .. $#target) { my ($node, $port) = @{ $target[$idx] }; if (my $noden = parse_address $node) { my $af = address_family $noden; if ($af == AF_INET && $family != 6) { push @res, [$idx, "ipv4", [AF_INET, $type, $proton, pack_sockaddr $port, $noden]] } if ($af == AF_INET6 && $family != 4) { push @res, [$idx, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, $noden]] } } else { $node =~ y/A-Z/a-z/; # a records if ($family != 6) { $cv->begin; AnyEvent::DNS::a $node, sub { push @res, [$idx, "ipv4", [AF_INET, $type, $proton, pack_sockaddr $port, parse_ipv4 $_]] for @_; # dns takes precedence over hosts _load_hosts_unless { push @res, map [$idx, "ipv4", [AF_INET, $type, $proton, pack_sockaddr $port, $_]], @{ ($HOSTS{$node} || [])->[0] }; } $cv, @_; }; } # aaaa records if ($family != 4) { $cv->begin; AnyEvent::DNS::aaaa $node, sub { push @res, [$idx, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, parse_ipv6 $_]] for @_; _load_hosts_unless { push @res, map [$idx + 0.5, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, $_]], @{ ($HOSTS{$node} || [])->[1] } } $cv, @_; }; } } } $cv->end; }; $node = AnyEvent::Util::idn_to_ascii $node if $node =~ /[^\x00-\x7f]/; # try srv records, if applicable if ($node eq "localhost") { $resolve->(["127.0.0.1", $port], ["::1", $port]); } elsif (defined $service && !parse_address $node) { AnyEvent::DNS::srv $service, $proto, $node, sub { my (@srv) = @_; if (@srv) { # the only srv record has "." ("" here) => abort $srv[0][2] ne "" || $#srv or return $cb->(); # use srv records then $resolve->( map ["$_->[3].", $_->[2]], grep $_->[3] ne ".", @srv ); } else { # no srv records, continue traditionally $resolve->([$node, $port]); } }; } else { # most common case $resolve->([$node, $port]); } } =item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb] This is a convenience function that creates a TCP socket and makes a 100% non-blocking connect to the given C<$host> (which can be a DNS/IDN hostname or a textual IP address, or the string C for UNIX domain sockets) and C<$service> (which can be a numeric port number or a service name, or a C string, or the pathname to a UNIX domain socket). If both C<$host> and C<$port> are names, then this function will use SRV records to locate the real target(s). In either case, it will create a list of target hosts (e.g. for multihomed hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to each in turn. After the connection is established, then the C<$connect_cb> will be invoked with the socket file handle (in non-blocking mode) as first, and the peer host (as a textual IP address) and peer port as second and third arguments, respectively. The fourth argument is a code reference that you can call if, for some reason, you don't like this connection, which will cause C to try the next one (or call your callback without any arguments if there are no more connections). In most cases, you can simply ignore this argument. $cb->($filehandle, $host, $port, $retry) If the connect is unsuccessful, then the C<$connect_cb> will be invoked without any arguments and C<$!> will be set appropriately (with C indicating a DNS resolution failure). The callback will I be invoked before C returns, even if C was able to connect immediately (e.g. on unix domain sockets). The file handle is perfect for being plugged into L, but can be used as a normal perl file handle as well. Unless called in void context, C returns a guard object that will automatically cancel the connection attempt when it gets destroyed - in which case the callback will not be invoked. Destroying it does not do anything to the socket after the connect was successful - you cannot "uncall" a callback that has been invoked already. Sometimes you need to "prepare" the socket before connecting, for example, to C it to some port, or you want a specific connect timeout that is lower than your kernel's default timeout. In this case you can specify a second callback, C<$prepare_cb>. It will be called with the file handle in not-yet-connected state as only argument and must return the connection timeout value (or C<0>, C or the empty list to indicate the default timeout is to be used). Note to the poor Microsoft Windows users: Windows (of course) doesn't correctly signal connection errors, so unless your event library works around this, failed connections will simply hang. The only event libraries that handle this condition correctly are L and L. Additionally, AnyEvent works around this bug with L and in its pure-perl backend. All other libraries cannot correctly handle this condition. To lessen the impact of this windows bug, a default timeout of 30 seconds will be imposed on windows. Cygwin is not affected. Simple Example: connect to localhost on port 22. tcp_connect localhost => 22, sub { my $fh = shift or die "unable to connect: $!"; # do something }; Complex Example: connect to www.google.com on port 80 and make a simple GET request without much error handling. Also limit the connection timeout to 15 seconds. tcp_connect "www.google.com", "http", sub { my ($fh) = @_ or die "unable to connect: $!"; my $handle; # avoid direct assignment so on_eof has it in scope. $handle = new AnyEvent::Handle fh => $fh, on_error => sub { AE::log error => $_[2]; $_[0]->destroy; }, on_eof => sub { $handle->destroy; # destroy handle AE::log info => "Done."; }; $handle->push_write ("GET / HTTP/1.0\015\012\015\012"); $handle->push_read (line => "\015\012\015\012", sub { my ($handle, $line) = @_; # print response header print "HEADER\n$line\n\nBODY\n"; $handle->on_read (sub { # print response body print $_[0]->rbuf; $_[0]->rbuf = ""; }); }); }, sub { my ($fh) = @_; # could call $fh->bind etc. here 15 }; Example: connect to a UNIX domain socket. tcp_connect "unix/", "/tmp/.X11-unix/X0", sub { ... } =cut sub tcp_connect($$$;$) { my ($host, $port, $connect, $prepare) = @_; # see http://cr.yp.to/docs/connect.html for some tricky aspects # also http://advogato.org/article/672.html my %state = ( fh => undef ); # name/service to type/sockaddr resolution resolve_sockaddr $host, $port, 0, 0, undef, sub { my @target = @_; $state{next} = sub { return unless exists $state{fh}; my $errno = $!; my $target = shift @target or return AE::postpone { return unless exists $state{fh}; %state = (); $! = $errno; $connect->(); }; my ($domain, $type, $proto, $sockaddr) = @$target; # socket creation socket $state{fh}, $domain, $type, $proto or return $state{next}(); AnyEvent::fh_unblock $state{fh}; my $timeout = $prepare && $prepare->($state{fh}); $timeout ||= 30 if AnyEvent::WIN32; $state{to} = AE::timer $timeout, 0, sub { $! = Errno::ETIMEDOUT; $state{next}(); } if $timeout; # now connect if ( (connect $state{fh}, $sockaddr) || ($! == Errno::EINPROGRESS # POSIX || $! == Errno::EWOULDBLOCK # WSAEINPROGRESS intentionally not checked - it means something else entirely || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt || $! == AnyEvent::Util::WSAEWOULDBLOCK) ) { $state{ww} = AE::io $state{fh}, 1, sub { # we are connected, or maybe there was an error if (my $sin = getpeername $state{fh}) { my ($port, $host) = unpack_sockaddr $sin; delete $state{ww}; delete $state{to}; my $guard = guard { %state = () }; $connect->(delete $state{fh}, format_address $host, $port, sub { $guard->cancel; $state{next}(); }); } else { if ($! == Errno::ENOTCONN) { # dummy read to fetch real error code if !cygwin sysread $state{fh}, my $buf, 1; # cygwin 1.5 continously reports "ready' but never delivers # an error with getpeername or sysread. # cygwin 1.7 only reports readyness *once*, but is otherwise # the same, which is actually more broken. # Work around both by using unportable SO_ERROR for cygwin. $! = (unpack "l", getsockopt $state{fh}, Socket::SOL_SOCKET(), Socket::SO_ERROR()) || Errno::EAGAIN if AnyEvent::CYGWIN && $! == Errno::EAGAIN; } return if $! == Errno::EAGAIN; # skip spurious wake-ups delete $state{ww}; delete $state{to}; $state{next}(); } }; } else { $state{next}(); } }; $! = Errno::ENXIO; $state{next}(); }; defined wantarray && guard { %state = () } } =item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb] Create and bind a stream socket to the given host address and port, set the SO_REUSEADDR flag (if applicable) and call C. Unlike the name implies, this function can also bind on UNIX domain sockets. For internet sockets, C<$host> must be an IPv4 or IPv6 address (or C, in which case it binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in future versions, as applicable). To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6 wildcard address, use C<::>. The port is specified by C<$service>, which must be either a service name or a numeric port number (or C<0> or C, in which case an ephemeral port will be used). For UNIX domain sockets, C<$host> must be C and C<$service> must be the absolute pathname of the socket. This function will try to C the socket before it tries to bind to it, and will try to unlink it after it stops using it. See SECURITY CONSIDERATIONS, below. For each new connection that could be Ced, call the C<< $accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking mode) as first, and the peer host and port as second and third arguments (see C for details). Croaks on any errors it can detect before the listen. In non-void context, this function returns a guard object whose lifetime it tied to the TCP server: If the object gets destroyed, the server will be stopped and the listening socket will be cleaned up/unlinked (already accepted connections will not be affected). When called in void-context, AnyEvent will keep the listening socket alive internally. In this case, there is no guarantee that the listening socket will be cleaned up or unlinked. In all cases, when the function returns to the caller, the socket is bound and in listening state. If you need more control over the listening socket, you can provide a C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the C call, with the listen file handle as first argument, and IP address and port number of the local socket endpoint as second and third arguments. It should return the length of the listen queue (or C<0> for the default). Note to IPv6 users: RFC-compliant behaviour for IPv6 sockets listening on C<::> is to bind to both IPv6 and IPv4 addresses by default on dual-stack hosts. Unfortunately, only GNU/Linux seems to implement this properly, so if you want both IPv4 and IPv6 listening sockets you should create the IPv6 socket first and then attempt to bind on the IPv4 socket, but ignore any C errors. Example: bind on some TCP port on the local machine and tell each client to go away. tcp_server undef, undef, sub { my ($fh, $host, $port) = @_; syswrite $fh, "The internet is full, $host:$port. Go away!\015\012"; }, sub { my ($fh, $thishost, $thisport) = @_; AE::log info => "Bound to $thishost, port $thisport."; }; Example: bind a server on a unix domain socket. tcp_server "unix/", "/tmp/mydir/mysocket", sub { my ($fh) = @_; }; =item $guard = AnyEvent::Socket::tcp_bind $host, $service, $done_cb[, $prepare_cb] Same as C, except it doesn't call C in a loop for you but simply passes the listen socket to the C<$done_cb>. This is useful when you want to have a convenient set up for your listen socket, but want to do the C'ing yourself, for example, in another process. In case of an error, C either croaks, or passes C to the C<$done_cb>. In non-void context, a guard will be returned. It will clean up/unlink the listening socket when destroyed. In void context, no automatic clean up might be performed. =cut sub _tcp_bind($$$;$) { my ($host, $service, $done, $prepare) = @_; $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6 ? "::" : "0" unless defined $host; my $ipn = parse_address $host or Carp::croak "tcp_bind: cannot parse '$host' as host address"; my $af = address_family $ipn; my %state; # win32 perl is too stupid to get this right :/ Carp::croak "tcp_bind: AF_UNIX address family not supported on win32" if AnyEvent::WIN32 && $af == AF_UNIX; socket my $fh, $af, SOCK_STREAM, 0 or Carp::croak "tcp_bind: $!"; $state{fh} = $fh; if ($af == AF_INET || $af == AF_INET6) { setsockopt $fh, SOL_SOCKET, SO_REUSEADDR, 1 or Carp::croak "tcp_bind: so_reuseaddr: $!" unless AnyEvent::WIN32; # work around windows bug unless ($service =~ /^\d*$/) { $service = (getservbyname $service, "tcp")[2] or Carp::croak "tcp_bind: unknown service '$service'" } } elsif ($af == AF_UNIX) { unlink $service; } bind $fh, pack_sockaddr $service, $ipn or Carp::croak "tcp_bind: $!"; if ($af == AF_UNIX and defined wantarray) { # this is racy, but is not designed to be foolproof, just best-effort my $ino = (lstat $service)[1]; $state{unlink} = guard { unlink $service if (lstat $service)[1] == $ino; }; } AnyEvent::fh_unblock $fh; my $len; if ($prepare) { my ($service, $host) = unpack_sockaddr getsockname $fh; $len = $prepare && $prepare->($fh, format_address $host, $service); } $len ||= 128; listen $fh, $len or Carp::croak "tcp_bind: $!"; $done->(\%state); defined wantarray ? guard { %state = () } # clear fh, unlink : () } sub tcp_bind($$$;$) { my ($host, $service, $done, $prepare) = @_; _tcp_bind $host, $service, sub { $done->(delete shift->{fh}); }, $prepare } sub tcp_server($$$;$) { my ($host, $service, $accept, $prepare) = @_; _tcp_bind $host, $service, sub { my $rstate = shift; $rstate->{aw} = AE::io $rstate->{fh}, 0, sub { # this closure keeps $state alive while ($rstate->{fh} && (my $peer = accept my $fh, $rstate->{fh})) { AnyEvent::fh_unblock $fh; # POSIX requires inheritance, the outside world does not my ($service, $host) = unpack_sockaddr $peer; $accept->($fh, format_address $host, $service); } }; }, $prepare } =item tcp_nodelay $fh, $enable Enables (or disables) the C socket option (also known as Nagle's algorithm). Returns false on error, true otherwise. =cut sub tcp_nodelay($$) { my $onoff = int ! ! $_[1]; setsockopt $_[0], Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), $onoff } =item tcp_congestion $fh, $algorithm Sets the tcp congestion avoidance algorithm (via the C socket option). The default is OS-specific, but is usually C. Typical other available choices include C, C, C, C, C, C, C, C, C, C, C and C. =cut sub tcp_congestion($$) { defined TCP_CONGESTION ? setsockopt $_[0], Socket::IPPROTO_TCP (), TCP_CONGESTION, "$_[1]" : undef } =back =head1 SECURITY CONSIDERATIONS This module is quite powerful, with with power comes the ability to abuse as well: If you accept "hostnames" and ports from untrusted sources, then note that this can be abused to delete files (host=C). This is not really a problem with this module, however, as blindly accepting any address and protocol and trying to bind a server or connect to it is harmful in general. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Util/0000755000000000000000000000000013540302027015107 5ustar rootrootAnyEvent-7.17/lib/AnyEvent/Util/uts46data.pl0000644000000000000000000017602513050323064017276 0ustar rootroot# autogenerated by util/gen_uts46data $uts46_imap = qAaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZzªa­²2³3µμ¹1ºo¼1⁄4½1⁄2¾3⁄4ÀàÁáÂâÃãÄäÅåÆæÇçÈèÉéÊêËëÌìÍíÎîÏïÐðÑñÒòÓóÔôÕõÖöØøÙùÚúÛûÜüÝýÞþĀāĂ㥹ĆćĈĉĊċČčĎďĐđĒēĔĕĖėĘęĚěĜĝĞğĠġĢģĤĥĦħĨĩĪīĬĭĮįİi̇IJijijijĴĵĶķĹĺĻļĽľĿl·ŀl·ŁłŃńŅņŇňʼnʼnŊŋŌōŎŏŐőŒœŔŕŖŗŘřŚśŜŝŞşŠšŢţŤťŦŧŨũŪūŬŭŮůŰűŲųŴŵŶŷŸÿŹźŻżŽžſsƁɓƂƃƄƅƆɔƇƈƉɖƊɗƋƌƎǝƏəƐɛƑƒƓɠƔɣƖɩƗɨƘƙƜɯƝɲƟɵƠơƢƣƤƥƦʀƧƨƩʃƬƭƮʈƯưƱʊƲʋƳƴƵƶƷʒƸƹƼƽDŽdžDždždždžLJljLjljljljNJnjNjnjnjnjǍǎǏǐǑǒǓǔǕǖǗǘǙǚǛǜǞǟǠǡǢǣǤǥǦǧǨǩǪǫǬǭǮǯDZdzDzdzdzdzǴǵǶƕǷƿǸǹǺǻǼǽǾǿȀȁȂȃȄȅȆȇȈȉȊȋȌȍȎȏȐȑȒȓȔȕȖȗȘșȚțȜȝȞȟȠƞȢȣȤȥȦȧȨȩȪȫȬȭȮȯȰȱȲȳȺⱥȻȼȽƚȾⱦɁɂɃƀɄʉɅʌɆɇɈɉɊɋɌɍɎɏʰhʱɦʲjʳrʴɹʵɻʶʁʷwʸyˠɣˡlˢsˣxˤʕ̀̀́́̓̓̈́̈́ͅι͏ͰͱͲͳʹʹͶͷͿϳΆά··ΈέΉήΊίΌόΎύΏώΑαΒβΓγΔδΕεΖζΗηΘθΙιΚκΛλΜμΝνΞξΟοΠπΡρΣσΤτΥυΦφΧχΨψΩωΪϊΫϋϏϗϐβϑθϒυϓύϔϋϕφϖπϘϙϚϛϜϝϞϟϠϡϢϣϤϥϦϧϨϩϪϫϬϭϮϯϰκϱρϲσϴθϵεϷϸϹσϺϻϽͻϾͼϿͽЀѐЁёЂђЃѓЄєЅѕІіЇїЈјЉљЊњЋћЌќЍѝЎўЏџАаБбВвГгДдЕеЖжЗзИиЙйКкЛлМмНнОоПпРрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯяѠѡѢѣѤѥѦѧѨѩѪѫѬѭѮѯѰѱѲѳѴѵѶѷѸѹѺѻѼѽѾѿҀҁҊҋҌҍҎҏҐґҒғҔҕҖҗҘҙҚқҜҝҞҟҠҡҢңҤҥҦҧҨҩҪҫҬҭҮүҰұҲҳҴҵҶҷҸҹҺһҼҽҾҿӁӂӃӄӅӆӇӈӉӊӋӌӍӎӐӑӒӓӔӕӖӗӘәӚӛӜӝӞӟӠӡӢӣӤӥӦӧӨөӪӫӬӭӮӯӰӱӲӳӴӵӶӷӸӹӺӻӼӽӾӿԀԁԂԃԄԅԆԇԈԉԊԋԌԍԎԏԐԑԒԓԔԕԖԗԘԙԚԛԜԝԞԟԠԡԢԣԤԥԦԧԨԩԪԫԬԭԮԯԱաԲբԳգԴդԵեԶզԷէԸըԹթԺժԻիԼլԽխԾծԿկՀհՁձՂղՃճՄմՅյՆնՇշՈոՉչՊպՋջՌռՍսՎվՏտՐրՑցՒւՓփՔքՕօՖֆևեւٵاٴٶوٴٷۇٴٸيٴक़क़ख़ख़ग़ग़ज़ज़ड़ड़ढ़ढ़फ़फ़य़य़ড়ড়ঢ়ঢ়য়য়ਲ਼ਲ਼ਸ਼ਸ਼ਖ਼ਖ਼ਗ਼ਗ਼ਜ਼ਜ਼ਫ਼ਫ਼ଡ଼ଡ଼ଢ଼ଢ଼ำําຳໍາໜຫນໝຫມ༌་གྷགྷཌྷཌྷདྷདྷབྷབྷཛྷཛྷཀྵཀྵཱཱཱཱིིུུྲྀྲྀཷྲཱྀླྀླྀཹླཱཱཱྀྀྀྒྷྒྷྜྷྜྷྡྷྡྷྦྷྦྷྫྷྫྷྐྵྐྵჇⴧჍⴭჼნᏸᏰᏹᏱᏺᏲᏻᏳᏼᏴᏽᏵ᠋᠌᠍ᲀвᲁдᲂоᲃсᲄтᲅтᲆъᲇѣᲈꙋᴬaᴭæᴮbᴰdᴱeᴲǝᴳgᴴhᴵiᴶjᴷkᴸlᴹmᴺnᴼoᴽȣᴾpᴿrᵀtᵁuᵂwᵃaᵄɐᵅɑᵆᴂᵇbᵈdᵉeᵊəᵋɛᵌɜᵍgᵏkᵐmᵑŋᵒoᵓɔᵔᴖᵕᴗᵖpᵗtᵘuᵙᴝᵚɯᵛvᵜᴥᵝβᵞγᵟδᵠφᵡχᵢiᵣrᵤuᵥvᵦβᵧγᵨρᵩφᵪχᵸнᶛɒᶜcᶝɕᶞðᶟɜᶠfᶡɟᶢɡᶣɥᶤɨᶥɩᶦɪᶧᵻᶨʝᶩɭᶪᶅᶫʟᶬɱᶭɰᶮɲᶯɳᶰɴᶱɵᶲɸᶳʂᶴʃᶵƫᶶʉᶷʊᶸᴜᶹʋᶺʌᶻzᶼʐᶽʑᶾʒᶿθḀḁḂḃḄḅḆḇḈḉḊḋḌḍḎḏḐḑḒḓḔḕḖḗḘḙḚḛḜḝḞḟḠḡḢḣḤḥḦḧḨḩḪḫḬḭḮḯḰḱḲḳḴḵḶḷḸḹḺḻḼḽḾḿṀṁṂṃṄṅṆṇṈṉṊṋṌṍṎṏṐṑṒṓṔṕṖṗṘṙṚṛṜṝṞṟṠṡṢṣṤṥṦṧṨṩṪṫṬṭṮṯṰṱṲṳṴṵṶṷṸṹṺṻṼṽṾṿẀẁẂẃẄẅẆẇẈẉẊẋẌẍẎẏẐẑẒẓẔẕẚaʾẛṡẞssẠạẢảẤấẦầẨẩẪẫẬậẮắẰằẲẳẴẵẶặẸẹẺẻẼẽẾếỀềỂểỄễỆệỈỉỊịỌọỎỏỐốỒồỔổỖỗỘộỚớỜờỞởỠỡỢợỤụỦủỨứỪừỬửỮữỰựỲỳỴỵỶỷỸỹỺỻỼỽỾỿἈἀἉἁἊἂἋἃἌἄἍἅἎἆἏἇἘἐἙἑἚἒἛἓἜἔἝἕἨἠἩἡἪἢἫἣἬἤἭἥἮἦἯἧἸἰἹἱἺἲἻἳἼἴἽἵἾἶἿἷὈὀὉὁὊὂὋὃὌὄὍὅὙὑὛὓὝὕὟὗὨὠὩὡὪὢὫὣὬὤὭὥὮὦὯὧάάέέήήίίόόύύώώᾀἀιᾁἁιᾂἂιᾃἃιᾄἄιᾅἅιᾆἆιᾇἇιᾈἀιᾉἁιᾊἂιᾋἃιᾌἄιᾍἅιᾎἆιᾏἇιᾐἠιᾑἡιᾒἢιᾓἣιᾔἤιᾕἥιᾖἦιᾗἧιᾘἠιᾙἡιᾚἢιᾛἣιᾜἤιᾝἥιᾞἦιᾟἧιᾠὠιᾡὡιᾢὢιᾣὣιᾤὤιᾥὥιᾦὦιᾧὧιᾨὠιᾩὡιᾪὢιᾫὣιᾬὤιᾭὥιᾮὦιᾯὧιᾲὰιᾳαιᾴάιᾷᾶιᾸᾰᾹᾱᾺὰΆάᾼαιιιῂὴιῃηιῄήιῇῆιῈὲΈέῊὴΉήῌηιΐΐῘῐῙῑῚὶΊίΰΰῨῠῩῡῪὺΎύῬῥῲὼιῳωιῴώιῷῶιῸὸΌόῺὼΏώῼωι​‑‐″′′‴′′′‶‵‵‷‵‵‵⁗′′′′⁠⁤⁰0ⁱi⁴4⁵5⁶6⁷7⁸8⁹9⁻−ⁿn₀0₁1₂2₃3₄4₅5₆6₇7₈8₉9₋−ₐaₑeₒoₓxₔəₕhₖkₗlₘmₙnₚpₛsₜt₨rsℂc℃°cℇɛ℉°fℊgℋhℌhℍhℎhℏħℐiℑiℒlℓlℕn№noℙpℚqℛrℜrℝr℠sm℡tel™tmℤzΩωℨzKkÅåℬbℭcℯeℰeℱfℳmℴoℵאℶבℷגℸדℹi℻faxℼπℽγℾγℿπ⅀∑ⅅdⅆdⅇeⅈiⅉj⅐1⁄7⅑1⁄9⅒1⁄10⅓1⁄3⅔2⁄3⅕1⁄5⅖2⁄5⅗3⁄5⅘4⁄5⅙1⁄6⅚5⁄6⅛1⁄8⅜3⁄8⅝5⁄8⅞7⁄8⅟1⁄ⅠiⅡiiⅢiiiⅣivⅤvⅥviⅦviiⅧviiiⅨixⅩxⅪxiⅫxiiⅬlⅭcⅮdⅯmⅰiⅱiiⅲiiiⅳivⅴvⅵviⅶviiⅷviiiⅸixⅹxⅺxiⅻxiiⅼlⅽcⅾdⅿm↉0⁄3∬∫∫∭∫∫∫∯∮∮∰∮∮∮〈〈〉〉①1②2③3④4⑤5⑥6⑦7⑧8⑨9⑩10⑪11⑫12⑬13⑭14⑮15⑯16⑰17⑱18⑲19⑳20ⒶaⒷbⒸcⒹdⒺeⒻfⒼgⒽhⒾiⒿjⓀkⓁlⓂmⓃnⓄoⓅpⓆqⓇrⓈsⓉtⓊuⓋvⓌwⓍxⓎyⓏzⓐaⓑbⓒcⓓdⓔeⓕfⓖgⓗhⓘiⓙjⓚkⓛlⓜmⓝnⓞoⓟpⓠqⓡrⓢsⓣtⓤuⓥvⓦwⓧxⓨyⓩz⓪0⨌∫∫∫∫⫝̸⫝̸ⰀⰰⰁⰱⰂⰲⰃⰳⰄⰴⰅⰵⰆⰶⰇⰷⰈⰸⰉⰹⰊⰺⰋⰻⰌⰼⰍⰽⰎⰾⰏⰿⰐⱀⰑⱁⰒⱂⰓⱃⰔⱄⰕⱅⰖⱆⰗⱇⰘⱈⰙⱉⰚⱊⰛⱋⰜⱌⰝⱍⰞⱎⰟⱏⰠⱐⰡⱑⰢⱒⰣⱓⰤⱔⰥⱕⰦⱖⰧⱗⰨⱘⰩⱙⰪⱚⰫⱛⰬⱜⰭⱝⰮⱞⱠⱡⱢɫⱣᵽⱤɽⱧⱨⱩⱪⱫⱬⱭɑⱮɱⱯɐⱰɒⱲⱳⱵⱶⱼjⱽvⱾȿⱿɀⲀⲁⲂⲃⲄⲅⲆⲇⲈⲉⲊⲋⲌⲍⲎⲏⲐⲑⲒⲓⲔⲕⲖⲗⲘⲙⲚⲛⲜⲝⲞⲟⲠⲡⲢⲣⲤⲥⲦⲧⲨⲩⲪⲫⲬⲭⲮⲯⲰⲱⲲⲳⲴⲵⲶⲷⲸⲹⲺⲻⲼⲽⲾⲿⳀⳁⳂⳃⳄⳅⳆⳇⳈⳉⳊⳋⳌⳍⳎⳏⳐⳑⳒⳓⳔⳕⳖⳗⳘⳙⳚⳛⳜⳝⳞⳟⳠⳡⳢⳣⳫⳬⳭⳮⳲⳳⵯⵡ⺟母⻳龟⼀一⼁丨⼂丶⼃丿⼄乙⼅亅⼆二⼇亠⼈人⼉儿⼊入⼋八⼌冂⼍冖⼎冫⼏几⼐凵⼑刀⼒力⼓勹⼔匕⼕匚⼖匸⼗十⼘卜⼙卩⼚厂⼛厶⼜又⼝口⼞囗⼟土⼠士⼡夂⼢夊⼣夕⼤大⼥女⼦子⼧宀⼨寸⼩小⼪尢⼫尸⼬屮⼭山⼮巛⼯工⼰己⼱巾⼲干⼳幺⼴广⼵廴⼶廾⼷弋⼸弓⼹彐⼺彡⼻彳⼼心⼽戈⼾戶⼿手⽀支⽁攴⽂文⽃斗⽄斤⽅方⽆无⽇日⽈曰⽉月⽊木⽋欠⽌止⽍歹⽎殳⽏毋⽐比⽑毛⽒氏⽓气⽔水⽕火⽖爪⽗父⽘爻⽙爿⽚片⽛牙⽜牛⽝犬⽞玄⽟玉⽠瓜⽡瓦⽢甘⽣生⽤用⽥田⽦疋⽧疒⽨癶⽩白⽪皮⽫皿⽬目⽭矛⽮矢⽯石⽰示⽱禸⽲禾⽳穴⽴立⽵竹⽶米⽷糸⽸缶⽹网⽺羊⽻羽⽼老⽽而⽾耒⽿耳⾀聿⾁肉⾂臣⾃自⾄至⾅臼⾆舌⾇舛⾈舟⾉艮⾊色⾋艸⾌虍⾍虫⾎血⾏行⾐衣⾑襾⾒見⾓角⾔言⾕谷⾖豆⾗豕⾘豸⾙貝⾚赤⾛走⾜足⾝身⾞車⾟辛⾠辰⾡辵⾢邑⾣酉⾤釆⾥里⾦金⾧長⾨門⾩阜⾪隶⾫隹⾬雨⾭靑⾮非⾯面⾰革⾱韋⾲韭⾳音⾴頁⾵風⾶飛⾷食⾸首⾹香⾺馬⾻骨⾼高⾽髟⾾鬥⾿鬯⿀鬲⿁鬼⿂魚⿃鳥⿄鹵⿅鹿⿆麥⿇麻⿈黃⿉黍⿊黑⿋黹⿌黽⿍鼎⿎鼓⿏鼠⿐鼻⿑齊⿒齒⿓龍⿔龜⿕龠。.〶〒〸十〹卄〺卅ゟよりヿコトㄱᄀㄲᄁㄳᆪㄴᄂㄵᆬㄶᆭㄷᄃㄸᄄㄹᄅㄺᆰㄻᆱㄼᆲㄽᆳㄾᆴㄿᆵㅀᄚㅁᄆㅂᄇㅃᄈㅄᄡㅅᄉㅆᄊㅇᄋㅈᄌㅉᄍㅊᄎㅋᄏㅌᄐㅍᄑㅎᄒㅏᅡㅐᅢㅑᅣㅒᅤㅓᅥㅔᅦㅕᅧㅖᅨㅗᅩㅘᅪㅙᅫㅚᅬㅛᅭㅜᅮㅝᅯㅞᅰㅟᅱㅠᅲㅡᅳㅢᅴㅣᅵㅥᄔㅦᄕㅧᇇㅨᇈㅩᇌㅪᇎㅫᇓㅬᇗㅭᇙㅮᄜㅯᇝㅰᇟㅱᄝㅲᄞㅳᄠㅴᄢㅵᄣㅶᄧㅷᄩㅸᄫㅹᄬㅺᄭㅻᄮㅼᄯㅽᄲㅾᄶㅿᅀㆀᅇㆁᅌㆂᇱㆃᇲㆄᅗㆅᅘㆆᅙㆇᆄㆈᆅㆉᆈㆊᆑㆋᆒㆌᆔㆍᆞㆎᆡ㆒一㆓二㆔三㆕四㆖上㆗中㆘下㆙甲㆚乙㆛丙㆜丁㆝天㆞地㆟人㉄問㉅幼㉆文㉇箏㉐pte㉑21㉒22㉓23㉔24㉕25㉖26㉗27㉘28㉙29㉚30㉛31㉜32㉝33㉞34㉟35㉠ᄀ㉡ᄂ㉢ᄃ㉣ᄅ㉤ᄆ㉥ᄇ㉦ᄉ㉧ᄋ㉨ᄌ㉩ᄎ㉪ᄏ㉫ᄐ㉬ᄑ㉭ᄒ㉮가㉯나㉰다㉱라㉲마㉳바㉴사㉵아㉶자㉷차㉸카㉹타㉺파㉻하㉼참고㉽주의㉾우㊀一㊁二㊂三㊃四㊄五㊅六㊆七㊇八㊈九㊉十㊊月㊋火㊌水㊍木㊎金㊏土㊐日㊑株㊒有㊓社㊔名㊕特㊖財㊗祝㊘労㊙秘㊚男㊛女㊜適㊝優㊞印㊟注㊠項㊡休㊢写㊣正㊤上㊥中㊦下㊧左㊨右㊩医㊪宗㊫学㊬監㊭企㊮資㊯協㊰夜㊱36㊲37㊳38㊴39㊵40㊶41㊷42㊸43㊹44㊺45㊻46㊼47㊽48㊾49㊿50㋀1月㋁2月㋂3月㋃4月㋄5月㋅6月㋆7月㋇8月㋈9月㋉10月㋊11月㋋12月㋌hg㋍erg㋎ev㋏ltd㋐ア㋑イ㋒ウ㋓エ㋔オ㋕カ㋖キ㋗ク㋘ケ㋙コ㋚サ㋛シ㋜ス㋝セ㋞ソ㋟タ㋠チ㋡ツ㋢テ㋣ト㋤ナ㋥ニ㋦ヌ㋧ネ㋨ノ㋩ハ㋪ヒ㋫フ㋬ヘ㋭ホ㋮マ㋯ミ㋰ム㋱メ㋲モ㋳ヤ㋴ユ㋵ヨ㋶ラ㋷リ㋸ル㋹レ㋺ロ㋻ワ㋼ヰ㋽ヱ㋾ヲ㌀アパート㌁アルファ㌂アンペア㌃アール㌄イニング㌅インチ㌆ウォン㌇エスクード㌈エーカー㌉オンス㌊オーム㌋カイリ㌌カラット㌍カロリー㌎ガロン㌏ガンマ㌐ギガ㌑ギニー㌒キュリー㌓ギルダー㌔キロ㌕キログラム㌖キロメートル㌗キロワット㌘グラム㌙グラムトン㌚クルゼイロ㌛クローネ㌜ケース㌝コルナ㌞コーポ㌟サイクル㌠サンチーム㌡シリング㌢センチ㌣セント㌤ダース㌥デシ㌦ドル㌧トン㌨ナノ㌩ノット㌪ハイツ㌫パーセント㌬パーツ㌭バーレル㌮ピアストル㌯ピクル㌰ピコ㌱ビル㌲ファラッド㌳フィート㌴ブッシェル㌵フラン㌶ヘクタール㌷ペソ㌸ペニヒ㌹ヘルツ㌺ペンス㌻ページ㌼ベータ㌽ポイント㌾ボルト㌿ホン㍀ポンド㍁ホール㍂ホーン㍃マイクロ㍄マイル㍅マッハ㍆マルク㍇マンション㍈ミクロン㍉ミリ㍊ミリバール㍋メガ㍌メガトン㍍メートル㍎ヤード㍏ヤール㍐ユアン㍑リットル㍒リラ㍓ルピー㍔ルーブル㍕レム㍖レントゲン㍗ワット㍘0点㍙1点㍚2点㍛3点㍜4点㍝5点㍞6点㍟7点㍠8点㍡9点㍢10点㍣11点㍤12点㍥13点㍦14点㍧15点㍨16点㍩17点㍪18点㍫19点㍬20点㍭21点㍮22点㍯23点㍰24点㍱hpa㍲da㍳au㍴bar㍵ov㍶pc㍷dm㍸dm2㍹dm3㍺iu㍻平成㍼昭和㍽大正㍾明治㍿株式会社㎀pa㎁na㎂μa㎃ma㎄ka㎅kb㎆mb㎇gb㎈cal㎉kcal㎊pf㎋nf㎌μf㎍μg㎎mg㎏kg㎐hz㎑khz㎒mhz㎓ghz㎔thz㎕μl㎖ml㎗dl㎘kl㎙fm㎚nm㎛μm㎜mm㎝cm㎞km㎟mm2㎠cm2㎡m2㎢km2㎣mm3㎤cm3㎥m3㎦km3㎧m∕s㎨m∕s2㎩pa㎪kpa㎫mpa㎬gpa㎭rad㎮rad∕s㎯rad∕s2㎰ps㎱ns㎲μs㎳ms㎴pv㎵nv㎶μv㎷mv㎸kv㎹mv㎺pw㎻nw㎼μw㎽mw㎾kw㎿mw㏀kω㏁mω㏃bq㏄cc㏅cd㏆c∕kg㏈db㏉gy㏊ha㏋hp㏌in㏍kk㏎km㏏kt㏐lm㏑ln㏒log㏓lx㏔mb㏕mil㏖mol㏗ph㏙ppm㏚pr㏛sr㏜sv㏝wb㏞v∕m㏟a∕m㏠1日㏡2日㏢3日㏣4日㏤5日㏥6日㏦7日㏧8日㏨9日㏩10日㏪11日㏫12日㏬13日㏭14日㏮15日㏯16日㏰17日㏱18日㏲19日㏳20日㏴21日㏵22日㏶23日㏷24日㏸25日㏹26日㏺27日㏻28日㏼29日㏽30日㏾31日㏿galꙀꙁꙂꙃꙄꙅꙆꙇꙈꙉꙊꙋꙌꙍꙎꙏꙐꙑꙒꙓꙔꙕꙖꙗꙘꙙꙚꙛꙜꙝꙞꙟꙠꙡꙢꙣꙤꙥꙦꙧꙨꙩꙪꙫꙬꙭꚀꚁꚂꚃꚄꚅꚆꚇꚈꚉꚊꚋꚌꚍꚎꚏꚐꚑꚒꚓꚔꚕꚖꚗꚘꚙꚚꚛꚜъꚝьꜢꜣꜤꜥꜦꜧꜨꜩꜪꜫꜬꜭꜮꜯꜲꜳꜴꜵꜶꜷꜸꜹꜺꜻꜼꜽꜾꜿꝀꝁꝂꝃꝄꝅꝆꝇꝈꝉꝊꝋꝌꝍꝎꝏꝐꝑꝒꝓꝔꝕꝖꝗꝘꝙꝚꝛꝜꝝꝞꝟꝠꝡꝢꝣꝤꝥꝦꝧꝨꝩꝪꝫꝬꝭꝮꝯꝰꝯꝹꝺꝻꝼꝽᵹꝾꝿꞀꞁꞂꞃꞄꞅꞆꞇꞋꞌꞍɥꞐꞑꞒꞓꞖꞗꞘꞙꞚꞛꞜꞝꞞꞟꞠꞡꞢꞣꞤꞥꞦꞧꞨꞩꞪɦꞫɜꞬɡꞭɬꞮɪꞰʞꞱʇꞲʝꞳꭓꞴꞵꞶꞷꟸħꟹœꭜꜧꭝꬷꭞɫꭟꭒꭰᎠꭱᎡꭲᎢꭳᎣꭴᎤꭵᎥꭶᎦꭷᎧꭸᎨꭹᎩꭺᎪꭻᎫꭼᎬꭽᎭꭾᎮꭿᎯꮀᎰꮁᎱꮂᎲꮃᎳꮄᎴꮅᎵꮆᎶꮇᎷꮈᎸꮉᎹꮊᎺꮋᎻꮌᎼꮍᎽꮎᎾꮏᎿꮐᏀꮑᏁꮒᏂꮓᏃꮔᏄꮕᏅꮖᏆꮗᏇꮘᏈꮙᏉꮚᏊꮛᏋꮜᏌꮝᏍꮞᏎꮟᏏꮠᏐꮡᏑꮢᏒꮣᏓꮤᏔꮥᏕꮦᏖꮧᏗꮨᏘꮩᏙꮪᏚꮫᏛꮬᏜꮭᏝꮮᏞꮯᏟꮰᏠꮱᏡꮲᏢꮳᏣꮴᏤꮵᏥꮶᏦꮷᏧꮸᏨꮹᏩꮺᏪꮻᏫꮼᏬꮽᏭꮾᏮꮿᏯ豈豈更更車車賈賈滑滑串串句句龜龜龜龜契契金金喇喇奈奈懶懶癩癩羅羅蘿蘿螺螺裸裸邏邏樂樂洛洛烙烙珞珞落落酪酪駱駱亂亂卵卵欄欄爛爛蘭蘭鸞鸞嵐嵐濫濫藍藍襤襤拉拉臘臘蠟蠟廊廊朗朗浪浪狼狼郎郎來來冷冷勞勞擄擄櫓櫓爐爐盧盧老老蘆蘆虜虜路路露露魯魯鷺鷺碌碌祿祿綠綠菉菉錄錄鹿鹿論論壟壟弄弄籠籠聾聾牢牢磊磊賂賂雷雷壘壘屢屢樓樓淚淚漏漏累累縷縷陋陋勒勒肋肋凜凜凌凌稜稜綾綾菱菱陵陵讀讀拏拏樂樂諾諾丹丹寧寧怒怒率率異異北北磻磻便便復復不不泌泌數數索索參參塞塞省省葉葉說說殺殺辰辰沈沈拾拾若若掠掠略略亮亮兩兩凉凉梁梁糧糧良良諒諒量量勵勵呂呂女女廬廬旅旅濾濾礪礪閭閭驪驪麗麗黎黎力力曆曆歷歷轢轢年年憐憐戀戀撚撚漣漣煉煉璉璉秊秊練練聯聯輦輦蓮蓮連連鍊鍊列列劣劣咽咽烈烈裂裂說說廉廉念念捻捻殮殮簾簾獵獵令令囹囹寧寧嶺嶺怜怜玲玲瑩瑩羚羚聆聆鈴鈴零零靈靈領領例例禮禮醴醴隸隸惡惡了了僚僚寮寮尿尿料料樂樂燎燎療療蓼蓼遼遼龍龍暈暈阮阮劉劉杻杻柳柳流流溜溜琉琉留留硫硫紐紐類類六六戮戮陸陸倫倫崙崙淪淪輪輪律律慄慄栗栗率率隆隆利利吏吏履履易易李李梨梨泥泥理理痢痢罹罹裏裏裡裡里里離離匿匿溺溺吝吝燐燐璘璘藺藺隣隣鱗鱗麟麟林林淋淋臨臨立立笠笠粒粒狀狀炙炙識識什什茶茶刺刺切切度度拓拓糖糖宅宅洞洞暴暴輻輻行行降降見見廓廓兀兀嗀嗀塚塚晴晴凞凞猪猪益益礼礼神神祥祥福福靖靖精精羽羽蘒蘒諸諸逸逸都都飯飯飼飼館館鶴鶴郞郞隷隷侮侮僧僧免免勉勉勤勤卑卑喝喝嘆嘆器器塀塀墨墨層層屮屮悔悔慨慨憎憎懲懲敏敏既既暑暑梅梅海海渚渚漢漢煮煮爫爫琢琢碑碑社社祉祉祈祈祐祐祖祖祝祝禍禍禎禎穀穀突突節節練練縉縉繁繁署署者者臭臭艹艹艹艹著著褐褐視視謁謁謹謹賓賓贈贈辶辶逸逸難難響響頻頻恵恵𤋮𤋮舘舘並並况况全全侀侀充充冀冀勇勇勺勺喝喝啕啕喙喙嗢嗢塚塚墳墳奄奄奔奔婢婢嬨嬨廒廒廙廙彩彩徭徭惘惘慎慎愈愈憎憎慠慠懲懲戴戴揄揄搜搜摒摒敖敖晴晴朗朗望望杖杖歹歹殺殺流流滛滛滋滋漢漢瀞瀞煮煮瞧瞧爵爵犯犯猪猪瑱瑱甆甆画画瘝瘝瘟瘟益益盛盛直直睊睊着着磌磌窱窱節節类类絛絛練練缾缾者者荒荒華華蝹蝹襁襁覆覆視視調調諸諸請請謁謁諾諾諭諭謹謹變變贈贈輸輸遲遲醙醙鉶鉶陼陼難難靖靖韛韛響響頋頋頻頻鬒鬒龜龜𢡊𢡊𢡄𢡄𣏕𣏕㮝㮝䀘䀘䀹䀹𥉉𥉉𥳐𥳐𧻓𧻓齃齃龎龎fffffififlflffiffifflfflſtstststﬓմնﬔմեﬕմիﬖվնﬗմխיִיִײַײַﬠעﬡאﬢדﬣהﬤכﬥלﬦםﬧרﬨתשׁשׁשׂשׂשּׁשּׁשּׂשּׂאַאַאָאָאּאּבּבּגּגּדּדּהּהּוּוּזּזּטּטּיּיּךּךּכּכּלּלּמּמּנּנּסּסּףּףּפּפּצּצּקּקּרּרּשּשּתּתּוֹוֹבֿבֿכֿכֿפֿפֿﭏאלﭐٱﭑٱﭒٻﭓٻﭔٻﭕٻﭖپﭗپﭘپﭙپﭚڀﭛڀﭜڀﭝڀﭞٺﭟٺﭠٺﭡٺﭢٿﭣٿﭤٿﭥٿﭦٹﭧٹﭨٹﭩٹﭪڤﭫڤﭬڤﭭڤﭮڦﭯڦﭰڦﭱڦﭲڄﭳڄﭴڄﭵڄﭶڃﭷڃﭸڃﭹڃﭺچﭻچﭼچﭽچﭾڇﭿڇﮀڇﮁڇﮂڍﮃڍﮄڌﮅڌﮆڎﮇڎﮈڈﮉڈﮊژﮋژﮌڑﮍڑﮎکﮏکﮐکﮑکﮒگﮓگﮔگﮕگﮖڳﮗڳﮘڳﮙڳﮚڱﮛڱﮜڱﮝڱﮞںﮟںﮠڻﮡڻﮢڻﮣڻﮤۀﮥۀﮦہﮧہﮨہﮩہﮪھﮫھﮬھﮭھﮮےﮯےﮰۓﮱۓﯓڭﯔڭﯕڭﯖڭﯗۇﯘۇﯙۆﯚۆﯛۈﯜۈﯝۇٴﯞۋﯟۋﯠۅﯡۅﯢۉﯣۉﯤېﯥېﯦېﯧېﯨىﯩىﯪئاﯫئاﯬئەﯭئەﯮئوﯯئوﯰئۇﯱئۇﯲئۆﯳئۆﯴئۈﯵئۈﯶئېﯷئېﯸئېﯹئىﯺئىﯻئىﯼیﯽیﯾیﯿیﰀئجﰁئحﰂئمﰃئىﰄئيﰅبجﰆبحﰇبخﰈبمﰉبىﰊبيﰋتجﰌتحﰍتخﰎتمﰏتىﰐتيﰑثجﰒثمﰓثىﰔثيﰕجحﰖجمﰗحجﰘحمﰙخجﰚخحﰛخمﰜسجﰝسحﰞسخﰟسمﰠصحﰡصمﰢضجﰣضحﰤضخﰥضمﰦطحﰧطمﰨظمﰩعجﰪعمﰫغجﰬغمﰭفجﰮفحﰯفخﰰفمﰱفىﰲفيﰳقحﰴقمﰵقىﰶقيﰷكاﰸكجﰹكحﰺكخﰻكلﰼكمﰽكىﰾكيﰿلجﱀلحﱁلخﱂلمﱃلىﱄليﱅمجﱆمحﱇمخﱈممﱉمىﱊميﱋنجﱌنحﱍنخﱎنمﱏنىﱐنيﱑهجﱒهمﱓهىﱔهيﱕيجﱖيحﱗيخﱘيمﱙيىﱚييﱛذٰﱜرٰﱝىٰﱤئرﱥئزﱦئمﱧئنﱨئىﱩئيﱪبرﱫبزﱬبمﱭبنﱮبىﱯبيﱰترﱱتزﱲتمﱳتنﱴتىﱵتيﱶثرﱷثزﱸثمﱹثنﱺثىﱻثيﱼفىﱽفيﱾقىﱿقيﲀكاﲁكلﲂكمﲃكىﲄكيﲅلمﲆلىﲇليﲈماﲉممﲊنرﲋنزﲌنمﲍننﲎنىﲏنيﲐىٰﲑيرﲒيزﲓيمﲔينﲕيىﲖييﲗئجﲘئحﲙئخﲚئمﲛئهﲜبجﲝبحﲞبخﲟبمﲠبهﲡتجﲢتحﲣتخﲤتمﲥتهﲦثمﲧجحﲨجمﲩحجﲪحمﲫخجﲬخمﲭسجﲮسحﲯسخﲰسمﲱصحﲲصخﲳصمﲴضجﲵضحﲶضخﲷضمﲸطحﲹظمﲺعجﲻعمﲼغجﲽغمﲾفجﲿفحﳀفخﳁفمﳂقحﳃقمﳄكجﳅكحﳆكخﳇكلﳈكمﳉلجﳊلحﳋلخﳌلمﳍلهﳎمجﳏمحﳐمخﳑممﳒنجﳓنحﳔنخﳕنمﳖنهﳗهجﳘهمﳙهٰﳚيجﳛيحﳜيخﳝيمﳞيهﳟئمﳠئهﳡبمﳢبهﳣتمﳤتهﳥثمﳦثهﳧسمﳨسهﳩشمﳪشهﳫكلﳬكمﳭلمﳮنمﳯنهﳰيمﳱيهﳲـَّﳳـُّﳴـِّﳵطىﳶطيﳷعىﳸعيﳹغىﳺغيﳻسىﳼسيﳽشىﳾشيﳿحىﴀحيﴁجىﴂجيﴃخىﴄخيﴅصىﴆصيﴇضىﴈضيﴉشجﴊشحﴋشخﴌشمﴍشرﴎسرﴏصرﴐضرﴑطىﴒطيﴓعىﴔعيﴕغىﴖغيﴗسىﴘسيﴙشىﴚشيﴛحىﴜحيﴝجىﴞجيﴟخىﴠخيﴡصىﴢصيﴣضىﴤضيﴥشجﴦشحﴧشخﴨشمﴩشرﴪسرﴫصرﴬضرﴭشجﴮشحﴯشخﴰشمﴱسهﴲشهﴳطمﴴسجﴵسحﴶسخﴷشجﴸشحﴹشخﴺطمﴻظمﴼاًﴽاًﵐتجمﵑتحجﵒتحجﵓتحمﵔتخمﵕتمجﵖتمحﵗتمخﵘجمحﵙجمحﵚحميﵛحمىﵜسحجﵝسجحﵞسجىﵟسمحﵠسمحﵡسمجﵢسممﵣسممﵤصححﵥصححﵦصممﵧشحمﵨشحمﵩشجيﵪشمخﵫشمخﵬشممﵭشممﵮضحىﵯضخمﵰضخمﵱطمحﵲطمحﵳطممﵴطميﵵعجمﵶعممﵷعممﵸعمىﵹغممﵺغميﵻغمىﵼفخمﵽفخمﵾقمحﵿقممﶀلحمﶁلحيﶂلحىﶃلججﶄلججﶅلخمﶆلخمﶇلمحﶈلمحﶉمحجﶊمحمﶋمحيﶌمجحﶍمجمﶎمخجﶏمخمﶒمجخﶓهمجﶔهممﶕنحمﶖنحىﶗنجمﶘنجمﶙنجىﶚنميﶛنمىﶜيممﶝيممﶞبخيﶟتجيﶠتجىﶡتخيﶢتخىﶣتميﶤتمىﶥجميﶦجحىﶧجمىﶨسخىﶩصحيﶪشحيﶫضحيﶬلجيﶭلميﶮيحيﶯيجيﶰيميﶱمميﶲقميﶳنحيﶴقمحﶵلحمﶶعميﶷكميﶸنجحﶹمخيﶺلجمﶻكممﶼلجمﶽنجحﶾجحيﶿحجيﷀمجيﷁفميﷂبحيﷃكممﷄعجمﷅصممﷆسخيﷇنجيﷰصلےﷱقلےﷲاللهﷳاكبرﷴمحمدﷵصلعمﷶرسولﷷعليهﷸوسلمﷹصلى﷼ریال︀︁︂︃︄︅︆︇︈︉︊︋︌︍︎️︑、︗〖︘〗︱—︲–︹〔︺〕︻【︼】︽《︾》︿〈﹀〉﹁「﹂」﹃『﹄』﹑、﹘—﹝〔﹞〕﹣-ﹱـًﹷـَﹹـُﹻـِﹽـّﹿـْﺀءﺁآﺂآﺃأﺄأﺅؤﺆؤﺇإﺈإﺉئﺊئﺋئﺌئﺍاﺎاﺏبﺐبﺑبﺒبﺓةﺔةﺕتﺖتﺗتﺘتﺙثﺚثﺛثﺜثﺝجﺞجﺟجﺠجﺡحﺢحﺣحﺤحﺥخﺦخﺧخﺨخﺩدﺪدﺫذﺬذﺭرﺮرﺯزﺰزﺱسﺲسﺳسﺴسﺵشﺶشﺷشﺸشﺹصﺺصﺻصﺼصﺽضﺾضﺿضﻀضﻁطﻂطﻃطﻄطﻅظﻆظﻇظﻈظﻉعﻊعﻋعﻌعﻍغﻎغﻏغﻐغﻑفﻒفﻓفﻔفﻕقﻖقﻗقﻘقﻙكﻚكﻛكﻜكﻝلﻞلﻟلﻠلﻡمﻢمﻣمﻤمﻥنﻦنﻧنﻨنﻩهﻪهﻫهﻬهﻭوﻮوﻯىﻰىﻱيﻲيﻳيﻴيﻵلآﻶلآﻷلأﻸلأﻹلإﻺلإﻻلاﻼلا－-．.０0１1２2３3４4５5６6７7８8９9ＡaＢbＣcＤdＥeＦfＧgＨhＩiＪjＫkＬlＭmＮnＯoＰpＱqＲrＳsＴtＵuＶvＷwＸxＹyＺzａaｂbｃcｄdｅeｆfｇgｈhｉiｊjｋkｌlｍmｎnｏoｐpｑqｒrｓsｔtｕuｖvｗwｘxｙyｚz｟⦅｠⦆｡.｢「｣」､、･・ｦヲｧァｨィｩゥｪェｫォｬャｭュｮョｯッｰーｱアｲイｳウｴエｵオｶカｷキｸクｹケｺコｻサｼシｽスｾセｿソﾀタﾁチﾂツﾃテﾄトﾅナﾆニﾇヌﾈネﾉノﾊハﾋヒﾌフﾍヘﾎホﾏマﾐミﾑムﾒメﾓモﾔヤﾕユﾖヨﾗラﾘリﾙルﾚレﾛロﾜワﾝンﾞ゙ﾟ゚ﾡᄀﾢᄁﾣᆪﾤᄂﾥᆬﾦᆭﾧᄃﾨᄄﾩᄅﾪᆰﾫᆱﾬᆲﾭᆳﾮᆴﾯᆵﾰᄚﾱᄆﾲᄇﾳᄈﾴᄡﾵᄉﾶᄊﾷᄋﾸᄌﾹᄍﾺᄎﾻᄏﾼᄐﾽᄑﾾᄒￂᅡￃᅢￄᅣￅᅤￆᅥￇᅦￊᅧￋᅨￌᅩￍᅪￎᅫￏᅬￒᅭￓᅮￔᅯￕᅰￖᅱￗᅲￚᅳￛᅴￜᅵ￠¢￡£￢¬￤¦￥¥￦₩￨│￩←￪↑￫→￬↓￭■￮○𐐀𐐨𐐁𐐩𐐂𐐪𐐃𐐫𐐄𐐬𐐅𐐭𐐆𐐮𐐇𐐯𐐈𐐰𐐉𐐱𐐊𐐲𐐋𐐳𐐌𐐴𐐍𐐵𐐎𐐶𐐏𐐷𐐐𐐸𐐑𐐹𐐒𐐺𐐓𐐻𐐔𐐼𐐕𐐽𐐖𐐾𐐗𐐿𐐘𐑀𐐙𐑁𐐚𐑂𐐛𐑃𐐜𐑄𐐝𐑅𐐞𐑆𐐟𐑇𐐠𐑈𐐡𐑉𐐢𐑊𐐣𐑋𐐤𐑌𐐥𐑍𐐦𐑎𐐧𐑏𐒰𐓘𐒱𐓙𐒲𐓚𐒳𐓛𐒴𐓜𐒵𐓝𐒶𐓞𐒷𐓟𐒸𐓠𐒹𐓡𐒺𐓢𐒻𐓣𐒼𐓤𐒽𐓥𐒾𐓦𐒿𐓧𐓀𐓨𐓁𐓩𐓂𐓪𐓃𐓫𐓄𐓬𐓅𐓭𐓆𐓮𐓇𐓯𐓈𐓰𐓉𐓱𐓊𐓲𐓋𐓳𐓌𐓴𐓍𐓵𐓎𐓶𐓏𐓷𐓐𐓸𐓑𐓹𐓒𐓺𐓓𐓻𐲀𐳀𐲁𐳁𐲂𐳂𐲃𐳃𐲄𐳄𐲅𐳅𐲆𐳆𐲇𐳇𐲈𐳈𐲉𐳉𐲊𐳊𐲋𐳋𐲌𐳌𐲍𐳍𐲎𐳎𐲏𐳏𐲐𐳐𐲑𐳑𐲒𐳒𐲓𐳓𐲔𐳔𐲕𐳕𐲖𐳖𐲗𐳗𐲘𐳘𐲙𐳙𐲚𐳚𐲛𐳛𐲜𐳜𐲝𐳝𐲞𐳞𐲟𐳟𐲠𐳠𐲡𐳡𐲢𐳢𐲣𐳣𐲤𐳤𐲥𐳥𐲦𐳦𐲧𐳧𐲨𐳨𐲩𐳩𐲪𐳪𐲫𐳫𐲬𐳬𐲭𐳭𐲮𐳮𐲯𐳯𐲰𐳰𐲱𐳱𐲲𐳲𑢠𑣀𑢡𑣁𑢢𑣂𑢣𑣃𑢤𑣄𑢥𑣅𑢦𑣆𑢧𑣇𑢨𑣈𑢩𑣉𑢪𑣊𑢫𑣋𑢬𑣌𑢭𑣍𑢮𑣎𑢯𑣏𑢰𑣐𑢱𑣑𑢲𑣒𑢳𑣓𑢴𑣔𑢵𑣕𑢶𑣖𑢷𑣗𑢸𑣘𑢹𑣙𑢺𑣚𑢻𑣛𑢼𑣜𑢽𑣝𑢾𑣞𑢿𑣟𛲠𛲡𛲢𛲣𝅗𝅥𝅗𝅥𝅘𝅥𝅘𝅥𝅘𝅥𝅮𝅘𝅥𝅮𝅘𝅥𝅯𝅘𝅥𝅯𝅘𝅥𝅰𝅘𝅥𝅰𝅘𝅥𝅱𝅘𝅥𝅱𝅘𝅥𝅲𝅘𝅥𝅲𝆹𝅥𝆹𝅥𝆺𝅥𝆺𝅥𝆹𝅥𝅮𝆹𝅥𝅮𝆺𝅥𝅮𝆺𝅥𝅮𝆹𝅥𝅯𝆹𝅥𝅯𝆺𝅥𝅯𝆺𝅥𝅯𝐀a𝐁b𝐂c𝐃d𝐄e𝐅f𝐆g𝐇h𝐈i𝐉j𝐊k𝐋l𝐌m𝐍n𝐎o𝐏p𝐐q𝐑r𝐒s𝐓t𝐔u𝐕v𝐖w𝐗x𝐘y𝐙z𝐚a𝐛b𝐜c𝐝d𝐞e𝐟f𝐠g𝐡h𝐢i𝐣j𝐤k𝐥l𝐦m𝐧n𝐨o𝐩p𝐪q𝐫r𝐬s𝐭t𝐮u𝐯v𝐰w𝐱x𝐲y𝐳z𝐴a𝐵b𝐶c𝐷d𝐸e𝐹f𝐺g𝐻h𝐼i𝐽j𝐾k𝐿l𝑀m𝑁n𝑂o𝑃p𝑄q𝑅r𝑆s𝑇t𝑈u𝑉v𝑊w𝑋x𝑌y𝑍z𝑎a𝑏b𝑐c𝑑d𝑒e𝑓f𝑔g𝑖i𝑗j𝑘k𝑙l𝑚m𝑛n𝑜o𝑝p𝑞q𝑟r𝑠s𝑡t𝑢u𝑣v𝑤w𝑥x𝑦y𝑧z𝑨a𝑩b𝑪c𝑫d𝑬e𝑭f𝑮g𝑯h𝑰i𝑱j𝑲k𝑳l𝑴m𝑵n𝑶o𝑷p𝑸q𝑹r𝑺s𝑻t𝑼u𝑽v𝑾w𝑿x𝒀y𝒁z𝒂a𝒃b𝒄c𝒅d𝒆e𝒇f𝒈g𝒉h𝒊i𝒋j𝒌k𝒍l𝒎m𝒏n𝒐o𝒑p𝒒q𝒓r𝒔s𝒕t𝒖u𝒗v𝒘w𝒙x𝒚y𝒛z𝒜a𝒞c𝒟d𝒢g𝒥j𝒦k𝒩n𝒪o𝒫p𝒬q𝒮s𝒯t𝒰u𝒱v𝒲w𝒳x𝒴y𝒵z𝒶a𝒷b𝒸c𝒹d𝒻f𝒽h𝒾i𝒿j𝓀k𝓁l𝓂m𝓃n𝓅p𝓆q𝓇r𝓈s𝓉t𝓊u𝓋v𝓌w𝓍x𝓎y𝓏z𝓐a𝓑b𝓒c𝓓d𝓔e𝓕f𝓖g𝓗h𝓘i𝓙j𝓚k𝓛l𝓜m𝓝n𝓞o𝓟p𝓠q𝓡r𝓢s𝓣t𝓤u𝓥v𝓦w𝓧x𝓨y𝓩z𝓪a𝓫b𝓬c𝓭d𝓮e𝓯f𝓰g𝓱h𝓲i𝓳j𝓴k𝓵l𝓶m𝓷n𝓸o𝓹p𝓺q𝓻r𝓼s𝓽t𝓾u𝓿v𝔀w𝔁x𝔂y𝔃z𝔄a𝔅b𝔇d𝔈e𝔉f𝔊g𝔍j𝔎k𝔏l𝔐m𝔑n𝔒o𝔓p𝔔q𝔖s𝔗t𝔘u𝔙v𝔚w𝔛x𝔜y𝔞a𝔟b𝔠c𝔡d𝔢e𝔣f𝔤g𝔥h𝔦i𝔧j𝔨k𝔩l𝔪m𝔫n𝔬o𝔭p𝔮q𝔯r𝔰s𝔱t𝔲u𝔳v𝔴w𝔵x𝔶y𝔷z𝔸a𝔹b𝔻d𝔼e𝔽f𝔾g𝕀i𝕁j𝕂k𝕃l𝕄m𝕆o𝕊s𝕋t𝕌u𝕍v𝕎w𝕏x𝕐y𝕒a𝕓b𝕔c𝕕d𝕖e𝕗f𝕘g𝕙h𝕚i𝕛j𝕜k𝕝l𝕞m𝕟n𝕠o𝕡p𝕢q𝕣r𝕤s𝕥t𝕦u𝕧v𝕨w𝕩x𝕪y𝕫z𝕬a𝕭b𝕮c𝕯d𝕰e𝕱f𝕲g𝕳h𝕴i𝕵j𝕶k𝕷l𝕸m𝕹n𝕺o𝕻p𝕼q𝕽r𝕾s𝕿t𝖀u𝖁v𝖂w𝖃x𝖄y𝖅z𝖆a𝖇b𝖈c𝖉d𝖊e𝖋f𝖌g𝖍h𝖎i𝖏j𝖐k𝖑l𝖒m𝖓n𝖔o𝖕p𝖖q𝖗r𝖘s𝖙t𝖚u𝖛v𝖜w𝖝x𝖞y𝖟z𝖠a𝖡b𝖢c𝖣d𝖤e𝖥f𝖦g𝖧h𝖨i𝖩j𝖪k𝖫l𝖬m𝖭n𝖮o𝖯p𝖰q𝖱r𝖲s𝖳t𝖴u𝖵v𝖶w𝖷x𝖸y𝖹z𝖺a𝖻b𝖼c𝖽d𝖾e𝖿f𝗀g𝗁h𝗂i𝗃j𝗄k𝗅l𝗆m𝗇n𝗈o𝗉p𝗊q𝗋r𝗌s𝗍t𝗎u𝗏v𝗐w𝗑x𝗒y𝗓z𝗔a𝗕b𝗖c𝗗d𝗘e𝗙f𝗚g𝗛h𝗜i𝗝j𝗞k𝗟l𝗠m𝗡n𝗢o𝗣p𝗤q𝗥r𝗦s𝗧t𝗨u𝗩v𝗪w𝗫x𝗬y𝗭z𝗮a𝗯b𝗰c𝗱d𝗲e𝗳f𝗴g𝗵h𝗶i𝗷j𝗸k𝗹l𝗺m𝗻n𝗼o𝗽p𝗾q𝗿r𝘀s𝘁t𝘂u𝘃v𝘄w𝘅x𝘆y𝘇z𝘈a𝘉b𝘊c𝘋d𝘌e𝘍f𝘎g𝘏h𝘐i𝘑j𝘒k𝘓l𝘔m𝘕n𝘖o𝘗p𝘘q𝘙r𝘚s𝘛t𝘜u𝘝v𝘞w𝘟x𝘠y𝘡z𝘢a𝘣b𝘤c𝘥d𝘦e𝘧f𝘨g𝘩h𝘪i𝘫j𝘬k𝘭l𝘮m𝘯n𝘰o𝘱p𝘲q𝘳r𝘴s𝘵t𝘶u𝘷v𝘸w𝘹x𝘺y𝘻z𝘼a𝘽b𝘾c𝘿d𝙀e𝙁f𝙂g𝙃h𝙄i𝙅j𝙆k𝙇l𝙈m𝙉n𝙊o𝙋p𝙌q𝙍r𝙎s𝙏t𝙐u𝙑v𝙒w𝙓x𝙔y𝙕z𝙖a𝙗b𝙘c𝙙d𝙚e𝙛f𝙜g𝙝h𝙞i𝙟j𝙠k𝙡l𝙢m𝙣n𝙤o𝙥p𝙦q𝙧r𝙨s𝙩t𝙪u𝙫v𝙬w𝙭x𝙮y𝙯z𝙰a𝙱b𝙲c𝙳d𝙴e𝙵f𝙶g𝙷h𝙸i𝙹j𝙺k𝙻l𝙼m𝙽n𝙾o𝙿p𝚀q𝚁r𝚂s𝚃t𝚄u𝚅v𝚆w𝚇x𝚈y𝚉z𝚊a𝚋b𝚌c𝚍d𝚎e𝚏f𝚐g𝚑h𝚒i𝚓j𝚔k𝚕l𝚖m𝚗n𝚘o𝚙p𝚚q𝚛r𝚜s𝚝t𝚞u𝚟v𝚠w𝚡x𝚢y𝚣z𝚤ı𝚥ȷ𝚨α𝚩β𝚪γ𝚫δ𝚬ε𝚭ζ𝚮η𝚯θ𝚰ι𝚱κ𝚲λ𝚳μ𝚴ν𝚵ξ𝚶ο𝚷π𝚸ρ𝚹θ𝚺σ𝚻τ𝚼υ𝚽φ𝚾χ𝚿ψ𝛀ω𝛁∇𝛂α𝛃β𝛄γ𝛅δ𝛆ε𝛇ζ𝛈η𝛉θ𝛊ι𝛋κ𝛌λ𝛍μ𝛎ν𝛏ξ𝛐ο𝛑π𝛒ρ𝛓σ𝛔σ𝛕τ𝛖υ𝛗φ𝛘χ𝛙ψ𝛚ω𝛛∂𝛜ε𝛝θ𝛞κ𝛟φ𝛠ρ𝛡π𝛢α𝛣β𝛤γ𝛥δ𝛦ε𝛧ζ𝛨η𝛩θ𝛪ι𝛫κ𝛬λ𝛭μ𝛮ν𝛯ξ𝛰ο𝛱π𝛲ρ𝛳θ𝛴σ𝛵τ𝛶υ𝛷φ𝛸χ𝛹ψ𝛺ω𝛻∇𝛼α𝛽β𝛾γ𝛿δ𝜀ε𝜁ζ𝜂η𝜃θ𝜄ι𝜅κ𝜆λ𝜇μ𝜈ν𝜉ξ𝜊ο𝜋π𝜌ρ𝜍σ𝜎σ𝜏τ𝜐υ𝜑φ𝜒χ𝜓ψ𝜔ω𝜕∂𝜖ε𝜗θ𝜘κ𝜙φ𝜚ρ𝜛π𝜜α𝜝β𝜞γ𝜟δ𝜠ε𝜡ζ𝜢η𝜣θ𝜤ι𝜥κ𝜦λ𝜧μ𝜨ν𝜩ξ𝜪ο𝜫π𝜬ρ𝜭θ𝜮σ𝜯τ𝜰υ𝜱φ𝜲χ𝜳ψ𝜴ω𝜵∇𝜶α𝜷β𝜸γ𝜹δ𝜺ε𝜻ζ𝜼η𝜽θ𝜾ι𝜿κ𝝀λ𝝁μ𝝂ν𝝃ξ𝝄ο𝝅π𝝆ρ𝝇σ𝝈σ𝝉τ𝝊υ𝝋φ𝝌χ𝝍ψ𝝎ω𝝏∂𝝐ε𝝑θ𝝒κ𝝓φ𝝔ρ𝝕π𝝖α𝝗β𝝘γ𝝙δ𝝚ε𝝛ζ𝝜η𝝝θ𝝞ι𝝟κ𝝠λ𝝡μ𝝢ν𝝣ξ𝝤ο𝝥π𝝦ρ𝝧θ𝝨σ𝝩τ𝝪υ𝝫φ𝝬χ𝝭ψ𝝮ω𝝯∇𝝰α𝝱β𝝲γ𝝳δ𝝴ε𝝵ζ𝝶η𝝷θ𝝸ι𝝹κ𝝺λ𝝻μ𝝼ν𝝽ξ𝝾ο𝝿π𝞀ρ𝞁σ𝞂σ𝞃τ𝞄υ𝞅φ𝞆χ𝞇ψ𝞈ω𝞉∂𝞊ε𝞋θ𝞌κ𝞍φ𝞎ρ𝞏π𝞐α𝞑β𝞒γ𝞓δ𝞔ε𝞕ζ𝞖η𝞗θ𝞘ι𝞙κ𝞚λ𝞛μ𝞜ν𝞝ξ𝞞ο𝞟π𝞠ρ𝞡θ𝞢σ𝞣τ𝞤υ𝞥φ𝞦χ𝞧ψ𝞨ω𝞩∇𝞪α𝞫β𝞬γ𝞭δ𝞮ε𝞯ζ𝞰η𝞱θ𝞲ι𝞳κ𝞴λ𝞵μ𝞶ν𝞷ξ𝞸ο𝞹π𝞺ρ𝞻σ𝞼σ𝞽τ𝞾υ𝞿φ𝟀χ𝟁ψ𝟂ω𝟃∂𝟄ε𝟅θ𝟆κ𝟇φ𝟈ρ𝟉π𝟊ϝ𝟋ϝ𝟎0𝟏1𝟐2𝟑3𝟒4𝟓5𝟔6𝟕7𝟖8𝟗9𝟘0𝟙1𝟚2𝟛3𝟜4𝟝5𝟞6𝟟7𝟠8𝟡9𝟢0𝟣1𝟤2𝟥3𝟦4𝟧5𝟨6𝟩7𝟪8𝟫9𝟬0𝟭1𝟮2𝟯3𝟰4𝟱5𝟲6𝟳7𝟴8𝟵9𝟶0𝟷1𝟸2𝟹3𝟺4𝟻5𝟼6𝟽7𝟾8𝟿9𞤀𞤢𞤁𞤣𞤂𞤤𞤃𞤥𞤄𞤦𞤅𞤧𞤆𞤨𞤇𞤩𞤈𞤪𞤉𞤫𞤊𞤬𞤋𞤭𞤌𞤮𞤍𞤯𞤎𞤰𞤏𞤱𞤐𞤲𞤑𞤳𞤒𞤴𞤓𞤵𞤔𞤶𞤕𞤷𞤖𞤸𞤗𞤹𞤘𞤺𞤙𞤻𞤚𞤼𞤛𞤽𞤜𞤾𞤝𞤿𞤞𞥀𞤟𞥁𞤠𞥂𞤡𞥃𞸀ا𞸁ب𞸂ج𞸃د𞸅و𞸆ز𞸇ح𞸈ط𞸉ي𞸊ك𞸋ل𞸌م𞸍ن𞸎س𞸏ع𞸐ف𞸑ص𞸒ق𞸓ر𞸔ش𞸕ت𞸖ث𞸗خ𞸘ذ𞸙ض𞸚ظ𞸛غ𞸜ٮ𞸝ں𞸞ڡ𞸟ٯ𞸡ب𞸢ج𞸤ه𞸧ح𞸩ي𞸪ك𞸫ل𞸬م𞸭ن𞸮س𞸯ع𞸰ف𞸱ص𞸲ق𞸴ش𞸵ت𞸶ث𞸷خ𞸹ض𞸻غ𞹂ج𞹇ح𞹉ي𞹋ل𞹍ن𞹎س𞹏ع𞹑ص𞹒ق𞹔ش𞹗خ𞹙ض𞹛غ𞹝ں𞹟ٯ𞹡ب𞹢ج𞹤ه𞹧ح𞹨ط𞹩ي𞹪ك𞹬م𞹭ن𞹮س𞹯ع𞹰ف𞹱ص𞹲ق𞹴ش𞹵ت𞹶ث𞹷خ𞹹ض𞹺ظ𞹻غ𞹼ٮ𞹾ڡ𞺀ا𞺁ب𞺂ج𞺃د𞺄ه𞺅و𞺆ز𞺇ح𞺈ط𞺉ي𞺋ل𞺌م𞺍ن𞺎س𞺏ع𞺐ف𞺑ص𞺒ق𞺓ر𞺔ش𞺕ت𞺖ث𞺗خ𞺘ذ𞺙ض𞺚ظ𞺛غ𞺡ب𞺢ج𞺣د𞺥و𞺦ز𞺧ح𞺨ط𞺩ي𞺫ل𞺬م𞺭ن𞺮س𞺯ع𞺰ف𞺱ص𞺲ق𞺳ر𞺴ش𞺵ت𞺶ث𞺷خ𞺸ذ𞺹ض𞺺ظ𞺻غ🄪〔s〕🄫c🄬r🄭cd🄮wz🄰a🄱b🄲c🄳d🄴e🄵f🄶g🄷h🄸i🄹j🄺k🄻l🄼m🄽n🄾o🄿p🅀q🅁r🅂s🅃t🅄u🅅v🅆w🅇x🅈y🅉z🅊hv🅋mv🅌sd🅍ss🅎ppv🅏wc🅪mc🅫md🆐dj🈀ほか🈁ココ🈂サ🈐手🈑字🈒双🈓デ🈔二🈕多🈖解🈗天🈘交🈙映🈚無🈛料🈜前🈝後🈞再🈟新🈠初🈡終🈢生🈣販🈤声🈥吹🈦演🈧投🈨捕🈩一🈪三🈫遊🈬左🈭中🈮右🈯指🈰走🈱打🈲禁🈳空🈴合🈵満🈶有🈷月🈸申🈹割🈺営🈻配🉀〔本〕🉁〔三〕🉂〔二〕🉃〔安〕🉄〔点〕🉅〔打〕🉆〔盗〕🉇〔勝〕🉈〔敗〕🉐得🉑可丽丽丸丸乁乁𠄢𠄢你你侮侮侻侻倂倂偺偺備備僧僧像像㒞㒞𠘺𠘺免免兔兔兤兤具具𠔜𠔜㒹㒹內內再再𠕋𠕋冗冗冤冤仌仌冬冬况况𩇟𩇟凵凵刃刃㓟㓟刻刻剆剆割割剷剷㔕㔕勇勇勉勉勤勤勺勺包包匆匆北北卉卉卑卑博博即即卽卽卿卿卿卿卿卿𠨬𠨬灰灰及及叟叟𠭣𠭣叫叫叱叱吆吆咞咞吸吸呈呈周周咢咢哶哶唐唐啓啓啣啣善善善善喙喙喫喫喳喳嗂嗂圖圖嘆嘆圗圗噑噑噴噴切切壮壮城城埴埴堍堍型型堲堲報報墬墬𡓤𡓤売売壷壷夆夆多多夢夢奢奢𡚨𡚨𡛪𡛪姬姬娛娛娧娧姘姘婦婦㛮㛮嬈嬈嬾嬾嬾嬾𡧈𡧈寃寃寘寘寧寧寳寳𡬘𡬘寿寿将将尢尢㞁㞁屠屠屮屮峀峀岍岍𡷤𡷤嵃嵃𡷦𡷦嵮嵮嵫嵫嵼嵼巡巡巢巢㠯㠯巽巽帨帨帽帽幩幩㡢㡢𢆃𢆃㡼㡼庰庰庳庳庶庶廊廊𪎒𪎒廾廾𢌱𢌱𢌱𢌱舁舁弢弢弢弢㣇㣇𣊸𣊸𦇚𦇚形形彫彫㣣㣣徚徚忍忍志志忹忹悁悁㤺㤺㤜㤜悔悔𢛔𢛔惇惇慈慈慌慌慎慎慌慌慺慺憎憎憲憲憤憤憯憯懞懞懲懲懶懶成成戛戛扝扝抱抱拔拔捐捐𢬌𢬌挽挽拼拼捨捨掃掃揤揤𢯱𢯱搢搢揅揅掩掩㨮㨮摩摩摾摾撝撝摷摷㩬㩬敏敏敬敬𣀊𣀊旣旣書書晉晉㬙㬙暑暑㬈㬈㫤㫤冒冒冕冕最最暜暜肭肭䏙䏙朗朗望望朡朡杞杞杓杓𣏃𣏃㭉㭉柺柺枅枅桒桒梅梅𣑭𣑭梎梎栟栟椔椔㮝㮝楂楂榣榣槪槪檨檨𣚣𣚣櫛櫛㰘㰘次次𣢧𣢧歔歔㱎㱎歲歲殟殟殺殺殻殻𣪍𣪍𡴋𡴋𣫺𣫺汎汎𣲼𣲼沿沿泍泍汧汧洖洖派派海海流流浩浩浸浸涅涅𣴞𣴞洴洴港港湮湮㴳㴳滋滋滇滇𣻑𣻑淹淹潮潮𣽞𣽞𣾎𣾎濆濆瀹瀹瀞瀞瀛瀛㶖㶖灊灊災災灷灷炭炭𠔥𠔥煅煅𤉣𤉣熜熜爨爨爵爵牐牐𤘈𤘈犀犀犕犕𤜵𤜵𤠔𤠔獺獺王王㺬㺬玥玥㺸㺸㺸㺸瑇瑇瑜瑜瑱瑱璅璅瓊瓊㼛㼛甤甤𤰶𤰶甾甾𤲒𤲒異異𢆟𢆟瘐瘐𤾡𤾡𤾸𤾸𥁄𥁄㿼㿼䀈䀈直直𥃳𥃳𥃲𥃲𥄙𥄙𥄳𥄳眞眞真真真真睊睊䀹䀹瞋瞋䁆䁆䂖䂖𥐝𥐝硎硎碌碌磌磌䃣䃣𥘦𥘦祖祖𥚚𥚚𥛅𥛅福福秫秫䄯䄯穀穀穊穊穏穏𥥼𥥼𥪧𥪧𥪧𥪧䈂䈂𥮫𥮫篆篆築築䈧䈧𥲀𥲀糒糒䊠䊠糨糨糣糣紀紀𥾆𥾆絣絣䌁䌁緇緇縂縂繅繅䌴䌴𦈨𦈨𦉇𦉇䍙䍙𦋙𦋙罺罺𦌾𦌾羕羕翺翺者者𦓚𦓚𦔣𦔣聠聠𦖨𦖨聰聰𣍟𣍟䏕䏕育育脃脃䐋䐋脾脾媵媵𦞧𦞧𦞵𦞵𣎓𣎓𣎜𣎜舁舁舄舄辞辞䑫䑫芑芑芋芋芝芝劳劳花花芳芳芽芽苦苦𦬼𦬼若若茝茝荣荣莭莭茣茣莽莽菧菧著著荓荓菊菊菌菌菜菜𦰶𦰶𦵫𦵫𦳕𦳕䔫䔫蓱蓱蓳蓳蔖蔖𧏊𧏊蕤蕤𦼬𦼬䕝䕝䕡䕡𦾱𦾱𧃒𧃒䕫䕫虐虐虜虜虧虧虩虩蚩蚩蚈蚈蜎蜎蛢蛢蝹蝹蜨蜨蝫蝫螆螆蟡蟡蠁蠁䗹䗹衠衠衣衣𧙧𧙧裗裗裞裞䘵䘵裺裺㒻㒻𧢮𧢮𧥦𧥦䚾䚾䛇䛇誠誠諭諭變變豕豕𧲨𧲨貫貫賁賁贛贛起起𧼯𧼯𠠄𠠄跋跋趼趼跰跰𠣞𠣞軔軔輸輸𨗒𨗒𨗭𨗭邔邔郱郱鄑鄑𨜮𨜮鄛鄛鈸鈸鋗鋗鋘鋘鉼鉼鏹鏹鐕鐕𨯺𨯺開開䦕䦕閷閷𨵷𨵷䧦䧦雃雃嶲嶲霣霣𩅅𩅅𩈚𩈚䩮䩮䩶䩶韠韠𩐊𩐊䪲䪲𩒖𩒖頋頋頋頋頩頩𩖶𩖶飢飢䬳䬳餩餩馧馧駂駂駾駾䯎䯎𩬰𩬰鬒鬒鱀鱀鳽鳽䳎䳎䳭䳭鵧鵧𪃎𪃎䳸䳸𪄅𪄅𪈎𪈎𪊑𪊑麻麻䵖䵖黹黹黾黾鼅鼅鼏鼏鼖鼖鼻鼻𪘀𪘀󠄀󠄁󠄂󠄃󠄄󠄅󠄆󠄇󠄈󠄉󠄊󠄋󠄌󠄍󠄎󠄏󠄐󠄑󠄒󠄓󠄔󠄕󠄖󠄗󠄘󠄙󠄚󠄛󠄜󠄝󠄞󠄟󠄠󠄡󠄢󠄣󠄤󠄥󠄦󠄧󠄨󠄩󠄪󠄫󠄬󠄭󠄮󠄯󠄰󠄱󠄲󠄳󠄴󠄵󠄶󠄷󠄸󠄹󠄺󠄻󠄼󠄽󠄾󠄿󠅀󠅁󠅂󠅃󠅄󠅅󠅆󠅇󠅈󠅉󠅊󠅋󠅌󠅍󠅎󠅏󠅐󠅑󠅒󠅓󠅔󠅕󠅖󠅗󠅘󠅙󠅚󠅛󠅜󠅝󠅞󠅟󠅠󠅡󠅢󠅣󠅤󠅥󠅦󠅧󠅨󠅩󠅪󠅫󠅬󠅭󠅮󠅯󠅰󠅱󠅲󠅳󠅴󠅵󠅶󠅷󠅸󠅹󠅺󠅻󠅼󠅽󠅾󠅿󠆀󠆁󠆂󠆃󠆄󠆅󠆆󠆇󠆈󠆉󠆊󠆋󠆌󠆍󠆎󠆏󠆐󠆑󠆒󠆓󠆔󠆕󠆖󠆗󠆘󠆙󠆚󠆛󠆜󠆝󠆞󠆟󠆠󠆡󠆢󠆣󠆤󠆥󠆦󠆧󠆨󠆩󠆪󠆫󠆬󠆭󠆮󠆯󠆰󠆱󠆲󠆳󠆴󠆵󠆶󠆷󠆸󠆹󠆺󠆻󠆼󠆽󠆾󠆿󠇀󠇁󠇂󠇃󠇄󠇅󠇆󠇇󠇈󠇉󠇊󠇋󠇌󠇍󠇎󠇏󠇐󠇑󠇒󠇓󠇔󠇕󠇖󠇗󠇘󠇙󠇚󠇛󠇜󠇝󠇞󠇟󠇠󠇡󠇢󠇣󠇤󠇥󠇦󠇧󠇨󠇩󠇪󠇫󠇬󠇭󠇮󠇯; $uts46_valid = q`ZÈUTT)1$N*-Q@U!8HTժ??O?y%Ӈ9?;9===`=`@/_%;_?{{======? ????@?곪??UC@@0}'B O??b {f???׺???~~~??@ `???????7o????9+????????????; 1; AnyEvent-7.17/lib/AnyEvent/Util/idna.pl0000644000000000000000000000573211737215626016404 0ustar rootroot# based on RFC 3492 use AnyEvent (); BEGIN { AnyEvent::common_sense } use Carp (); use List::Util (); use integer; sub pyc_base () { 36 } sub pyc_tmin () { 1 } sub pyc_tmax () { 26 } sub pyc_initial_bias () { 72 } sub pyc_initial_n () { 128 } sub pyc_digits () { "abcdefghijklmnopqrstuvwxyz0123456789" } sub pyc_adapt($$$) { my ($delta, $numpoints, $firsttime) = @_; $delta = $firsttime ? $delta / 700 : $delta >> 1; $delta += $delta / $numpoints; my $k; while ($delta > (pyc_base - pyc_tmin) * pyc_tmax / 2) { $delta /= pyc_base - pyc_tmin; $k += pyc_base; } $k + $delta * (pyc_base - pyc_tmin + 1) / ($delta + 38) } sub punycode_encode($) { my ($input) = @_; my ($n, $bias, $delta) = (pyc_initial_n, pyc_initial_bias); (my $output = $input) =~ y/\x00-\x7f//cd; my $h = my $b = length $output; my @input = split '', $input; $output .= "-" if $b && $h < @input; while ($h < @input) { my $m = List::Util::min grep { $_ >= $n } map ord, @input; $m - $n <= (0x7fffffff - $delta) / ($h + 1) or Carp::croak "punycode_encode: overflow in punycode delta encoding"; $delta += ($m - $n) * ($h + 1); $n = $m; for my $i (@input) { my $c = ord $i; ++$delta < 0x7fffffff or Carp::croak "punycode_encode: overflow in punycode delta encoding" if $c < $n; if ($c == $n) { my ($q, $k) = ($delta, pyc_base); while () { my $t = List::Util::min pyc_tmax, List::Util::max pyc_tmin, $k - $bias; last if $q < $t; $output .= substr pyc_digits, $t + (($q - $t) % (pyc_base - $t)), 1; $q = ($q - $t) / (pyc_base - $t); $k += pyc_base; } $output .= substr pyc_digits, $q, 1; $bias = pyc_adapt $delta, $h + 1, $h == $b; $delta = 0; ++$h; } } ++$delta; ++$n; } $output } sub punycode_decode($) { my ($input) = @_; my ($n, $bias, $i) = (pyc_initial_n, pyc_initial_bias); my $output; if ($input =~ /^(.*?)-([^-]*)$/x) { $output = $1; $input = $2; $output =~ /[^\x00-\x7f]/ and Carp::croak "punycode_decode: malformed punycode"; } while (length $input) { my $oldi = $i; my $w = 1; for (my $k = pyc_base; ; $k += pyc_base) { (my $digit = index pyc_digits, substr $input, 0, 1, "") >= 0 or Carp::croak "punycode_decode: malformed punycode"; $i += $digit * $w; my $t = List::Util::max pyc_tmin, List::Util::min pyc_tmax, $k - $bias; last if $digit < $t; $w *= pyc_base - $t; } my $outlen = 1 + length $output; $bias = pyc_adapt $i - $oldi, $outlen, $oldi == 0; $n += $i / $outlen; $i %= $outlen; substr $output, $i, 0, chr $n; ++$i; } $output } 1 AnyEvent-7.17/lib/AnyEvent/Impl/0000755000000000000000000000000013540302027015073 5ustar rootrootAnyEvent-7.17/lib/AnyEvent/Impl/EV.pm0000644000000000000000000000370511740210771015754 0ustar rootroot=head1 NAME AnyEvent::Impl::EV - AnyEvent adaptor for EV =head1 SYNOPSIS use AnyEvent; use EV; # this module gets loaded automatically as required =head1 DESCRIPTION This module provides transparent support for AnyEvent. You don't have to do anything to make EV work with AnyEvent except by loading EV before creating the first AnyEvent watcher. EV is the fastest event library for perl, and best supported by AnyEvent. Most functions from the L API are implemented as direct aliases to EV functions, so using EV via AE is as fast as using EV directly. =cut package AnyEvent::Impl::EV; use AnyEvent (); BEGIN { AnyEvent::common_sense } use EV 4.00; *AE::time = \&EV::time; *AE::now = \&EV::now; *AE::now_update = \&EV::now_update; *AE::timer = \&EV::timer; *AE::signal = \&EV::signal; *AE::idle = \&EV::idle; # cannot override directly, as EV doesn't allow arguments sub time { EV::time } sub now { EV::now } sub now_update { EV::now_update } *AE::io = defined &EV::_ae_io # 3.8+, but keep just in case it is dropped ? \&EV::_ae_io : sub($$$) { EV::io $_[0], $_[1] ? EV::WRITE : EV::READ, $_[2] }; sub timer { my ($class, %arg) = @_; EV::timer $arg{after}, $arg{interval}, $arg{cb} } sub io { my ($class, %arg) = @_; EV::io $arg{fh}, $arg{poll} eq "r" ? EV::READ : EV::WRITE, $arg{cb} } sub signal { my ($class, %arg) = @_; EV::signal $arg{signal}, $arg{cb} } sub child { my ($class, %arg) = @_; my $cb = $arg{cb}; EV::child $arg{pid}, 0, sub { $cb->($_[0]->rpid, $_[0]->rstatus); } } sub idle { my ($class, %arg) = @_; EV::idle $arg{cb} } sub _poll { EV::run EV::RUN_ONCE; } sub AnyEvent::CondVar::Base::_wait { EV::run EV::RUN_ONCE until exists $_[0]{_ae_sent}; } #sub loop { # EV::run; #} =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/Tk.pm0000644000000000000000000001062112176042343016015 0ustar rootroot=head1 NAME AnyEvent::Impl::Tk - AnyEvent adaptor for Tk =head1 SYNOPSIS use AnyEvent; use Tk; # this module gets loaded automatically as required =head1 DESCRIPTION This module provides transparent support for AnyEvent. You don't have to do anything to make Tk work with AnyEvent except by loading Tk before creating the first AnyEvent watcher. Tk is buggy. Tk is extremely buggy. Tk is so unbelievably buggy that for each bug reported and fixed, you get one new bug followed by reintroduction of the old bug in a later revision. It is also basically unmaintained: the maintainers are not even interested in improving the situation - reporting bugs is considered rude, and fixing bugs is considered changing holy code, so it's apparently better to leave it broken. I regularly run out of words to describe how bad it really is. To work around some of the many, many bugs in Tk that don't get fixed, this adaptor dup()'s all filehandles that get passed into its I/O watchers, so if you register a read and a write watcher for one fh, AnyEvent will create two additional file descriptors (and handles). This creates a high overhead and is slow, but seems to work around most known bugs in L on 32 bit architectures (Tk seems to be terminally broken on 64 bit, do not expect more than 10 or so watchers to work on 64 bit machines). Do not expect these workarounds to avoid segfaults and crashes inside Tk. Note also that Tk event ids wrap around after 2**32 or so events, which on my machine can happen within less than 12 hours, after which Tk will stomp on random other events and kill them. So don't run Tk programs for more than an hour or so. To be able to access the Tk event loop, this module creates a main window and withdraws it immediately. This might cause flickering on some platforms, but Tk perversely requires a window to be able to wait for file handle readyness notifications. This window is always created (in this version of AnyEvent) and can be accessed as C<$AnyEvent::Impl::Tk::mw>. =cut package AnyEvent::Impl::Tk; use AnyEvent (); BEGIN { AnyEvent::common_sense } use Tk (); our $mw = new MainWindow -title => "AnyEvent Dummy Window"; $mw->withdraw; END { undef $mw } sub io { my (undef, %arg) = @_; # work around these bugs in Tk: # - removing a callback will destroy other callbacks # - removing a callback might crash # - adding a callback might destroy other callbacks # - only one callback per fh # - only one callback per fh/poll combination my ($fh, $tk) = AnyEvent::_dupfh $arg{poll}, $arg{fh}, "readable", "writable"; $mw->fileevent ($fh, $tk => $arg{cb}); bless [$fh, $tk], "AnyEvent::Impl::Tk::io" } sub AnyEvent::Impl::Tk::io::DESTROY { my ($fh, $tk) = @{$_[0]}; # work around another bug: watchers don't get removed when # the fh is closed, contrary to documentation. also, trying # to unregister a read callback will make it impossible # to remove the write callback. # if your program segfaults here then you need to destroy # your watchers before program exit. sorry, no way around # that. $mw->fileevent ($fh, $tk => ""); } sub timer { my (undef, %arg) = @_; my $after = $arg{after} < 0 ? 0 : $arg{after} * 1000; my $cb = $arg{cb}; my $id; if ($arg{interval}) { my $ival = $arg{interval} * 1000; my $rcb = sub { $id = Tk::after $mw, $ival, [$_[0], $_[0]]; &$cb; }; $id = Tk::after $mw, $after, [$rcb, $rcb]; } else { # tk blesses $cb, thus the extra indirection $id = Tk::after $mw, $after, sub { &$cb }; } bless \\$id, "AnyEvent::Impl::Tk::after" } sub idle { my (undef, %arg) = @_; my $cb = $arg{cb}; my $id; my $rcb = sub { # in their endless stupidity, they decided to give repeating idle watchers # strictly higher priority than timers :/ $id = Tk::after $mw, 0 => [sub { $id = Tk::after $mw, idle => [$_[0], $_[0]]; }, $_[0]]; &$cb; }; $id = Tk::after $mw, idle => [$rcb, $rcb]; bless \\$id, "AnyEvent::Impl::Tk::after" } sub AnyEvent::Impl::Tk::after::DESTROY { Tk::after $mw, cancel => $${$_[0]}; } #sub loop { # Tk::MainLoop; #} sub _poll { Tk::DoOneEvent (0); } sub AnyEvent::CondVar::Base::_wait { Tk::DoOneEvent (0) until exists $_[0]{_ae_sent}; } =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/Perl.pm0000644000000000000000000000325712207455226016353 0ustar rootroot=head1 NAME AnyEvent::Impl::Perl - AnyEvent adaptor for AnyEvent's pure perl AnyEvent::Loop =head1 SYNOPSIS use AnyEvent; use AnyEvent::Loop; # this module gets loaded automatically as required =head1 DESCRIPTION This module provides transparent support for AnyEvent in case no other event loop could be found or loaded. If you want to use this module instead of autoloading another event loop you can simply load L before creating the first watcher. Naturally, it supports all features of AnyEvent. See L for more details on performance characteristics. =cut package AnyEvent::Impl::Perl; use AnyEvent (); BEGIN { AnyEvent::common_sense } use AnyEvent::Loop; our $VERSION = $AnyEvent::VERSION; # time() is provided via AnyEvent::Base *AE::now = \&AnyEvent::Loop::now; *AE::now_update = \&AnyEvent::Loop::now_update; *AE::io = \&AnyEvent::Loop::io; *AE::timer = \&AnyEvent::Loop::timer; *AE::idle = \&AnyEvent::Loop::idle; *_poll = \&AnyEvent::Loop::one_event; *loop = \&AnyEvent::Loop::run; # compatibility with AnyEvent < 6.0 *now_update = \&AnyEvent::Loop::now_update; sub now { $AnyEvent::Loop::NOW } sub AnyEvent::CondVar::Base::_wait { AnyEvent::Loop::one_event until exists $_[0]{_ae_sent}; } sub io { my (undef, %arg) = @_; AnyEvent::Loop::io $arg{fh}, $arg{poll} eq "w", $arg{cb} } sub timer { my (undef, %arg) = @_; AnyEvent::Loop::timer $arg{after}, $arg{interval}, $arg{cb} } sub idle { my (undef, %arg) = @_; AnyEvent::Loop::idle $arg{cb} } =head1 SEE ALSO L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/POE.pm0000644000000000000000000003556711740210771016100 0ustar rootroot=head1 NAME AnyEvent::Impl::POE - AnyEvent adaptor for POE =encoding utf-8 =head1 SYNOPSIS use AnyEvent; use POE; # this module gets loaded automatically as required =head1 DESCRIPTION This module provides transparent support for AnyEvent. You don't have to do anything to make POE work with AnyEvent except by loading POE before creating the first AnyEvent watcher. There are some cases where POE will issue spurious (and non-suppressible) warnings. These can be avoided by loading AnyEvent::Impl::POE before loading any other modules using POE and AnyEvent, i.e. in your main program. AnyEvent::Impl::POE will output some spurious message how to work around POE's spurious messages when it detects these cases. Unfortunately, POE isn't generic enough to implement a fully working AnyEvent backend: POE is too badly designed, too badly documented and too badly implemented. Here are the details, and what it means to you if you want to be interoperable with POE: =over 4 =item Weird messages If you only use C (as AnyEvent has to for its condition variables), POE will print an ugly, unsuppressible, message at program exit: Sessions were started, but POE::Kernel's run() method was never... The message is correct, the question is why POE prints it in the first place in a correct program (this is not a singular case though). AnyEvent consequently patches the POE kernel so it thinks it already ran. Other workarounds, even the one cited in the POE documentation itself, have serious side effects, such as throwing away events. The author of POE verified that this is indeed true, and has no plans to change this. POE has other weird messages, and sometimes weird behaviour, for example, it doesn't support overloaded code references as callbacks for no apparent reason. =item One POE session per Event AnyEvent has to create one POE::Session per event watcher, which is immensely slow and makes watchers very large. The reason for this is lacking lifetime management (mostly undocumented, too). Without one session/watcher it is not possible to easily keep the kernel from running endlessly. This is not just a problem with the way AnyEvent has to interact with POE, but is a principal issue with POEs lifetime management (namely that stopping the kernel stops sessions, but AnyEvent has no control over who and when the kernel starts or stops w.r.t. AnyEvent watcher creation/destruction). From benchmark data it is not clear that session creation is that costly, though - the real inefficiencies with POE seem to come from other sources, such as event handling. =item One watcher per fd/event combo POE, of course, suffers from the same bug as Tk and some other badly designed event models in that it doesn't support multiple watchers per fd/poll combo. The workaround is the same as with Tk: AnyEvent::Impl::POE creates a separate file descriptor to hand to POE, which isn't fast and certainly not nice to your resources. Of course, without the workaround, POE also prints ugly messages again that say the program *might* be buggy. While this is not good to performance, at least regarding speed, with a modern Linux kernel, the overhead is actually quite small. =item Timing deficiencies POE manages to not have a function that returns the current time. This is extremely problematic, as POE can use different time functions, which can differ by more than a second - and user code is left guessing which one is used. In addition, most timer functions in POE want an absolute timestamp, which is hard to create if all you have is a relative time and no function to return the "current time". And of course POE doesn't handle time jumps at all (not even when using an event loop that happens to do that, such as L, as it does its own unoptimised timer management). AnyEvent works around the unavailability of the current time using relative timers exclusively, in the hope that POE gets it right at least internally. =item Lack of defined event ordering POE cannot guarantee the order of callback invocation for timers, and usually gets it wrong. That is, if you have two timers, one timing out after another (all else being equal), the callbacks might be called in reverse order. How one manages to even implement stuff that way escapes me. =item Child watchers POE offers child watchers - which is a laudable thing, as few event loops do. Unfortunately, they cannot even implement AnyEvent's simple child watchers: they are not generic enough (the POE implementation isn't even generic enough to let properly designed back-end use their native child watcher instead - it insist on doing it itself the broken way). Unfortunately, POE's child handling is inherently racy: if the child exits before the handler is created (because e.g. it crashes or simply is quick about it), then current versions of POE (1.352) will I invoke the child watcher, and there is nothing that can be done about it. Older versions of POE only delayed in this case. The reason is that POE first checks if the child has already exited, and I installs the signal handler - aa classical race. Your only hope is for the fork'ed process to not exit too quickly, in which case everything happens to work. Of course, whenever POE reaps an unrelated child it will also output a message for it that you cannot suppress (which shouldn't be too surprising at this point). Very professional. As a workaround, AnyEvent::Impl::POE will take advantage of undocumented behaviour in POE::Kernel to catch the status of all child processes, but it cannot guarantee delivery. How one manages to have such a glaring bug in an event loop after ten years of development escapes me. (There are more annoying bugs, for example, POE runs C unconditionally at finaliser time, so your program will hang until all child processes have exited.) =item Documentation quality At the time of this writing, POE was in its tenth year. Still, its documentation is extremely lacking, making it impossible to implement stuff as trivial as AnyEvent watchers without having to resort to undocumented behaviour or features. For example, the POE::Kernel manpage has nine occurrences of the word TODO with an explanation of whats missing. In general, the POE man pages are littered with comments like "section not yet written". Some other gems: This allows many object methods to also be package methods. This is nice, but since it doesn't document I methods these are, this is utterly useless information. Terminal signals will kill sessions if they are not handled by a "sig_handled"() call. The OS signals that usually kill or dump a process are considered terminal in POE, but they never trigger a coredump. These are: HUP, INT, QUIT and TERM. Although AnyEvent calls C, removing it has no apparent effects on POE handling SIGINT. refcount_increment SESSION_ID, COUNTER_NAME Nowhere is explained which COUNTER_NAMEs are valid and which aren't - not all scalars (or even strings) are valid counter names. Take your guess, failure is of course completely silent. I found this out the hard way, as the first name I came up with was silently ignored. get_next_event_time() returns the time the next event is due, in a form compatible with the UNIX time() function. And surely, one would hope that POE supports sub-second accuracy as documented elsewhere, unlike the explanation above implies. Yet: POE::Kernel timers support subsecond accuracy, but don’t expect too much here. Perl is not the right language for realtime programming. ... of course, Perl is not the right language to expect sub-second accuracy - the manpage author must hate Perl to spread so much FUD in so little space. The Deliantra game server logs with 100µs-accuracy because Perl is fast enough to require this, and is still able to deliver map updates with little jitter at exactly the right time. It does not, however, use POE. Furthermore, since the Kernel keeps track of everything sessions do, it knows when a session has run out of tasks to perform. This is impossible - how does the kernel know that a session is no longer watching for some (external) event (e.g. by some other session)? It cannot, and therefore this is wrong - but you would be hard pressed to find out how to work around this and tell the kernel manually about such events. It gets worse, though - the notion of "task" or "resource", although used throughout the documentation, is not defined in a usable way. For example, waiting for a timeout is considered to be a task, waiting for a signal is not (a session that only waits for a signal is considered finished and gets removed). The user is left guessing when waiting for an event counts as task and when not (in fact, the issue with signals is mentioned in passing in a section about child watchers and directly contradicts earlier parts in that document). One could go on endlessly - ten years, no usable documentation. It is likely that differences between documentation, or the one or two things I had to guess, cause unanticipated problems with this adaptor. =item Fragile and inconsistent API The POE API is extremely inconsistent - sometimes you have to pass a session argument, sometimes it gets ignored, sometimes a session-specific method must not use a session argument. Error handling is sub-standard as well: even for programming mistakes, POE does not C but, in most cases, just sets C<$!> or simply does nothing at all, leading to fragile programs. Sometimes registering a handler uses the "eventname, parameter" ordering (timeouts), sometimes it is "parameter, eventname" (signals). There is little consistency overall. =item Lack of knowledge The IO::Poll event loop provides an alternative that theoretically scales better than select(). The IO::Poll "event loop" (who in his right mind would call that an event loop) of course scales about identically (sometimes it is a bit faster, sometimes a bit slower) to select in theory, and also in practise, of course, as both are O(n) in the number of file descriptors, which is rather bad. This is just one place where it gets obvious how little the author of the POE manpage understands. =item No idle events The POE-recommended workaround to this is apparently to use C. Consequently, idle watchers will have to be emulated by AnyEvent. =item Questionable maintainer behaviour The author of POE is known to fabricate statements and post these to public mailinglists - apparently, spreading FUD about competing (in his eyes) projects or their maintainers is acceptable to him. This has (I believe) zero effects on the quality or usefulness of his code, but it does completely undermine his trustworthyness - so don't blindly believe anything he says, he might have just made it up to suit his needs (benchmark results, the names of my ten wifes, the length of my penis, etc. etc.). When in doubt, double-check - not just him, anybody actually. Example: L. I challenged him in that thread to provide evidence for his statement by giving at least two examples, but of course since he just made it up, he couldn't provide any evidence. =back On the good side, AnyEvent allows you to write your modules in a 100% POE-compatible way (bug-for-bug compatible even), without forcing your module to use POE - it is still open to better event models, of which there are plenty. Oh, and one other positive thing: RUNNING_IN_HELL POE knows about the nature of the beast! =cut package AnyEvent::Impl::POE; use AnyEvent (); BEGIN { AnyEvent::common_sense } use POE; # suppress an idiotic warning inside POE ${ POE::Kernel->new->[POE::Kernel::KR_RUN] } |= POE::Kernel::KR_RUN_CALLED; sub io { my ($class, %arg) = @_; # POE itself might do the right thing, but some POE backends don't, # so do the safe thing, it's not as if this will slow us down # any further *g* my ($fh, $pee) = AnyEvent::_dupfh $arg{poll}, $arg{fh}, "select_read", "select_write"; my $cb = delete $arg{cb}; my $cb = sub { &$cb }; # POE doesn't like callable objects my $session = POE::Session->create ( inline_states => { _start => sub { $_[KERNEL]->$pee ($fh => "ready") }, ready => sub { $cb->() }, stop => sub { $_[KERNEL]->$pee ($fh) }, }, ); bless \\$session, "AnyEvent::Impl::POE" } sub timer { my ($class, %arg) = @_; my $after = delete $arg{after}; my $ival = delete $arg{interval}; my $cb = delete $arg{cb}; my $cb = sub { &$cb }; # POE doesn't like callable objects my $session = POE::Session->create ( inline_states => { _start => sub { $_[KERNEL]->delay_set (timeout => $after); }, timeout => $ival ? sub { $_[KERNEL]->delay_set (timeout => $ival); $cb->() } : $cb, stop => sub { $_[KERNEL]->alarm_remove_all; }, }, ); bless \\$session, "AnyEvent::Impl::POE" } sub signal { my ($class, %arg) = @_; my $signal = AnyEvent::Base::sig2name delete $arg{signal}; my $cb = delete $arg{cb}; my $cb = sub { &$cb }; # POE doesn't like callable objects my $session = POE::Session->create ( inline_states => { _start => sub { # I suck - POE }, start => sub { $_[KERNEL]->sig ($signal => "catch"); $_[KERNEL]->refcount_increment ($_[SESSION]->ID => "poe"); }, catch => sub { $cb->(); $_[KERNEL]->sig_handled; }, stop => sub { $_[KERNEL]->refcount_decrement ($_[SESSION]->ID => "poe"); $_[KERNEL]->sig ($signal); }, }, ); POE::Kernel->call ($session, "start"); bless \\$session, "AnyEvent::Impl::POE" } sub child { my ($class, %arg) = @_; my $pid = delete $arg{pid}; my $cb = delete $arg{cb}; my $cb = sub { &$cb }; # POE doesn't like callable objects my $session = POE::Session->create ( inline_states => { _start => sub { # I suck - POE }, start => sub { $_[KERNEL]->sig (CHLD => "child"); $_[KERNEL]->refcount_increment ($_[SESSION]->ID => "poe"); }, child => sub { my ($rpid, $status) = @_[ARG1, ARG2]; $cb->($rpid, $status) if $rpid == $pid || $pid == 0; }, stop => sub { $_[KERNEL]->refcount_decrement ($_[SESSION]->ID => "poe"); $_[KERNEL]->sig ("CHLD"); }, }, ); # newer POE versions lose signals unless we call ->sig early. POE::Kernel->call ($session, "start"); bless \\$session, "AnyEvent::Impl::POE" } sub DESTROY { POE::Kernel->call (${${$_[0]}}, "stop"); } #sub loop { # POE::Kernel->run; #} sub _poll { POE::Kernel->loop_do_timeslice; } sub AnyEvent::CondVar::Base::_wait { POE::Kernel->loop_do_timeslice until exists $_[0]{_ae_sent}; } =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/EventLib.pm0000644000000000000000000001013511740210771017145 0ustar rootroot=head1 NAME AnyEvent::Impl::EventLib - AnyEvent adaptor for Event::Lib =head1 SYNOPSIS use AnyEvent; use Event::Lib; # this module gets loaded automatically as required =head1 DESCRIPTION This module provides transparent support for AnyEvent. You don't have to do anything to make Event work with AnyEvent except by loading Event::Lib before creating the first AnyEvent watcher. Note: the AnyEvent author has not found recent releases of Event::Lib to be even remotely working (not even the examples from the manpage or the testsuite work), so this event backend should be avoided (or somebody should step up and maintain it, hint, hint). The L module suffers from the same limitations and bugs as libevent, most notably it kills already-installed watchers on a file descriptor and it is unable to support fork. These are not fatal issues, and are worked-around by this module, but the L perl module itself has many additional bugs such as taking references to file handles and callbacks instead of making a copy or freeing still-allocated scalars, causing memory corruption and random crashes. Only Tk rivals it in its brokenness. This adaptor module employs the same workaround around the watcher problems as Tk and should therefore be avoided. (This was done for simplicity, one could in theory work around the problems with lower overhead by managing our own watchers). Event::Lib also leaks file handles and memory and tends to just exit on problems. It also doesn't work around the Windows bug of not signalling TCP connection failures. It also doesn't work with many special devices on Linux (F works, F fails, F works, F fails and so on). Event::Lib does not support idle watchers. They could be emulated using low-priority timers but as the priority range (and availability) is not queryable nor guaranteed, and the default priority is likely the lowest one, this module cannot use them. Avoid Event::Lib if you can. =cut package AnyEvent::Impl::EventLib; use AnyEvent (); BEGIN { AnyEvent::common_sense } use Event::Lib; # Event::Lib doesn't always take a reference to the callback, so closures # cause memory corruption and segfaults. it also has an issue actually # calling callbacks, so this exists as workaround. sub ccb { # Event:Lib accesses $_[0] after the callback, when it might be freed, # so we keep it referenced until after the callback. This still accesses # a freed scalar, but at least it'll not crash. my $keep_it = $_[0]; $_[2](); } my $ccb = \&ccb; sub io { my (undef, %arg) = @_; # work around these bugs in Event::Lib: # - adding a callback might destroy other callbacks # - only one callback per fd/poll combination my ($fh, $mode) = AnyEvent::_dupfh $arg{poll}, $arg{fh}, EV_READ, EV_WRITE; # event_new errornously takes a reference to fh and cb instead of making a copy # fortunately, going through %arg/_dupfh already makes a copy, so it happpens to work my $w = event_new $fh, $mode | EV_PERSIST, $ccb, $arg{cb}; event_add $w; bless \\$w, __PACKAGE__ } sub timer { my (undef, %arg) = @_; my $ival = $arg{interval}; my $cb = $arg{cb}; my $w; $w = timer_new $ccb, $ival ? sub { event_add $w, $ival; &$cb } : sub { undef $w ; &$cb }; event_add $w, $arg{after} || 1e-10; # work around 0-bug in Event::Lib bless \\$w, __PACKAGE__ } sub DESTROY { local $@; ${${$_[0]}}->remove; } sub signal { my (undef, %arg) = @_; my $w = signal_new AnyEvent::Base::sig2num $arg{signal}, $ccb, $arg{cb}; event_add $w; AnyEvent::Base::_sig_add; bless \\$w, "AnyEvent::Impl::EventLib::signal" } sub AnyEvent::Impl::EventLib::signal::DESTROY { AnyEvent::Base::_sig_del; local $@; ${${$_[0]}}->remove; } #sub loop { # event_mainloop; #} sub _poll { event_one_loop; } sub AnyEvent::CondVar::Base::_wait { event_one_loop until exists $_[0]{_ae_sent}; } =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/Cocoa.pm0000644000000000000000000000266011740210771016465 0ustar rootroot=head1 NAME AnyEvent::Impl::Cocoa - AnyEvent adaptor for Cocoa::EventLoop =head1 SYNOPSIS use AnyEvent; use Cocoa::EventLoop; # do something =head1 DESCRIPTION This module provides NSRunLoop support to AnyEvent. NSRunLoop is an event loop for Cocoa applications, wrapped by L. By using this module, you can use Cocoa based API in your AnyEvent application, or AnyEvent within Cocoa applications. It does not support blocking waits. =head1 BUGS Right now, L (and this module) are in an early development phase and has some shortcomings and likely bugs. For example, there seems to be no way to just handle a single event with Cocoa (is there nothing they can implement properly?), so this module currently wakes up at least ten times a second when waiting for events. Also, events caused by timers might get delayed by up to 0.1 seconds. =cut package AnyEvent::Impl::Cocoa; use AnyEvent (); BEGIN { AnyEvent::common_sense } use Cocoa::EventLoop; sub io { my ($class, %arg) = @_; Cocoa::EventLoop->io (%arg) } sub timer { my ($class, %arg) = @_; Cocoa::EventLoop->timer (%arg) } # does not support blocking waits #sub loop { # Cocoa::EventLoop->run; #} =head1 AUTHORS Daisuke Murase , Marc Lehmann . =head1 COPYRIGHTS Copyright (c) 2009 by KAYAC Inc. Copyright (c) 2010,2011 by Marc Lehmann =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/UV.pm0000644000000000000000000000727712377644742016024 0ustar rootroot=head1 NAME AnyEvent::Impl::UV - AnyEvent adaptor for UV =head1 SYNOPSIS use AnyEvent; use UV; # this module gets loaded automatically as required =head1 DESCRIPTION This module provides transparent support for AnyEvent. You don't have to do anything to make UV work with AnyEvent except by loading UV before creating the first AnyEvent watcher. =cut package AnyEvent::Impl::UV; use AnyEvent (); BEGIN { AnyEvent::common_sense } use UV 0.24; use Scalar::Util qw(weaken); sub warnlog { my $err = UV::last_error; AnyEvent::log warn => "returned $_[0]: " . UV::err_name ($err) . "($err): " . UV::strerror ($err); @_ } # https://github.com/joyent/libuv/issues/680 # https://github.com/joyent/libuv/blob/dc1ea27c736f0d21c7160c790bcd1b113d20abd9/include/uv.h#L1277 my %io_watchers; sub io_watcher_cb { my $slaves = shift; my (undef, $events) = @_; return unless defined $slaves; foreach my $entry (keys %$slaves) { my $slave = $slaves->{$entry}; $slave->{cb}(@_) if $slave->{mode} & $events; } } sub AnyEvent::Impl::UV::io_slave::new { bless { parent => $_[1] }, $_[0] } sub AnyEvent::Impl::UV::io_slave::DESTROY { my $self = $_[0]; my $master = $self->{parent}; delete $master->{slaves}{$self}; if (keys %{$master->{slaves}} == 0) { if (defined $master->{w}) { my $rc = UV::poll_stop $master->{w}; warnlog $rc if $rc; } delete $io_watchers{$master->{fd}}; return; } my $mode = 0; foreach my $entry (keys %{$master->{slaves}}) { $mode |= $master->{slaves}{$entry}{mode}; } if ($master->{mode} != $mode) { $master->{mode} = $mode; my $rc = UV::poll_start $master->{w}, $master->{mode}, sub { io_watcher_cb $master->{slaves}, @_; }; warnlog $rc if $rc; } } sub io { my ($class, %arg) = @_; my $fd = fileno $arg{fh}; defined $fd or $fd = $arg{fh}; my $master = $io_watchers{$fd} ||= { fd => $fd }; unless (defined $master->{w}) { $master->{w} = UV::poll_init $fd; return warnlog $master->{w} unless defined $master->{w}; $master->{slaves} = {}; } my $slave = AnyEvent::Impl::UV::io_slave->new ($master); weaken ($master->{slaves}->{$slave} = $slave); $slave->{mode} = $arg{poll} eq "r" ? UV::READABLE : UV::WRITABLE; $master->{mode} = 0 unless defined $master->{mode}; $slave->{cb} = $arg{cb}; unless ($master->{mode} & $slave->{mode}) { $master->{mode} |= $slave->{mode}; my $rc = UV::poll_start $master->{w}, $master->{mode}, sub { io_watcher_cb $master->{slaves}, @_; }; warnlog $rc if $rc; } $slave } sub AnyEvent::Impl::UV::handle::new { my ($class, $w, $start, $stop, @args) = @_; return warnlog $w unless defined $w; my $rc = $start->($w, @args); warnlog $rc if $rc; bless { w => $w, stop => $stop }, $class } sub AnyEvent::Impl::UV::handle::DESTROY { my $h = $_[0]; return unless $h->{w}; my $rc = $h->{stop}($h->{w}); warnlog $rc if $rc; UV::close $h->{w}; } sub idle { my ($class, %arg) = @_; AnyEvent::Impl::UV::handle->new ( UV::timer_init, \&UV::idle_start, \&UV::idle_stop, $arg{cb} ); } sub timer { my ($class, %arg) = @_; AnyEvent::Impl::UV::handle->new ( UV::timer_init, \&UV::timer_start, \&UV::timer_stop, $arg{after} * 1000, $arg{interval} * 1000, $arg{cb} ); } sub now { UV::now } sub _poll { UV::run UV::RUN_ONCE; } sub AnyEvent::CondVar::Base::_wait { UV::run UV::RUN_NOWAIT until exists $_[0]{_ae_sent}; } =head1 SEE ALSO L, L. =head1 AUTHOR Mike Lowell =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/Event.pm0000644000000000000000000000416211740210771016521 0ustar rootroot=head1 NAME AnyEvent::Impl::Event - AnyEvent adaptor for Event =head1 SYNOPSIS use AnyEvent; use Event; # this module gets loaded automatically as required =head1 DESCRIPTION This module provides transparent support for AnyEvent. You don't have to do anything to make Event work with AnyEvent except by loading Event before creating the first AnyEvent watcher. The event module is reasonably efficient and generally works correctly even with many watchers, except that its signal handling is inherently racy and requires the wake-up-frequently workaround. =cut package AnyEvent::Impl::Event; use AnyEvent (); BEGIN { AnyEvent::common_sense } use Event qw(unloop); # we have to import something to make Event use Time::HiRes sub io { my (undef, %arg) = @_; $arg{fd} = delete $arg{fh}; $arg{poll} .= "e" if AnyEvent::WIN32; # work around windows connect bug my $cb = $arg{cb}; $arg{cb} = sub { &$cb }; # event doesn't like callable objects bless \(Event->io (%arg)), __PACKAGE__ } sub timer { my (undef, %arg) = @_; $arg{after} = 0 if $arg{after} < 0; my $cb = $arg{cb}; $arg{cb} = sub { &$cb }; # event doesn't like callable objects bless \Event->timer (%arg, repeat => $arg{interval}), __PACKAGE__ } sub idle { my (undef, %arg) = @_; my $cb = $arg{cb}; $arg{cb} = sub { &$cb }; # event doesn't like callable objects bless \Event->idle (repeat => 1, min => 0, %arg), __PACKAGE__ } sub DESTROY { ${$_[0]}->cancel; } sub signal { my (undef, %arg) = @_; my $cb = $arg{cb}; my $w = Event->signal ( signal => AnyEvent::Base::sig2name $arg{signal}, cb => sub { &$cb }, # event doesn't like callable objects ); AnyEvent::Base::_sig_add; bless \$w, "AnyEvent::Impl::Event::signal" } sub AnyEvent::Impl::Event::signal::DESTROY { AnyEvent::Base::_sig_del; ${$_[0]}->cancel; } sub _poll { Event::one_event; } sub AnyEvent::CondVar::Base::_wait { Event::one_event until exists $_[0]{_ae_sent}; } #sub loop { # Event::loop; #} =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/IOAsync.pm0000644000000000000000000001644612251671453016763 0ustar rootroot=head1 NAME AnyEvent::Impl::IOAsync - AnyEvent adaptor for IO::Async =head1 SYNOPSIS use AnyEvent; use IO::Async::Loop; # optionally set another event loop use AnyEvent::Impl::IOAsync; my $loop = new IO::Async::Loop; AnyEvent::Impl::IOAsync::set_loop $loop; =head1 DESCRIPTION This module provides support for IO::Async as AnyEvent backend. It supports I/O, timers, signals and child process watchers. Idle watchers are emulated. I/O watchers need to dup their fh because IO::Async only supports IO handles, not plain file descriptors. =head1 FUNCTIONS AND VARIABLES The only user-servicible part in this module is the C function and C<$LOOP> variable: =over 4 =item AnyEvent::Impl::IOAsync::set_loop $new_loop Unfortunately, IO::Async has no concept of a default loop. Modules using IO::Async must be told by their caller which loop to use, which makes it impossible to transparently use IO::Async from a module. This module is no exception. It creates a new IO::Async::Loop object when it is loaded. This might not be the right loop object, though, and thus you can replace it by a call to this function with the loop object of your choice. Note that switching loops while watchers are already initialised can have unexpected effects, and is not supported unless you can live witht he consequences. =item $AnyEvent::Impl::IOAsync::LOOP This variable always contains the IO::Async::Loop object used by this AnyEvent backend. See above for more info. Storing the "default" loop makes this module a possible arbiter for other modules that want to use IO::Async transparently. It's advised to directly refer to this variable each time you want to use it, without making a local copy. =back =head1 PROBLEMS WITH IO::Async This section had a long list of problems and shortcomings that made it almost impossible to support L. With version 0.33 of IO::Async, however, most of these have been fixed, so L can now be used as easily as many other loops. There are a few remaining problems that require emulation or workarounds: =over 4 =item No support for multiple watchers per event In most (all? documentation?) cases you cannot have multiple watchers for the same event (what's the point of having all these fancy notifier classes when you cannot have multiple notifiers for the same event? That's like only allowing one timer per second or so...). For I/O watchers, AnyEvent has to dup() every file handle, as IO::Async fails to support the same or different file handles pointing to the same fd (the good thing is that it is documented, but why not fix it instead?). =back Apart from these fatal flaws, there are a number of unpleasent properties that just need some mentioning: =over 4 =item Confusing and misleading names Another rather negative point about this module family is its name, which is deeply confusing: Despite the "async" in the name, L only does I I/O, there is nothing "asynchronous" about it whatsoever (when I first heard about it, I thought, "wow, a second async I/O module, what does it do compared to L", and was somehow set back when I learned that the only "async" aspect of it is the name). =item Inconsistent, incomplete and convoluted API Implementing AnyEvent's rather simple timers on top of IO::Async's timers was a nightmare (try implementing a timer with configurable interval and delay value...). The method naming is chaotic: C creates a child watcher, but C is an internal method; C removes a signal watcher, but C forks a subprocess and so on). =item Unpleasant surprises on GNU/Linux When you develop your program on FreeBSD and run it on GNU/Linux, you might have unpleasant surprises, as IO::Async::Loop will by default use L, which is incompatible with C, so your network server will run into spurious and very hard to debug problems under heavy load, as IO::Async forks a lot of processes, e.g. for DNS resolution. It would be better if IO::Async would only load "safe" backends by default (or fix the epoll backend to work in the presence of fork, which admittedly is hard - EV does it for you, and also does not use unsafe backends by default). =back On the positive side, performance with IO::Async is quite good even in my very demanding eyes. =cut package AnyEvent::Impl::IOAsync; use AnyEvent (); BEGIN { AnyEvent::common_sense } use Time::HiRes (); use Scalar::Util (); use IO::Async::Loop 0.33; our $LOOP = new IO::Async::Loop; sub set_loop($) { $LOOP = $_[0]; } sub timer { my ($class, %arg) = @_; my $cb = $arg{cb}; my $id; if (my $ival = $arg{interval}) { my $ival_cb; $ival_cb = sub { $id = $LOOP->enqueue_timer (delay => $ival, code => $ival_cb); &$cb; }; $id = $LOOP->enqueue_timer (delay => $arg{after}, code => $ival_cb); # we have to weaken afterwards, but when enqueue dies, we have a memleak. # still, we do anything for speed... Scalar::Util::weaken $ival_cb; } else { # IO::Async has problems with overloaded objects $id = $LOOP->enqueue_timer (delay => $arg{after}, code => sub { undef $id; # IO::Async <= 0.43 bug workaround &$cb; }); } bless \\$id, "AnyEvent::Impl::IOAsync::timer" } sub AnyEvent::Impl::IOAsync::timer::DESTROY { # Need to be well-behaved during global destruction $LOOP->cancel_timer (${${$_[0]}}) if defined ${${$_[0]}}; # IO::Async <= 0.43 bug workaround } sub io { my ($class, %arg) = @_; # Ensure we have a real IO handle, and not just a UNIX fd integer my ($fh) = AnyEvent::_dupfh $arg{poll}, $arg{fh}; my $event = $arg{poll} eq "r" ? "on_read_ready" : "on_write_ready"; $LOOP->watch_io ( handle => $fh, $event => $arg{cb}, ); bless [$fh, $event], "AnyEvent::Impl::IOAsync::io" } sub AnyEvent::Impl::IOAsync::io::DESTROY { $LOOP->unwatch_io ( handle => $_[0][0], $_[0][1] => 1, ); } sub signal { my ($class, %arg) = @_; my $signal = $arg{signal}; my $id = $LOOP->attach_signal ($arg{signal}, $arg{cb}); bless [$signal, $id], "AnyEvent::Impl::IOAsync::signal" } sub AnyEvent::Impl::IOAsync::signal::DESTROY { $LOOP->detach_signal (@{ $_[0] }); } our %pid_cb; sub child { my ($class, %arg) = @_; my $pid = $arg{pid}; $LOOP->watch_child ($pid, $arg{cb}); bless [$pid], "AnyEvent::Impl::IOAsync::child" } sub child { my ($class, %arg) = @_; my $pid = $arg{pid}; my $cb = $arg{cb}; unless (%{ $pid_cb{$pid} }) { $LOOP->watch_child ($pid, sub { $_->($_[0], $_[1]) for values %{ $pid_cb{$pid} }; }); } $pid_cb{$pid}{$cb+0} = $cb; bless [$pid, $cb+0], "AnyEvent::Impl::IOAsync::child" } sub AnyEvent::Impl::IOAsync::child::DESTROY { my ($pid, $icb) = @{ $_[0] }; delete $pid_cb{$pid}{$icb}; unless (%{ $pid_cb{$pid} }) { delete $pid_cb{$pid}; $LOOP->unwatch_child ($pid); } } #sub loop { # $LOOP->loop_forever; #} sub _poll { $LOOP->loop_once; } sub AnyEvent::CondVar::Base::_wait { $LOOP->loop_once until exists $_[0]{_ae_sent}; } =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de Paul Evans Rewrote the backend for IO::Async version 0.33. =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/Irssi.pm0000644000000000000000000000675211740210771016540 0ustar rootroot=head1 NAME AnyEvent::Impl::Irssi - AnyEvent adaptor for Irssi =head1 SYNOPSIS use AnyEvent; # this module gets loaded automatically when running under irssi =head1 DESCRIPTION This module provides transparent support for AnyEvent. You don't have to do anything to make Irssi scripts work with AnyEvent. Limitations of this backend and implementation details: =over 4 =item * This backend does not support blocking waits. That means you must set a callback on any condvars, or otherwise make sure to never call C on a condvar that hasn't been signalled yet. =item * Child exits will be handled by AnyEvent. AnyEvent will take over child handling, as Irssi only polls for children once/second and cannot handle unspecific child watchers. This I have no negative effect, as AnyEvent will emit a pidwait signal just like irssi itself would. =item * Artificial timer delays. Irssi artificially enforces timers to have at least a 10ms delay (by croaking, even). This means that some applications will be limited to a rate of 100Hz (for example, L thread scheduling). =item * Irssi leaks memory like hell. Yeah. =back Apart from that, documentation is notoriously wrong (e.g. file handles are not supported by C, contrary to documentation), hooking into irssi has to be done in... weird... ways, but otherwise, Irssi is surprisingly full-featured (for basically being a hack). =cut package AnyEvent::Impl::Irssi; use AnyEvent (); BEGIN { AnyEvent::common_sense } use Carp (); use Irssi (); our @ISA; # irssi works only from certain namespaces, so we # create one and use it. sub init { my $pkg = caller; push @ISA, $pkg; local $/; eval "package $pkg; " . ; print "AnyEvent::Impl::Irssi fatal compilation error: $@" if $@; close DATA; } Irssi::command "/script exec -permanent AnyEvent::Impl::Irssi::init 'AnyEvent adaptor'"; 1; __DATA__ BEGIN { AnyEvent::common_sense } use base "AnyEvent::Base"; sub io { my ($class, %arg) = @_; my $cb = $arg{cb}; my $fd = fileno $arg{fh}; defined $fd or $fd = $arg{fh}; my $source = Irssi::input_add $fd, $arg{poll} eq "r" ? Irssi::INPUT_READ : Irssi::INPUT_WRITE, $cb, undef; bless \\$source, "AnyEvent::Impl::Irssi::io" } sub AnyEvent::Impl::Irssi::io::DESTROY { Irssi::input_remove $${$_[0]}; } sub timer { my ($class, %arg) = @_; my $cb = $arg{cb}; my $ival = $arg{interval} * 1000; my $after = $arg{after} * 1000; my $source; $source = Irssi::timeout_add_once $after > 10 ? $after : 10, ($ival ? sub { $source = Irssi::timeout_add $ival > 10 ? $ival : 10, $cb, undef; &$cb; 0 } : $cb), undef; bless \\$source, "AnyEvent::Impl::Irssi::timer" } sub AnyEvent::Impl::Irssi::timer::DESTROY { Irssi::timeout_remove $${$_[0]}; } my $_pidwait = sub { my ($rpid, $rstatus) = @_; AnyEvent::Base->_emit_childstatus ($rpid, $rstatus); }; Irssi::signal_add pidwait => $_pidwait; sub _emit_childstatus { my ($self, $rpid, $rstatus) = @_; $self->SUPER::_emit_childstatus ($rpid, $rstatus); Irssi::signal_remove pidwait => $_pidwait; Irssi::signal_emit pidwait => $rpid+0, $rstatus+0; Irssi::signal_add pidwait => $_pidwait; } #sub loop { # Carp::croak "Irssi does not support blocking waits"; #} =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/FLTK.pm0000644000000000000000000000606611740210771016205 0ustar rootroot=head1 NAME AnyEvent::Impl::FLTK - AnyEvent adaptor for FLTK (Fast Light Toolkit version two) =head1 SYNOPSIS use AnyEvent; use FLTK; # this module gets loaded automatically as required =head1 DESCRIPTION This module provides transparent support for AnyEvent. You don't have to do anything to make FLTK work with AnyEvent except by loading FLTK before creating the first AnyEvent watcher. This implementation is not to be confused with AnyEvent::Impl::FLTK by Sanko Robinson. That implementation is completely broken, and the author is apparently unreachable. In any case, FLTK suffers from typical GUI-ToolKit diseases, such as O(n) or worse for every operation (adding a timer, destroying a timer etc.), the typical Not-Well-Tested Perl Interface disases such as non-random memory corruption and the typical Event-Loop-as-an-Afterthrough issues, such as multiple watchers on the same fd silently overwriting the others. It doesn't have native idle, signal or child watchers, so all of these are emulated. =cut package AnyEvent::Impl::FLTK; use AnyEvent (); BEGIN { AnyEvent::common_sense } use FLTK 0.532 (); use Scalar::Util (); #*AE::timer = \&EV::timer; #*AE::signal = \&EV::signal; #*AE::idle = \&EV::idle; # FLTK::get_time_secs returns a glob :/ # on unix, fltk uses gettimeofday, so we are likely compatible # on windows, fltk uses GetTickCount, to which we are unlikely to be compatible with. #sub time { FLTK::get_time_secs } #*now = \&time; sub timer_interval_cb { my $id = shift; # add_timeout kills @_, so we have to make a copy :( $id->[0] = FLTK::add_timeout $id->[1], \&timer_interval_cb, $id; &{ $id->[2] } } sub timer { my ($class, %arg) = @_; my $cb = $arg{cb}; if ($arg{interval}) { my $id = [undef, $arg{interval}, $cb]; $id->[0] = FLTK::add_timeout $arg{after}, \&timer_interval_cb, $id; return bless $id, "AnyEvent::Impl::FLTK::timer" } else { # non-repeating timers can be done very efficiently # also, FLTK doesn't like callable objects return FLTK::add_timeout $arg{after}, sub { &$cb } } } sub AnyEvent::Impl::FLTK::timer::DESTROY { undef $_[0][0]; } sub io { my ($class, %arg) = @_; # only one watcher/fd :( my $cb = $arg{cb}; my ($fh, $ev) = AnyEvent::_dupfh $arg{poll}, $arg{fh}, FLTK::READ, FLTK::WRITE | (AnyEvent::WIN32 ? FLTK::EXCEPT : 0); # fltk hardcodes poll constants and aliases EXCEPT with POLLERR, # which is grossly wrong, but likely it doesn't use poll on windows. FLTK::add_fd $fh, $ev, sub { &$cb } } # use signal and child emulation - fltk has no facilities for that # fltk idle watchers are like EV::check watchers, and fltk check watchers # are like EV::prepare watchers. both are called when the loop is busy, # so we have to use idle watcher emulation. sub _poll { FLTK::wait; } sub AnyEvent::CondVar::Base::_wait { FLTK::wait until exists $_[0]{_ae_sent}; } #sub loop { # FLTK::run; #} =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/Glib.pm0000644000000000000000000001113512377613174016326 0ustar rootroot=head1 NAME AnyEvent::Impl::Glib - AnyEvent adaptor for Glib =head1 SYNOPSIS use AnyEvent; use Glib; # this module gets loaded automatically as required =head1 DESCRIPTION This module provides transparent support for AnyEvent. You don't have to do anything to make Glib work with AnyEvent except by loading Glib before creating the first AnyEvent watcher. Glib is probably the most inefficient event loop that has ever seen the light of the world: Glib not only scans all its watchers (really, ALL of them, whether I/O-related, timer-related or what not) during each loop iteration, it also does so multiple times and rebuilds the poll list for the kernel each time again, dynamically even. Newer versions of libglib fortunately do not call malloc/free on every single watcher invocation, though. Glib also enforces certain undocumented behaviours, for example, you cannot always remove active child watchers, and the conditions on when it is valid to do so are not documented. Of course, if you get it wrong, you get "GLib-CRITICAL" messages. This makes it extremely hard to write "correct" glib programs, as you have to study the source code to get it right, and hope future versions don't change any internals. AnyEvent implements the necessary workarounds, at a small performance cost. On the positive side, and most importantly, when it works, Glib generally works correctly, no quarrels there. If you create many watchers (as in: more than two), you might consider one of the L, L or L modules that map Glib to other, more efficient, event loops. This module uses the default Glib main context for all its watchers. =cut package AnyEvent::Impl::Glib; use AnyEvent (); BEGIN { AnyEvent::common_sense } use Glib 1.210 (); # (stable 1.220 2009, also Glib 2.4+ required, 2004) our $mainloop = Glib::MainContext->default; my %io_cond = ( r => ["in" , "hup"], w => ["out", "hup"], ); sub io { my ($class, %arg) = @_; my $cb = $arg{cb}; my $fd = fileno $arg{fh}; defined $fd or $fd = $arg{fh}; my $source = add_watch Glib::IO $fd, $io_cond{$arg{poll}}, sub { &$cb; 1 }; bless \\$source, $class } sub timer { my ($class, %arg) = @_; my $cb = $arg{cb}; my $ival = $arg{interval} * 1000; my $source; $source = add Glib::Timeout $arg{after} < 0 ? 0 : $arg{after} * 1000, $ival ? sub { remove Glib::Source $source; $source = add Glib::Timeout $ival, sub { &$cb; 1 }; &$cb; 1 # already removed, should be a nop } : sub { # due to the braindamaged libglib API (it manages # removed-but-active watchers internally, but forces # users to # manage the same externally as well), # we have to go through these contortions. remove Glib::Source $source; undef $source; &$cb; 1 # already removed, should be a nop }; bless \\$source, $class } sub idle { my ($class, %arg) = @_; my $cb = $arg{cb}; my $source = add Glib::Idle sub { &$cb; 1 }; bless \\$source, $class } sub DESTROY { remove Glib::Source $${$_[0]} if defined $${$_[0]}; } our %pid_w; our %pid_cb; sub child { my ($class, %arg) = @_; $arg{pid} > 0 or Carp::croak "Glib does not support watching for all pids (pid == 0) as attempted"; my $pid = $arg{pid}; my $cb = $arg{cb}; $pid_cb{$pid}{$cb+0} = $cb; $pid_w{$pid} ||= Glib::Child->watch_add ($pid, sub { # the unbelievably braindamaged glib api ignores the return # value and always removes the watcher (this is of course # undocumented), so we need to go through these contortions to # work around this, here and in DESTROY. undef $pid_w{$pid}; $_->($_[0], $_[1]) for values %{ $pid_cb{$pid} }; 1 # gets ignored }); bless [$pid, $cb+0], "AnyEvent::Impl::Glib::child" } sub AnyEvent::Impl::Glib::child::DESTROY { my ($pid, $icb) = @{ $_[0] }; delete $pid_cb{$pid}{$icb}; unless (%{ $pid_cb{$pid} }) { delete $pid_cb{$pid}; my $source = delete $pid_w{$pid}; remove Glib::Source if defined $source; } } #sub loop { # # hackish, but we do not have a mainloop, just a maincontext # $mainloop->iteration (1) while 1; #} sub _poll { $mainloop->iteration (1); } sub AnyEvent::CondVar::Base::_wait { $mainloop->iteration (1) until exists $_[0]{_ae_sent}; } =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Impl/Qt.pm0000644000000000000000000000605411740210771016026 0ustar rootroot=head1 NAME AnyEvent::Impl::Qt - AnyEvent adaptor for Qt =head1 SYNOPSIS use AnyEvent; use Qt; my $app = Qt::Application \@ARGV; # REQUIRED! # this module gets loaded automatically as required =head1 DESCRIPTION This module provides transparent support for AnyEvent. You don't have to do anything to make Qt work with AnyEvent except by loading Qt before creating the first AnyEvent watcher I. Failure to do so will result in segfaults, which is why this model doesn't work as a default model and will not be autoprobed (but it will be autodetected when the main program uses Qt). Qt suffers from the same limitations as Event::Lib and Tk, the workaround is also the same (duplicating file descriptors). Qt doesn't support idle events, so they are being emulated. Avoid Qt if you can. =cut package AnyEvent::Impl::Qt::Io; use Qt; use Qt::isa qw(Qt::SocketNotifier); # Socket? what where they smoking use Qt::slots cb => []; sub NEW { my ($class, $fh, $mode, $cb) = @_; shift->SUPER::NEW (fileno $fh, $mode); this->{fh} = $fh; this->{cb} = $cb; this->connect (this, SIGNAL "activated(int)", SLOT "cb()"); } sub cb { this->setEnabled (0); # required according to the docs. heavy smoking required. this->{cb}->(); this->setEnabled (1); } package AnyEvent::Impl::Qt::Timer; use Qt; use Qt::isa qw(Qt::Timer); use Qt::slots cb => []; # having to go through these contortions just to get a timer event is # considered an advantage over other gui toolkits how? sub NEW { my ($class, $after, $interval, $cb) = @_; shift->SUPER::NEW (); this->{interval} = $interval; this->{cb} = $cb; this->connect (this, SIGNAL "timeout()", SLOT "cb()"); this->start ($after, 1); } sub cb { this->start (this->{interval}, 1) if defined this->{interval}; this->{cb}->(); } package AnyEvent::Impl::Qt; use AnyEvent (); BEGIN { AnyEvent::common_sense } use Qt; use AnyEvent::Impl::Qt::Timer; use AnyEvent::Impl::Qt::Io; our $app = Qt::Application \@ARGV; # REQUIRED! sub io { my ($class, %arg) = @_; # work around these bugs in Qt: # - adding a callback might destroy other callbacks # - only one callback per fd/poll combination my ($fh, $qt) = AnyEvent::_dupfh $arg{poll}, $arg{fh}, Qt::SocketNotifier::Read (), Qt::SocketNotifier::Write (); AnyEvent::Impl::Qt::Io $fh, $qt, $arg{cb} } sub timer { my ($class, %arg) = @_; # old Qt treats 0 timeout as "idle" AnyEvent::Impl::Qt::Timer $arg{after} * 1000 || 1, $arg{interval} ? $arg{interval} * 1000 || 1 : undef, $arg{cb} } # newer Qt have no idle mode for timers anymore... #sub idle { # my ($class, %arg) = @_; # # AnyEvent::Impl::Qt::Timer 0, 0, $arg{cb} #} #sub loop { # Qt::app->exec; #} sub _poll { Qt::app->processOneEvent; } sub AnyEvent::CondVar::Base::_wait { Qt::app->processOneEvent until exists $_[0]{_ae_sent}; } =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Intro.pod0000644000000000000000000014451013522711044016001 0ustar rootroot=encoding utf-8 =head1 NAME AnyEvent::Intro - an introductory tutorial to AnyEvent =head1 Introduction to AnyEvent This is a tutorial that will introduce you to the features of AnyEvent. The first part introduces the core AnyEvent module (after swamping you a bit in evangelism), which might already provide all you ever need: If you are only interested in AnyEvent's event handling capabilities, read no further. The second part focuses on network programming using sockets, for which AnyEvent offers a lot of support you can use, and a lot of workarounds around portability quirks. =head1 What is AnyEvent? If you don't care for the whys and want to see code, skip this section! AnyEvent is first of all just a framework to do event-based programming. Typically such frameworks are an all-or-nothing thing: If you use one such framework, you can't (easily, or even at all) use another in the same program. AnyEvent is different - it is a thin abstraction layer on top of other event loops, just like DBI is an abstraction of many different database APIs. Its main purpose is to move the choice of the underlying framework (the event loop) from the module author to the program author using the module. That means you can write code that uses events to control what it does, without forcing other code in the same program to use the same underlying framework as you do - i.e. you can create a Perl module that is event-based using AnyEvent, and users of that module can still choose between using L, L, L (or run inside Irssi or rxvt-unicode) or any other supported event loop. AnyEvent even comes with its own pure-perl event loop implementation, so your code works regardless of other modules that might or might not be installed. The latter is important, as AnyEvent does not have any hard dependencies to other modules, which makes it easy to install, for example, when you lack a C compiler. No matter what environment, AnyEvent will just cope with it. A typical limitation of existing Perl modules such as L is that they come with their own event loop: In L, a program which uses it needs to start the event loop of L. That means that one cannot integrate this module into a L GUI for instance, as that module, too, enforces the use of its own event loop (namely L). Another example is L: it provides no event interface at all. It's a pure blocking HTTP (and FTP etc.) client library, which usually means that you either have to start another process or have to fork for a HTTP request, or use threads (e.g. L), if you want to do something else while waiting for the request to finish. The motivation behind these designs is often that a module doesn't want to depend on some complicated XS-module (Net::IRC), or that it doesn't want to force the user to use some specific event loop at all (LWP), out of fear of severly limiting the usefulness of the module: If your module requires Glib, it will not run in a Tk program. L solves this dilemma, by B forcing module authors to either: =over 4 =item - write their own event loop (because it guarantees the availability of an event loop everywhere - even on windows with no extra modules installed). =item - choose one specific event loop (because AnyEvent works with most event loops available for Perl). =back If the module author uses L for all his (or her) event needs (IO events, timers, signals, ...) then all other modules can just use his module and don't have to choose an event loop or adapt to his event loop. The choice of the event loop is ultimately made by the program author who uses all the modules and writes the main program. And even there he doesn't have to choose, he can just let L choose the most efficient event loop available on the system. Read more about this in the main documentation of the L module. =head1 Introduction to Event-Based Programming So what exactly is programming using events? It quite simply means that instead of your code actively waiting for something, such as the user entering something on STDIN: $| = 1; print "enter your name> "; my $name = ; You instead tell your event framework to notify you in the event of some data being available on STDIN, by using a callback mechanism: use AnyEvent; $| = 1; print "enter your name> "; my $name; my $wait_for_input = AnyEvent->io ( fh => \*STDIN, # which file handle to check poll => "r", # which event to wait for ("r"ead data) cb => sub { # what callback to execute $name = ; # read it } ); # do something else here Looks more complicated, and surely is, but the advantage of using events is that your program can do something else instead of waiting for input (side note: combining AnyEvent with a thread package such as Coro can recoup much of the simplicity, effectively getting the best of two worlds). Waiting as done in the first example is also called "blocking" the process because you "block"/keep your process from executing anything else while you do so. The second example avoids blocking by only registering interest in a read event, which is fast and doesn't block your process. The callback will be called only when data is available and can be read without blocking. The "interest" is represented by an object returned by C<< AnyEvent->io >> called a "watcher" object - thus named because it "watches" your file handle (or other event sources) for the event you are interested in. In the example above, we create an I/O watcher by calling the C<< AnyEvent->io >> method. A lack of further interest in some event is expressed by simply forgetting about its watcher, for example by C-ing the only variable it is stored in. AnyEvent will automatically clean up the watcher if it is no longer used, much like Perl closes your file handles if you no longer use them anywhere. =head3 A short note on callbacks A common issue that hits people is the problem of passing parameters to callbacks. Programmers used to languages such as C or C++ are often used to a style where one passes the address of a function (a function reference) and some data value, e.g.: sub callback { my ($arg) = @_; $arg->method; } my $arg = ...; call_me_back_later \&callback, $arg; This is clumsy, as the place where behaviour is specified (when the callback is registered) is often far away from the place where behaviour is implemented. It also doesn't use Perl syntax to invoke the code. There is also an abstraction penalty to pay as one has to I the callback, which often is unnecessary and leads to nonsensical or duplicated names. In Perl, one can specify behaviour much more directly by using I. Closures are code blocks that take a reference to the enclosing scope(s) when they are created. This means lexical variables in scope when a closure is created can be used inside the closure: my $arg = ...; call_me_back_later sub { $arg->method }; Under most circumstances, closures are faster, use fewer resources and result in much clearer code than the traditional approach. Faster, because parameter passing and storing them in local variables in Perl is relatively slow. Fewer resources, because closures take references to existing variables without having to create new ones, and clearer code because it is immediately obvious that the second example calls the C method when the callback is invoked. Apart from these, the strongest argument for using closures with AnyEvent is that AnyEvent does not allow passing parameters to the callback, so closures are the only way to achieve that in most cases :-> =head3 A little hint to catch mistakes AnyEvent does not check the parameters you pass in, at least not by default. to enable checking, simply start your program with C in the environment, or put C near the top of your program: AE_STRICT=1 perl myprogram You can find more info on this and additional debugging aids later in this introduction. =head2 Condition Variables Back to the I/O watcher example: The code is not yet a fully working program, and will not work as-is. The reason is that your callback will not be invoked out of the blue; you have to run the event loop first. Also, event-based programs need to block sometimes too, such as when there is nothing to do, and everything is waiting for new events to arrive. In AnyEvent, this is done using condition variables. Condition variables are named "condition variables" because they represent a condition that is initially false and needs to be fulfilled. You can also call them "merge points", "sync points", "rendezvous ports" or even callbacks and many other things (and they are often called these names in other frameworks). The important point is that you can create them freely and later wait for them to become true. Condition variables have two sides - one side is the "producer" of the condition (whatever code detects and flags the condition), the other side is the "consumer" (the code that waits for that condition). In our example in the previous section, the producer is the event callback and there is no consumer yet - let's change that right now: use AnyEvent; $| = 1; print "enter your name> "; my $name; my $name_ready = AnyEvent->condvar; my $wait_for_input = AnyEvent->io ( fh => \*STDIN, poll => "r", cb => sub { $name = ; $name_ready->send; } ); # do something else here # now wait until the name is available: $name_ready->recv; undef $wait_for_input; # watcher no longer needed print "your name is $name\n"; This program creates an AnyEvent condvar by calling the C<< AnyEvent->condvar >> method. It then creates a watcher as usual, but inside the callback it Cs the C<$name_ready> condition variable, which causes whoever is waiting on it to continue. The "whoever" in this case is the code that follows, which calls C<< $name_ready->recv >>: The producer calls C, the consumer calls C. If there is no C<$name> available yet, then the call to C<< $name_ready->recv >> will halt your program until the condition becomes true. As the names C and C imply, you can actually send and receive data using this, for example, the above code could also be written like this, without an extra variable to store the name in: use AnyEvent; $| = 1; print "enter your name> "; my $name_ready = AnyEvent->condvar; my $wait_for_input = AnyEvent->io ( fh => \*STDIN, poll => "r", cb => sub { $name_ready->send (scalar ) } ); # do something else here # now wait and fetch the name my $name = $name_ready->recv; undef $wait_for_input; # watcher no longer needed print "your name is $name\n"; You can pass any number of arguments to C, and every subsequent call to C will return them. =head2 The "main loop" Most event-based frameworks have something called a "main loop" or "event loop run function" or something similar. Just like in C AnyEvent, these functions need to be called eventually so that your event loop has a chance of actually looking for the events you are interested in. For example, in a L program, the above example could also be written like this: use Gtk2 -init; use AnyEvent; ############################################ # create a window and some label my $window = new Gtk2::Window "toplevel"; $window->add (my $label = new Gtk2::Label "soon replaced by name"); $window->show_all; ############################################ # do our AnyEvent stuff $| = 1; print "enter your name> "; my $wait_for_input = AnyEvent->io ( fh => \*STDIN, poll => "r", cb => sub { # set the label $label->set_text (scalar ); print "enter another name> "; } ); ############################################ # Now enter Gtk2's event loop main Gtk2; No condition variable anywhere in sight - instead, we just read a line from STDIN and replace the text in the label. In fact, since nobody Cs C<$wait_for_input> you can enter multiple lines. Instead of waiting for a condition variable, the program enters the Gtk2 main loop by calling C<< Gtk2->main >>, which will block the program and wait for events to arrive. This also shows that AnyEvent is quite flexible - you didn't have to do anything to make the AnyEvent watcher use Gtk2 (actually Glib) - it just worked. Admittedly, the example is a bit silly - who would want to read names from standard input in a Gtk+ application? But imagine that instead of doing that, you make an HTTP request in the background and display its results. In fact, with event-based programming you can make many HTTP requests in parallel in your program and still provide feedback to the user and stay interactive. And in the next part you will see how to do just that - by implementing an HTTP request, on our own, with the utility modules AnyEvent comes with. Before that, however, let's briefly look at how you would write your program using only AnyEvent, without ever calling some other event loop's run function. In the example using condition variables, we used those to start waiting for events, and in fact, condition variables are the solution: my $quit_program = AnyEvent->condvar; # create AnyEvent watchers (or not) here $quit_program->recv; If any of your watcher callbacks decide to quit (this is often called an "unloop" in other frameworks), they can just call C<< $quit_program->send >>. Of course, they could also decide not to and call C instead, or they could decide never to quit (e.g. in a long-running daemon program). If you don't need some clean quit functionality and just want to run the event loop, you can do this: AnyEvent->condvar->recv; And this is, in fact, the closest to the idea of a main loop run function that AnyEvent offers. =head2 Timers and other event sources So far, we have used only I/O watchers. These are useful mainly to find out whether a socket has data to read, or space to write more data. On sane operating systems this also works for console windows/terminals (typically on standard input), serial lines, all sorts of other devices, basically almost everything that has a file descriptor but isn't a file itself. (As usual, "sane" excludes windows - on that platform you would need different functions for all of these, complicating code immensely - think "socket only" on windows). However, I/O is not everything - the second most important event source is the clock. For example when doing an HTTP request you might want to time out when the server doesn't answer within some predefined amount of time. In AnyEvent, timer event watchers are created by calling the C<< AnyEvent->timer >> method: use AnyEvent; my $cv = AnyEvent->condvar; my $wait_one_and_a_half_seconds = AnyEvent->timer ( after => 1.5, # after how many seconds to invoke the cb? cb => sub { # the callback to invoke $cv->send; }, ); # can do something else here # now wait till our time has come $cv->recv; Unlike I/O watchers, timers are only interested in the amount of seconds they have to wait. When (at least) that amount of time has passed, AnyEvent will invoke your callback. Unlike I/O watchers, which will call your callback as many times as there is data available, timers are normally one-shot: after they have "fired" once and invoked your callback, they are dead and no longer do anything. To get a repeating timer, such as a timer firing roughly once per second, you can specify an C parameter: my $once_per_second = AnyEvent->timer ( after => 0, # first invoke ASAP interval => 1, # then invoke every second cb => sub { # the callback to invoke $cv->send; }, ); =head3 More esoteric sources AnyEvent also has some other, more esoteric event sources you can tap into: signal, child and idle watchers. Signal watchers can be used to wait for "signal events", which means your process was sent a signal (such as C or C). Child-process watchers wait for a child process to exit. They are useful when you fork a separate process and need to know when it exits, but you do not want to wait for that by blocking. Idle watchers invoke their callback when the event loop has handled all outstanding events, polled for new events and didn't find any, i.e., when your process is otherwise idle. They are useful if you want to do some non-trivial data processing that can be done when your program doesn't have anything better to do. All these watcher types are described in detail in the main L manual page. Sometimes you also need to know what the current time is: C<< AnyEvent->now >> returns the time the event toolkit uses to schedule relative timers, and is usually what you want. It is often cached (which means it can be a bit outdated). In that case, you can use the more costly C<< AnyEvent->time >> method which will ask your operating system for the current time, which is slower, but also more up to date. =head1 Network programming and AnyEvent So far you have seen how to register event watchers and handle events. This is a great foundation to write network clients and servers, and might be all that your module (or program) ever requires, but writing your own I/O buffering again and again becomes tedious, not to mention that it attracts errors. While the core L module is still small and self-contained, the distribution comes with some very useful utility modules such as L, L and L. These can make your life as a non-blocking network programmer a lot easier. Here is a quick overview of these three modules: =head2 L This module allows fully asynchronous DNS resolution. It is used mainly by L to resolve hostnames and service ports for you, but is a great way to do other DNS resolution tasks, such as reverse lookups of IP addresses for log files. =head2 L This module handles non-blocking IO on (socket-, pipe- etc.) file handles in an event based manner. It provides a wrapper object around your file handle that provides queueing and buffering of incoming and outgoing data for you. It also implements the most common data formats, such as text lines, or fixed and variable-width data blocks. =head2 L This module provides you with functions that handle socket creation and IP address magic. The two main functions are C and C. The former will connect a (streaming) socket to an internet host for you and the later will make a server socket for you, to accept connections. This module also comes with transparent IPv6 support, this means: If you write your programs with this module, you will be IPv6 ready without doing anything special. It also works around a lot of portability quirks (especially on the windows platform), which makes it even easier to write your programs in a portable way (did you know that windows uses different error codes for all socket functions and that Perl does not know about these? That "Unknown error 10022" (which is C) can mean that our C call was successful? That unsuccessful TCP connects might never be reported back to your program? That C means your C call was ignored instead of being in progress? AnyEvent::Socket works around all of these Windows/Perl bugs for you). =head2 Implementing a parallel finger client with non-blocking connects and AnyEvent::Socket The finger protocol is one of the simplest protocols in use on the internet. Or in use in the past, as almost nobody uses it anymore. It works by connecting to the finger port on another host, writing a single line with a user name and then reading the finger response, as specified by that user. OK, RFC 1288 specifies a vastly more complex protocol, but it basically boils down to this: # telnet freebsd.org finger Trying 8.8.178.135... Connected to freebsd.org (8.8.178.135). Escape character is '^]'. larry Login: lile Name: Larry Lile Directory: /home/lile Shell: /usr/local/bin/bash No Mail. Mail forwarded to: lile@stdio.com No Plan. So let's write a little AnyEvent function that makes a finger request: use AnyEvent; use AnyEvent::Socket; sub finger($$) { my ($user, $host) = @_; # use a condvar to return results my $cv = AnyEvent->condvar; # first, connect to the host tcp_connect $host, "finger", sub { # the callback receives the socket handle - or nothing my ($fh) = @_ or return $cv->send; # now write the username syswrite $fh, "$user\015\012"; my $response; # register a read watcher my $read_watcher; $read_watcher = AnyEvent->io ( fh => $fh, poll => "r", cb => sub { my $len = sysread $fh, $response, 1024, length $response; if ($len <= 0) { # we are done, or an error occured, lets ignore the latter undef $read_watcher; # no longer interested $cv->send ($response); # send results } }, ); }; # pass $cv to the caller $cv } That's a mouthful! Let's dissect this function a bit, first the overall function and execution flow: sub finger($$) { my ($user, $host) = @_; # use a condvar to return results my $cv = AnyEvent->condvar; # first, connect to the host tcp_connect $host, "finger", sub { ... }; $cv } This isn't too complicated, just a function with two parameters that creates a condition variable C<$cv>, initiates a TCP connect to C<$host>, and returns C<$cv>. The caller can use the returned C<$cv> to receive the finger response, but one could equally well pass a third argument, a callback, to the function. Since we are programming event'ish, we do not wait for the connect to finish - it could block the program for a minute or longer! Instead, we pass C a callback to invoke when the connect is done. The callback is called with the socket handle as its first argument if the connect succeeds, and no arguments otherwise. The important point is that it will always be called as soon as the outcome of the TCP connect is known. This style of programming is also called "continuation style": the "continuation" is simply the way the program continues - normally at the next line after some statement (the exception is loops or things like C). When we are interested in events, however, we instead specify the "continuation" of our program by passing a closure, which makes that closure the "continuation" of the program. The C call is like saying "return now, and when the connection is established or the attempt failed, continue there". Now let's look at the callback/closure in more detail: # the callback receives the socket handle - or nothing my ($fh) = @_ or return $cv->send; The first thing the callback does is to save the socket handle in C<$fh>. When there was an error (no arguments), then our instinct as expert Perl programmers would tell us to C: my ($fh) = @_ or die "$host: $!"; While this would give good feedback to the user (if he happens to watch standard error), our program would probably stop working here, as we never report the results to anybody, certainly not the caller of our C function, and most event loops continue even after a C! This is why we instead C, but also call C<< $cv->send >> without any arguments to signal to the condvar consumer that something bad has happened. The return value of C<< $cv->send >> is irrelevant, as is the return value of our callback. The C statement is used for the side effect of, well, returning immediately from the callback. Checking for errors and handling them this way is very common, which is why this compact idiom is so handy. As the next step in the finger protocol, we send the username to the finger daemon on the other side of our connection (the kernel.org finger service doesn't actually wait for a username, but the net is running out of finger servers fast): syswrite $fh, "$user\015\012"; Note that this isn't 100% clean socket programming - the socket could, for whatever reasons, not accept our data. When writing a small amount of data like in this example it doesn't matter, as a socket buffer is almost always big enough for a mere "username", but for real-world cases you might need to implement some kind of write buffering - or use L, which handles these matters for you, as shown in the next section. What we I have to do is implement our own read buffer - the response data could arrive late or in multiple chunks, and we cannot just wait for it (event-based programming, you know?). To do that, we register a read watcher on the socket which waits for data: my $read_watcher; $read_watcher = AnyEvent->io ( fh => $fh, poll => "r", There is a trick here, however: the read watcher isn't stored in a global variable, but in a local one - if the callback returns, it would normally destroy the variable and its contents, which would in turn unregister our watcher. To avoid that, we refer to the watcher variable in the watcher callback. This means that, when the C callback returns, perl thinks (quite correctly) that the read watcher is still in use - namely inside the inner callback - and thus keeps it alive even if nothing else in the program refers to it anymore (it is much like Baron Münchhausen keeping himself from dying by pulling himself out of a swamp). The trick, however, is that instead of: my $read_watcher = AnyEvent->io (... The program does: my $read_watcher; $read_watcher = AnyEvent->io (... The reason for this is a quirk in the way Perl works: variable names declared with C are only visible in the I statement. If the whole C<< AnyEvent->io >> call, including the callback, would be done in a single statement, the callback could not refer to the C<$read_watcher> variable to Cine it, so it is done in two statements. Whether you'd want to format it like this is of course a matter of style. This way emphasizes that the declaration and assignment really are one logical statement. The callback itself calls C for as many times as necessary, until C returns either an error or end-of-file: cb => sub { my $len = sysread $fh, $response, 1024, length $response; if ($len <= 0) { Note that C has the ability to append data it reads to a scalar if we specify an offset, a feature which we make use of in this example. When C indicates we are done, the callback Cines the watcher and then Cs the response data to the condition variable. All this has the following effects: Undefining the watcher destroys it, as our callback was the only one still having a reference to it. When the watcher gets destroyed, it destroys the callback, which in turn means the C<$fh> handle is no longer used, so that gets destroyed as well. The result is that all resources will be nicely cleaned up by perl for us. =head3 Using the finger client Now, we could probably write the same finger client in a simpler way if we used C, ignored the problem of multiple hosts and ignored IPv6 and a few other things that C handles for us. But the main advantage is that we can not only run this finger function in the background, we even can run multiple sessions in parallel, like this: my $f1 = finger "kuriyama", "freebsd.org"; my $f2 = finger "icculus?listarchives=1", "icculus.org"; my $f3 = finger "mikachu", "icculus.org"; print "kuriyama's gpg key\n" , $f1->recv, "\n"; print "icculus' plan archive\n" , $f2->recv, "\n"; print "mikachu's plan zomgn\n" , $f3->recv, "\n"; It doesn't look like it, but in fact all three requests run in parallel. The code waits for the first finger request to finish first, but that doesn't keep it from executing them parallel: when the first C call sees that the data isn't ready yet, it serves events for all three requests automatically, until the first request has finished. The second C call might either find the data is already there, or it will continue handling events until that is the case, and so on. By taking advantage of network latencies, which allows us to serve other requests and events while we wait for an event on one socket, the overall time to do these three requests will be greatly reduced, typically all three are done in the same time as the slowest of the three requests. By the way, you do not actually have to wait in the C method on an AnyEvent condition variable - after all, waiting is evil - you can also register a callback: $f1->cb (sub { my $response = shift->recv; # ... }); The callback will be invoked only when C is called. In fact, instead of returning a condition variable you could also pass a third parameter to your finger function, the callback to invoke with the response: sub finger($$$) { my ($user, $host, $cb) = @_; How you implement it is a matter of taste - if you expect your function to be used mainly in an event-based program you would normally prefer to pass a callback directly. If you write a module and expect your users to use it "synchronously" often (for example, a simple http-get script would not really care much for events), then you would use a condition variable and tell them "simply C<< ->recv >> the data". =head3 Problems with the implementation and how to fix them To make this example more real-world-ready, we would not only implement some write buffering (for the paranoid, or maybe denial-of-service aware security expert), but we would also have to handle timeouts and maybe protocol errors. Doing this quickly gets unwieldy, which is why we introduce L in the next section, which takes care of all these details for you and lets you concentrate on the actual protocol. =head2 Implementing simple HTTP and HTTPS GET requests with AnyEvent::Handle The L module has been hyped quite a bit in this document so far, so let's see what it really offers. As finger is such a simple protocol, let's try something slightly more complicated: HTTP/1.0. An HTTP GET request works by sending a single request line that indicates what you want the server to do and the URI you want to act it on, followed by as many "header" lines (C, same as e-mail headers) as required for the request, followed by an empty line. The response is formatted very similarly, first a line with the response status, then again as many header lines as required, then an empty line, followed by any data that the server might send. Again, let's try it out with C (I condensed the output a bit - if you want to see the full response, do it yourself). # telnet www.google.com 80 Trying 209.85.135.99... Connected to www.google.com (209.85.135.99). Escape character is '^]'. GET /test HTTP/1.0 HTTP/1.0 404 Not Found Date: Mon, 02 Jun 2008 07:05:54 GMT Content-Type: text/html; charset=UTF-8 [...] Connection closed by foreign host. The C and the empty line were entered manually, the rest of the telnet output is google's response, in this case a C<404 not found> one. So, here is how you would do it with C: sub http_get { my ($host, $uri, $cb) = @_; # store results here my ($response, $header, $body); my $handle; $handle = new AnyEvent::Handle connect => [$host => 'http'], on_error => sub { $cb->("HTTP/1.0 500 $!"); $handle->destroy; # explicitly destroy handle }, on_eof => sub { $cb->($response, $header, $body); $handle->destroy; # explicitly destroy handle }; $handle->push_write ("GET $uri HTTP/1.0\015\012\015\012"); # now fetch response status line $handle->push_read (line => sub { my ($handle, $line) = @_; $response = $line; }); # then the headers $handle->push_read (line => "\015\012\015\012", sub { my ($handle, $line) = @_; $header = $line; }); # and finally handle any remaining data as body $handle->on_read (sub { $body .= $_[0]->rbuf; $_[0]->rbuf = ""; }); } And now let's go through it step by step. First, as usual, the overall C function structure: sub http_get { my ($host, $uri, $cb) = @_; # store results here my ($response, $header, $body); my $handle; $handle = new AnyEvent::Handle ... create handle object ... push data to write ... push what to expect to read queue } Unlike in the finger example, this time the caller has to pass a callback to C. Also, instead of passing a URL as one would expect, the caller has to provide the hostname and URI - normally you would use the C module to parse a URL and separate it into those parts, but that is left to the inspired reader :) Since everything else is left to the caller, all C does is initiate the connection by creating the AnyEvent::Handle object (which calls C for us) and leave everything else to its callback. The handle object is created, unsurprisingly, by calling the C method of L: my $handle; $handle = new AnyEvent::Handle connect => [$host => 'http'], on_error => sub { $cb->("HTTP/1.0 500 $!"); $handle->destroy; # explicitly destroy handle }, on_eof => sub { $cb->($response, $header, $body); $handle->destroy; # explicitly destroy handle }; The C argument tells AnyEvent::Handle to call C for the specified host and service/port. The C callback will be called on any unexpected error, such as a refused connection, or unexpected end-of-file while reading headers. Instead of having an extra mechanism to signal errors, connection errors are signalled by crafting a special "response status line", like this: HTTP/1.0 500 Connection refused This means the caller cannot distinguish (easily) between locally-generated errors and server errors, but it simplifies error handling for the caller a lot. The error callback also destroys the handle explicitly, because we are not interested in continuing after any errors. In AnyEvent::Handle callbacks you have to call C explicitly to destroy a handle. Outside of those callbacks you can just forget the object reference and it will be automatically cleaned up. Last but not least, we set an C callback that is called when the other side indicates it has stopped writing data, which we will use to gracefully shut down the handle and report the results. This callback is only called when the read queue is empty - if the read queue expects some data and the handle gets an EOF from the other side this will be an error - after all, you did expect more to come. If you wanted to write a server using AnyEvent::Handle, you would use C and then create the AnyEvent::Handle with the C argument. =head3 The write queue The next line sends the actual request: $handle->push_write ("GET $uri HTTP/1.0\015\012\015\012"); No headers will be sent (this is fine for simple requests), so the whole request is just a single line followed by an empty line to signal the end of the headers to the server. The more interesting question is why the method is called C and not just write. The reason is that you can I add some write data without blocking, and to do this, AnyEvent::Handle needs some write queue internally - and C pushes some data onto the end of that queue, just like Perl's C pushes data onto the end of an array. The deeper reason is that at some point in the future, there might be C as well, and in any case, we will shortly meet C and C, and it's usually easiest to remember if all those functions have some symmetry in their name. So C is used as the opposite of C in AnyEvent::Handle, not as the opposite of C - just like in Perl. Note that we call C right after creating the AnyEvent::Handle object, before it has had time to actually connect to the server. This is fine, pushing the read and write requests will queue them in the handle object until the connection has been established. Alternatively, we could do this "on demand" in the C callback. If C is called with more than one argument, then you can do I I/O. For example, this would JSON-encode your data before pushing it to the write queue: $handle->push_write (json => [1, 2, 3]); This pretty much summarises the write queue, there is little else to it. Reading the response is far more interesting, because it involves the more powerful and complex I: =head3 The read queue The response consists of three parts: a single line with the response status, a single paragraph of headers ended by an empty line, and the request body, which is the remaining data on the connection. For the first two, we push two read requests onto the read queue: # now fetch response status line $handle->push_read (line => sub { my ($handle, $line) = @_; $response = $line; }); # then the headers $handle->push_read (line => "\015\012\015\012", sub { my ($handle, $line) = @_; $header = $line; }); While one can just push a single callback to parse all the data on the queue, formatted I/O really comes to our aid here, since there is a ready-made "read line" read type. The first read expects a single line, ended by C<\015\012> (the standard end-of-line marker in internet protocols). The second "line" is actually a single paragraph - instead of reading it line by line we tell C that the end-of-line marker is really C<\015\012\015\012>, which is an empty line. The result is that the whole header paragraph will be treated as a single line and read. The word "line" is interpreted very freely, much like Perl itself does it. Note that push read requests are pushed immediately after creating the handle object - since AnyEvent::Handle provides a queue we can push as many requests as we want, and AnyEvent::Handle will handle them in order. There is, however, no read type for "the remaining data". For that, we install our own C callback: # and finally handle any remaining data as body $handle->on_read (sub { $body .= $_[0]->rbuf; $_[0]->rbuf = ""; }); This callback is invoked every time data arrives and the read queue is empty - which in this example will only be the case when both response and header have been read. The C callback could actually have been specified when constructing the object, but doing it this way preserves logical ordering. The read callback adds the current read buffer to its C<$body> variable and, most importantly, I the buffer by assigning the empty string to it. Given these instructions, AnyEvent::Handle will handle incoming data - if all goes well, the callback will be invoked with the response data; if not, it will get an error. In general, you can implement pipelining (a semi-advanced feature of many protocols) very easily with AnyEvent::Handle: If you have a protocol with a request/response structure, your request methods/functions will all look like this (simplified): sub request { # send the request to the server $handle->push_write (...); # push some response handlers $handle->push_read (...); } This means you can queue as many requests as you want, and while AnyEvent::Handle goes through its read queue to handle the response data, the other side can work on the next request - queueing the request just appends some data to the write queue and installs a handler to be called later. You might ask yourself how to handle decisions you can only make I you have received some data (such as handling a short error response or a long and differently-formatted response). The answer to this problem is C, which we will introduce together with an example in the coming sections. =head3 Using C Finally, here is how you would use C: http_get "www.google.com", "/", sub { my ($response, $header, $body) = @_; print $response, "\n", $body; }; And of course, you can run as many of these requests in parallel as you want (and your memory supports). =head3 HTTPS Now, as promised, let's implement the same thing for HTTPS, or more correctly, let's change our C function into a function that speaks HTTPS instead. HTTPS is a standard TLS connection (Bransport Bayer Becurity is the official name for what most people refer to as C) that contains standard HTTP protocol exchanges. The only other difference to HTTP is that by default it uses port C<443> instead of port C<80>. To implement these two differences we need two tiny changes, first, in the C parameter, we replace C by C to connect to the https port: connect => [$host => 'https'], The other change deals with TLS, which is something L does for us if the L module is available. To enable TLS with L, we pass an additional C parameter to the call to C: tls => "connect", Specifying C enables TLS, and the argument specifies whether AnyEvent::Handle is the server side ("accept") or the client side ("connect") for the TLS connection, as unlike TCP, there is a clear server/client relationship in TLS. That's all. Of course, all this should be handled transparently by C after parsing the URL. If you need this, see the part about exercising your inspiration earlier in this document. You could also use the L module from CPAN, which implements all this and works around a lot of quirks for you too. =head3 The read queue - revisited HTTP always uses the same structure in its responses, but many protocols require parsing responses differently depending on the response itself. For example, in SMTP, you normally get a single response line: 220 mail.example.net Neverusesendmail 8.8.8 But SMTP also supports multi-line responses: 220-mail.example.net Neverusesendmail 8.8.8 220-hey guys 220 my response is longer than yours To handle this, we need C. As the name (we hope) implies, C will not append your read request to the end of the read queue, but will prepend it to the queue instead. This is useful in the situation above: Just push your response-line read request when sending the SMTP command, and when handling it, you look at the line to see if more is to come, and C another reader callback if required, like this: my $response; # response lines end up in here my $read_response; $read_response = sub { my ($handle, $line) = @_; $response .= "$line\n"; # check for continuation lines ("-" as 4th character") if ($line =~ /^...-/) { # if yes, then unshift another line read $handle->unshift_read (line => $read_response); } else { # otherwise we are done # free callback undef $read_response; print "we are don reading: $response\n"; } }; $handle->push_read (line => $read_response); This recipe can be used for all similar parsing problems, for example in NNTP, the response code to some commands indicates that more data will be sent: $handle->push_write ("article 42"); # read response line $handle->push_read (line => sub { my ($handle, $status) = @_; # article data following? if ($status =~ /^2/) { # yes, read article body $handle->unshift_read (line => "\012.\015\012", sub { my ($handle, $body) = @_; $finish->($status, $body); }); } else { # some error occured, no article data $finish->($status); } } =head3 Your own read queue handler Sometimes your protocol doesn't play nice, and uses lines or chunks of data not formatted in a way handled out of the box by AnyEvent::Handle. In this case you have to implement your own read parser. To make up a contorted example, imagine you are looking for an even number of characters followed by a colon (":"). Also imagine that AnyEvent::Handle has no C read type which could be used, so you'd have to do it manually. To implement a read handler for this, you would C (or C) a single code reference. This code reference will then be called each time there is (new) data available in the read buffer, and is expected to either successfully eat/consume some of that data (and return true) or to return false to indicate that it wants to be called again. If the code reference returns true, then it will be removed from the read queue (because it has parsed/consumed whatever it was supposed to consume), otherwise it stays in the front of it. The example above could be coded like this: $handle->push_read (sub { my ($handle) = @_; # check for even number of characters + ":" # and remove the data if a match is found. # if not, return false (actually nothing) $handle->{rbuf} =~ s/^( (?:..)* ) ://x or return; # we got some data in $1, pass it to whoever wants it $finish->($1); # and return true to indicate we are done 1 }); =head1 Debugging aids Now that you have seen how to use AnyEvent, here's what to use when you don't use it correctly, or simply hit a bug somewhere and want to debug it: =over 4 =item Enable strict argument checking during development AnyEvent does not, by default, do any argument checking. This can lead to strange and unexpected results especially if you are just trying to find your way with AnyEvent. AnyEvent supports a special "strict" mode - off by default - which does very strict argument checking, at the expense of slowing down your program. During development, however, this mode is very useful because it quickly catches the msot common errors. You can enable this strict mode either by having an environment variable C with a true value in your environment: AE_STRICT=1 perl myprog Or you can write C in your program, which has the same effect (do not do this in production, however). =item Increase verbosity, configure logging AnyEvent, by default, only logs critical messages. If something doesn't work, maybe there was a warning about it that you didn't see because it was suppressed. So during development it is recommended to push up the logging level to at least warn level (C<5>): AE_VERBOSE=5 perl myprog Other levels that might be helpful are debug (C<8>) or even trace (C<9>). AnyEvent's logging is quite versatile - the L manpage has all the details. =item Watcher wrapping, tracing, the shell For even more debugging, you can enable watcher wrapping: AE_DEBUG_WRAP=2 perl myprog This will have the effect of wrapping every watcher into a special object that stores a backtrace of when it was created, stores a backtrace when an exception occurs during watcher execution, and stores a lot of other information. If that slows down your program too much, then C avoids the costly backtraces. Here is an example of what of information is stored: 59148536 DC::DB:472(Server::run)>io>DC::DB::Server::fh_read type: io watcher args: poll r fh GLOB(0x35283f0) created: 2011-09-01 23:13:46.597336 +0200 (1314911626.59734) file: ./blib/lib/Deliantra/Client/private/DC/DB.pm line: 472 subname: DC::DB::Server::run context: tracing: enabled cb: CODE(0x2d1fb98) (DC::DB::Server::fh_read) invoked: 0 times created (eval 25) line 6 AnyEvent::Debug::Wrap::__ANON__('AnyEvent','fh',GLOB(0x35283f0),'poll','r','cb',CODE(0x2d1fb98)=DC::DB::Server::fh_read) DC::DB line 472 AE::io(GLOB(0x35283f0),'0',CODE(0x2d1fb98)=DC::DB::Server::fh_read) bin/deliantra line 2776 DC::DB::Server::run() bin/deliantra line 2941 main::main() There are many ways to get at this data - see the L and L manpages for more details. The most interesting and interactive way is to create a debug shell, for example by setting C: AE_DEBUG_WRAP=2 AE_DEBUG_SHELL=$HOME/myshell ./myprog # while myprog is running: socat readline $HOME/myshell Note that anybody who can access F<$HOME/myshell> can make your program do anything he or she wants, so if you are not the only user on your machine, better put it into a secure location (F<$HOME> might not be secure enough). If you don't have C (a shame!) and care even less about security, you can also use TCP and C: AE_DEBUG_WRAP=2 AE_DEBUG_SHELL=127.0.0.1:1234 ./myprog telnet 127.0.0.1 1234 The debug shell can enable and disable tracing of watcher invocations, can display the trace output, give you a list of watchers and lets you investigate watchers in detail. =back This concludes our little tutorial. =head1 Where to go from here? This introduction should have explained the key concepts of L - event watchers and condition variables, L - basic networking utilities, and L - a nice wrapper around sockets. You could either start coding stuff right away, look at those manual pages for the gory details, or roam CPAN for other AnyEvent modules (such as L or L) to see more code examples (or simply to use them). If you need a protocol that doesn't have an implementation using AnyEvent, remember that you can mix AnyEvent with one other event framework, such as L, so you can always use AnyEvent for your own tasks plus modules of one other event framework to fill any gaps. And last not least, you could also look at L, especially L, to see how you can turn event-based programming from callback style back to the usual imperative style (also called "inversion of control" - AnyEvent calls I, but Coro lets I call AnyEvent). =head1 Authors Robin Redeker C<< >>, Marc Lehmann . AnyEvent-7.17/lib/AnyEvent/Loop.pm0000644000000000000000000002404413540267151015455 0ustar rootroot=head1 NAME AnyEvent::Loop - AnyEvent's Pure-Perl event loop =head1 SYNOPSIS use AnyEvent; # use AnyEvent::Loop; # this module gets loaded automatically when no other loop can be found # Explicit use: use AnyEvent::Loop; use AnyEvent; ... AnyEvent::Loop::run; # run the event loop =head1 DESCRIPTION This module provides an event loop for AnyEvent in case no other event loop could be found or loaded. You don't have to do anything to make it work with AnyEvent except by possibly loading it before creating the first AnyEvent watcher. This module is I some loop abstracion used by AnyEvent, but just another event loop like EV or Glib, just written in pure perl and delivered with AnyEvent, so AnyEvent always works, even in the absence of any other backend. If you want to use this module instead of autoloading a potentially better event loop you can simply load it (and no other event loops) before creating the first watcher. As for performance, this module is on par with (and usually faster than) most select/poll-based C event modules such as Event or Glib (it does not even come close to EV, though), with respect to I/O watchers. Timers are handled less optimally, but for many common tasks, it is still on par with event loops written in C. This event loop has been optimised for the following use cases: =over 4 =item monotonic clock is available This module will use the POSIX monotonic clock option (if it can be detected at runtime) or the POSIX C function (if the resolution is at least 100Hz), in which case it will not suffer adversely from time jumps. If no monotonic clock is available, this module will not attempt to correct for time jumps in any way. The clock chosen will be reported if the environment variable C<$PERL_ANYEVENT_VERBOSE> is set to 8 or higher. =item any number of watchers on one fd Supporting a large number of watchers per fd is purely a dirty benchmark optimisation not relevant in practise. The more common case of having one watcher per fd/poll combo is special-cased, however, and therefore fast, too. =item relatively few active fds per C traditionally is fast), at the expense of the "dense activity case" where most of the fds are active (which suits C in the presence of a large number of inactive file descriptors. =item lots of timer changes/iteration, or none at all This module sorts the timer list using perl's C, even though a total ordering is not required for timers internally. This sorting is expensive, but means sorting can be avoided unless the timer list has changed in a way that requires a new sort. This means that adding lots of timers is very efficient, as well as not changing the timers. Advancing timers (e.g. recreating a timeout watcher on activity) is also relatively efficient, for example, if you have a large number of timeout watchers that time out after 10 seconds, then the timer list will be sorted only once every 10 seconds. This should not have much of an impact unless you have hundreds or thousands of timers, though, or your timers have very small timeouts. =back =head1 FUNCTIONS The only user-visible functions provided by this module loop related - watchers are created via the normal AnyEvent mechanisms. =over 4 =item AnyEvent::Loop::run Run the event loop, usually the last thing done in the main program when you want to use the pure-perl backend. =item AnyEvent::Loop::one_event Blocks until at least one new event has been received by the operating system, whether or not it was AnyEvent-related. =back =cut package AnyEvent::Loop; use Scalar::Util qw(weaken); use List::Util (); use AnyEvent (); BEGIN { AnyEvent::common_sense } use AnyEvent::Util (); our $VERSION = $AnyEvent::VERSION; our ($NOW, $MNOW); sub MAXWAIT() { 3600 } # never sleep for longer than this many seconds BEGIN { local $SIG{__DIE__}; # protect us against the many broken __DIE__ handlers out there my $time_hires = eval "use Time::HiRes (); 1"; my $clk_tck = eval "use POSIX (); POSIX::sysconf (POSIX::_SC_CLK_TCK ())"; my $round; # actual granularity if ($time_hires && eval "&Time::HiRes::clock_gettime (Time::HiRes::CLOCK_MONOTONIC ())") { AE::log 8 => "Using CLOCK_MONOTONIC as timebase."; *_update_clock = sub { $NOW = &Time::HiRes::time; $MNOW = Time::HiRes::clock_gettime (&Time::HiRes::CLOCK_MONOTONIC); }; } elsif (100 <= $clk_tck && $clk_tck <= 1000000 && eval { (POSIX::times ())[0] != -1 }) { # -1 is also a valid return value :/ AE::log 8 => "Using POSIX::times (monotonic) as timebase."; my $HZ1 = 1 / $clk_tck; my $last = (POSIX::times ())[0]; my $next; *_update_clock = sub { $NOW = time; # d'oh $next = (POSIX::times ())[0]; # we assume 32 bit signed on wrap but 64 bit will never wrap $last -= 4294967296 if $last > $next; # 0x100000000, but perl has problems with big hex constants $MNOW += ($next - $last) * $HZ1; $last = $next; }; $round = $HZ1; } elsif (eval "use Time::HiRes (); 1") { AE::log 8 => "Using Time::HiRes::time (non-monotonic) clock as timebase."; *_update_clock = sub { $NOW = $MNOW = &Time::HiRes::time; }; } else { AE::log fatal => "Unable to find sub-second time source (is this really perl 5.8.0 or later?)"; } $round = 0.001 if $round < 0.001; # 1ms is enough for us $round -= $round * 1e-2; # 0.1 => 0.099 eval "sub ROUNDUP() { $round }"; } _update_clock; # rely on AnyEvent:Base::time to provide time sub now () { $NOW } sub now_update() { _update_clock } # fds[0] is for read, fds[1] is for write watchers # fds[poll][V] is the bitmask for select # fds[poll][W][fd] contains a list of i/o watchers # an I/O watcher is a blessed arrayref containing [fh, poll(0/1), callback, queue-index] # the queue-index is simply the index in the [W] array, which is only used to improve # benchmark results in the synthetic "many watchers on one fd" benchmark. my @fds = ([], []); sub V() { 0 } sub W() { 1 } my $need_sort = 1e300; # when to re-sort timer list my @timer; # list of [ abs-timeout, Timer::[callback] ] my @idle; # list of idle callbacks # the pure perl mainloop sub one_event { _update_clock; # first sort timers if required (slow) if ($MNOW >= $need_sort) { $need_sort = 1e300; @timer = sort { $a->[0] <=> $b->[0] } @timer; } # handle all pending timers if (@timer && $timer[0][0] <= $MNOW) { do { my $timer = shift @timer; $timer->[1] && $timer->[1]($timer); } while @timer && $timer[0][0] <= $MNOW; } else { # poll for I/O events, we do not do this when there # were any pending timers to ensure that one_event returns # quickly when some timers have been handled my ($wait, @vec, $fds) = (@timer && $timer[0][0] < $need_sort ? $timer[0][0] : $need_sort) - $MNOW; $wait = $wait < MAXWAIT ? $wait + ROUNDUP : MAXWAIT; $wait = 0 if @idle; $fds = CORE::select $vec[0] = $fds[0][V], $vec[1] = $fds[1][V], AnyEvent::WIN32 ? $vec[2] = $fds[1][V] : undef, $wait; _update_clock; if ($fds > 0) { # buggy microshit windows errornously sets exceptfds instead of writefds $vec[1] |= $vec[2] if AnyEvent::WIN32; # prefer write watchers, because they might reduce memory pressure. for (1, 0) { my $fds = $fds[$_]; # we parse the bitmask by first expanding it into # a string of bits for (unpack "b*", $vec[$_]) { # and then repeatedly matching a regex against it while (/1/g) { # and use the resulting string position as fd $_ && $_->[2]() for @{ $fds->[W][(pos) - 1] || [] }; } } } } elsif (AnyEvent::WIN32 && $fds && $! == AnyEvent::Util::WSAEINVAL) { # buggy microshit windoze asks us to route around it CORE::select undef, undef, undef, $wait if $wait; } elsif (!@timer || $timer[0][0] > $MNOW && !$fds) { $$$_ && $$$_->() for @idle = grep $$$_, @idle; } } } sub run { one_event while 1; } sub io($$$) { my ($fd, $write, $cb) = @_; defined ($fd = fileno $fd) or $fd = $_[0]; my $self = bless [ $fd, $write, $cb, # q-idx ], "AnyEvent::Loop::io"; my $fds = $fds[$self->[1]]; # add watcher to fds structure my $q = $fds->[W][$fd] ||= []; (vec $fds->[V], $fd, 1) = 1; $self->[3] = @$q; push @$q, $self; weaken $q->[-1]; $self } sub AnyEvent::Loop::io::DESTROY { my ($self) = @_; my $fds = $fds[$self->[1]]; # remove watcher from fds structure my $fd = $self->[0]; if (@{ $fds->[W][$fd] } == 1) { delete $fds->[W][$fd]; (vec $fds->[V], $fd, 1) = 0; } else { my $q = $fds->[W][$fd]; my $last = pop @$q; if ($last != $self) { weaken ($q->[$self->[3]] = $last); $last->[3] = $self->[3]; } } } sub timer($$$) { my ($after, $interval, $cb) = @_; my $self; if ($interval) { $self = [$MNOW + $after , sub { $_[0][0] = List::Util::max $_[0][0] + $interval, $MNOW; push @timer, $_[0]; weaken $timer[-1]; $need_sort = $_[0][0] if $_[0][0] < $need_sort; &$cb; }]; } else { $self = [$MNOW + $after, $cb]; } push @timer, $self; weaken $timer[-1]; $need_sort = $self->[0] if $self->[0] < $need_sort; $self } sub idle($) { my $cb = shift; push @idle, \\$cb; weaken ${$idle[-1]}; ${$idle[-1]} } =head1 SEE ALSO L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Util.pm0000644000000000000000000006575413174001013015460 0ustar rootroot=encoding utf-8 =head1 NAME AnyEvent::Util - various utility functions. =head1 SYNOPSIS use AnyEvent::Util; =head1 DESCRIPTION This module implements various utility functions, mostly replacing well-known functions by event-ised counterparts. All functions documented without C prefix are exported by default. =over 4 =cut package AnyEvent::Util; use Carp (); use Errno (); use Socket (); use AnyEvent (); BEGIN { AnyEvent::common_sense } use base 'Exporter'; our @EXPORT = qw(fh_nonblocking guard fork_call portable_pipe portable_socketpair run_cmd); our @EXPORT_OK = qw( AF_INET6 WSAEWOULDBLOCK WSAEINPROGRESS WSAEINVAL close_all_fds_except punycode_encode punycode_decode idn_nameprep idn_to_ascii idn_to_unicode ); our $VERSION = $AnyEvent::VERSION; BEGIN { # provide us with AF_INET6, but only if allowed if ( $AnyEvent::PROTOCOL{ipv6} && _AF_INET6 && socket my $ipv6_socket, _AF_INET6, Socket::SOCK_DGRAM(), 0 # check if they can be created ) { *AF_INET6 = \&_AF_INET6; } else { # disable ipv6 *AF_INET6 = sub () { 0 }; delete $AnyEvent::PROTOCOL{ipv6}; } # fix buggy Errno on some non-POSIX platforms # such as openbsd and windows. my %ERR = ( EBADMSG => Errno::EDOM (), EPROTO => Errno::ESPIPE (), ); while (my ($k, $v) = each %ERR) { next if eval "Errno::$k ()"; AE::log 8 => "Broken Errno module, adding Errno::$k."; eval "sub Errno::$k () { $v }"; push @Errno::EXPORT_OK, $k; push @{ $Errno::EXPORT_TAGS{POSIX} }, $k; } } =item ($r, $w) = portable_pipe Calling C in Perl is portable - except it doesn't really work on sucky windows platforms (at least not with most perls - cygwin's perl notably works fine): On windows, you actually get two file handles you cannot use select on. This function gives you a pipe that actually works even on the broken windows platform (by creating a pair of TCP sockets on windows, so do not expect any speed from that) and using C everywhere else. See C, below, for a bidirectional "pipe". Returns the empty list on any errors. =item ($fh1, $fh2) = portable_socketpair Just like C, above, but returns a bidirectional pipe (usually by calling C to create a local loopback socket pair, except on windows, where it again returns two interconnected TCP sockets). Returns the empty list on any errors. =cut BEGIN { if (AnyEvent::WIN32) { *_win32_socketpair = sub () { # perl's socketpair emulation fails on many vista machines, because # vista returns fantasy port numbers. for (1..10) { socket my $l, Socket::AF_INET(), Socket::SOCK_STREAM(), 0 or next; bind $l, Socket::pack_sockaddr_in 0, "\x7f\x00\x00\x01" or next; my $sa = getsockname $l or next; listen $l, 1 or next; socket my $r, Socket::AF_INET(), Socket::SOCK_STREAM(), 0 or next; bind $r, Socket::pack_sockaddr_in 0, "\x7f\x00\x00\x01" or next; connect $r, $sa or next; accept my $w, $l or next; # vista has completely broken peername/sockname that return # fantasy ports. this combo seems to work, though. (Socket::unpack_sockaddr_in getpeername $r)[0] == (Socket::unpack_sockaddr_in getsockname $w)[0] or (($! = WSAEINVAL), next); # vista example (you can't make this shit up...): #(Socket::unpack_sockaddr_in getsockname $r)[0] == 53364 #(Socket::unpack_sockaddr_in getpeername $r)[0] == 53363 #(Socket::unpack_sockaddr_in getsockname $w)[0] == 53363 #(Socket::unpack_sockaddr_in getpeername $w)[0] == 53365 return ($r, $w); } () }; *portable_socketpair = \&_win32_socketpair; *portable_pipe = \&_win32_socketpair; } else { *portable_pipe = sub () { my ($r, $w); pipe $r, $w or return; ($r, $w); }; *portable_socketpair = sub () { socketpair my $fh1, my $fh2, Socket::AF_UNIX(), Socket::SOCK_STREAM(), 0 or return; ($fh1, $fh2) }; } } =item fork_call { CODE } @args, $cb->(@res) Executes the given code block asynchronously, by forking. Everything the block returns will be transferred to the calling process (by serialising and deserialising via L). If there are any errors, then the C<$cb> will be called without any arguments. In that case, either C<$@> contains the exception (and C<$!> is irrelevant), or C<$!> contains an error number. In all other cases, C<$@> will be Cined. The code block must not ever call an event-polling function or use event-based programming that might cause any callbacks registered in the parent to run. Win32 spoilers: Due to the endlessly sucky and broken native windows perls (there is no way to cleanly exit a child process on that platform that doesn't also kill the parent), you have to make sure that your main program doesn't exit as long as any C are still in progress, otherwise the program won't exit. Also, on most windows platforms some memory will leak for every invocation. We are open for improvements that don't require XS hackery. Note that forking can be expensive in large programs (RSS 200MB+). On windows, it is abysmally slow, do not expect more than 5..20 forks/s on that sucky platform (note this uses perl's pseudo-threads, so avoid those like the plague). Example: poor man's async disk I/O (better use L together with L). fork_call { open my $fh, " } sub { my ($passwd) = @_; ... }; =item $AnyEvent::Util::MAX_FORKS [default: 10] The maximum number of child processes that C will fork in parallel. Any additional requests will be queued until a slot becomes free again. The environment variable C is used to initialise this value. =cut our $MAX_FORKS = int 1 * $ENV{PERL_ANYEVENT_MAX_FORKS}; $MAX_FORKS = 10 if $MAX_FORKS <= 0; my $forks; my @fork_queue; sub _fork_schedule; sub _fork_schedule { require Storable unless $Storable::VERSION; require POSIX unless $POSIX::VERSION; while ($forks < $MAX_FORKS) { my $job = shift @fork_queue or last; ++$forks; my $coderef = shift @$job; my $cb = pop @$job; # gimme a break... my ($r, $w) = portable_pipe or ($forks and last) # allow failures when we have at least one job or die "fork_call: $!"; my $pid = fork; if ($pid != 0) { # parent close $w; my $buf; my $ww; $ww = AE::io $r, 0, sub { my $len = sysread $r, $buf, 65536, length $buf; return unless defined $len or $! != Errno::EINTR; if (!$len) { undef $ww; close $r; --$forks; _fork_schedule; my $result = eval { Storable::thaw ($buf) }; $result = [$@] unless $result; $@ = shift @$result; $cb->(@$result); # work around the endlessly broken windows perls kill 9, $pid if AnyEvent::WIN32; # clean up the pid waitpid $pid, 0; } }; } elsif (defined $pid) { # child close $r; my $result = eval { local $SIG{__DIE__}; Storable::freeze ([undef, $coderef->(@$job)]) }; $result = Storable::freeze (["$@"]) if $@; # windows forces us to these contortions my $ofs; while () { my $len = (length $result) - $ofs or last; $len = syswrite $w, $result, $len < 65536 ? $len : 65536, $ofs; last unless $len || (!defined $len && $! == Errno::EINTR); $ofs += $len; } # on native windows, _exit KILLS YOUR FORKED CHILDREN! if (AnyEvent::WIN32) { shutdown $w, 1; # signal parent to please kill us sleep 10; # give parent a chance to clean up sysread $w, (my $buf), 1; # this *might* detect the parent exiting in some cases. } POSIX::_exit (0); exit 1; } elsif (($! != &Errno::EAGAIN && $! != &Errno::EWOULDBLOCK && $! != &Errno::ENOMEM) || !$forks) { # we ignore some errors as long as we can run at least one job # maybe we should wait a few seconds and retry instead die "fork_call: $!"; } } } sub fork_call(&@) { push @fork_queue, [@_]; _fork_schedule; } END { if (AnyEvent::WIN32) { while ($forks) { @fork_queue = (); AnyEvent->one_event; } } } # to be removed sub dotted_quad($) { $_[0] =~ /^(?:25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?) \.(?:25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?) \.(?:25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?) \.(?:25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?)$/x } # just a forwarder sub inet_aton { require AnyEvent::Socket; *inet_aton = \&AnyEvent::Socket::inet_aton; goto &inet_aton } =item fh_nonblocking $fh, $nonblocking Sets the blocking state of the given filehandle (true == nonblocking, false == blocking). Uses fcntl on anything sensible and ioctl FIONBIO on broken (i.e. windows) platforms. Instead of using this function, you could use C or C. =cut BEGIN { *fh_nonblocking = \&AnyEvent::_fh_nonblocking; } =item $guard = guard { CODE } This function creates a special object that, when destroyed, will execute the code block. This is often handy in continuation-passing style code to clean up some resource regardless of where you break out of a process. The L module will be used to implement this function, if it is available. Otherwise a pure-perl implementation is used. While the code is allowed to throw exceptions in unusual conditions, it is not defined whether this exception will be reported (at the moment, the Guard module and AnyEvent's pure-perl implementation both try to report the error and continue). You can call one method on the returned object: =item $guard->cancel This simply causes the code block not to be invoked: it "cancels" the guard. =cut BEGIN { if (!$ENV{PERL_ANYEVENT_AVOID_GUARD} && eval { require Guard; $Guard::VERSION >= 0.5 }) { *guard = \&Guard::guard; AE::log 8 => "Using Guard module to implement guards."; } else { *AnyEvent::Util::guard::DESTROY = sub { local $@; eval { local $SIG{__DIE__}; ${$_[0]}->(); }; AE::log 4 => "Runtime error in AnyEvent::guard callback: $@" if $@; }; *AnyEvent::Util::guard::cancel = sub ($) { ${$_[0]} = sub { }; }; *guard = sub (&) { bless \(my $cb = shift), "AnyEvent::Util::guard" }; AE::log 8 => "Using pure-perl guard implementation."; } } =item AnyEvent::Util::close_all_fds_except @fds This rarely-used function simply closes all file descriptors (or tries to) of the current process except the ones given as arguments. When you want to start a long-running background server, then it is often beneficial to do this, as too many C-libraries are too stupid to mark their internal fd's as close-on-exec. The function expects to be called shortly before an C call. Example: close all fds except 0, 1, 2. close_all_fds_except 0, 2, 1; =cut sub close_all_fds_except { my %except; @except{@_} = (); require POSIX unless $POSIX::VERSION; # some OSes have a usable /dev/fd, sadly, very few if ($^O =~ /(freebsd|cygwin|linux)/) { # netbsd, openbsd, solaris have a broken /dev/fd my $dir; if (opendir $dir, "/dev/fd" or opendir $dir, "/proc/self/fd") { my @fds = sort { $a <=> $b } grep /^\d+$/, readdir $dir; # broken OS's have device nodes for 0..63 usually, solaris 0..255 if (@fds < 20 or "@fds" ne join " ", 0..$#fds) { # assume the fds array is valid now exists $except{$_} or POSIX::close ($_) for @fds; return; } } } my $fd_max = eval { POSIX::sysconf (POSIX::_SC_OPEN_MAX ()) - 1 } || 1023; exists $except{$_} or POSIX::close ($_) for 0..$fd_max; } =item $cv = run_cmd $cmd, key => value... Run a given external command, potentially redirecting file descriptors and return a condition variable that gets sent the exit status (like C<$?>) when the program exits I all redirected file descriptors have been exhausted. The C<$cmd> is either a single string, which is then passed to a shell, or an arrayref, which is passed to the C function (the first array element is used both for the executable name and argv[0]). The key-value pairs can be: =over 4 =item ">" => $filename Redirects program standard output into the specified filename, similar to C<< >filename >> in the shell. =item ">" => \$data Appends program standard output to the referenced scalar. The condvar will not be signalled before EOF or an error is signalled. Specifying the same scalar in multiple ">" pairs is allowed, e.g. to redirect both stdout and stderr into the same scalar: ">" => \$output, "2>" => \$output, =item ">" => $filehandle Redirects program standard output to the given filehandle (or actually its underlying file descriptor). =item ">" => $callback->($data) Calls the given callback each time standard output receives some data, passing it the data received. On EOF or error, the callback will be invoked once without any arguments. The condvar will not be signalled before EOF or an error is signalled. =item "fd>" => $see_above Like ">", but redirects the specified fd number instead. =item "<" => $see_above The same, but redirects the program's standard input instead. The same forms as for ">" are allowed. In the callback form, the callback is supposed to return data to be written, or the empty list or C or a zero-length scalar to signal EOF. Similarly, either the write data must be exhausted or an error is to be signalled before the condvar is signalled, for both string-reference and callback forms. =item "fd<" => $see_above Like "<", but redirects the specified file descriptor instead. =item on_prepare => $cb Specify a callback that is executed just before the command is C'ed, in the child process. Be careful not to use any event handling or other services not available in the child. This can be useful to set up the environment in special ways, such as changing the priority of the command or manipulating signal handlers (e.g. setting C to C). =item close_all => $boolean When C is enabled (default is disabled), then all extra file descriptors will be closed, except the ones that were redirected and C<0>, C<1> and C<2>. See C for more details. =item '$$' => \$pid A reference to a scalar which will receive the PID of the newly-created subprocess after C returns. Note the the PID might already have been recycled and used by an unrelated process at the time C returns, so it's not useful to send signals, use as a unique key in data structures and so on. =back Example: run C, redirecting standard input, output and error to F. my $cv = run_cmd [qw(rm -rf /)], "<", "/dev/null", ">", "/dev/null", "2>", "/dev/null"; $cv->recv and die "d'oh! something survived!" Example: run F and create a self-signed certificate and key, storing them in C<$cert> and C<$key>. When finished, check the exit status in the callback and print key and certificate. my $cv = run_cmd [qw(openssl req -new -nodes -x509 -days 3650 -newkey rsa:2048 -keyout /dev/fd/3 -batch -subj /CN=AnyEvent )], "<", "/dev/null", ">" , \my $cert, "3>", \my $key, "2>", "/dev/null"; $cv->cb (sub { shift->recv and die "openssl failed"; print "$key\n$cert\n"; }); =cut sub run_cmd { my $cmd = shift; require POSIX unless $POSIX::VERSION; my $cv = AE::cv; my %arg; my %redir; my @exe; while (@_) { my ($type, $ob) = splice @_, 0, 2; my $fd = $type =~ s/^(\d+)// ? $1 : undef; if ($type eq ">") { $fd = 1 unless defined $fd; if (defined eval { fileno $ob }) { $redir{$fd} = $ob; } elsif (ref $ob) { my ($pr, $pw) = AnyEvent::Util::portable_pipe; $cv->begin; fcntl $pr, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC; fh_nonblocking $pr, 1; my $w; $w = AE::io $pr, 0, "SCALAR" eq ref $ob ? sub { defined (sysread $pr, $$ob, 16384, length $$ob and return) or ($! == Errno::EINTR and return); undef $w; $cv->end; } : sub { my $buf; defined (sysread $pr, $buf, 16384 and return $ob->($buf)) or ($! == Errno::EINTR and return); undef $w; $cv->end; $ob->(); } ; $redir{$fd} = $pw; } else { push @exe, sub { open my $fh, ">", $ob or POSIX::_exit (125); $redir{$fd} = $fh; }; } } elsif ($type eq "<") { $fd = 0 unless defined $fd; if (defined eval { fileno $ob }) { $redir{$fd} = $ob; } elsif (ref $ob) { my ($pr, $pw) = AnyEvent::Util::portable_pipe; $cv->begin; my $data; if ("SCALAR" eq ref $ob) { $data = $$ob; $ob = sub { }; } else { $data = $ob->(); } fcntl $pw, AnyEvent::F_SETFD, AnyEvent::FD_CLOEXEC; fh_nonblocking $pw, 1; my $w; $w = AE::io $pw, 1, sub { my $len = syswrite $pw, $data; return unless defined $len or $! != Errno::EINTR; if (!$len) { undef $w; $cv->end; } else { substr $data, 0, $len, ""; unless (length $data) { $data = $ob->(); unless (length $data) { undef $w; $cv->end } } } }; $redir{$fd} = $pr; } else { push @exe, sub { open my $fh, "<", $ob or POSIX::_exit (125); $redir{$fd} = $fh; }; } } else { $arg{$type} = $ob; } } my $pid = fork; defined $pid or Carp::croak "fork: $!"; unless ($pid) { # step 1, execute $_->() for @exe; # step 2, move any existing fd's out of the way # this also ensures that dup2 is never called with fd1==fd2 # so the cloexec flag is always cleared my (@oldfh, @close); for my $fh (values %redir) { push @oldfh, $fh; # make sure we keep it open $fh = fileno $fh; # we only want the fd # dup if we are in the way # if we "leak" fds here, they will be dup2'ed over later defined ($fh = POSIX::dup ($fh)) or POSIX::_exit (124) while exists $redir{$fh}; } # step 3, execute redirects while (my ($k, $v) = each %redir) { defined POSIX::dup2 ($v, $k) or POSIX::_exit (123); } # step 4, close everything else, except 0, 1, 2 if ($arg{close_all}) { close_all_fds_except 0, 1, 2, keys %redir } else { POSIX::close ($_) for values %redir; } eval { $arg{on_prepare}(); 1 } or POSIX::_exit (123) if exists $arg{on_prepare}; ref $cmd ? exec {$cmd->[0]} @$cmd : exec $cmd; POSIX::_exit (126); } ${$arg{'$$'}} = $pid if $arg{'$$'}; %redir = (); # close child side of the fds my $status; $cv->begin (sub { shift->send ($status) }); my $cw; $cw = AE::child $pid, sub { $status = $_[1]; undef $cw; $cv->end; }; $cv } =item AnyEvent::Util::punycode_encode $string Punycode-encodes the given C<$string> and returns its punycode form. Note that uppercase letters are I casefolded - you have to do that yourself. Croaks when it cannot encode the string. =item AnyEvent::Util::punycode_decode $string Tries to punycode-decode the given C<$string> and return its unicode form. Again, uppercase letters are not casefoled, you have to do that yourself. Croaks when it cannot decode the string. =cut sub punycode_encode($) { require "AnyEvent/Util/idna.pl"; goto &punycode_encode; } sub punycode_decode($) { require "AnyEvent/Util/idna.pl"; goto &punycode_decode; } =item AnyEvent::Util::idn_nameprep $idn[, $display] Implements the IDNA nameprep normalisation algorithm. Or actually the UTS#46 algorithm. Or maybe something similar - reality is complicated between IDNA2003, UTS#46 and IDNA2008. If C<$display> is true then the name is prepared for display, otherwise it is prepared for lookup (default). If you have no clue what this means, look at C instead. This function is designed to avoid using a lot of resources - it uses about 1MB of RAM (most of this due to Unicode::Normalize). Also, names that are already "simple" will only be checked for basic validity, without the overhead of full nameprep processing. =cut our ($uts46_valid, $uts46_imap); sub idn_nameprep($;$) { local $_ = $_[0]; # lowercasing these should always be valid, and is required for xn-- detection y/A-Z/a-z/; if (/[^0-9a-z\-.]/) { # load the mapping data unless (defined $uts46_imap) { require Unicode::Normalize; require "AnyEvent/Util/uts46data.pl"; } # uts46 nameprep # I naively tried to use a regex/transliterate approach first, # with one regex and one y///, but the compiled code was 4.5MB. # this version has a bit-table for the valid class, and # a char-replacement search string # for speed (cough) reasons, we skip-case 0-9a-z, -, ., which # really ought to be trivially valid. A-Z is valid, but already lowercased. s{ ([^0-9a-z\-.]) }{ my $chr = $1; unless (vec $uts46_valid, ord $chr, 1) { # not in valid class, search for mapping utf8::encode $chr; # the imap table is in utf-8 (my $rep = index $uts46_imap, "\x00$chr") >= 0 or Carp::croak "$_[0]: disallowed characters (U+" . (unpack "H*", $chr) . ") during idn_nameprep"; (substr $uts46_imap, $rep, 128) =~ /\x00 .[\x80-\xbf]* ([^\x00]*) \x00/x or die "FATAL: idn_nameprep imap table has unexpected contents"; $rep = $1; $chr = $rep unless $rep =~ s/^\x01// && $_[1]; # replace unless deviation and display utf8::decode $chr; } $chr }gex; # KC $_ = Unicode::Normalize::NFKC ($_); } # decode punycode components, check for invalid xx-- prefixes s{ (^|\.)(..)--([^\.]*) }{ my ($pfx, $ace, $pc) = ($1, $2, $3); if ($ace eq "xn") { $pc = punycode_decode $pc; # will croak on error (we hope :) require Unicode::Normalize; $pc eq Unicode::Normalize::NFC ($pc) or Carp::croak "$_[0]: punycode label not in NFC detected during idn_nameprep"; "$pfx$pc" } elsif ($ace !~ /^[a-z0-9]{2}$/) { "$pfx$ace--$pc" } else { Carp::croak "$_[0]: hyphens in 3rd/4th position of a label are not allowed"; } }gex; # uts46 verification /\.-|-\./ and Carp::croak "$_[0]: invalid hyphens detected during idn_nameprep"; # missing: label begin with combining mark, idna2008 bidi # now check validity of each codepoint if (/[^0-9a-z\-.]/) { # load the mapping data unless (defined $uts46_imap) { require "AnyEvent/Util/uts46data.pl"; } vec $uts46_valid, ord, 1 or $_[1] && 0 <= index $uts46_imap, pack "C0U*", 0, ord, 1 # deviation == \x00$chr\x01 or Carp::croak "$_[0]: disallowed characters during idn_nameprep" for split //; } $_ } =item $domainname = AnyEvent::Util::idn_to_ascii $idn Converts the given unicode string (C<$idn>, international domain name, e.g. 日本語。ＪＰ) to a pure-ASCII domain name (this is usually called the "IDN ToAscii" transform). This transformation is idempotent, which means you can call it just in case and it will do the right thing. Unlike some other "ToAscii" implementations, this one works on full domain names and should never fail - if it cannot convert the name, then it will return it unchanged. This function is an amalgam of IDNA2003, UTS#46 and IDNA2008 - it tries to be reasonably compatible to other implementations, reasonably secure, as much as IDNs can be secure, and reasonably efficient when confronted with IDNs that are already valid DNS names. =cut sub idn_to_ascii($) { return $_[0] unless $_[0] =~ /[^\x00-\x7f]/; my @output; eval { # punycode by label for (split /\./, (idn_nameprep $_[0]), -1) { if (/[^\x00-\x7f]/) { eval { push @output, "xn--" . punycode_encode $_; 1; } or do { push @output, $_; }; } else { push @output, $_; } } 1 } or return $_[0]; shift @output while !length $output[0] && @output > 1; join ".", @output } =item $idn = AnyEvent::Util::idn_to_unicode $idn Converts the given unicode string (C<$idn>, international domain name, e.g. 日本語。ＪＰ, www.deliantra.net, www.xn--l-0ga.de) to unicode form (this is usually called the "IDN ToUnicode" transform). This transformation is idempotent, which means you can call it just in case and it will do the right thing. Unlike some other "ToUnicode" implementations, this one works on full domain names and should never fail - if it cannot convert the name, then it will return it unchanged. This function is an amalgam of IDNA2003, UTS#46 and IDNA2008 - it tries to be reasonably compatible to other implementations, reasonably secure, as much as IDNs can be secure, and reasonably efficient when confronted with IDNs that are already valid DNS names. At the moment, this function simply calls C, returning its argument when that function fails. =cut sub idn_to_unicode($) { my $res = eval { idn_nameprep $_[0], 1 }; defined $res ? $res : $_[0] } =back =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/DNS.pm0000644000000000000000000012656213466242051015177 0ustar rootroot=head1 NAME AnyEvent::DNS - fully asynchronous DNS resolution =head1 SYNOPSIS use AnyEvent::DNS; my $cv = AnyEvent->condvar; AnyEvent::DNS::a "www.google.de", $cv; # ... later my @addrs = $cv->recv; =head1 DESCRIPTION This module offers both a number of DNS convenience functions as well as a fully asynchronous and high-performance pure-perl stub resolver. The stub resolver supports DNS over IPv4 and IPv6, UDP and TCP, optional EDNS0 support for up to 4kiB datagrams and automatically falls back to virtual circuit mode for large responses. =head2 CONVENIENCE FUNCTIONS =over 4 =cut package AnyEvent::DNS; use Carp (); use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM); use AnyEvent (); BEGIN { AnyEvent::common_sense } use AnyEvent::Util qw(AF_INET6); our $VERSION = $AnyEvent::VERSION; our @DNS_FALLBACK; # some public dns servers as fallback { my $prep = sub { $_ = $_->[rand @$_] for @_; push @_, splice @_, rand $_, 1 for reverse 1..@_; # shuffle $_ = pack "H*", $_ for @_; \@_ }; my $ipv4 = $prep->( ["08080808", "08080404"], # 8.8.8.8, 8.8.4.4 - google public dns ["01010101", "01000001"], # 1.1.1.1, 1.0.0.1 - cloudflare public dns ["50505050", "50505151"], # 80.80.80.80, 80.80.81.81 - freenom.world ## ["d1f40003", "d1f30004"], # v209.244.0.3/4 - resolver1/2.level3.net - status unknown ## ["04020201", "04020203", "04020204", "04020205", "04020206"], # v4.2.2.1/3/4/5/6 - vnsc-pri.sys.gtei.net - effectively public ## ["cdd22ad2", "4044c8c8"], # 205.210.42.205, 64.68.200.200 - cache1/2.dnsresolvers.com - verified public # ["8d010101"], # 141.1.1.1 - cable&wireless, now vodafone - status unknown # 84.200.69.80 # dns.watch # 84.200.70.40 # dns.watch # 37.235.1.174 # freedns.zone # 37.235.1.177 # freedns.zone # 213.73.91.35 # dnscache.berlin.ccc.de # 194.150.168.168 # dns.as250.net; Berlin/Frankfurt # 85.214.20.141 # FoeBud (digitalcourage.de) # 77.109.148.136 # privacyfoundation.ch # 77.109.148.137 # privacyfoundation.ch # 91.239.100.100 # anycast.censurfridns.dk # 89.233.43.71 # ns1.censurfridns.dk # 204.152.184.76 # f.6to4-servers.net, ISC, USA ); my $ipv6 = $prep->( ["20014860486000000000000000008888", "20014860486000000000000000008844"], # 2001:4860:4860::8888/8844 - google ipv6 ["26064700470000000000000000001111", "26064700470000000000000000001001"], # 2606:4700:4700::1111/1001 - cloudflare dns ); undef $ipv4 unless $AnyEvent::PROTOCOL{ipv4}; undef $ipv6 unless $AnyEvent::PROTOCOL{ipv6}; ($ipv6, $ipv4) = ($ipv4, $ipv6) if $AnyEvent::PROTOCOL{ipv6} > $AnyEvent::PROTOCOL{ipv4}; @DNS_FALLBACK = (@$ipv4, @$ipv6); } =item AnyEvent::DNS::a $domain, $cb->(@addrs) Tries to resolve the given domain to IPv4 address(es). =item AnyEvent::DNS::aaaa $domain, $cb->(@addrs) Tries to resolve the given domain to IPv6 address(es). =item AnyEvent::DNS::mx $domain, $cb->(@hostnames) Tries to resolve the given domain into a sorted (lower preference value first) list of domain names. =item AnyEvent::DNS::ns $domain, $cb->(@hostnames) Tries to resolve the given domain name into a list of name servers. =item AnyEvent::DNS::txt $domain, $cb->(@hostnames) Tries to resolve the given domain name into a list of text records. Only the first text string per record will be returned. If you want all strings, you need to call the resolver manually: resolver->resolve ($domain => "txt", sub { for my $record (@_) { my (undef, undef, undef, @txt) = @$record; # strings now in @txt } }); =item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr) Tries to resolve the given service, protocol and domain name into a list of service records. Each C<$srv_rr> is an array reference with the following contents: C<[$priority, $weight, $transport, $target]>. They will be sorted with lowest priority first, then randomly distributed by weight as per RFC 2782. Example: AnyEvent::DNS::srv "sip", "udp", "schmorp.de", sub { ... # @_ = ( [10, 10, 5060, "sip1.schmorp.de" ] ) =item AnyEvent::DNS::any $domain, $cb->(@rrs) Tries to resolve the given domain and passes all resource records found to the callback. Note that this uses a DNS C query, which, as of RFC 8482, are officially deprecated. =item AnyEvent::DNS::ptr $domain, $cb->(@hostnames) Tries to make a PTR lookup on the given domain. See C and C if you want to resolve an IP address to a hostname instead. =item AnyEvent::DNS::reverse_lookup $ipv4_or_6, $cb->(@hostnames) Tries to reverse-resolve the given IPv4 or IPv6 address (in textual form) into its hostname(s). Handles V4MAPPED and V4COMPAT IPv6 addresses transparently. =item AnyEvent::DNS::reverse_verify $ipv4_or_6, $cb->(@hostnames) The same as C, but does forward-lookups to verify that the resolved hostnames indeed point to the address, which makes spoofing harder. If you want to resolve an address into a hostname, this is the preferred method: The DNS records could still change, but at least this function verified that the hostname, at one point in the past, pointed at the IP address you originally resolved. Example: AnyEvent::DNS::reverse_verify "2001:500:2f::f", sub { print shift }; # => f.root-servers.net =cut sub MAX_PKT() { 4096 } # max packet size we advertise and accept sub DOMAIN_PORT() { 53 } # if this changes drop me a note sub resolver (); sub a($$) { my ($domain, $cb) = @_; resolver->resolve ($domain => "a", sub { $cb->(map $_->[4], @_); }); } sub aaaa($$) { my ($domain, $cb) = @_; resolver->resolve ($domain => "aaaa", sub { $cb->(map $_->[4], @_); }); } sub mx($$) { my ($domain, $cb) = @_; resolver->resolve ($domain => "mx", sub { $cb->(map $_->[5], sort { $a->[4] <=> $b->[4] } @_); }); } sub ns($$) { my ($domain, $cb) = @_; resolver->resolve ($domain => "ns", sub { $cb->(map $_->[4], @_); }); } sub txt($$) { my ($domain, $cb) = @_; resolver->resolve ($domain => "txt", sub { $cb->(map $_->[4], @_); }); } sub srv($$$$) { my ($service, $proto, $domain, $cb) = @_; # todo, ask for any and check glue records resolver->resolve ("_$service._$proto.$domain" => "srv", sub { my @res; # classify by priority my %pri; push @{ $pri{$_->[4]} }, [ @$_[4,5,6,7] ] for @_; # order by priority for my $pri (sort { $a <=> $b } keys %pri) { # order by weight my @rr = sort { $a->[1] <=> $b->[1] } @{ delete $pri{$pri} }; my $sum; $sum += $_->[1] for @rr; while (@rr) { my $w = int rand $sum + 1; for (0 .. $#rr) { if (($w -= $rr[$_][1]) <= 0) { $sum -= $rr[$_][1]; push @res, splice @rr, $_, 1, (); last; } } } } $cb->(@res); }); } sub ptr($$) { my ($domain, $cb) = @_; resolver->resolve ($domain => "ptr", sub { $cb->(map $_->[4], @_); }); } sub any($$) { my ($domain, $cb) = @_; resolver->resolve ($domain => "*", $cb); } # convert textual ip address into reverse lookup form sub _munge_ptr($) { my $ipn = $_[0] or return; my $ptr; my $af = AnyEvent::Socket::address_family ($ipn); if ($af == AF_INET6) { $ipn = substr $ipn, 0, 16; # anticipate future expansion # handle v4mapped and v4compat if ($ipn =~ s/^\x00{10}(?:\xff\xff|\x00\x00)//) { $af = AF_INET; } else { $ptr = join ".", (reverse split //, unpack "H32", $ipn), "ip6.arpa."; } } if ($af == AF_INET) { $ptr = join ".", (reverse unpack "C4", $ipn), "in-addr.arpa."; } $ptr } sub reverse_lookup($$) { my ($ip, $cb) = @_; $ip = _munge_ptr AnyEvent::Socket::parse_address ($ip) or return $cb->(); resolver->resolve ($ip => "ptr", sub { $cb->(map $_->[4], @_); }); } sub reverse_verify($$) { my ($ip, $cb) = @_; my $ipn = AnyEvent::Socket::parse_address ($ip) or return $cb->(); my $af = AnyEvent::Socket::address_family ($ipn); my @res; my $cnt; my $ptr = _munge_ptr $ipn or return $cb->(); $ip = AnyEvent::Socket::format_address ($ipn); # normalise into the same form ptr $ptr, sub { for my $name (@_) { ++$cnt; # () around AF_INET to work around bug in 5.8 resolver->resolve ("$name." => ($af == (AF_INET) ? "a" : "aaaa"), sub { for (@_) { push @res, $name if $_->[4] eq $ip; } $cb->(@res) unless --$cnt; }); } $cb->() unless $cnt; }; } ################################################################################# =back =head2 LOW-LEVEL DNS EN-/DECODING FUNCTIONS =over 4 =item $AnyEvent::DNS::EDNS0 This variable decides whether dns_pack automatically enables EDNS0 support. By default, this is disabled (C<0>), unless overridden by C<$ENV{PERL_ANYEVENT_EDNS0}>, but when set to C<1>, AnyEvent::DNS will use EDNS0 in all requests. =cut our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0}*1; # set to 1 to enable (partial) edns0 our %opcode_id = ( query => 0, iquery => 1, status => 2, notify => 4, update => 5, map +($_ => $_), 3, 6..15 ); our %opcode_str = reverse %opcode_id; our %rcode_id = ( noerror => 0, formerr => 1, servfail => 2, nxdomain => 3, notimp => 4, refused => 5, yxdomain => 6, # Name Exists when it should not [RFC 2136] yxrrset => 7, # RR Set Exists when it should not [RFC 2136] nxrrset => 8, # RR Set that should exist does not [RFC 2136] notauth => 9, # Server Not Authoritative for zone [RFC 2136] notzone => 10, # Name not contained in zone [RFC 2136] # EDNS0 16 BADVERS Bad OPT Version [RFC 2671] # EDNS0 16 BADSIG TSIG Signature Failure [RFC 2845] # EDNS0 17 BADKEY Key not recognized [RFC 2845] # EDNS0 18 BADTIME Signature out of time window [RFC 2845] # EDNS0 19 BADMODE Bad TKEY Mode [RFC 2930] # EDNS0 20 BADNAME Duplicate key name [RFC 2930] # EDNS0 21 BADALG Algorithm not supported [RFC 2930] map +($_ => $_), 11..15 ); our %rcode_str = reverse %rcode_id; our %type_id = ( a => 1, ns => 2, md => 3, mf => 4, cname => 5, soa => 6, mb => 7, mg => 8, mr => 9, null => 10, wks => 11, ptr => 12, hinfo => 13, minfo => 14, mx => 15, txt => 16, sig => 24, key => 25, gpos => 27, # rfc1712 aaaa => 28, loc => 29, # rfc1876 srv => 33, naptr => 35, # rfc2915 dname => 39, # rfc2672 opt => 41, ds => 43, # rfc4034 sshfp => 44, # rfc4255 rrsig => 46, # rfc4034 nsec => 47, # rfc4034 dnskey=> 48, # rfc4034 smimea=> 53, # rfc8162 cds => 59, # rfc7344 cdnskey=> 60, # rfc7344 openpgpkey=> 61, # rfc7926 csync => 62, # rfc7929 spf => 99, tkey => 249, tsig => 250, ixfr => 251, axfr => 252, mailb => 253, "*" => 255, uri => 256, caa => 257, # rfc6844 ); our %type_str = reverse %type_id; our %class_id = ( in => 1, ch => 3, hs => 4, none => 254, "*" => 255, ); our %class_str = reverse %class_id; sub _enc_name($) { pack "(C/a*)*", (split /\./, shift), "" } if ($] < 5.008) { # special slower 5.6 version *_enc_name = sub ($) { join "", map +(pack "C/a*", $_), (split /\./, shift), "" }; } sub _enc_qd() { (_enc_name $_->[0]) . pack "nn", ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}), ($_->[3] > 0 ? $_->[2] : $class_id{$_->[2] || "in"}) } sub _enc_rr() { die "encoding of resource records is not supported"; } =item $pkt = AnyEvent::DNS::dns_pack $dns Packs a perl data structure into a DNS packet. Reading RFC 1035 is strongly recommended, then everything will be totally clear. Or maybe not. Resource records are not yet encodable. Examples: # very simple request, using lots of default values: { rd => 1, qd => [ [ "host.domain", "a"] ] } # more complex example, showing how flags etc. are named: { id => 10000, op => "query", rc => "nxdomain", # flags qr => 1, aa => 0, tc => 0, rd => 0, ra => 0, ad => 0, cd => 0, qd => [@rr], # query section an => [@rr], # answer section ns => [@rr], # authority section ar => [@rr], # additional records section } =cut sub dns_pack($) { my ($req) = @_; pack "nn nnnn a* a* a* a* a*", $req->{id}, ! !$req->{qr} * 0x8000 + $opcode_id{$req->{op}} * 0x0800 + ! !$req->{aa} * 0x0400 + ! !$req->{tc} * 0x0200 + ! !$req->{rd} * 0x0100 + ! !$req->{ra} * 0x0080 + ! !$req->{ad} * 0x0020 + ! !$req->{cd} * 0x0010 + $rcode_id{$req->{rc}} * 0x0001, scalar @{ $req->{qd} || [] }, scalar @{ $req->{an} || [] }, scalar @{ $req->{ns} || [] }, $EDNS0 + scalar @{ $req->{ar} || [] }, # EDNS0 option included here (join "", map _enc_qd, @{ $req->{qd} || [] }), (join "", map _enc_rr, @{ $req->{an} || [] }), (join "", map _enc_rr, @{ $req->{ns} || [] }), (join "", map _enc_rr, @{ $req->{ar} || [] }), ($EDNS0 ? pack "C nnNn", 0, 41, MAX_PKT, 0, 0 : "") # EDNS0 option } our $ofs; our $pkt; # bitches sub _dec_name { my @res; my $redir; my $ptr = $ofs; my $cnt; while () { return undef if ++$cnt >= 256; # to avoid DoS attacks my $len = ord substr $pkt, $ptr++, 1; if ($len >= 0xc0) { $ptr++; $ofs = $ptr if $ptr > $ofs; $ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff; } elsif ($len) { push @res, substr $pkt, $ptr, $len; $ptr += $len; } else { $ofs = $ptr if $ptr > $ofs; return join ".", @res; } } } sub _dec_qd { my $qname = _dec_name; my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4; [$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc] } our %dec_rr = ( 1 => sub { join ".", unpack "C4", $_ }, # a 2 => sub { local $ofs = $ofs - length; _dec_name }, # ns 5 => sub { local $ofs = $ofs - length; _dec_name }, # cname 6 => sub { local $ofs = $ofs - length; my $mname = _dec_name; my $rname = _dec_name; ($mname, $rname, unpack "NNNNN", substr $pkt, $ofs) }, # soa 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx 16 => sub { unpack "(C/a*)*", $_ }, # txt 28 => sub { AnyEvent::Socket::format_ipv6 ($_) }, # aaaa 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv 35 => sub { # naptr # requires perl 5.10, sorry my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_; local $ofs = $ofs + $offset - length; ($order, $preference, $flags, $service, $regexp, _dec_name) }, 39 => sub { local $ofs = $ofs - length; _dec_name }, # dname 99 => sub { unpack "(C/a*)*", $_ }, # spf 257 => sub { unpack "CC/a*a*", $_ }, # caa ); sub _dec_rr { my $name = _dec_name; my ($rt, $rc, $ttl, $rdlen) = unpack "nn N n", substr $pkt, $ofs; $ofs += 10; local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen; [ $name, $type_str{$rt} || $rt, $class_str{$rc} || $rc, $ttl, ($dec_rr{$rt} || sub { $_ })->(), ] } =item $dns = AnyEvent::DNS::dns_unpack $pkt Unpacks a DNS packet into a perl data structure. Examples: # an unsuccessful reply { 'qd' => [ [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ] ], 'rc' => 'nxdomain', 'ar' => [], 'ns' => [ [ 'uni-karlsruhe.de', 'soa', 'in', 600, 'netserv.rz.uni-karlsruhe.de', 'hostmaster.rz.uni-karlsruhe.de', 2008052201, 10800, 1800, 2592000, 86400 ] ], 'tc' => '', 'ra' => 1, 'qr' => 1, 'id' => 45915, 'aa' => '', 'an' => [], 'rd' => 1, 'op' => 'query', '__' => '', } # a successful reply { 'qd' => [ [ 'www.google.de', 'a', 'in' ] ], 'rc' => 0, 'ar' => [ [ 'a.l.google.com', 'a', 'in', 3600, '209.85.139.9' ], [ 'b.l.google.com', 'a', 'in', 3600, '64.233.179.9' ], [ 'c.l.google.com', 'a', 'in', 3600, '64.233.161.9' ], ], 'ns' => [ [ 'l.google.com', 'ns', 'in', 3600, 'a.l.google.com' ], [ 'l.google.com', 'ns', 'in', 3600, 'b.l.google.com' ], ], 'tc' => '', 'ra' => 1, 'qr' => 1, 'id' => 64265, 'aa' => '', 'an' => [ [ 'www.google.de', 'cname', 'in', 3600, 'www.google.com' ], [ 'www.google.com', 'cname', 'in', 3600, 'www.l.google.com' ], [ 'www.l.google.com', 'a', 'in', 3600, '66.249.93.104' ], [ 'www.l.google.com', 'a', 'in', 3600, '66.249.93.147' ], ], 'rd' => 1, 'op' => 0, '__' => '', } =cut sub dns_unpack($) { local $pkt = shift; my ($id, $flags, $qd, $an, $ns, $ar) = unpack "nn nnnn A*", $pkt; local $ofs = 6 * 2; { __ => $pkt, id => $id, qr => ! ! ($flags & 0x8000), aa => ! ! ($flags & 0x0400), tc => ! ! ($flags & 0x0200), rd => ! ! ($flags & 0x0100), ra => ! ! ($flags & 0x0080), ad => ! ! ($flags & 0x0020), cd => ! ! ($flags & 0x0010), op => $opcode_str{($flags & 0x001e) >> 11}, rc => $rcode_str{($flags & 0x000f)}, qd => [map _dec_qd, 1 .. $qd], an => [map _dec_rr, 1 .. $an], ns => [map _dec_rr, 1 .. $ns], ar => [map _dec_rr, 1 .. $ar], } } ############################################################################# =back =head3 Extending DNS Encoder and Decoder This section describes an I method to extend the DNS encoder and decoder with new opcode, rcode, class and type strings, as well as resource record decoders. Since this is experimental, it can change, as anything can change, but this interface is expe ctedc to be relatively stable and was stable during the whole existance of C so far. Note that, since changing the decoder or encoder might break existing code, you should either be sure to control for this, or only temporarily change these values, e.g. like so: my $decoded = do { local $AnyEvent::DNS::opcode_str{7} = "yxrrset"; AnyEvent::DNS::dns_unpack $mypkt }; =over 4 =item %AnyEvent::DNS::opcode_id, %AnyEvent::DNS::opcode_str Two hashes that map lowercase opcode strings to numerical id's (For the encoder), or vice versa (for the decoder). Example: add a new opcode string C. $AnyEvent::DNS::opcode_id{notzone} = 10; $AnyEvent::DNS::opcode_str{10} = 'notzone'; =item %AnyEvent::DNS::rcode_id, %AnyEvent::DNS::rcode_str Same as above, for for rcode values. =item %AnyEvent::DNS::class_id, %AnyEvent::DNS::class_str Same as above, but for resource record class names/values. =item %AnyEvent::DNS::type_id, %AnyEvent::DNS::type_str Same as above, but for resource record type names/values. =item %AnyEvent::DNS::dec_rr This hash maps resource record type values to code references. When decoding, they are called with C<$_> set to the undecoded data portion and C<$ofs> being the current byte offset. of the record. You should have a look at the existing implementations to understand how it works in detail, but here are two examples: Decode an A record. A records are simply four bytes with one byte per address component, so the decoder simply unpacks them and joins them with dots in between: $AnyEvent::DNS::dec_rr{1} = sub { join ".", unpack "C4", $_ }; Decode a CNAME record, which contains a potentially compressed domain name. package AnyEvent::DNS; # for %dec_rr, $ofsd and &_dec_name $dec_rr{5} = sub { local $ofs = $ofs - length; _dec_name }; =back =head2 THE AnyEvent::DNS RESOLVER CLASS This is the class which does the actual protocol work. =over 4 =cut use Carp (); use Scalar::Util (); use Socket (); our $NOW; =item AnyEvent::DNS::resolver This function creates and returns a resolver that is ready to use and should mimic the default resolver for your system as good as possible. It is used by AnyEvent itself as well. It only ever creates one resolver and returns this one on subsequent calls - see C<$AnyEvent::DNS::RESOLVER>, below, for details. Unless you have special needs, prefer this function over creating your own resolver object. The resolver is created with the following parameters: untaint enabled max_outstanding $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS} (default 10) C will be used for OS-specific configuration, unless C<$ENV{PERL_ANYEVENT_RESOLV_CONF}> is specified, in which case that file gets parsed. =item $AnyEvent::DNS::RESOLVER This variable stores the default resolver returned by C, or C when the default resolver hasn't been instantiated yet. One can provide a custom resolver (e.g. one with caching functionality) by storing it in this variable, causing all subsequent resolves done via C to be done via the custom one. =cut our $RESOLVER; sub resolver() { $RESOLVER || do { $RESOLVER = new AnyEvent::DNS untaint => 1, max_outstanding => $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}*1 || 10, ; $ENV{PERL_ANYEVENT_RESOLV_CONF} ? $RESOLVER->_load_resolv_conf_file ($ENV{PERL_ANYEVENT_RESOLV_CONF}) : $RESOLVER->os_config; $RESOLVER } } =item $resolver = new AnyEvent::DNS key => value... Creates and returns a new resolver. The following options are supported: =over 4 =item server => [...] A list of server addresses (default: C or C<::1>) in network format (i.e. as returned by C - both IPv4 and IPv6 are supported). =item timeout => [...] A list of timeouts to use (also determines the number of retries). To make three retries with individual time-outs of 2, 5 and 5 seconds, use C<[2, 5, 5]>, which is also the default. =item search => [...] The default search list of suffixes to append to a domain name (default: none). =item ndots => $integer The number of dots (default: C<1>) that a name must have so that the resolver tries to resolve the name without any suffixes first. =item max_outstanding => $integer Most name servers do not handle many parallel requests very well. This option limits the number of outstanding requests to C<$integer> (default: C<10>), that means if you request more than this many requests, then the additional requests will be queued until some other requests have been resolved. =item reuse => $seconds The number of seconds (default: C<300>) that a query id cannot be re-used after a timeout. If there was no time-out then query ids can be reused immediately. =item untaint => $boolean When true, then the resolver will automatically untaint results, and might also ignore certain environment variables. =back =cut sub new { my ($class, %arg) = @_; my $self = bless { server => [], timeout => [2, 5, 5], search => [], ndots => 1, max_outstanding => 10, reuse => 300, %arg, inhibit => 0, reuse_q => [], }, $class; # search should default to gethostname's domain # but perl lacks a good posix module # try to create an ipv4 and an ipv6 socket # only fail when we cannot create either my $got_socket; Scalar::Util::weaken (my $wself = $self); if (socket my $fh4, AF_INET , Socket::SOCK_DGRAM(), 0) { ++$got_socket; AnyEvent::fh_unblock $fh4; $self->{fh4} = $fh4; $self->{rw4} = AE::io $fh4, 0, sub { if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) { $wself->_recv ($pkt, $peer); } }; } if (AF_INET6 && socket my $fh6, AF_INET6, Socket::SOCK_DGRAM(), 0) { ++$got_socket; $self->{fh6} = $fh6; AnyEvent::fh_unblock $fh6; $self->{rw6} = AE::io $fh6, 0, sub { if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) { $wself->_recv ($pkt, $peer); } }; } $got_socket or Carp::croak "unable to create either an IPv4 or an IPv6 socket"; $self->_compile; $self } # called to start asynchronous configuration sub _config_begin { ++$_[0]{inhibit}; } # called when done with async config sub _config_done { --$_[0]{inhibit}; $_[0]->_compile; $_[0]->_scheduler; } =item $resolver->parse_resolv_conf ($string) Parses the given string as if it were a F file. The following directives are supported (but not necessarily implemented). C<#>- and C<;>-style comments, C, C, C, C, C (C, C, C). Everything else is silently ignored. =cut sub parse_resolv_conf { my ($self, $resolvconf) = @_; $self->{server} = []; $self->{search} = []; my $attempts; for (split /\n/, $resolvconf) { s/\s*[;#].*$//; # not quite legal, but many people insist if (/^\s*nameserver\s+(\S+)\s*$/i) { my $ip = $1; if (my $ipn = AnyEvent::Socket::parse_address ($ip)) { push @{ $self->{server} }, $ipn; } else { AE::log 5 => "nameserver $ip invalid and ignored, while parsing resolver config."; } } elsif (/^\s*domain\s+(\S*)\s*$/i) { $self->{search} = [$1]; } elsif (/^\s*search\s+(.*?)\s*$/i) { $self->{search} = [split /\s+/, $1]; } elsif (/^\s*sortlist\s+(.*?)\s*$/i) { # ignored, NYI } elsif (/^\s*options\s+(.*?)\s*$/i) { for (split /\s+/, $1) { if (/^timeout:(\d+)$/) { $self->{timeout} = [$1]; } elsif (/^attempts:(\d+)$/) { $attempts = $1; } elsif (/^ndots:(\d+)$/) { $self->{ndots} = $1; } else { # debug, rotate, no-check-names, inet6 } } } else { # silently skip stuff we don't understand } } $self->{timeout} = [($self->{timeout}[0]) x $attempts] if $attempts; $self->_compile; } sub _load_resolv_conf_file { my ($self, $resolv_conf) = @_; $self->_config_begin; require AnyEvent::IO; AnyEvent::IO::aio_load ($resolv_conf, sub { if (my ($contents) = @_) { $self->parse_resolv_conf ($contents); } else { AE::log 4 => "$resolv_conf: $!"; } $self->_config_done; }); } =item $resolver->os_config Tries so load and parse F on portable operating systems. Tries various egregious hacks on windows to force the DNS servers and searchlist out of the system. This method must be called at most once before trying to resolve anything. =cut sub os_config { my ($self) = @_; $self->_config_begin; $self->{server} = []; $self->{search} = []; if ((AnyEvent::WIN32 || $^O =~ /cygwin/i)) { # TODO: this blocks the program, but should not, but I # am too lazy to implement and test it. need to boot windows. ugh. #no strict 'refs'; # there are many options to find the current nameservers etc. on windows # all of them don't work consistently: # - the registry thing needs separate code on win32 native vs. cygwin # - the registry layout differs between windows versions # - calling windows api functions doesn't work on cygwin # - ipconfig uses locale-specific messages # we use Net::DNS::Resolver first, and if it fails, will fall back to # ipconfig parsing. unless (eval { # Net::DNS::Resolver uses a LOT of ram (~10mb), but what can we do :/ # (this seems mostly to be due to Win32::API). require Net::DNS::Resolver; my $r = Net::DNS::Resolver->new; $r->nameservers or die; for my $s ($r->nameservers) { if (my $ipn = AnyEvent::Socket::parse_address ($s)) { push @{ $self->{server} }, $ipn; } } $self->{search} = [$r->searchlist]; 1 }) { # we use ipconfig parsing because, despite all its brokenness, # it seems quite stable in practise. # unfortunately it wants a console window. # for good measure, we append a fallback nameserver to our list. if (open my $fh, "ipconfig /all |") { # parsing strategy: we go through the output and look for # :-lines with DNS in them. everything in those is regarded as # either a nameserver (if it parses as an ip address), or a suffix # (all else). my $dns; local $_; while (<$fh>) { if (s/^\s.*\bdns\b.*://i) { $dns = 1; } elsif (/^\S/ || /^\s[^:]{16,}: /) { $dns = 0; } if ($dns && /^\s*(\S+)\s*$/) { my $s = $1; $s =~ s/%\d+(?!\S)//; # get rid of ipv6 scope id if (my $ipn = AnyEvent::Socket::parse_address ($s)) { push @{ $self->{server} }, $ipn; } else { push @{ $self->{search} }, $s; } } } } } # always add the fallback servers on windows push @{ $self->{server} }, @DNS_FALLBACK; $self->_config_done; } else { # try /etc/resolv.conf everywhere else require AnyEvent::IO; AnyEvent::IO::aio_stat ("/etc/resolv.conf", sub { $self->_load_resolv_conf_file ("/etc/resolv.conf") if @_; $self->_config_done; }); } } =item $resolver->timeout ($timeout, ...) Sets the timeout values. See the C constructor argument (and note that this method expects the timeout values themselves, not an array-reference). =cut sub timeout { my ($self, @timeout) = @_; $self->{timeout} = \@timeout; $self->_compile; } =item $resolver->max_outstanding ($nrequests) Sets the maximum number of outstanding requests to C<$nrequests>. See the C constructor argument. =cut sub max_outstanding { my ($self, $max) = @_; $self->{max_outstanding} = $max; $self->_compile; } sub _compile { my $self = shift; my %search; $self->{search} = [grep 0 < length, grep !$search{$_}++, @{ $self->{search} }]; my %server; $self->{server} = [grep 0 < length, grep !$server{$_}++, @{ $self->{server} }]; unless (@{ $self->{server} }) { # use 127.0.0.1/::1 by default, add public nameservers as fallback my $default = $AnyEvent::PROTOCOL{ipv6} > $AnyEvent::PROTOCOL{ipv4} ? "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\1" : "\x7f\x00\x00\x01"; $self->{server} = [$default, @DNS_FALLBACK]; } my @retry; for my $timeout (@{ $self->{timeout} }) { for my $server (@{ $self->{server} }) { push @retry, [$server, $timeout]; } } $self->{retry} = \@retry; } sub _feed { my ($self, $res) = @_; ($res) = $res =~ /^(.*)$/s if AnyEvent::TAINT && $self->{untaint}; $res = dns_unpack $res or return; my $id = $self->{id}{$res->{id}}; return unless ref $id; $NOW = time; $id->[1]->($res); } sub _recv { my ($self, $pkt, $peer) = @_; # we ignore errors (often one gets port unreachable, but there is # no good way to take advantage of that. my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer); return unless $port == DOMAIN_PORT && grep $_ eq $host, @{ $self->{server} }; $self->_feed ($pkt); } sub _free_id { my ($self, $id, $timeout) = @_; if ($timeout) { # we need to block the id for a while $self->{id}{$id} = 1; push @{ $self->{reuse_q} }, [$NOW + $self->{reuse}, $id]; } else { # we can quickly recycle the id delete $self->{id}{$id}; } --$self->{outstanding}; $self->_scheduler; } # execute a single request, involves sending it with timeouts to multiple servers sub _exec { my ($self, $req) = @_; my $retry; # of retries my $do_retry; $do_retry = sub { my $retry_cfg = $self->{retry}[$retry++] or do { # failure $self->_free_id ($req->[2], $retry > 1); undef $do_retry; return $req->[1]->(); }; my ($server, $timeout) = @$retry_cfg; $self->{id}{$req->[2]} = [(AE::timer $timeout, 0, sub { $NOW = time; # timeout, try next &$do_retry if $do_retry; }), sub { my ($res) = @_; if ($res->{tc}) { # success, but truncated, so use tcp AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub { return unless $do_retry; # some other request could have invalidated us already my ($fh) = @_ or return &$do_retry; require AnyEvent::Handle; my $handle; $handle = new AnyEvent::Handle fh => $fh, timeout => $timeout, on_error => sub { undef $handle; return unless $do_retry; # some other request could have invalidated us already # failure, try next &$do_retry; }; $handle->push_write (pack "n/a*", $req->[0]); $handle->push_read (chunk => 2, sub { $handle->unshift_read (chunk => (unpack "n", $_[1]), sub { undef $handle; $self->_feed ($_[1]); }); }); }, sub { $timeout }); } else { # success $self->_free_id ($req->[2], $retry > 1); undef $do_retry; return $req->[1]->($res); } }]; my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server); my $fh = AF_INET == AnyEvent::Socket::sockaddr_family ($sa) ? $self->{fh4} : $self->{fh6} or return &$do_retry; send $fh, $req->[0], 0, $sa; }; &$do_retry; } sub _scheduler { my ($self) = @_; return if $self->{inhibit}; #no strict 'refs'; $NOW = time; # first clear id reuse queue delete $self->{id}{ (shift @{ $self->{reuse_q} })->[1] } while @{ $self->{reuse_q} } && $self->{reuse_q}[0][0] <= $NOW; while ($self->{outstanding} < $self->{max_outstanding}) { if (@{ $self->{reuse_q} } >= 30000) { # we ran out of ID's, wait a bit $self->{reuse_to} ||= AE::timer $self->{reuse_q}[0][0] - $NOW, 0, sub { delete $self->{reuse_to}; $self->_scheduler; }; last; } if (my $req = shift @{ $self->{queue} }) { # found a request in the queue, execute it while () { $req->[2] = int rand 65536; last unless exists $self->{id}{$req->[2]}; } ++$self->{outstanding}; $self->{id}{$req->[2]} = 1; substr $req->[0], 0, 2, pack "n", $req->[2]; $self->_exec ($req); } elsif (my $cb = shift @{ $self->{wait} }) { # found a wait_for_slot callback $cb->($self); } else { # nothing to do, just exit last; } } } =item $resolver->request ($req, $cb->($res)) This is the main low-level workhorse for sending DNS requests. This function sends a single request (a hash-ref formated as specified for C) to the configured nameservers in turn until it gets a response. It handles timeouts, retries and automatically falls back to virtual circuit mode (TCP) when it receives a truncated reply. It does not handle anything else, such as the domain searchlist or relative names - use C<< ->resolve >> for that. Calls the callback with the decoded response packet if a reply was received, or no arguments in case none of the servers answered. =cut sub request($$) { my ($self, $req, $cb) = @_; # _enc_name barfs on names that are too long, which is often outside # program control, so check for too long names here. for (@{ $req->{qd} }) { return AE::postpone sub { $cb->(undef) } if 255 < length $_->[0]; } push @{ $self->{queue} }, [dns_pack $req, $cb]; $self->_scheduler; } =item $resolver->resolve ($qname, $qtype, %options, $cb->(@rr)) Queries the DNS for the given domain name C<$qname> of type C<$qtype>. A C<$qtype> is either a numerical query type (e.g. C<1> for A records) or a lowercase name (you have to look at the source to see which aliases are supported, but all types from RFC 1035, C, C, C and a few more are known to this module). A C<$qtype> of "*" is supported and means "any" record type. The callback will be invoked with a list of matching result records or none on any error or if the name could not be found. CNAME chains (although illegal) are followed up to a length of 10. The callback will be invoked with arraryefs of the form C<[$name, $type, $class, $ttl, @data>], where C<$name> is the domain name, C<$type> a type string or number, C<$class> a class name, C<$ttl> is the remaining time-to-live and C<@data> is resource-record-dependent data, in seconds. For C records, this will be the textual IPv4 addresses, for C or C records this will be a domain name, for C records these are all the strings and so on. All types mentioned in RFC 1035, C, C, C and C are decoded. All resource records not known to this module will have the raw C field as fifth array element. Note that this resolver is just a stub resolver: it requires a name server supporting recursive queries, will not do any recursive queries itself and is not secure when used against an untrusted name server. The following options are supported: =over 4 =item search => [$suffix...] Use the given search list (which might be empty), by appending each one in turn to the C<$qname>. If this option is missing then the configured C and C values define its value (depending on C, the empty suffix will be prepended or appended to that C value). If the C<$qname> ends in a dot, then the searchlist will be ignored. =item accept => [$type...] Lists the acceptable result types: only result types in this set will be accepted and returned. The default includes the C<$qtype> and nothing else. If this list includes C, then CNAME-chains will not be followed (because you asked for the CNAME record). =item class => "class" Specify the query class ("in" for internet, "ch" for chaosnet and "hs" for hesiod are the only ones making sense). The default is "in", of course. =back Examples: # full example, you can paste this into perl: use Data::Dumper; use AnyEvent::DNS; AnyEvent::DNS::resolver->resolve ( "google.com", "*", my $cv = AnyEvent->condvar); warn Dumper [$cv->recv]; # shortened result: # [ # [ 'google.com', 'soa', 'in', 3600, 'ns1.google.com', 'dns-admin.google.com', # 2008052701, 7200, 1800, 1209600, 300 ], # [ # 'google.com', 'txt', 'in', 3600, # 'v=spf1 include:_netblocks.google.com ~all' # ], # [ 'google.com', 'a', 'in', 3600, '64.233.187.99' ], # [ 'google.com', 'mx', 'in', 3600, 10, 'smtp2.google.com' ], # [ 'google.com', 'ns', 'in', 3600, 'ns2.google.com' ], # ] # resolve a records: $res->resolve ("ruth.plan9.de", "a", sub { warn Dumper [@_] }); # result: # [ # [ 'ruth.schmorp.de', 'a', 'in', 86400, '129.13.162.95' ] # ] # resolve any records, but return only a and aaaa records: $res->resolve ("test1.laendle", "*", accept => ["a", "aaaa"], sub { warn Dumper [@_]; } ); # result: # [ # [ 'test1.laendle', 'a', 'in', 86400, '10.0.0.255' ], # [ 'test1.laendle', 'aaaa', 'in', 60, '3ffe:1900:4545:0002:0240:0000:0000:f7e1' ] # ] =cut sub resolve($%) { my $cb = pop; my ($self, $qname, $qtype, %opt) = @_; $self->wait_for_slot (sub { my $self = shift; my @search = $qname =~ s/\.$// ? "" : $opt{search} ? @{ $opt{search} } : ($qname =~ y/.//) >= $self->{ndots} ? ("", @{ $self->{search} }) : (@{ $self->{search} }, ""); my $class = $opt{class} || "in"; my %atype = $opt{accept} ? map +($_ => 1), @{ $opt{accept} } : ($qtype => 1); # advance in searchlist my ($do_search, $do_req); $do_search = sub { @search or (undef $do_search), (undef $do_req), return $cb->(); (my $name = lc "$qname." . shift @search) =~ s/\.$//; my $depth = 10; # advance in cname-chain $do_req = sub { $self->request ({ rd => 1, qd => [[$name, $qtype, $class]], }, sub { my ($res) = @_ or return $do_search->(); my $cname; while () { # results found? my @rr = grep $name eq lc $_->[0] && ($atype{"*"} || $atype{$_->[1]}), @{ $res->{an} }; (undef $do_search), (undef $do_req), return $cb->(@rr) if @rr; # see if there is a cname we can follow my @rr = grep $name eq lc $_->[0] && $_->[1] eq "cname", @{ $res->{an} }; if (@rr) { $depth-- or return $do_search->(); # cname chain too long $cname = 1; $name = lc $rr[0][4]; } elsif ($cname) { # follow the cname return $do_req->(); } else { # no, not found anything return $do_search->(); } } }); }; $do_req->(); }; $do_search->(); }); } =item $resolver->wait_for_slot ($cb->($resolver)) Wait until a free request slot is available and call the callback with the resolver object. A request slot is used each time a request is actually sent to the nameservers: There are never more than C of them. Although you can submit more requests (they will simply be queued until a request slot becomes available), sometimes, usually for rate-limiting purposes, it is useful to instead wait for a slot before generating the request (or simply to know when the request load is low enough so one can submit requests again). This is what this method does: The callback will be called when submitting a DNS request will not result in that request being queued. The callback may or may not generate any requests in response. Note that the callback will only be invoked when the request queue is empty, so this does not play well if somebody else keeps the request queue full at all times. =cut sub wait_for_slot { my ($self, $cb) = @_; push @{ $self->{wait} }, $cb; $self->_scheduler; } use AnyEvent::Socket (); # circular dependency, so do not import anything and do it at the end =back =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/IO.pm0000644000000000000000000005307713406503471015062 0ustar rootroot=head1 NAME AnyEvent::IO - the DBI of asynchronous I/O implementations =head1 SYNOPSIS use AnyEvent::IO; # load /etc/passwd, call callback with the file data when done. aio_load "/etc/passwd", sub { my ($data) = @_ or return AE::log error => "/etc/passwd: $!"; warn "/etc/passwd contains ", ($data =~ y/://) , " colons.\n"; }; # the rest of the SYNOPSIS does the same, but with individual I/O calls # also import O_XXX flags use AnyEvent::IO qw(:DEFAULT :flags); my $filedata = AE::cv; # first open the file aio_open "/etc/passwd", O_RDONLY, 0, sub { my ($fh) = @_ or return AE::log error => "/etc/passwd: $!"; # now stat the file to get the size aio_stat $fh, sub { @_ or return AE::log error => "/etc/passwd: $!"; my $size = -s _; # now read all the file data aio_read $fh, $size, sub { my ($data) = @_ or return AE::log error => "/etc/passwd: $!"; $size == length $data or return AE::log error => "/etc/passwd: short read, file changed?"; # mostly the same as aio_load, above - $data contains # the file contents now. $filedata->($data); }; }; }; my $passwd = $filedata->recv; warn length $passwd, " octets.\n"; =head1 DESCRIPTION This module provides functions that do I/O in an asynchronous fashion. It is to I/O the same as L is to event libraries - it only I to other implementations or to a portable pure-perl implementation (which does not, however, do asynchronous I/O). The only other implementation that is supported (or even known to the author) is L, which is used automatically when it can be loaded (via L, which also needs to be installed). If it is not available, then L falls back to its synchronous pure-perl implementation. Unlike L, which model to use is currently decided at module load time, not at first use. Future releases might change this. =head2 RATIONALE While disk I/O often seems "instant" compared to, say, socket I/O, there are many situations where your program can block for extended time periods when doing disk I/O. For example, you access a disk on an NFS server and it is gone - can take ages to respond again, if ever. Or your system is extremely busy because it creates or restores a backup - reading data from disk can then take seconds. Or you use Linux, which for so many years has a close-to-broken VM/IO subsystem that can often induce minutes or more of delay for disk I/O, even under what I would consider light I/O loads. Whatever the situation, some programs just can't afford to block for long times (say, half a second or more), because they need to respond as fast as possible. For those cases, you need asynchronous I/O. The problem is, AnyEvent itself sometimes reads disk files (for example, when looking at F), and under the above situations, this can bring your program to a complete halt even if your program otherwise takes care to only use asynchronous I/O for everything (e.g. by using L). On the other hand, requiring L for AnyEvent is clearly impossible, as AnyEvent promises to stay pure-perl, and the overhead of IO::AIO for small programs would be immense, especially when asynchronous I/O isn't even needed. Clearly, this calls for an abstraction layer, and that is what you are looking at right now :-) =head2 ASYNCHRONOUS VS. NON-BLOCKING Many people are continuously confused on what the difference is between asynchronous I/O and non-blocking I/O. In fact, those two terms are not well defined, which often makes it hard to even talk about the difference. Here is a short guideline that should leave you less confused. It only talks about read operations, but the reasoning works with other I/O operations as well. Non-blocking I/O means that data is delivered by some external means, automatically - that is, something I data towards your file handle, without you having to do anything. Non-blocking means that if your operating system currently has no data (or EOF, or some error) available for you, it will not wait ("block") as it would normally do, but immediately return with an error (e.g. C - "I would have blocked, but you forbid it"). Your program can then wait for data to arrive by other means, for example, an I/O watcher which tells you when to re-attempt the read, after which it can try to read again, and so on. Often, you would expect this to work for disk files as well - if the data isn't already in memory, one might want to wait for it and then re-attempt the read for example. While this is sound reasoning, the POSIX API does not support this, because disk drives and file systems do not send data "on their own", and more so, the OS already knows that data is there, it doesn't need to "wait" until it arrives from some external entity, it only needs to transfer the data from disk to your memory buffer. So basically, while the concept is sound, the existing OS APIs do not support this. Therefore, it makes no sense to switch a disk file handle into non-blocking mode - it will behave exactly the same as in blocking mode, namely it will block until the data has been read from the disk. The alternative to non-blocking I/O that actually works with disk files is usually called I. Asynchronous, because the actual I/O is done while your program does something else: there is no need to call the read function to see if data is there, you only order the read once, and it will notify you when the read has finished and the data is your buffer - all the work is done in the background. This works with disk files, and even with sockets and other sources. It is, however, not very efficient when used with sources that could be driven in a non-blocking way, because it usually has higher overhead in the OS than non-blocking I/O, because it ties memory buffers for a potentially unlimited time and often only a limited number of operations can be done in parallel. That's why asynchronous I/O makes most sense when confronted with disk files, and non-blocking I/O only makes sense with sockets, pipes and similar streaming sources. =head1 IMPORT TAGS By default, this module exports all Cxxx functions. In addition, the following import tags can be used: :aio all aio_* functions, same as :DEFAULT :flags the fcntl open flags (O_CREAT, O_RDONLY, ...) =head1 API NOTES The functions in this module are not meant to be the most versatile or the highest-performers (they are not very slow either, of course). They are primarily meant to give users of your code the option to do the I/O asynchronously (by installing L and L), without adding a dependency on those modules. =head2 NAMING All the functions in this module implement an I/O operation, usually with the same or similar name as the Perl built-in that they mimic, but with an C prefix. If you like you can think of the Cxxx functions as "AnyEvent I/O" or "Asynchronous I/O" variants of Perl built-ins. =head2 CALLING CONVENTIONS AND ERROR REPORTING Each function expects a callback as their last argument. The callback is usually called with the result data or result code. An error is usually signalled by passing no arguments to the callback, which is then free to look at C<$!> for the error code. This makes all of the following forms of error checking valid: aio_open ...., sub { my $fh = shift # scalar assignment - will assign undef on error or return AE::log error => "..."; my ($fh) = @_ # list assignment - will be 0 elements on error or return AE::log error => "..."; @_ # check the number of elements directly or return AE::log error => "..."; =head2 CAVEAT: RELATIVE PATHS When a path is specified, this path I path, unless you make certain that nothing in your process calls C or an equivalent function while the request executes. =head2 CAVEAT: OTHER SHARED STATE Changing the C while any requests execute that create files (or otherwise rely on the current umask) results in undefined behaviour - likewise changing anything else that would change the outcome, such as your effective user or group ID. =head2 CALLBACKS MIGHT BE CALLED BEFORE FUNCTION RETURNS TO CALLER Unlike other functions in the AnyEvent module family, these functions I call your callback instantly, before returning. This should not be a real problem, as these functions never return anything useful. =head2 BEHAVIOUR AT PROGRAM EXIT Both L and L implementations make sure that operations that have started will be finished on a clean programs exit. That makes programs work that start some I/O operations and then exit. For example this complete program: use AnyEvent::IO; aio_stat "path1", sub { aio_stat "path2", sub { warn "both stats done\n"; }; }; Starts a C operation and then exits by "falling off the end" of the program. Nevertheless, I C operations will be executed, as AnyEvent::IO waits for all outstanding requests to finish and you can start new requests from request callbacks. In fact, since L is currently synchronous, the program will do both stats before falling off the end, but with L, the program first falls of the end, then the stats are executed. While not guaranteed, this behaviour will be present in future versions, if reasonably possible (which is extreemly likely :). =cut package AnyEvent::IO; use AnyEvent (); BEGIN { AnyEvent::common_sense } use base "Exporter"; our @AIO_REQ = qw( aio_load aio_open aio_close aio_seek aio_read aio_write aio_truncate aio_utime aio_chown aio_chmod aio_stat aio_lstat aio_link aio_symlink aio_readlink aio_rename aio_unlink aio_mkdir aio_rmdir aio_readdir ); *EXPORT = \@AIO_REQ; our @FLAGS = qw(O_RDONLY O_WRONLY O_RDWR O_CREAT O_EXCL O_TRUNC O_APPEND); *EXPORT_OK = \@FLAGS; our %EXPORT_TAGS = (flags => \@FLAGS, aio => \@AIO_REQ); our $MODEL; if ($MODEL) { AE::log 7 => "Found preloaded IO model '$MODEL', using it."; } else { if ($ENV{PERL_ANYEVENT_IO_MODEL} =~ /^([a-zA-Z0-9:]+)$/) { if (eval { require "AnyEvent/IO/$ENV{PERL_ANYEVENT_IO_MODEL}.pm" }) { AE::log 7 => "Loaded IO model '$MODEL' (forced by \$ENV{PERL_ANYEVENT_IO_MODEL}), using it."; } else { undef $MODEL; AE::log 4 => "Unable to load IO model '$ENV{PERL_ANYEVENT_IO_MODEL}' (from \$ENV{PERL_ANYEVENT_IO_MODEL}):\n$@"; } } unless ($MODEL) { if (eval { require IO::AIO; require AnyEvent::AIO; require AnyEvent::IO::IOAIO }) { AE::log 7 => "Autoloaded IO model 'IOAIO', using it."; } else { require AnyEvent::IO::Perl; AE::log 7 => "Autoloaded IO model 'Perl', using it."; } } } =head1 GLOBAL VARIABLES AND FUNCTIONS =over 4 =item $AnyEvent::IO::MODEL Contains the package name of the backend I/O model in use - at the moment, this is usually C or C. =item aio_load $path, $cb->($data) Tries to open C<$path> and read its contents into memory (obviously, should only be used on files that are "small enough"), then passes them to the callback as a string. Example: load F. aio_load "/etc/hosts", sub { my ($hosts) = @_ or return AE::log error => "/etc/hosts: $!"; AE::log info => "/etc/hosts contains ", ($hosts =~ y/\n/), " lines\n"; }; =item aio_open $path, $flags, $mode, $cb->($fh) Tries to open the file specified by C<$path> with the O_XXX-flags C<$flags> (from the Fcntl module, or see below) and the mode C<$mode> (a good value is 0666 for C, and C<0> otherwise). The (normal, standard, perl) file handle associated with the opened file is then passed to the callback. This works very much like Perl's C function. Changing the C while this request executes results in undefined behaviour - likewise changing anything else that would change the outcome, such as your effective user or group ID. To avoid having to load L, this module provides constants for C, C, C, C, C, C and C - you can either access them directly (C) or import them by specifying the C<:flags> import tag (see SYNOPSIS). Example: securely open a file in F, fail if it exists or is a symlink. use AnyEvent::IO qw(:flags); aio_open "/var/tmp/mytmp$$", O_CREAT | O_EXCL | O_RDWR, 0600, sub { my ($fh) = @_ or return AE::log error => "$! - denial of service attack?"; # now we have $fh }; =item aio_close $fh, $cb->($success) Closes the file handle (yes, close can block your process indefinitely) and passes a true value to the callback on success. Due to idiosyncrasies in perl, instead of calling C, the file handle might get closed by C'ing another file descriptor over it, that is, the C<$fh> might still be open, but can be closed safely afterwards and must not be used for anything. Example: close a file handle, and dirty as we are, do not even bother to check for errors. aio_close $fh, sub { }; =item aio_read $fh, $length, $cb->($data) Tries to read C<$length> octets from the current position from C<$fh> and passes these bytes to C<$cb>. Otherwise the semantics are very much like those of Perl's C. If less than C<$length> octets have been read, C<$data> will contain only those bytes actually read. At EOF, C<$data> will be a zero-length string. If an error occurs, then nothing is passed to the callback. Obviously, multiple C's or C's at the same time on file handles sharing the underlying open file description results in undefined behaviour, due to sharing of the current file offset (and less obviously so, because OS X is not thread safe and corrupts data when you try). Example: read 128 octets from a file. aio_read $fh, 128, sub { my ($data) = @_ or return AE::log error "read from fh: $!"; if (length $data) { print "read ", length $data, " octets.\n"; } else { print "EOF\n"; } }; =item aio_seek $fh, $offset, $whence, $callback->($offs) Seeks the filehandle to the new C<$offset>, similarly to Perl's C. The C<$whence> are the traditional values (C<0> to count from start, C<1> to count from the current position and C<2> to count from the end). The resulting absolute offset will be passed to the callback on success. Example: measure the size of the file in the old-fashioned way using seek. aio_seek $fh, 0, 2, sub { my ($size) = @_ or return AE::log error => "seek to end failed: $!"; # maybe we need to seek to the beginning again? aio_seek $fh, 0, 0, sub { # now we are hopefully at the beginning }; }; =item aio_write $fh, $data, $cb->($length) Tries to write the octets in C<$data> to the current position of C<$fh> and passes the actual number of bytes written to the C<$cb>. Otherwise the semantics are very much like those of Perl's C. If less than C octets have been written, C<$length> will reflect that. If an error occurs, then nothing is passed to the callback. Obviously, multiple C's or C's at the same time on file handles sharing the underlying open file description results in undefined behaviour, due to sharing of the current file offset (and less obviously so, because OS X is not thread safe and corrupts data when you try). =item aio_truncate $fh_or_path, $new_length, $cb->($success) Calls C on the path or perl file handle and passes a true value to the callback on success. Example: truncate F to zero length - this only works on systems that support C, should not be tried out for obvious reasons and debian will probably open yte another security bug about this example. aio_truncate "/etc/passwd", sub { @_ or return AE::log error => "/etc/passwd: $! - are you root enough?"; }; =item aio_utime $fh_or_path, $atime, $mtime, $cb->($success) Calls C on the path or perl file handle and passes a true value to the callback on success. The special case of both C<$atime> and C<$mtime> being C sets the times to the current time, on systems that support this. Example: try to touch F. aio_utime "file", undef, undef, sub { }; =item aio_chown $fh_or_path, $uid, $gid, $cb->($success) Calls C on the path or perl file handle and passes a true value to the callback on success. If C<$uid> or C<$gid> can be specified as C, in which case the uid or gid of the file is not changed. This differs from Perl's C built-in, which wants C<-1> for this. Example: update the group of F to 0 (root), but leave the owner alone. aio_chown "file", undef, 0, sub { @_ or return AE::log error => "chown 'file': $!"; }; =item aio_chmod $fh_or_path, $perms, $cb->($success) Calls C on the path or perl file handle and passes a true value to the callback on success. Example: change F to be user/group/world-readable, but leave the other flags alone. aio_stat "file", sub { @_ or return AE::log error => "file: $!"; aio_chmod "file", (stat _)[2] & 07777 | 00444, sub { }; }; =item aio_stat $fh_or_path, $cb->($success) =item aio_lstat $path, $cb->($success) Calls C or C on the path or perl file handle and passes a true value to the callback on success. The stat data will be available by C'ing the C<_> file handle (e.g. C<-x _>, C and so on). Example: see if we can find the number of subdirectories of F. aio_stat "/etc", sub { @_ or return AE::log error => "/etc: $!"; (stat _)[3] >= 2 or return AE::log warn => "/etc has low link count - non-POSIX filesystem?"; print "/etc has ", (stat _)[3] - 2, " subdirectories.\n"; }; =item aio_link $oldpath, $newpath, $cb->($success) Calls C on the paths and passes a true value to the callback on success. Example: link "F to F, then rename F over F, to atomically replace it. aio_link "file", "file.bak", sub { @_ or return AE::log error => "file: $!"; aio_rename "file.new", "file", sub { @_ or return AE::log error => "file.new: $!"; print "file atomically replaced by file.new, backup file.bak\n"; }; }; =item aio_symlink $oldpath, $newpath, $cb->($success) Calls C on the paths and passes a true value to the callback on success. Example: create a symlink "F containing "random data". aio_symlink "random data", "slink", sub { @_ or return AE::log error => "slink: $!"; }; =item aio_readlink $path, $cb->($target) Calls C on the paths and passes the link target string to the callback. Example: read the symlink called Fyslink> and verify that it contains "random data". aio_readlink "slink", sub { my ($target) = @_ or return AE::log error => "slink: $!"; $target eq "random data" or AE::log critical => "omg, the world will end!"; }; =item aio_rename $oldpath, $newpath, $cb->($success) Calls C on the paths and passes a true value to the callback on success. See C for an example. =item aio_unlink $path, $cb->($success) Tries to unlink the object at C<$path> and passes a true value to the callback on success. Example: try to delete the file F. aio_unlink "tmpfile.dat~", sub { }; =item aio_mkdir $path, $perms, $cb->($success) Calls C on the path with the given permissions C<$perms> (when in doubt, C<0777> is a good value) and passes a true value to the callback on success. Example: try to create the directory F and leave it to whoeveer comes after us to check whether it worked. aio_mkdir "subdir", 0777, sub { }; =item aio_rmdir $path, $cb->($success) Tries to remove the directory at C<$path> and passes a true value to the callback on success. Example: try to remove the directory F and don't give a damn if that fails. aio_rmdir "subdir", sub { }; =item aio_readdir $path, $cb->(\@names) Reads all filenames from the directory specified by C<$path> and passes them to the callback, as an array reference with the names (without a path prefix). The F<.> and F<..> names will be filtered out first. The ordering of the file names is undefined - backends that are capable of it (e.g. L) will return the ordering that most likely is fastest to C through, and furthermore put entries that likely are directories first in the array. If you need best performance in recursive directory traversal or when looking at really big directories, you are advised to use L directly, specifically the C and C functions, which have more options to tune performance. Example: recursively scan a directory hierarchy, silently skip diretcories we couldn't read and print all others. sub scan($); # visibility-in-next statement is not so useful these days sub scan($) { my ($path) = @_; aio_readdir $path, sub { my ($names) = @_ or return; print "$path\n"; for my $name (@$names) { aio_lstat "$path/$name", sub { scan "$path/$name" if -d _; }; } }; } scan "/etc"; =back =head1 ENVIRONMENT VARIABLES See the description of C in the L manpage. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/IO/0000755000000000000000000000000013540302027014501 5ustar rootrootAnyEvent-7.17/lib/AnyEvent/IO/Perl.pm0000644000000000000000000000503211740210771015745 0ustar rootroot=head1 NAME AnyEvent::IO::Perl - pure perl backend for AnyEvent::IO =head1 SYNOPSIS use AnyEvent::IO; =head1 DESCRIPTION This is the pure-perl backend of L - it is always available, but does not actually implement any I/O operation asynchronously - everything is synchronous. For simple programs that can wait for I/O, this is likely the most efficient implementation. =cut package AnyEvent::IO::Perl; use AnyEvent (); BEGIN { AnyEvent::common_sense } our $VERSION = $AnyEvent::VERSION; package AnyEvent::IO; our $MODEL = "AnyEvent::IO::Perl"; sub aio_load($$) { my ($path, $cb, $fh, $data) = @_; $cb->( (open $fh, "<:raw:perlio", $path and stat $fh and (-s _) == sysread $fh, $data, -s _) ? $data : () ); } sub aio_open($$$$) { sysopen my $fh, $_[0], $_[1], $_[2] or return $_[3](); $_[3]($fh) } sub aio_close($$) { $_[1](close $_[0]); } sub aio_seek($$$$) { my $data; $_[3](sysseek $_[0], $_[1], $_[2] or ()); } sub aio_read($$$) { my $data; $_[2]( (defined sysread $_[0], $data, $_[1]) ? $data : () ); } sub aio_write($$$) { my $res = syswrite $_[0], $_[1]; $_[2](defined $res ? $res : ()); } sub aio_truncate($$$) { #TODO: raises an exception on !truncate|ftruncate systems, maybe eval + set errno? $_[2](truncate $_[0], $_[1] or ()); } sub aio_utime($$$$) { $_[3](utime $_[1], $_[2], $_[0] or ()); } sub aio_chown($$$$) { $_[3](chown defined $_[1] ? $_[1] : -1, defined $_[2] ? $_[2] : -1, $_[0] or ()); } sub aio_chmod($$$) { $_[2](chmod $_[1], $_[0] or ()); } sub aio_stat($$) { $_[1](stat $_[0]); } sub aio_lstat($$) { $_[1](lstat $_[0]); } sub aio_link($$$) { $_[2](link $_[0], $_[1] or ()); } sub aio_symlink($$$) { #TODO: raises an exception on !symlink systems, maybe eval + set errno? $_[2](symlink $_[0], $_[1] or ()); } sub aio_readlink($$) { #TODO: raises an exception on !symlink systems, maybe eval + set errno? my $res = readlink $_[0]; $_[1](defined $res ? $res : ()); } sub aio_rename($$$) { $_[2](rename $_[0], $_[1] or ()); } sub aio_unlink($$) { $_[1](unlink $_[0] or ()); } sub aio_mkdir($$$) { $_[2](mkdir $_[0], $_[1] or ()); } sub aio_rmdir($$) { $_[1](rmdir $_[0] or ()); } sub aio_readdir($$) { my ($fh, @res); opendir $fh, $_[0] or return $_[1](); @res = grep !/^\.\.?$/, readdir $fh; $_[1]((closedir $fh) ? \@res : ()); } =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/IO/IOAIO.pm0000644000000000000000000000652311740210771015711 0ustar rootroot=head1 NAME AnyEvent::IO::IOAIO - AnyEvent::IO backend based on IO::AIO =head1 SYNOPSIS use AnyEvent::IO; =head1 DESCRIPTION This is the L-based backend of L (via L). All I/O operations it implements are done asynchronously. =head1 FUNCTIONS =over 4 =cut package AnyEvent::IO::IOAIO; use AnyEvent (); BEGIN { AnyEvent::common_sense } our $VERSION = $AnyEvent::VERSION; package AnyEvent::IO; use IO::AIO 4.13 (); use AnyEvent::AIO (); our $MODEL = "AnyEvent::IO::IOAIO"; sub aio_load($$) { my ($cb, $data) = $_[1]; IO::AIO::aio_load $_[0], $data, sub { $cb->($_[0] >= 0 ? $data : ()) }; } sub aio_open($$$$) { my $cb = $_[3]; IO::AIO::aio_open $_[0], $_[1], $_[2], sub { $cb->($_[0] or ()) }; } sub aio_close($$) { my $cb = $_[1]; IO::AIO::aio_close $_[0], sub { $cb->($_[0] >= 0 ? 1 : ()) }; } sub aio_seek($$$$) { my ($cb) = $_[3]; IO::AIO::aio_seek $_[0], $_[1], $_[2], sub { $cb->($_[0] >= 0 ? $_[0] : ()) }; } sub aio_read($$$) { my ($cb, $data) = $_[2]; IO::AIO::aio_read $_[0], undef, $_[1], $data, 0, sub { $cb->($_[0] >= 0 ? $data : ()) }; } sub aio_write($$$) { my $cb = $_[2]; IO::AIO::aio_write $_[0], undef, (length $_[1]), $_[1], 0, sub { $cb->($_[0] >= 0 ? $_[0] : ()) }; } sub aio_truncate($$$) { my $cb = $_[2]; IO::AIO::aio_truncate $_[0], $_[1], sub { $cb->($_[0] ? () : 1) }; } sub aio_utime($$$$) { my $cb = $_[3]; IO::AIO::aio_utime $_[0], $_[1], $_[2], sub { $cb->($_[0] ? () : 1) }; } sub aio_chown($$$$) { my $cb = $_[3]; IO::AIO::aio_chown $_[0], $_[1], $_[2], sub { $cb->($_[0] ? () : 1) }; } sub aio_chmod($$$) { my $cb = $_[2]; IO::AIO::aio_chmod $_[0], $_[1], sub { $cb->($_[0] ? () : 1) }; } sub aio_stat($$) { my $cb = $_[1]; IO::AIO::aio_stat $_[0], sub { $cb->($_[0] ? () : 1) }; } sub aio_lstat($$) { my $cb = $_[1]; IO::AIO::aio_lstat $_[0], sub { $cb->($_[0] ? () : 1) } } sub aio_link($$$) { my $cb = $_[2]; IO::AIO::aio_link $_[0], $_[1], sub { $cb->($_[0] ? () : 1) }; } sub aio_symlink($$$) { my $cb = $_[2]; IO::AIO::aio_symlink $_[0], $_[1], sub { $cb->($_[0] ? () : 1) }; } sub aio_readlink($$) { my $cb = $_[1]; IO::AIO::aio_readlink $_[0], sub { $cb->(defined $_[0] ? $_[0] : ()) }; } sub aio_rename($$$) { my $cb = $_[2]; IO::AIO::aio_rename $_[0], $_[1], sub { $cb->($_[0] ? () : 1) }; } sub aio_unlink($$) { my $cb = $_[1]; IO::AIO::aio_unlink $_[0], sub { $cb->($_[0] ? () : 1) }; } sub aio_mkdir($$$) { my $cb = $_[2]; IO::AIO::aio_mkdir $_[0], $_[1], sub { $cb->($_[0] ? () : 1) }; } sub aio_rmdir($$) { my $cb = $_[1]; IO::AIO::aio_rmdir $_[0], sub { $cb->($_[0] ? () : 1) }; } sub aio_readdir($$) { my $cb = $_[1]; IO::AIO::aio_readdirx $_[0], IO::AIO::READDIR_DIRS_FIRST | IO::AIO::READDIR_STAT_ORDER, sub { $cb->($_[0] or ()); }; } =back =head1 SEE ALSO L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Log.pm0000644000000000000000000013215513533451221015263 0ustar rootroot=head1 NAME AnyEvent::Log - simple logging "framework" =head1 SYNOPSIS Simple uses: use AnyEvent; AE::log fatal => "No config found, cannot continue!"; # never returns AE::log alert => "The battery died!"; AE::log crit => "The battery is too hot!"; AE::log error => "Division by zero attempted."; AE::log warn => "Couldn't delete the file."; AE::log note => "Attempted to create config, but config already exists."; AE::log info => "File soandso successfully deleted."; AE::log debug => "the function returned 3"; AE::log trace => "going to call function abc"; Log level overview: LVL NAME SYSLOG PERL NOTE 1 fatal emerg exit system unusable, aborts program! 2 alert failure in primary system 3 critical crit failure in backup system 4 error err die non-urgent program errors, a bug 5 warn warning possible problem, not necessarily error 6 note notice unusual conditions 7 info normal messages, no action required 8 debug debugging messages for development 9 trace copious tracing output "Complex" uses (for speed sensitive code, e.g. trace/debug messages): use AnyEvent::Log; my $tracer = AnyEvent::Log::logger trace => \my $trace; $tracer->("i am here") if $trace; $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; Configuration (also look at the EXAMPLES section): # set default logging level to suppress anything below "notice" # i.e. enable logging at "notice" or above - the default is to # to not log anything at all. $AnyEvent::Log::FILTER->level ("notice"); # set logging for the current package to errors and higher only AnyEvent::Log::ctx->level ("error"); # enable logging for the current package, regardless of global logging level AnyEvent::Log::ctx->attach ($AnyEvent::Log::LOG); # enable debug logging for module some::mod and enable logging by default (AnyEvent::Log::ctx "some::mod")->level ("debug"); (AnyEvent::Log::ctx "some::mod")->attach ($AnyEvent::Log::LOG); # send all critical and higher priority messages to syslog, # regardless of (most) other settings $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx level => "critical", log_to_syslog => "user", ); =head1 DESCRIPTION This module implements a relatively simple "logging framework". It doesn't attempt to be "the" logging solution or even "a" logging solution for AnyEvent - AnyEvent simply creates logging messages internally, and this module more or less exposes the mechanism, with some extra spiff to allow using it from other modules as well. Remember that the default verbosity level is C<4> (C), so only errors and more important messages will be logged, unless you set C to a higher number before starting your program (C is recommended during development), or change the logging level at runtime with something like: use AnyEvent::Log; $AnyEvent::Log::FILTER->level ("info"); The design goal behind this module was to keep it simple (and small), but make it powerful enough to be potentially useful for any module, and extensive enough for the most common tasks, such as logging to multiple targets, or being able to log into a database. The module is also usable before AnyEvent itself is initialised, in which case some of the functionality might be reduced. The amount of documentation might indicate otherwise, but the runtime part of the module is still just below 300 lines of code. =head1 LOGGING LEVELS Logging levels in this module range from C<1> (highest priority) to C<9> (lowest priority). Note that the lowest numerical value is the highest priority, so when this document says "higher priority" it means "lower numerical value". Instead of specifying levels by name you can also specify them by aliases: LVL NAME SYSLOG PERL NOTE 1 fatal emerg exit system unusable, aborts program! 2 alert failure in primary system 3 critical crit failure in backup system 4 error err die non-urgent program errors, a bug 5 warn warning possible problem, not necessarily error 6 note notice unusual conditions 7 info normal messages, no action required 8 debug debugging messages for development 9 trace copious tracing output As you can see, some logging levels have multiple aliases - the first one is the "official" name, the second one the "syslog" name (if it differs) and the third one the "perl" name, suggesting (only!) that you log C messages at C priority. The NOTE column tries to provide some rationale on how to chose a logging level. As a rough guideline, levels 1..3 are primarily meant for users of the program (admins, staff), and are the only ones logged to STDERR by default. Levels 4..6 are meant for users and developers alike, while levels 7..9 are usually meant for developers. You can normally only log a message once at highest priority level (C<1>, C), because logging a fatal message will also quit the program - so use it sparingly :) For example, a program that finds an unknown switch on the commandline might well use a fatal logging level to tell users about it - the "system" in this case would be the program, or module. Some methods also offer some extra levels, such as C<0>, C, C or C - these are only valid for the methods that documented them. =head1 LOGGING FUNCTIONS The following functions allow you to log messages. They always use the caller's package as a "logging context". Also, the main logging function, C, is aliased to C and C when the C module is loaded. =over 4 =cut package AnyEvent::Log; use Carp (); use POSIX (); # layout of a context # 0 1 2 3 4, 5 # [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap] use AnyEvent (); BEGIN { AnyEvent::common_sense } #use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log our $VERSION = $AnyEvent::VERSION; our ($COLLECT, $FILTER, $LOG); our ($now_int, $now_str1, $now_str2); # Format Time, not public - yet? sub format_time($) { my $i = int $_[0]; my $f = sprintf "%06d", 1e6 * ($_[0] - $i); ($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i) if $now_int != $i; "$now_str1$f$now_str2" } our %CTX; # all package contexts # creates a default package context object for the given package sub _pkg_ctx($) { my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx"; # link "parent" package my $parent = $_[0] =~ /^(.+)::/ ? $CTX{$1} ||= &_pkg_ctx ("$1") : $COLLECT; $ctx->[2]{$parent+0} = $parent; $ctx } =item AnyEvent::Log::log $level, $msg[, @args] Requests logging of the given C<$msg> with the given log level, and returns true if the message was logged I. For loglevel C, the program will abort. If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the C<$msg> is interpreted as an sprintf format string. The C<$msg> should not end with C<\n>, but may if that is convenient for you. Also, multiline messages are handled properly. Last not least, C<$msg> might be a code reference, in which case it is supposed to return the message. It will be called only then the message actually gets logged, which is useful if it is costly to create the message in the first place. This function takes care of saving and restoring C<$!> and C<$@>, so you don't have to. Whether the given message will be logged depends on the maximum log level and the caller's package. The return value can be used to ensure that messages or not "lost" - for example, when L detects a runtime error it tries to log it at C level, but if that message is lost it simply uses warn. Note that you can (and should) call this function as C or C, without C-ing this module if possible (i.e. you don't need any additional functionality), as those functions will load the logging module on demand only. They are also much shorter to write. Also, if you optionally generate a lot of debug messages (such as when tracing some code), you should look into using a logger callback and a boolean enabler (see C, below). Example: log something at error level. AE::log error => "something"; Example: use printf-formatting. AE::log info => "%5d %-10.10s %s", $index, $category, $msg; Example: only generate a costly dump when the message is actually being logged. AE::log debug => sub { require Data::Dump; Data::Dump::dump \%cache }; =cut # also allow syslog equivalent names our %STR2LEVEL = ( fatal => 1, emerg => 1, exit => 1, alert => 2, critical => 3, crit => 3, error => 4, err => 4, die => 4, warn => 5, warning => 5, note => 6, notice => 6, info => 7, debug => 8, trace => 9, ); our $TIME_EXACT; sub exact_time($) { $TIME_EXACT = shift; *_ts = $AnyEvent::MODEL ? $TIME_EXACT ? \&AE::now : \&AE::time : sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time }; } BEGIN { exact_time 0; } AnyEvent::post_detect { exact_time $TIME_EXACT; }; our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); # time, ctx, level, msg sub default_format($$$$) { my $ts = format_time $_[0]; my $ct = " "; my @res; for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) { push @res, "$ts$ct$_\n"; $ct = " + "; } join "", @res } sub fatal_exit() { exit 1; } sub _log { my ($ctx, $level, $format, @args) = @_; $level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; my $mask = 1 << $level; my ($success, %seen, @ctx, $now, @fmt); do { # if !ref, then it's a level number if (!ref $ctx) { $level = $ctx; } elsif ($ctx->[1] & $mask and !$seen{$ctx+0}++) { # logging/recursing into this context # level cap if ($ctx->[5] > $level) { push @ctx, $level; # restore level when going up in tree $level = $ctx->[5]; } # log if log cb if ($ctx->[3]) { # logging target found local ($!, $@); # now get raw message, unless we have it already unless ($now) { $format = $format->() if ref $format; $format = sprintf $format, @args if @args; $format =~ s/\n$//; $now = _ts; }; # format msg my $str = $ctx->[4] ? $ctx->[4]($now, $_[0], $level, $format) : ($fmt[$level] ||= default_format $now, $_[0], $level, $format); $success = 1; $ctx->[3]($str) or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate } else { push @ctx, values %{ $ctx->[2] }; # not masked - propagate } } } while $ctx = pop @ctx; fatal_exit if $level <= 1; $success } sub log($$;@) { _log $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], @_; } =item $logger = AnyEvent::Log::logger $level[, \$enabled] Creates a code reference that, when called, acts as if the C function was called at this point with the given level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with the C function: my $debug_log = AnyEvent::Log::logger "debug"; $debug_log->("debug here"); $debug_log->("%06d emails processed", 12345); $debug_log->(sub { $obj->as_string }); The idea behind this function is to decide whether to log before actually logging - when the C function is called once, but the returned logger callback often, then this can be a tremendous speed win. Despite this speed advantage, changes in logging configuration will still be reflected by the logger callback, even if configuration changes I it was created. To further speed up logging, you can bind a scalar variable to the logger, which contains true if the logger should be called or not - if it is false, calling the logger can be safely skipped. This variable will be updated as long as C<$logger> is alive. Full example: # near the init section use AnyEvent::Log; my $debug_log = AnyEvent:Log::logger debug => \my $debug; # and later in your program $debug_log->("yo, stuff here") if $debug; $debug and $debug_log->("123"); =cut our %LOGGER; # re-assess logging status for all loggers sub _reassess { local $SIG{__DIE__}; my $die = sub { die }; for (@_ ? $LOGGER{$_[0]} : values %LOGGER) { my ($ctx, $level, $renabled) = @$_; # to detect whether a message would be logged, we actually # try to log one and die. this isn't fast, but we can be # sure that the logging decision is correct :) $$renabled = !eval { _log $ctx, $level, $die; 1 }; } } sub _logger { my ($ctx, $level, $renabled) = @_; $$renabled = 1; my $logger = [$ctx, $level, $renabled]; $LOGGER{$logger+0} = $logger; _reassess $logger+0; require AnyEvent::Util unless $AnyEvent::Util::VERSION; my $guard = AnyEvent::Util::guard (sub { # "clean up" delete $LOGGER{$logger+0}; }); sub { $guard if 0; # keep guard alive, but don't cause runtime overhead _log $ctx, $level, @_ if $$renabled; } } sub logger($;$) { _logger $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], @_ } =item AnyEvent::Log::exact_time $on By default, C will use C, i.e. the cached eventloop time, for the log timestamps. After calling this function with a true value it will instead resort to C, i.e. fetch the current time on each log message. This only makes a difference for event loops that actually cache the time (such as L or L). This setting can be changed at any time by calling this function. Since C has to work even before the L has been initialised, this switch will also decide whether to use C or C when logging a message before L becomes available. =item AnyEvent::Log::format_time $timestamp Formats a timestamp as returned by C<< AnyEvent->now >> or C<< AnyEvent->time >> or many other functions in the same way as C does. In your main program (as opposed to in your module) you can override the default timestamp display format by loading this module and then redefining this function. Most commonly, this function can be used in formatting callbacks. =item AnyEvent::Log::default_format $time, $ctx, $level, $msg Format a log message using the given timestamp, logging context, log level and log message. This is the formatting function used to format messages when no custom function is provided. In your main program (as opposed to in your module) you can override the default message format by loading this module and then redefining this function. =item AnyEvent::Log::fatal_exit() This is the function that is called after logging a C log message. It must not return. The default implementation simply calls C. In your main program (as opposed to in your module) you can override the fatal exit function by loading this module and then redefining this function. Make sure you don't return. =back =head1 LOGGING CONTEXTS This module associates every log message with a so-called I, based on the package of the caller. Every perl package has its own logging context. A logging context has three major responsibilities: filtering, logging and propagating the message. For the first purpose, filtering, each context has a set of logging levels, called the log level mask. Messages not in the set will be ignored by this context (masked). For logging, the context stores a formatting callback (which takes the timestamp, context, level and string message and formats it in the way it should be logged) and a logging callback (which is responsible for actually logging the formatted message and telling C whether it has consumed the message, or whether it should be propagated). For propagation, a context can have any number of attached I. Any message that is neither masked by the logging mask nor masked by the logging callback returning true will be passed to all slave contexts. Each call to a logging function will log the message at most once per context, so it does not matter (much) if there are cycles or if the message can arrive at the same context via multiple paths. =head2 DEFAULTS By default, all logging contexts have an full set of log levels ("all"), a disabled logging callback and the default formatting callback. Package contexts have the package name as logging title by default. They have exactly one slave - the context of the "parent" package. The parent package is simply defined to be the package name without the last component, i.e. C becomes C, and C becomes ... C<$AnyEvent::Log::COLLECT> which is the exception of the rule - just like the "parent" of any single-component package name in Perl is C
, the default slave of any top-level package context is C<$AnyEvent::Log::COLLECT>. Since perl packages form only an approximate hierarchy, this slave context can of course be removed. All other (anonymous) contexts have no slaves and an empty title by default. When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging context that simply logs everything via C, without propagating anything anywhere by default. The purpose of this context is to provide a convenient place to override the global logging target or to attach additional log targets. It's not meant for filtering. It then creates the C<$AnyEvent::Log::FILTER> context whose purpose is to suppress all messages with priority higher than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context is to simply provide filtering according to some global log level. Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT> and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise leaves it at default config. Its purpose is simply to collect all log messages system-wide. The hierarchy is then: any package, eventually -> $COLLECT -> $FILTER -> $LOG The effect of all this is that log messages, by default, wander up to the C<$AnyEvent::Log::COLLECT> context where all messages normally end up, from there to C<$AnyEvent::Log::FILTER> where log messages with lower priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then to the C<$AnyEvent::Log::LOG> context to be passed to C. This makes it easy to set a global logging level (by modifying $FILTER), but still allow other contexts to send, for example, their debug and trace messages to the $LOG target despite the global logging level, or to attach additional log targets that log messages, regardless of the global logging level. It also makes it easy to modify the default warn-logger ($LOG) to something that logs to a file, or to attach additional logging targets (such as loggign to a file) by attaching it to $FILTER. =head2 CREATING/FINDING/DESTROYING CONTEXTS =over 4 =item $ctx = AnyEvent::Log::ctx [$pkg] This function creates or returns a logging context (which is an object). If a package name is given, then the context for that package is returned. If it is called without any arguments, then the context for the callers package is returned (i.e. the same context as a C call would use). If C is given, then it creates a new anonymous context that is not tied to any package and is destroyed when no longer referenced. =cut sub ctx(;$) { my $pkg = @_ ? shift : (caller)[0]; ref $pkg ? $pkg : defined $pkg ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx" } =item AnyEvent::Log::reset Resets all package contexts and recreates the default hierarchy if necessary, i.e. resets the logging subsystem to defaults, as much as possible. This process keeps references to contexts held by other parts of the program intact. This can be used to implement config-file (re-)loading: before loading a configuration, reset all contexts. =cut our $ORIG_VERBOSE = $AnyEvent::VERBOSE; $AnyEvent::VERBOSE = 9; sub reset { # hard to kill complex data structures # we "recreate" all package loggers and reset the hierarchy while (my ($k, $v) = each %CTX) { @$v = ($k, (1 << 10) - 1 - 1, { }); $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT); } @$_ = ($_->[0], (1 << 10) - 1 - 1) for $LOG, $FILTER, $COLLECT; #$LOG->slaves; $LOG->title ('$AnyEvent::Log::LOG'); $LOG->log_to_warn; $FILTER->slaves ($LOG); $FILTER->title ('$AnyEvent::Log::FILTER'); $FILTER->level ($ORIG_VERBOSE); $COLLECT->slaves ($FILTER); $COLLECT->title ('$AnyEvent::Log::COLLECT'); _reassess; } # override AE::log/logger *AnyEvent::log = *AE::log = \&log; *AnyEvent::logger = *AE::logger = \&logger; # convert AnyEvent loggers to AnyEvent::Log loggers $_->[0] = ctx $_->[0] # convert "pkg" to "ctx" for values %LOGGER; # create the default logger contexts $LOG = ctx undef; $FILTER = ctx undef; $COLLECT = ctx undef; AnyEvent::Log::reset; # hello, CPAN, please catch me package AnyEvent::Log::LOG; package AE::Log::LOG; package AnyEvent::Log::FILTER; package AE::Log::FILTER; package AnyEvent::Log::COLLECT; package AE::Log::COLLECT; package AnyEvent::Log::Ctx; =item $ctx = new AnyEvent::Log::Ctx methodname => param... This is a convenience constructor that makes it simpler to construct anonymous logging contexts. Each key-value pair results in an invocation of the method of the same name as the key with the value as parameter, unless the value is an arrayref, in which case it calls the method with the contents of the array. The methods are called in the same order as specified. Example: create a new logging context and set both the default logging level, some slave contexts and a logging callback. $ctx = new AnyEvent::Log::Ctx title => "dubious messages", level => "error", log_cb => sub { print STDOUT shift; 0 }, slaves => [$ctx1, $ctx, $ctx2], ; =back =cut sub new { my $class = shift; my $ctx = AnyEvent::Log::ctx undef; while (@_) { my ($k, $v) = splice @_, 0, 2; $ctx->$k (ref $v eq "ARRAY" ? @$v : $v); } bless $ctx, $class # do we really support subclassing, hmm? } =head2 CONFIGURING A LOG CONTEXT The following methods can be used to configure the logging context. =over 4 =item $ctx->title ([$new_title]) Returns the title of the logging context - this is the package name, for package contexts, and a user defined string for all others. If C<$new_title> is given, then it replaces the package name or title. =cut sub title { $_[0][0] = $_[1] if @_ > 1; $_[0][0] } =back =head3 LOGGING LEVELS The following methods deal with the logging level set associated with the log context. The most common method to use is probably C<< $ctx->level ($level) >>, which configures the specified and any higher priority levels. All functions which accept a list of levels also accept the special string C which expands to all logging levels. =over 4 =item $ctx->levels ($level[, $level...) Enables logging for the given levels and disables it for all others. =item $ctx->level ($level) Enables logging for the given level and all lower level (higher priority) ones. In addition to normal logging levels, specifying a level of C<0> or C disables all logging for this level. Example: log warnings, errors and higher priority messages. $ctx->level ("warn"); $ctx->level (5); # same thing, just numeric =item $ctx->enable ($level[, $level...]) Enables logging for the given levels, leaving all others unchanged. =item $ctx->disable ($level[, $level...]) Disables logging for the given levels, leaving all others unchanged. =item $ctx->cap ($level) Caps the maximum priority to the given level, for all messages logged to, or passing through, this context. That is, while this doesn't affect whether a message is logged or passed on, the maximum priority of messages will be limited to the specified level - messages with a higher priority will be set to the specified priority. Another way to view this is that C<< ->level >> filters out messages with a too low priority, while C<< ->cap >> modifies messages with a too high priority. This is useful when different log targets have different interpretations of priority. For example, for a specific command line program, a wrong command line switch might well result in a C log message, while the same message, logged to syslog, is likely I fatal to the system or syslog facility as a whole, but more likely a mere C. This can be modeled by having a stderr logger that logs messages "as-is" and a syslog logger that logs messages with a level cap of, say, C, or, for truly system-critical components, actually C. =cut sub _lvl_lst { map { $_ > 0 && $_ <= 9 ? $_+0 : $_ eq "all" ? (1 .. 9) : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" } @_ } sub _lvl { $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1] } our $NOP_CB = sub { 0 }; sub levels { my $ctx = shift; $ctx->[1] = 0; $ctx->[1] |= 1 << $_ for &_lvl_lst; AnyEvent::Log::_reassess; } sub level { my $ctx = shift; $ctx->[1] = ((1 << &_lvl) - 1) << 1; AnyEvent::Log::_reassess; } sub enable { my $ctx = shift; $ctx->[1] |= 1 << $_ for &_lvl_lst; AnyEvent::Log::_reassess; } sub disable { my $ctx = shift; $ctx->[1] &= ~(1 << $_) for &_lvl_lst; AnyEvent::Log::_reassess; } sub cap { my $ctx = shift; $ctx->[5] = &_lvl; } =back =head3 SLAVE CONTEXTS The following methods attach and detach another logging context to a logging context. Log messages are propagated to all slave contexts, unless the logging callback consumes the message. =over 4 =item $ctx->attach ($ctx2[, $ctx3...]) Attaches the given contexts as slaves to this context. It is not an error to add a context twice (the second add will be ignored). A context can be specified either as package name or as a context object. =item $ctx->detach ($ctx2[, $ctx3...]) Removes the given slaves from this context - it's not an error to attempt to remove a context that hasn't been added. A context can be specified either as package name or as a context object. =item $ctx->slaves ($ctx2[, $ctx3...]) Replaces all slaves attached to this context by the ones given. =cut sub attach { my $ctx = shift; $ctx->[2]{$_+0} = $_ for map { AnyEvent::Log::ctx $_ } @_; AnyEvent::Log::_reassess; } sub detach { my $ctx = shift; delete $ctx->[2]{$_+0} for map { AnyEvent::Log::ctx $_ } @_; AnyEvent::Log::_reassess; } sub slaves { undef $_[0][2]; &attach; AnyEvent::Log::_reassess; } =back =head3 LOG TARGETS The following methods configure how the logging context actually does the logging (which consists of formatting the message and printing it or whatever it wants to do with it). =over 4 =item $ctx->log_cb ($cb->($str)) Replaces the logging callback on the context (C disables the logging callback). The logging callback is responsible for handling formatted log messages (see C below) - normally simple text strings that end with a newline (and are possibly multiline themselves). It also has to return true iff it has consumed the log message, and false if it hasn't. Consuming a message means that it will not be sent to any slave context. When in doubt, return C<0> from your logging callback. Example: a very simple logging callback, simply dump the message to STDOUT and do not consume it. $ctx->log_cb (sub { print STDERR shift; 0 }); You can filter messages by having a log callback that simply returns C<1> and does not do anything with the message, but this counts as "message being logged" and might not be very efficient. Example: propagate all messages except for log levels "debug" and "trace". The messages will still be generated, though, which can slow down your program. $ctx->levels ("debug", "trace"); $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages =item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message)) Replaces the formatting callback on the context (C restores the default formatter). The callback is passed the (possibly fractional) timestamp, the original logging context (object, not title), the (numeric) logging level and the raw message string and needs to return a formatted log message. In most cases this will be a string, but it could just as well be an array reference that just stores the values. If, for some reason, you want to use C to find out more about the logger then you should walk up the call stack until you are no longer inside the C package. To implement your own logging callback, you might find the C and C functions useful. Example: format the message just as AnyEvent::Log would, by letting AnyEvent::Log do the work. This is a good basis to design a formatting callback that only changes minor aspects of the formatting. $ctx->fmt_cb (sub { my ($time, $ctx, $lvl, $msg) = @_; AnyEvent::Log::default_format $time, $ctx, $lvl, $msg }); Example: format just the raw message, with numeric log level in angle brackets. $ctx->fmt_cb (sub { my ($time, $ctx, $lvl, $msg) = @_; "<$lvl>$msg\n" }); Example: return an array reference with just the log values, and use C to store the message in a database. $ctx->fmt_cb (sub { \@_ }); $ctx->log_cb (sub { my ($msg) = @_; sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)", $msg->[0] + 0, "$msg->[1]", $msg->[2] + 0, "$msg->[3]"; 0 }); =item $ctx->log_to_warn Sets the C to simply use C to report any messages (usually this logs to STDERR). =item $ctx->log_to_file ($path) Sets the C to log to a file (by appending), unbuffered. The function might return before the log file has been opened or created. =item $ctx->log_to_path ($path) Same as C<< ->log_to_file >>, but opens the file for each message. This is much slower, but allows you to change/move/rename/delete the file at basically any time. Needless(?) to say, if you do not want to be bitten by some evil person calling C, the path should be absolute. Doesn't help with C, but hey... =item $ctx->log_to_syslog ([$facility]) Logs all messages via L, mapping C to C and all the others in the obvious way. If specified, then the C<$facility> is used as the facility (C, C, C and so on). The default facility is C. Note that this function also sets a C - the logging part requires an array reference with [$level, $str] as input. =cut sub log_cb { my ($ctx, $cb) = @_; $ctx->[3] = $cb; } sub fmt_cb { my ($ctx, $cb) = @_; $ctx->[4] = $cb; } sub log_to_warn { my ($ctx, $path) = @_; $ctx->log_cb (sub { warn shift; 0 }); } # this function is a good example of why threads are a must, # simply for priority inversion. sub _log_to_disk { # eval'uating this at runtime saves 220kb rss - perl has become # an insane memory waster. eval q{ # poor man's autoloading {} sub _log_to_disk { my ($ctx, $path, $keepopen) = @_; my $fh; my @queue; my $delay; my $disable; use AnyEvent::IO (); my $kick = sub { undef $delay; return unless @queue; $delay = 1; # we pass $kick to $kick, so $kick itself doesn't keep a reference to $kick. my $kick = shift; # write one or more messages my $write = sub { # we write as many messages as have been queued my $data = join "", @queue; @queue = (); AnyEvent::IO::aio_write $fh, $data, sub { $disable = 1; @_ ? ($_[0] == length $data or AE::log 4 => "unable to write to logfile '$path': short write") : AE::log 4 => "unable to write to logfile '$path': $!"; undef $disable; if ($keepopen) { $kick->($kick); } else { AnyEvent::IO::aio_close ($fh, sub { undef $fh; $kick->($kick); }); } }; }; if ($fh) { $write->(); } else { AnyEvent::IO::aio_open $path, AnyEvent::IO::O_CREAT | AnyEvent::IO::O_WRONLY | AnyEvent::IO::O_APPEND, 0666, sub { $fh = shift or do { $disable = 1; AE::log 4 => "unable to open logfile '$path': $!"; undef $disable; return; }; $write->(); } ; } }; $ctx->log_cb (sub { return if $disable; push @queue, shift; $kick->($kick) unless $delay; 0 }); $kick->($kick) if $keepopen; # initial open }; }; die if $@; &_log_to_disk } sub log_to_file { my ($ctx, $path) = @_; _log_to_disk $ctx, $path, 1; } sub log_to_path { my ($ctx, $path) = @_; _log_to_disk $ctx, $path, 0; } sub log_to_syslog { my ($ctx, $facility) = @_; require Sys::Syslog; $ctx->fmt_cb (sub { my $str = $_[3]; $str =~ s/\n(?=.)/\n+ /g; [$_[2], "($_[1][0]) $str"] }); $facility ||= "user"; $ctx->log_cb (sub { my $lvl = $_[0][0] < 9 ? $_[0][0] : 8; Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_) for split /\n/, $_[0][1]; 0 }); } =back =head3 MESSAGE LOGGING These methods allow you to log messages directly to a context, without going via your package context. =over 4 =item $ctx->log ($level, $msg[, @params]) Same as C, but uses the given context as log context. Example: log a message in the context of another package. (AnyEvent::Log::ctx "Other::Package")->log (warn => "heely bo"); =item $logger = $ctx->logger ($level[, \$enabled]) Same as C, but uses the given context as log context. =cut *log = \&AnyEvent::Log::_log; *logger = \&AnyEvent::Log::_logger; =back =cut package AnyEvent::Log; =head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG} Logging can also be configured by setting the environment variable C (or C). The value consists of one or more logging context specifications separated by C<:> or whitespace. Each logging specification in turn starts with a context name, followed by C<=>, followed by zero or more comma-separated configuration directives, here are some examples: # set default logging level filter=warn # log to file instead of to stderr log=file=/tmp/mylog # log to file in addition to stderr log=+%file:%file=file=/tmp/mylog # enable debug log messages, log warnings and above to syslog filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0 # log trace messages (only) from AnyEvent::Debug to file AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog A context name in the log specification can be any of the following: =over 4 =item C, C, C Correspond to the three predefined C<$AnyEvent::Log::COLLECT>, C and C<$AnyEvent::Log::LOG> contexts. =item C<%name> Context names starting with a C<%> are anonymous contexts created when the name is first mentioned. The difference to package contexts is that by default they have no attached slaves. This makes it possible to create new log contexts that can be refered to multiple times by name within the same log specification. =item a perl package name Any other string references the logging context associated with the given Perl C. In the unlikely case where you want to specify a package context that matches on of the other context name forms, you can add a C<::> to the package name to force interpretation as a package. =back The configuration specifications can be any number of the following: =over 4 =item C Configures the context to use Perl's C function (which typically logs to C). Works like C. =item CI Configures the context to log to a file with the given path. Works like C. =item CI Configures the context to log to a file with the given path. Works like C. =item C or CI Configures the context to log to syslog. If I is given, then it is evaluated in the L package, so you could use: log=syslog=LOG_LOCAL0 =item C Configures the context to not log anything by itself, which is the default. Same as C<< $ctx->log_cb (undef) >>. =item CI Caps logging messages entering this context at the given level, i.e. reduces the priority of messages with higher priority than this level. The default is C<0> (or C), meaning the priority will not be touched. =item C<0> or C Sets the logging level of the context to C<0>, i.e. all messages will be filtered out. =item C Enables all logging levels, i.e. filtering will effectively be switched off (the default). =item C Disables all logging levels, and changes the interpretation of following level specifications to enable the specified level only. Example: only enable debug messages for a context. context=only,debug =item C Enables all logging levels, and changes the interpretation of following level specifications to disable that level. Rarely used. Example: enable all logging levels except fatal and trace (this is rather nonsensical). filter=exept,fatal,trace =item C Enables all logging levels, and changes the interpretation of following level specifications to be "that level or any higher priority message". This is the default. Example: log anything at or above warn level. filter=warn # or, more verbose filter=only,level,warn =item C<1>..C<9> or a logging level name (C, C etc.) A numeric loglevel or the name of a loglevel will be interpreted according to the most recent C, C or C directive. By default, specifying a logging level enables that and any higher priority messages. =item C<+>I Attaches the named context as slave to the context. =item C<+> A lone C<+> detaches all contexts, i.e. clears the slave list from the context. Anonymous (C<%name>) contexts have no attached slaves by default, but package contexts have the parent context as slave by default. Example: log messages from My::Module to a file, do not send them to the default log collector. My::Module=+,file=/tmp/mymodulelog =back Any character can be escaped by prefixing it with a C<\> (backslash), as usual, so to log to a file containing a comma, colon, backslash and some spaces in the filename, you would do this: PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes' Since whitespace (which includes newlines) is allowed, it is fine to specify multiple lines in C, e.g.: PERL_ANYEVENT_LOG=" filter=warn AnyEvent::Debug=+%trace %trace=only,trace,+log " myprog Also, in the unlikely case when you want to concatenate specifications, use whitespace as separator, as C<::> will be interpreted as part of a module name, an empty spec with two separators: PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug" =cut for (my $spec = $ENV{PERL_ANYEVENT_LOG}) { my %anon; my $pkg = sub { $_[0] eq "log" ? $LOG : $_[0] eq "filter" ? $FILTER : $_[0] eq "collect" ? $COLLECT : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx }) : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/ : die # never reached? }; /\G[[:space:]]+/gc; # skip initial whitespace while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) { my $ctx = $pkg->($1); my $level = "level"; while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) { for ("$1") { if ($_ eq "stderr" ) { $ctx->log_to_warn; } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1"); } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1"); } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1"); } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef); } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1"); } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1")); } elsif ($_ eq "+" ) { $ctx->slaves; } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0); } elsif ($_ eq "all" ) { $ctx->level ("all"); } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level"; } elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable"; } elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable"; } elsif (/^\d$/ ) { $ctx->$level ($_); } elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_); } else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n"; } } /\G,/gc or last; } /\G[:[:space:]]+/gc or last; } /\G[[:space:]]+/gc; # skip trailing whitespace if (/\G(.+)/g) { die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n"; } } =head1 EXAMPLES This section shows some common configurations, both as code, and as C string. =over 4 =item Setting the global logging level. Either put C into your environment before running your program, use C or modify the log level of the root context at runtime: PERL_ANYEVENT_VERBOSE=5 ./myprog PERL_ANYEVENT_LOG=log=warn $AnyEvent::Log::FILTER->level ("warn"); =item Append all messages to a file instead of sending them to STDERR. This is affected by the global logging level. $AnyEvent::Log::LOG->log_to_file ($path); PERL_ANYEVENT_LOG=log=file=/some/path =item Write all messages with priority C and higher to a file. This writes them only when the global logging level allows it, because it is attached to the default context which is invoked I global filtering. $AnyEvent::Log::FILTER->attach ( new AnyEvent::Log::Ctx log_to_file => $path); PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path This writes them regardless of the global logging level, because it is attached to the toplevel context, which receives all messages I the global filtering. $AnyEvent::Log::COLLECT->attach ( new AnyEvent::Log::Ctx log_to_file => $path); PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger In both cases, messages are still written to STDERR. =item Additionally log all messages with C and higher priority to C, but cap at C. This logs all messages to the default log target, but also logs messages with priority C or higher (and not filtered otherwise) to syslog facility C. Messages with priority higher than C will be logged with level C. $AnyEvent::Log::LOG->attach ( new AnyEvent::Log::Ctx level => "warn", cap => "error", syslog => "user", ); PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog =item Write trace messages (only) from L to the default logging target(s). Attach the C<$AnyEvent::Log::LOG> context to the C context - this simply circumvents the global filtering for trace messages. my $debug = AnyEvent::Debug->AnyEvent::Log::ctx; $debug->attach ($AnyEvent::Log::LOG); PERL_ANYEVENT_LOG=AnyEvent::Debug=+log This of course works for any package, not just L, but assumes the log level for AnyEvent::Debug hasn't been changed from the default. =back =head1 ASYNCHRONOUS DISK I/O This module uses L to actually write log messages (in C and C), so it doesn't block your program when the disk is busy and a non-blocking L backend is available. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AnyEvent/Handle.pm0000644000000000000000000024463413435114041015740 0ustar rootroot=head1 NAME AnyEvent::Handle - non-blocking I/O on streaming handles via AnyEvent =head1 SYNOPSIS use AnyEvent; use AnyEvent::Handle; my $cv = AnyEvent->condvar; my $hdl; $hdl = new AnyEvent::Handle fh => \*STDIN, on_error => sub { my ($hdl, $fatal, $msg) = @_; AE::log error => $msg; $hdl->destroy; $cv->send; }; # send some request line $hdl->push_write ("getinfo\015\012"); # read the response line $hdl->push_read (line => sub { my ($hdl, $line) = @_; say "got line <$line>"; $cv->send; }); $cv->recv; =head1 DESCRIPTION This is a helper module to make it easier to do event-based I/O on stream-based filehandles (sockets, pipes, and other stream things). Specifically, it doesn't work as expected on files, packet-based sockets or similar things. The L tutorial contains some well-documented AnyEvent::Handle examples. In the following, where the documentation refers to "bytes", it means characters. As sysread and syswrite are used for all I/O, their treatment of characters applies to this module as well. At the very minimum, you should specify C or C, and the C callback. All callbacks will be invoked with the handle object as their first argument. =cut package AnyEvent::Handle; use Scalar::Util (); use List::Util (); use Carp (); use Errno qw(EAGAIN EWOULDBLOCK EINTR); use AnyEvent (); BEGIN { AnyEvent::common_sense } use AnyEvent::Util qw(WSAEWOULDBLOCK); our $VERSION = $AnyEvent::VERSION; sub _load_func($) { my $func = $_[0]; unless (defined &$func) { my $pkg = $func; do { $pkg =~ s/::[^:]+$// or return; eval "require $pkg"; } until defined &$func; } \&$func } sub MAX_READ_SIZE() { 131072 } =head1 METHODS =over 4 =item $handle = B AnyEvent::Handle fh => $filehandle, key => value... The constructor supports these arguments (all as C<< key => value >> pairs). =over 4 =item fh => $filehandle [C or C MANDATORY] The filehandle this L object will operate on. NOTE: The filehandle will be set to non-blocking mode (using C) by the constructor and needs to stay in that mode. =item connect => [$host, $service] [C or C MANDATORY] Try to connect to the specified host and service (port), using C. The C<$host> additionally becomes the default C. You have to specify either this parameter, or C, above. It is possible to push requests on the read and write queues, and modify properties of the stream, even while AnyEvent::Handle is connecting. When this parameter is specified, then the C, C and C callbacks will be called under the appropriate circumstances: =over 4 =item on_prepare => $cb->($handle) This (rarely used) callback is called before a new connection is attempted, but after the file handle has been created (you can access that file handle via C<< $handle->{fh} >>). It could be used to prepare the file handle with parameters required for the actual connect (as opposed to settings that can be changed when the connection is already established). The return value of this callback should be the connect timeout value in seconds (or C<0>, or C, or the empty list, to indicate that the default timeout is to be used). =item on_connect => $cb->($handle, $host, $port, $retry->()) This callback is called when a connection has been successfully established. The peer's numeric host and port (the socket peername) are passed as parameters, together with a retry callback. At the time it is called the read and write queues, EOF status, TLS status and similar properties of the handle will have been reset. If, for some reason, the handle is not acceptable, calling C<$retry> will continue with the next connection target (in case of multi-homed hosts or SRV records there can be multiple connection endpoints). The C<$retry> callback can be invoked after the connect callback returns, i.e. one can start a handshake and then decide to retry with the next host if the handshake fails. In most cases, you should ignore the C<$retry> parameter. =item on_connect_error => $cb->($handle, $message) This callback is called when the connection could not be established. C<$!> will contain the relevant error code, and C<$message> a message describing it (usually the same as C<"$!">). If this callback isn't specified, then C will be called with a fatal error instead. =back =item on_error => $cb->($handle, $fatal, $message) This is the error callback, which is called when, well, some error occured, such as not being able to resolve the hostname, failure to connect, or a read error. Some errors are fatal (which is indicated by C<$fatal> being true). On fatal errors the handle object will be destroyed (by a call to C<< -> destroy >>) after invoking the error callback (which means you are free to examine the handle object). Examples of fatal errors are an EOF condition with active (but unsatisfiable) read watchers (C) or I/O errors. In cases where the other side can close the connection at will, it is often easiest to not report C errors in this callback. AnyEvent::Handle tries to find an appropriate error code for you to check against, but in some cases (TLS errors), this does not work well. If you report the error to the user, it is recommended to always output the C<$message> argument in human-readable error messages (you don't need to report C<"$!"> if you report C<$message>). If you want to react programmatically to the error, then looking at C<$!> and comparing it against some of the documented C values is usually better than looking at the C<$message>. Non-fatal errors can be retried by returning, but it is recommended to simply ignore this parameter and instead abondon the handle object when this callback is invoked. Examples of non-fatal errors are timeouts C) or badly-formatted data (C). On entry to the callback, the value of C<$!> contains the operating system error code (or C, C, C, C or C). While not mandatory, it is I recommended to set this callback, as you will not be notified of errors otherwise. The default just calls C. =item on_read => $cb->($handle) This sets the default read callback, which is called when data arrives and no read request is in the queue (unlike read queue callbacks, this callback will only be called when at least one octet of data is in the read buffer). To access (and remove data from) the read buffer, use the C<< ->rbuf >> method or access the C<< $handle->{rbuf} >> member directly. Note that you must not enlarge or modify the read buffer, you can only remove data at the beginning from it. You can also call C<< ->push_read (...) >> or any other function that modifies the read queue. Or do both. Or ... When an EOF condition is detected, AnyEvent::Handle will first try to feed all the remaining data to the queued callbacks and C before calling the C callback. If no progress can be made, then a fatal error will be raised (with C<$!> set to C). Note that, unlike requests in the read queue, an C callback doesn't mean you I some data: if there is an EOF and there are outstanding read requests then an error will be flagged. With an C callback, the C callback will be invoked. =item on_eof => $cb->($handle) Set the callback to be called when an end-of-file condition is detected, i.e. in the case of a socket, when the other side has closed the connection cleanly, and there are no outstanding read requests in the queue (if there are read requests, then an EOF counts as an unexpected connection close and will be flagged as an error). For sockets, this just means that the other side has stopped sending data, you can still try to write data, and, in fact, one can return from the EOF callback and continue writing data, as only the read part has been shut down. If an EOF condition has been detected but no C callback has been set, then a fatal error will be raised with C<$!> set to <0>. =item on_drain => $cb->($handle) This sets the callback that is called once when the write buffer becomes empty (and immediately when the handle object is created). To append to the write buffer, use the C<< ->push_write >> method. This callback is useful when you don't want to put all of your write data into the queue at once, for example, when you want to write the contents of some file to the socket you might not want to read the whole file into memory and push it into the queue, but instead only read more data from the file when the write queue becomes empty. =item timeout => $fractional_seconds =item rtimeout => $fractional_seconds =item wtimeout => $fractional_seconds If non-zero, then these enables an "inactivity" timeout: whenever this many seconds pass without a successful read or write on the underlying file handle (or a call to C), the C callback will be invoked (and if that one is missing, a non-fatal C error will be raised). There are three variants of the timeouts that work independently of each other, for both read and write (triggered when nothing was read I written), just read (triggered when nothing was read), and just write: C, C and C, with corresponding callbacks C, C and C, and reset functions C, C, and C. Note that timeout processing is active even when you do not have any outstanding read or write requests: If you plan to keep the connection idle then you should disable the timeout temporarily or ignore the timeout in the corresponding C callback, in which case AnyEvent::Handle will simply restart the timeout. Zero (the default) disables the corresponding timeout. =item on_timeout => $cb->($handle) =item on_rtimeout => $cb->($handle) =item on_wtimeout => $cb->($handle) Called whenever the inactivity timeout passes. If you return from this callback, then the timeout will be reset as if some activity had happened, so this condition is not fatal in any way. =item rbuf_max => If defined, then a fatal error will be raised (with C<$!> set to C) when the read buffer ever (strictly) exceeds this size. This is useful to avoid some forms of denial-of-service attacks. For example, a server accepting connections from untrusted sources should be configured to accept only so-and-so much data that it cannot act on (for example, when expecting a line, an attacker could send an unlimited amount of data without a callback ever being called as long as the line isn't finished). =item wbuf_max => If defined, then a fatal error will be raised (with C<$!> set to C) when the write buffer ever (strictly) exceeds this size. This is useful to avoid some forms of denial-of-service attacks. Although the units of this parameter is bytes, this is the I number of bytes not yet accepted by the kernel. This can make a difference when you e.g. use TLS, as TLS typically makes your write data larger (but it can also make it smaller due to compression). As an example of when this limit is useful, take a chat server that sends chat messages to a client. If the client does not read those in a timely manner then the send buffer in the server would grow unbounded. =item autocork => When disabled (the default), C will try to immediately write the data to the handle if possible. This avoids having to register a write watcher and wait for the next event loop iteration, but can be inefficient if you write multiple small chunks (on the wire, this disadvantage is usually avoided by your kernel's nagle algorithm, see C, but this option can save costly syscalls). When enabled, writes will always be queued till the next event loop iteration. This is efficient when you do many small writes per iteration, but less efficient when you do a single write only per iteration (or when the write buffer often is full). It also increases write latency. =item no_delay => When doing small writes on sockets, your operating system kernel might wait a bit for more data before actually sending it out. This is called the Nagle algorithm, and usually it is beneficial. In some situations you want as low a delay as possible, which can be accomplishd by setting this option to a true value. The default is your operating system's default behaviour (most likely enabled). This option explicitly enables or disables it, if possible. =item keepalive => Enables (default disable) the SO_KEEPALIVE option on the stream socket: normally, TCP connections have no time-out once established, so TCP connections, once established, can stay alive forever even when the other side has long gone. TCP keepalives are a cheap way to take down long-lived TCP connections when the other side becomes unreachable. While the default is OS-dependent, TCP keepalives usually kick in after around two hours, and, if the other side doesn't reply, take down the TCP connection some 10 to 15 minutes later. It is harmless to specify this option for file handles that do not support keepalives, and enabling it on connections that are potentially long-lived is usually a good idea. =item oobinline => BSD majorly fucked up the implementation of TCP urgent data. The result is that almost no OS implements TCP according to the specs, and every OS implements it slightly differently. If you want to handle TCP urgent data, then setting this flag (the default is enabled) gives you the most portable way of getting urgent data, by putting it into the stream. Since BSD emulation of OOB data on top of TCP's urgent data can have security implications, AnyEvent::Handle sets this flag automatically unless explicitly specified. Note that setting this flag after establishing a connection I be a bit too late (data loss could already have occured on BSD systems), but at least it will protect you from most attacks. =item read_size => The initial read block size, the number of bytes this module will try to read during each loop iteration. Each handle object will consume at least this amount of memory for the read buffer as well, so when handling many connections watch out for memory requirements). See also C. Default: C<2048>. =item max_read_size => The maximum read buffer size used by the dynamic adjustment algorithm: Each time AnyEvent::Handle can read C bytes in one go it will double C up to the maximum given by this option. Default: C<131072> or C, whichever is higher. =item low_water_mark => Sets the number of bytes (default: C<0>) that make up an "empty" write buffer: If the buffer reaches this size or gets even samller it is considered empty. Sometimes it can be beneficial (for performance reasons) to add data to the write buffer before it is fully drained, but this is a rare case, as the operating system kernel usually buffers data as well, so the default is good in almost all cases. =item linger => If this is non-zero (default: C<3600>), the destructor of the AnyEvent::Handle object will check whether there is still outstanding write data and will install a watcher that will write this data to the socket. No errors will be reported (this mostly matches how the operating system treats outstanding data at socket close time). This will not work for partial TLS data that could not be encoded yet. This data will be lost. Calling the C method in time might help. =item peername => $string A string used to identify the remote site - usually the DNS hostname (I IDN!) used to create the connection, rarely the IP address. Apart from being useful in error messages, this string is also used in TLS peername verification (see C in L). This verification will be skipped when C is not specified or is C. =item tls => "accept" | "connect" | Net::SSLeay::SSL object When this parameter is given, it enables TLS (SSL) mode, that means AnyEvent will start a TLS handshake as soon as the connection has been established and will transparently encrypt/decrypt data afterwards. All TLS protocol errors will be signalled as C, with an appropriate error message. TLS mode requires Net::SSLeay to be installed (it will be loaded automatically when you try to create a TLS handle): this module doesn't have a dependency on that module, so if your module requires it, you have to add the dependency yourself. If Net::SSLeay cannot be loaded or is too old, you get an C error. Unlike TCP, TLS has a server and client side: for the TLS server side, use C, and for the TLS client side of a connection, use C mode. You can also provide your own TLS connection object, but you have to make sure that you call either C or C on it before you pass it to AnyEvent::Handle. Also, this module will take ownership of this connection object. At some future point, AnyEvent::Handle might switch to another TLS implementation, then the option to use your own session object will go away. B since Net::SSLeay "objects" are really only integers, passing in the wrong integer will lead to certain crash. This most often happens when one uses a stylish C<< tls => 1 >> and is surprised about the segmentation fault. Use the C<< ->starttls >> method if you need to start TLS negotiation later. =item tls_ctx => $anyevent_tls Use the given C object to create the new TLS connection (unless a connection object was specified directly). If this parameter is missing (or C), then AnyEvent::Handle will use C. Instead of an object, you can also specify a hash reference with C<< key => value >> pairs. Those will be passed to L to create a new TLS context object. =item on_starttls => $cb->($handle, $success[, $error_message]) This callback will be invoked when the TLS/SSL handshake has finished. If C<$success> is true, then the TLS handshake succeeded, otherwise it failed (C will not be called in this case). The session in C<< $handle->{tls} >> can still be examined in this callback, even when the handshake was not successful. TLS handshake failures will not cause C to be invoked when this callback is in effect, instead, the error message will be passed to C. Without this callback, handshake failures lead to C being called as usual. Note that you cannot just call C again in this callback. If you need to do that, start an zero-second timer instead whose callback can then call C<< ->starttls >> again. =item on_stoptls => $cb->($handle) When a SSLv3/TLS shutdown/close notify/EOF is detected and this callback is set, then it will be invoked after freeing the TLS session. If it is not, then a TLS shutdown condition will be treated like a normal EOF condition on the handle. The session in C<< $handle->{tls} >> can still be examined in this callback. This callback will only be called on TLS shutdowns, not when the underlying handle signals EOF. =item json => L, L or L object This is the json coder object used by the C read and write types. If you don't supply it, then AnyEvent::Handle will create and use a suitable one (on demand), which will write and expect UTF-8 encoded JSON texts (either using L or L). The written texts are guaranteed not to contain any newline character. For security reasons, this encoder will likely I handle numbers and strings, only arrays and objects/hashes. The reason is that originally JSON was self-delimited, but Dougles Crockford thought it was a splendid idea to redefine JSON incompatibly, so this is no longer true. For protocols that used back-to-back JSON texts, this might lead to run-ins, where two or more JSON texts will be interpreted as one JSON text. For this reason, if the default encoder uses L, it will default to not allowing anything but arrays and objects/hashes, at least for the forseeable future (it will change at some point). This might or might not be true for the L module, so this might cause a security issue. If you depend on either behaviour, you should create your own json object and pass it in explicitly. =item cbor => L object This is the cbor coder object used by the C read and write types. If you don't supply it, then AnyEvent::Handle will create and use a suitable one (on demand), which will write CBOR without using extensions, if possible. Note that you are responsible to depend on the L module if you want to use this functionality, as AnyEvent does not have a dependency on it itself. =back =cut sub new { my $class = shift; my $self = bless { @_ }, $class; if ($self->{fh}) { $self->_start; return unless $self->{fh}; # could be gone by now } elsif ($self->{connect}) { require AnyEvent::Socket; $self->{peername} = $self->{connect}[0] unless exists $self->{peername}; $self->{_skip_drain_rbuf} = 1; { Scalar::Util::weaken (my $self = $self); $self->{_connect} = AnyEvent::Socket::tcp_connect ( $self->{connect}[0], $self->{connect}[1], sub { my ($fh, $host, $port, $retry) = @_; delete $self->{_connect}; # no longer needed if ($fh) { $self->{fh} = $fh; delete $self->{_skip_drain_rbuf}; $self->_start; $self->{on_connect} and $self->{on_connect}($self, $host, $port, sub { delete @$self{qw(fh _tw _rtw _wtw _ww _rw _eof _queue rbuf _wbuf tls _tls_rbuf _tls_wbuf)}; $self->{_skip_drain_rbuf} = 1; &$retry; }); } else { if ($self->{on_connect_error}) { $self->{on_connect_error}($self, "$!"); $self->destroy if $self; } else { $self->_error ($!, 1); } } }, sub { local $self->{fh} = $_[0]; $self->{on_prepare} ? $self->{on_prepare}->($self) : () } ); } } else { Carp::croak "AnyEvent::Handle: either an existing fh or the connect parameter must be specified"; } $self } sub _start { my ($self) = @_; # too many clueless people try to use udp and similar sockets # with AnyEvent::Handle, do them a favour. my $type = getsockopt $self->{fh}, Socket::SOL_SOCKET (), Socket::SO_TYPE (); Carp::croak "AnyEvent::Handle: only stream sockets supported, anything else will NOT work!" if Socket::SOCK_STREAM () != (unpack "I", $type) && defined $type; AnyEvent::fh_unblock $self->{fh}; $self->{_activity} = $self->{_ractivity} = $self->{_wactivity} = AE::now; $self->{read_size} ||= 2048; $self->{max_read_size} = $self->{read_size} if $self->{read_size} > ($self->{max_read_size} || MAX_READ_SIZE); $self->timeout (delete $self->{timeout} ) if $self->{timeout}; $self->rtimeout (delete $self->{rtimeout} ) if $self->{rtimeout}; $self->wtimeout (delete $self->{wtimeout} ) if $self->{wtimeout}; $self->no_delay (delete $self->{no_delay} ) if exists $self->{no_delay} && $self->{no_delay}; $self->keepalive (delete $self->{keepalive}) if exists $self->{keepalive} && $self->{keepalive}; $self->oobinline (exists $self->{oobinline} ? delete $self->{oobinline} : 1); $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}) if $self->{tls}; $self->on_drain (delete $self->{on_drain} ) if $self->{on_drain}; $self->start_read if $self->{on_read} || @{ $self->{_queue} }; $self->_drain_wbuf; } sub _error { my ($self, $errno, $fatal, $message) = @_; $! = $errno; $message ||= "$!"; if ($self->{on_error}) { $self->{on_error}($self, $fatal, $message); $self->destroy if $fatal; } elsif ($self->{fh} || $self->{connect}) { $self->destroy; Carp::croak "AnyEvent::Handle uncaught error: $message"; } } =item $fh = $handle->fh This method returns the file handle used to create the L object. =cut sub fh { $_[0]{fh} } =item $handle->on_error ($cb) Replace the current C callback (see the C constructor argument). =cut sub on_error { $_[0]{on_error} = $_[1]; } =item $handle->on_eof ($cb) Replace the current C callback (see the C constructor argument). =cut sub on_eof { $_[0]{on_eof} = $_[1]; } =item $handle->on_timeout ($cb) =item $handle->on_rtimeout ($cb) =item $handle->on_wtimeout ($cb) Replace the current C, C or C callback, or disables the callback (but not the timeout) if C<$cb> = C. See the C constructor argument and method. =cut # see below =item $handle->autocork ($boolean) Enables or disables the current autocork behaviour (see C constructor argument). Changes will only take effect on the next write. =cut sub autocork { $_[0]{autocork} = $_[1]; } =item $handle->no_delay ($boolean) Enables or disables the C setting (see constructor argument of the same name for details). =cut sub no_delay { $_[0]{no_delay} = $_[1]; setsockopt $_[0]{fh}, Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), int $_[1] if $_[0]{fh}; } =item $handle->keepalive ($boolean) Enables or disables the C setting (see constructor argument of the same name for details). =cut sub keepalive { $_[0]{keepalive} = $_[1]; eval { local $SIG{__DIE__}; setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_KEEPALIVE (), int $_[1] if $_[0]{fh}; }; } =item $handle->oobinline ($boolean) Enables or disables the C setting (see constructor argument of the same name for details). =cut sub oobinline { $_[0]{oobinline} = $_[1]; eval { local $SIG{__DIE__}; setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_OOBINLINE (), int $_[1] if $_[0]{fh}; }; } =item $handle->on_starttls ($cb) Replace the current C callback (see the C constructor argument). =cut sub on_starttls { $_[0]{on_starttls} = $_[1]; } =item $handle->on_stoptls ($cb) Replace the current C callback (see the C constructor argument). =cut sub on_stoptls { $_[0]{on_stoptls} = $_[1]; } =item $handle->rbuf_max ($max_octets) Configures the C setting (C disables it). =item $handle->wbuf_max ($max_octets) Configures the C setting (C disables it). =cut sub rbuf_max { $_[0]{rbuf_max} = $_[1]; } sub wbuf_max { $_[0]{wbuf_max} = $_[1]; } ############################################################################# =item $handle->timeout ($seconds) =item $handle->rtimeout ($seconds) =item $handle->wtimeout ($seconds) Configures (or disables) the inactivity timeout. The timeout will be checked instantly, so this method might destroy the handle before it returns. =item $handle->timeout_reset =item $handle->rtimeout_reset =item $handle->wtimeout_reset Reset the activity timeout, as if data was received or sent. These methods are cheap to call. =cut for my $dir ("", "r", "w") { my $timeout = "${dir}timeout"; my $tw = "_${dir}tw"; my $on_timeout = "on_${dir}timeout"; my $activity = "_${dir}activity"; my $cb; *$on_timeout = sub { $_[0]{$on_timeout} = $_[1]; }; *$timeout = sub { my ($self, $new_value) = @_; $new_value >= 0 or Carp::croak "AnyEvent::Handle->$timeout called with negative timeout ($new_value), caught"; $self->{$timeout} = $new_value; delete $self->{$tw}; &$cb; }; *{"${dir}timeout_reset"} = sub { $_[0]{$activity} = AE::now; }; # main workhorse: # reset the timeout watcher, as neccessary # also check for time-outs $cb = sub { my ($self) = @_; if ($self->{$timeout} && $self->{fh}) { my $NOW = AE::now; # when would the timeout trigger? my $after = $self->{$activity} + $self->{$timeout} - $NOW; # now or in the past already? if ($after <= 0) { $self->{$activity} = $NOW; if ($self->{$on_timeout}) { $self->{$on_timeout}($self); } else { $self->_error (Errno::ETIMEDOUT); } # callback could have changed timeout value, optimise return unless $self->{$timeout}; # calculate new after $after = $self->{$timeout}; } Scalar::Util::weaken $self; return unless $self; # ->error could have destroyed $self $self->{$tw} ||= AE::timer $after, 0, sub { delete $self->{$tw}; $cb->($self); }; } else { delete $self->{$tw}; } } } ############################################################################# =back =head2 WRITE QUEUE AnyEvent::Handle manages two queues per handle, one for writing and one for reading. The write queue is very simple: you can add data to its end, and AnyEvent::Handle will automatically try to get rid of it for you. When data could be written and the write buffer is shorter then the low water mark, the C callback will be invoked once. =over 4 =item $handle->on_drain ($cb) Sets the C callback or clears it (see the description of C in the constructor). This method may invoke callbacks (and therefore the handle might be destroyed after it returns). =cut sub on_drain { my ($self, $cb) = @_; $self->{on_drain} = $cb; $cb->($self) if $cb && $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf}); } =item $handle->push_write ($data) Queues the given scalar to be written. You can push as much data as you want (only limited by the available memory and C), as C buffers it independently of the kernel. This method may invoke callbacks (and therefore the handle might be destroyed after it returns). =cut sub _drain_wbuf { my ($self) = @_; if (!$self->{_ww} && length $self->{wbuf}) { Scalar::Util::weaken $self; my $cb = sub { my $len = syswrite $self->{fh}, $self->{wbuf}; if (defined $len) { substr $self->{wbuf}, 0, $len, ""; $self->{_activity} = $self->{_wactivity} = AE::now; $self->{on_drain}($self) if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf}) && $self->{on_drain}; delete $self->{_ww} unless length $self->{wbuf}; } elsif ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK) { $self->_error ($!, 1); } }; # try to write data immediately $cb->() unless $self->{autocork}; # if still data left in wbuf, we need to poll $self->{_ww} = AE::io $self->{fh}, 1, $cb if length $self->{wbuf}; if ( defined $self->{wbuf_max} && $self->{wbuf_max} < length $self->{wbuf} ) { $self->_error (Errno::ENOSPC, 1), return; } }; } our %WH; # deprecated sub register_write_type($$) { $WH{$_[0]} = $_[1]; } sub push_write { my $self = shift; if (@_ > 1) { my $type = shift; @_ = ($WH{$type} ||= _load_func "$type\::anyevent_write_type" or Carp::croak "unsupported/unloadable type '$type' passed to AnyEvent::Handle::push_write") ->($self, @_); } # we downgrade here to avoid hard-to-track-down bugs, # and diagnose the problem earlier and better. if ($self->{tls}) { utf8::downgrade $self->{_tls_wbuf} .= $_[0]; &_dotls ($self) if $self->{fh}; } else { utf8::downgrade $self->{wbuf} .= $_[0]; $self->_drain_wbuf if $self->{fh}; } } =item $handle->push_write (type => @args) Instead of formatting your data yourself, you can also let this module do the job by specifying a type and type-specific arguments. You can also specify the (fully qualified) name of a package, in which case AnyEvent tries to load the package and then expects to find the C function inside (see "custom write types", below). Predefined types are (if you have ideas for additional types, feel free to drop by and tell us): =over 4 =item netstring => $string Formats the given value as netstring (http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them). =cut register_write_type netstring => sub { my ($self, $string) = @_; (length $string) . ":$string," }; =item packstring => $format, $data An octet string prefixed with an encoded length. The encoding C<$format> uses the same format as a Perl C format, but must specify a single integer only (only one of C is allowed, plus an optional C, C<< < >> or C<< > >> modifier). =cut register_write_type packstring => sub { my ($self, $format, $string) = @_; pack "$format/a*", $string }; =item json => $array_or_hashref Encodes the given hash or array reference into a JSON object. Unless you provide your own JSON object, this means it will be encoded to JSON text in UTF-8. The default encoder might or might not handle every type of JSON value - it might be limited to arrays and objects for security reasons. See the C constructor attribute for more details. JSON objects (and arrays) are self-delimiting, so if you only use arrays and hashes, you can write JSON at one end of a handle and read them at the other end without using any additional framing. The JSON text generated by the default encoder is guaranteed not to contain any newlines: While this module doesn't need delimiters after or between JSON texts to be able to read them, many other languages depend on them. A simple RPC protocol that interoperates easily with other languages is to send JSON arrays (or objects, although arrays are usually the better choice as they mimic how function argument passing works) and a newline after each JSON text: $handle->push_write (json => ["method", "arg1", "arg2"]); # whatever $handle->push_write ("\012"); An AnyEvent::Handle receiver would simply use the C read type and rely on the fact that the newline will be skipped as leading whitespace: $handle->push_read (json => sub { my $array = $_[1]; ... }); Other languages could read single lines terminated by a newline and pass this line into their JSON decoder of choice. =item cbor => $perl_scalar Encodes the given scalar into a CBOR value. Unless you provide your own L object, this means it will be encoded to a CBOR string not using any extensions, if possible. CBOR values are self-delimiting, so you can write CBOR at one end of a handle and read them at the other end without using any additional framing. A simple nd very very fast RPC protocol that interoperates with other languages is to send CBOR and receive CBOR values (arrays are recommended): $handle->push_write (cbor => ["method", "arg1", "arg2"]); # whatever An AnyEvent::Handle receiver would simply use the C read type: $handle->push_read (cbor => sub { my $array = $_[1]; ... }); =cut sub json_coder() { eval { require JSON::XS; JSON::XS->new->utf8 } || do { require JSON::PP; JSON::PP->new->utf8 } } register_write_type json => sub { my ($self, $ref) = @_; ($self->{json} ||= json_coder) ->encode ($ref) }; sub cbor_coder() { require CBOR::XS; CBOR::XS->new } register_write_type cbor => sub { my ($self, $scalar) = @_; ($self->{cbor} ||= cbor_coder) ->encode ($scalar) }; =item storable => $reference Freezes the given reference using L and writes it to the handle. Uses the C format. =cut register_write_type storable => sub { my ($self, $ref) = @_; require Storable unless $Storable::VERSION; pack "w/a*", Storable::nfreeze ($ref) }; =back =item $handle->push_shutdown Sometimes you know you want to close the socket after writing your data before it was actually written. One way to do that is to replace your C handler by a callback that shuts down the socket (and set C to C<0>). This method is a shorthand for just that, and replaces the C callback with: sub { shutdown $_[0]{fh}, 1 } This simply shuts down the write side and signals an EOF condition to the the peer. You can rely on the normal read queue and C handling afterwards. This is the cleanest way to close a connection. This method may invoke callbacks (and therefore the handle might be destroyed after it returns). =cut sub push_shutdown { my ($self) = @_; delete $self->{low_water_mark}; $self->on_drain (sub { shutdown $_[0]{fh}, 1 }); } =item custom write types - Package::anyevent_write_type $handle, @args Instead of one of the predefined types, you can also specify the name of a package. AnyEvent will try to load the package and then expects to find a function named C inside. If it isn't found, it progressively tries to load the parent package until it either finds the function (good) or runs out of packages (bad). Whenever the given C is used, C will the function with the handle object and the remaining arguments. The function is supposed to return a single octet string that will be appended to the write buffer, so you can mentally treat this function as a "arguments to on-the-wire-format" converter. Example: implement a custom write type C that joins the remaining arguments using the first one. $handle->push_write (My::Type => " ", 1,2,3); # uses the following package, which can be defined in the "My::Type" or in # the "My" modules to be auto-loaded, or just about anywhere when the # My::Type::anyevent_write_type is defined before invoking it. package My::Type; sub anyevent_write_type { my ($handle, $delim, @args) = @_; join $delim, @args } =cut ############################################################################# =back =head2 READ QUEUE AnyEvent::Handle manages two queues per handle, one for writing and one for reading. The read queue is more complex than the write queue. It can be used in two ways, the "simple" way, using only C and the "complex" way, using a queue. In the simple case, you just install an C callback and whenever new data arrives, it will be called. You can then remove some data (if enough is there) from the read buffer (C<< $handle->rbuf >>). Or you can leave the data there if you want to accumulate more (e.g. when only a partial message has been received so far), or change the read queue with e.g. C. In the more complex case, you want to queue multiple callbacks. In this case, AnyEvent::Handle will call the first queued callback each time new data arrives (also the first time it is queued) and remove it when it has done its job (see C, below). This way you can, for example, push three line-reads, followed by reading a chunk of data, and AnyEvent::Handle will execute them in order. Example 1: EPP protocol parser. EPP sends 4 byte length info, followed by the specified number of bytes which give an XML datagram. # in the default state, expect some header bytes $handle->on_read (sub { # some data is here, now queue the length-header-read (4 octets) shift->unshift_read (chunk => 4, sub { # header arrived, decode my $len = unpack "N", $_[1]; # now read the payload shift->unshift_read (chunk => $len, sub { my $xml = $_[1]; # handle xml }); }); }); Example 2: Implement a client for a protocol that replies either with "OK" and another line or "ERROR" for the first request that is sent, and 64 bytes for the second request. Due to the availability of a queue, we can just pipeline sending both requests and manipulate the queue as necessary in the callbacks. When the first callback is called and sees an "OK" response, it will C another line-read. This line-read will be queued I the 64-byte chunk callback. # request one, returns either "OK + extra line" or "ERROR" $handle->push_write ("request 1\015\012"); # we expect "ERROR" or "OK" as response, so push a line read $handle->push_read (line => sub { # if we got an "OK", we have to _prepend_ another line, # so it will be read before the second request reads its 64 bytes # which are already in the queue when this callback is called # we don't do this in case we got an error if ($_[1] eq "OK") { $_[0]->unshift_read (line => sub { my $response = $_[1]; ... }); } }); # request two, simply returns 64 octets $handle->push_write ("request 2\015\012"); # simply read 64 bytes, always $handle->push_read (chunk => 64, sub { my $response = $_[1]; ... }); =over 4 =cut sub _drain_rbuf { my ($self) = @_; # avoid recursion return if $self->{_skip_drain_rbuf}; local $self->{_skip_drain_rbuf} = 1; while () { # we need to use a separate tls read buffer, as we must not receive data while # we are draining the buffer, and this can only happen with TLS. $self->{rbuf} .= delete $self->{_tls_rbuf} if exists $self->{_tls_rbuf}; my $len = length $self->{rbuf}; if (my $cb = shift @{ $self->{_queue} }) { unless ($cb->($self)) { # no progress can be made # (not enough data and no data forthcoming) $self->_error (Errno::EPIPE, 1), return if $self->{_eof}; unshift @{ $self->{_queue} }, $cb; last; } } elsif ($self->{on_read}) { last unless $len; $self->{on_read}($self); if ( $len == length $self->{rbuf} # if no data has been consumed && !@{ $self->{_queue} } # and the queue is still empty && $self->{on_read} # but we still have on_read ) { # no further data will arrive # so no progress can be made $self->_error (Errno::EPIPE, 1), return if $self->{_eof}; last; # more data might arrive } } else { # read side becomes idle delete $self->{_rw} unless $self->{tls}; last; } } if ($self->{_eof}) { $self->{on_eof} ? $self->{on_eof}($self) : $self->_error (0, 1, "Unexpected end-of-file"); return; } if ( defined $self->{rbuf_max} && $self->{rbuf_max} < length $self->{rbuf} ) { $self->_error (Errno::ENOSPC, 1), return; } # may need to restart read watcher unless ($self->{_rw}) { $self->start_read if $self->{on_read} || @{ $self->{_queue} }; } } =item $handle->on_read ($cb) This replaces the currently set C callback, or clears it (when the new callback is C). See the description of C in the constructor. This method may invoke callbacks (and therefore the handle might be destroyed after it returns). =cut sub on_read { my ($self, $cb) = @_; $self->{on_read} = $cb; $self->_drain_rbuf if $cb; } =item $handle->rbuf Returns the read buffer (as a modifiable lvalue). You can also access the read buffer directly as the C<< ->{rbuf} >> member, if you want (this is much faster, and no less clean). The only operation allowed on the read buffer (apart from looking at it) is removing data from its beginning. Otherwise modifying or appending to it is not allowed and will lead to hard-to-track-down bugs. NOTE: The read buffer should only be used or modified in the C callback or when C or C are used with a single callback (i.e. untyped). Typed C and C methods will manage the read buffer on their own. =cut sub rbuf : lvalue { $_[0]{rbuf} } =item $handle->push_read ($cb) =item $handle->unshift_read ($cb) Append the given callback to the end of the queue (C) or prepend it (C). The callback is called each time some additional read data arrives. It must check whether enough data is in the read buffer already. If not enough data is available, it must return the empty list or a false value, in which case it will be called repeatedly until enough data is available (or an error condition is detected). If enough data was available, then the callback must remove all data it is interested in (which can be none at all) and return a true value. After returning true, it will be removed from the queue. These methods may invoke callbacks (and therefore the handle might be destroyed after it returns). =cut our %RH; sub register_read_type($$) { $RH{$_[0]} = $_[1]; } sub push_read { my $self = shift; my $cb = pop; if (@_) { my $type = shift; $cb = ($RH{$type} ||= _load_func "$type\::anyevent_read_type" or Carp::croak "unsupported/unloadable type '$type' passed to AnyEvent::Handle::push_read") ->($self, $cb, @_); } push @{ $self->{_queue} }, $cb; $self->_drain_rbuf; } sub unshift_read { my $self = shift; my $cb = pop; if (@_) { my $type = shift; $cb = ($RH{$type} ||= _load_func "$type\::anyevent_read_type" or Carp::croak "unsupported/unloadable type '$type' passed to AnyEvent::Handle::unshift_read") ->($self, $cb, @_); } unshift @{ $self->{_queue} }, $cb; $self->_drain_rbuf; } =item $handle->push_read (type => @args, $cb) =item $handle->unshift_read (type => @args, $cb) Instead of providing a callback that parses the data itself you can chose between a number of predefined parsing formats, for chunks of data, lines etc. You can also specify the (fully qualified) name of a package, in which case AnyEvent tries to load the package and then expects to find the C function inside (see "custom read types", below). Predefined types are (if you have ideas for additional types, feel free to drop by and tell us): =over 4 =item chunk => $octets, $cb->($handle, $data) Invoke the callback only once C<$octets> bytes have been read. Pass the data read to the callback. The callback will never be called with less data. Example: read 2 bytes. $handle->push_read (chunk => 2, sub { say "yay " . unpack "H*", $_[1]; }); =cut register_read_type chunk => sub { my ($self, $cb, $len) = @_; sub { $len <= length $_[0]{rbuf} or return; $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 1 } }; =item line => [$eol, ]$cb->($handle, $line, $eol) The callback will be called only once a full line (including the end of line marker, C<$eol>) has been read. This line (excluding the end of line marker) will be passed to the callback as second argument (C<$line>), and the end of line marker as the third argument (C<$eol>). The end of line marker, C<$eol>, can be either a string, in which case it will be interpreted as a fixed record end marker, or it can be a regex object (e.g. created by C), in which case it is interpreted as a regular expression. The end of line marker argument C<$eol> is optional, if it is missing (NOT undef), then C is used (which is good for most internet protocols). Partial lines at the end of the stream will never be returned, as they are not marked by the end of line marker. =cut register_read_type line => sub { my ($self, $cb, $eol) = @_; if (@_ < 3) { # this is faster then the generic code below sub { (my $pos = index $_[0]{rbuf}, "\012") >= 0 or return; (my $str = substr $_[0]{rbuf}, 0, $pos + 1, "") =~ s/(\015?\012)\Z// or die; $cb->($_[0], $str, "$1"); 1 } } else { $eol = quotemeta $eol unless ref $eol; $eol = qr|^(.*?)($eol)|s; sub { $_[0]{rbuf} =~ s/$eol// or return; $cb->($_[0], "$1", "$2"); 1 } } }; =item regex => $accept[, $reject[, $skip], $cb->($handle, $data) Makes a regex match against the regex object C<$accept> and returns everything up to and including the match. All the usual regex variables ($1, %+ etc.) from the regex match are available in the callback. Example: read a single line terminated by '\n'. $handle->push_read (regex => qr<\n>, sub { ... }); If C<$reject> is given and not undef, then it determines when the data is to be rejected: it is matched against the data when the C<$accept> regex does not match and generates an C error when it matches. This is useful to quickly reject wrong data (to avoid waiting for a timeout or a receive buffer overflow). Example: expect a single decimal number followed by whitespace, reject anything else (not the use of an anchor). $handle->push_read (regex => qr<^[0-9]+\s>, qr<[^0-9]>, sub { ... }); If C<$skip> is given and not C, then it will be matched against the receive buffer when neither C<$accept> nor C<$reject> match, and everything preceding and including the match will be accepted unconditionally. This is useful to skip large amounts of data that you know cannot be matched, so that the C<$accept> or C<$reject> regex do not have to start matching from the beginning. This is purely an optimisation and is usually worth it only when you expect more than a few kilobytes. Example: expect a http header, which ends at C<\015\012\015\012>. Since we expect the header to be very large (it isn't in practice, but...), we use a skip regex to skip initial portions. The skip regex is tricky in that it only accepts something not ending in either \015 or \012, as these are required for the accept regex. $handle->push_read (regex => qr<\015\012\015\012>, undef, # no reject qr<^.*[^\015\012]>, sub { ... }); =cut register_read_type regex => sub { my ($self, $cb, $accept, $reject, $skip) = @_; my $data; my $rbuf = \$self->{rbuf}; sub { # accept if ($$rbuf =~ $accept) { $data .= substr $$rbuf, 0, $+[0], ""; $cb->($_[0], $data); return 1; } # reject if ($reject && $$rbuf =~ $reject) { $_[0]->_error (Errno::EBADMSG); } # skip if ($skip && $$rbuf =~ $skip) { $data .= substr $$rbuf, 0, $+[0], ""; } () } }; =item netstring => $cb->($handle, $string) A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement). Throws an error with C<$!> set to EBADMSG on format violations. =cut register_read_type netstring => sub { my ($self, $cb) = @_; sub { unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { if ($_[0]{rbuf} =~ /[^0-9]/) { $_[0]->_error (Errno::EBADMSG); } return; } my $len = $1; $_[0]->unshift_read (chunk => $len, sub { my $string = $_[1]; $_[0]->unshift_read (chunk => 1, sub { if ($_[1] eq ",") { $cb->($_[0], $string); } else { $_[0]->_error (Errno::EBADMSG); } }); }); 1 } }; =item packstring => $format, $cb->($handle, $string) An octet string prefixed with an encoded length. The encoding C<$format> uses the same format as a Perl C format, but must specify a single integer only (only one of C is allowed, plus an optional C, C<< < >> or C<< > >> modifier). For example, DNS over TCP uses a prefix of C (2 octet network order), EPP uses a prefix of C (4 octtes). Example: read a block of data prefixed by its length in BER-encoded format (very efficient). $handle->push_read (packstring => "w", sub { my ($handle, $data) = @_; }); =cut register_read_type packstring => sub { my ($self, $cb, $format) = @_; sub { # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method defined (my $len = eval { unpack $format, $_[0]{rbuf} }) or return; $format = length pack $format, $len; # bypass unshift if we already have the remaining chunk if ($format + $len <= length $_[0]{rbuf}) { my $data = substr $_[0]{rbuf}, $format, $len; substr $_[0]{rbuf}, 0, $format + $len, ""; $cb->($_[0], $data); } else { # remove prefix substr $_[0]{rbuf}, 0, $format, ""; # read remaining chunk $_[0]->unshift_read (chunk => $len, $cb); } 1 } }; =item json => $cb->($handle, $hash_or_arrayref) Reads a JSON object or array, decodes it and passes it to the callback. When a parse error occurs, an C error will be raised. If a C object was passed to the constructor, then that will be used for the final decode, otherwise it will create a L or L coder object expecting UTF-8. This read type uses the incremental parser available with JSON version 2.09 (and JSON::XS version 2.2) and above. Since JSON texts are fully self-delimiting, the C read and write types are an ideal simple RPC protocol: just exchange JSON datagrams. See the C write type description, above, for an actual example. =cut register_read_type json => sub { my ($self, $cb) = @_; my $json = $self->{json} ||= json_coder; my $data; sub { my $ref = eval { $json->incr_parse ($_[0]{rbuf}) }; if ($ref) { $_[0]{rbuf} = $json->incr_text; $json->incr_text = ""; $cb->($_[0], $ref); 1 } elsif ($@) { # error case $json->incr_skip; $_[0]{rbuf} = $json->incr_text; $json->incr_text = ""; $_[0]->_error (Errno::EBADMSG); () } else { $_[0]{rbuf} = ""; () } } }; =item cbor => $cb->($handle, $scalar) Reads a CBOR value, decodes it and passes it to the callback. When a parse error occurs, an C error will be raised. If a L object was passed to the constructor, then that will be used for the final decode, otherwise it will create a CBOR coder without enabling any options. You have to provide a dependency to L on your own: this module will load the L module, but AnyEvent does not depend on it itself. Since CBOR values are fully self-delimiting, the C read and write types are an ideal simple RPC protocol: just exchange CBOR datagrams. See the C write type description, above, for an actual example. =cut register_read_type cbor => sub { my ($self, $cb) = @_; my $cbor = $self->{cbor} ||= cbor_coder; my $data; sub { my (@value) = eval { $cbor->incr_parse ($_[0]{rbuf}) }; if (@value) { $cb->($_[0], @value); 1 } elsif ($@) { # error case $cbor->incr_reset; $_[0]->_error (Errno::EBADMSG); () } else { () } } }; =item storable => $cb->($handle, $ref) Deserialises a L frozen representation as written by the C write type (BER-encoded length prefix followed by nfreeze'd data). Raises C error if the data could not be decoded. =cut register_read_type storable => sub { my ($self, $cb) = @_; require Storable unless $Storable::VERSION; sub { # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method defined (my $len = eval { unpack "w", $_[0]{rbuf} }) or return; my $format = length pack "w", $len; # bypass unshift if we already have the remaining chunk if ($format + $len <= length $_[0]{rbuf}) { my $data = substr $_[0]{rbuf}, $format, $len; substr $_[0]{rbuf}, 0, $format + $len, ""; eval { $cb->($_[0], Storable::thaw ($data)); 1 } or return $_[0]->_error (Errno::EBADMSG); } else { # remove prefix substr $_[0]{rbuf}, 0, $format, ""; # read remaining chunk $_[0]->unshift_read (chunk => $len, sub { eval { $cb->($_[0], Storable::thaw ($_[1])); 1 } or $_[0]->_error (Errno::EBADMSG); }); } 1 } }; =item tls_detect => $cb->($handle, $detect, $major, $minor) Checks the input stream for a valid SSL or TLS handshake TLSPaintext record without consuming anything. Only SSL version 3 or higher is handled, up to the fictituous protocol 4.x (but both SSL3+ and SSL2-compatible framing is supported). If it detects that the input data is likely TLS, it calls the callback with a true value for C<$detect> and the (on-wire) TLS version as second and third argument (C<$major> is C<3>, and C<$minor> is 0..4 for SSL 3.0, TLS 1.0, 1.1, 1.2 and 1.3, respectively). If it detects the input to be definitely not TLS, it calls the callback with a false value for C<$detect>. The callback could use this information to decide whether or not to start TLS negotiation. In all cases the data read so far is passed to the following read handlers. Usually you want to use the C read type instead. If you want to design a protocol that works in the presence of TLS dtection, make sure that any non-TLS data doesn't start with the octet 22 (ASCII SYN, 16 hex) or 128-255 (i.e. highest bit set). The checks this read type does are a bit more strict, but might losen in the future to accomodate protocol changes. This read type does not rely on L (and thus, not on L). =item tls_autostart => [$tls_ctx, ]$tls Tries to detect a valid SSL or TLS handshake. If one is detected, it tries to start tls by calling C with the given arguments. In practise, C<$tls> must be C, or a Net::SSLeay context that has been configured to accept, as servers do not normally send a handshake on their own and ths cannot be detected in this way. See C above for more details. Example: give the client a chance to start TLS before accepting a text line. $hdl->push_read (tls_autostart => "accept"); $hdl->push_read (line => sub { print "received ", ($_[0]{tls} ? "encrypted" : "cleartext"), " <$_[1]>\n"; }); =cut register_read_type tls_detect => sub { my ($self, $cb) = @_; sub { # this regex matches a full or partial tls record if ( # ssl3+: type(22=handshake) major(=3) minor(any) length_hi $self->{rbuf} =~ /^(?:\z| \x16 (\z| [\x03\x04] (?:\z| . (?:\z| [\x00-\x40] ))))/xs # ssl2 comapatible: len_hi len_lo type(1) major minor dummy(forlength) or $self->{rbuf} =~ /^(?:\z| [\x80-\xff] (?:\z| . (?:\z| \x01 (\z| [\x03\x04] (?:\z| . (?:\z| . ))))))/xs ) { return if 3 != length $1; # partial match, can't decide yet # full match, valid TLS record my ($major, $minor) = unpack "CC", $1; $cb->($self, "accept", $major, $minor); } else { # mismatch == guaranteed not TLS $cb->($self, undef); } 1 } }; register_read_type tls_autostart => sub { my ($self, @tls) = @_; $RH{tls_detect}($self, sub { return unless $_[1]; $_[0]->starttls (@tls); }) }; =back =item custom read types - Package::anyevent_read_type $handle, $cb, @args Instead of one of the predefined types, you can also specify the name of a package. AnyEvent will try to load the package and then expects to find a function named C inside. If it isn't found, it progressively tries to load the parent package until it either finds the function (good) or runs out of packages (bad). Whenever this type is used, C will invoke the function with the handle object, the original callback and the remaining arguments. The function is supposed to return a callback (usually a closure) that works as a plain read callback (see C<< ->push_read ($cb) >>), so you can mentally treat the function as a "configurable read type to read callback" converter. It should invoke the original callback when it is done reading (remember to pass C<$handle> as first argument as all other callbacks do that, although there is no strict requirement on this). For examples, see the source of this module (F, search for C)). =item $handle->stop_read =item $handle->start_read In rare cases you actually do not want to read anything from the socket. In this case you can call C. Neither C nor any queued callbacks will be executed then. To start reading again, call C. Note that AnyEvent::Handle will automatically C for you when you change the C callback or push/unshift a read callback, and it will automatically C for you when neither C is set nor there are any read requests in the queue. In older versions of this module (<= 5.3), these methods had no effect, as TLS does not support half-duplex connections. In current versions they work as expected, as this behaviour is required to avoid certain resource attacks, where the program would be forced to read (and buffer) arbitrary amounts of data before being able to send some data. The drawback is that some readings of the the SSL/TLS specifications basically require this attack to be working, as SSL/TLS implementations might stall sending data during a rehandshake. As a guideline, during the initial handshake, you should not stop reading, and as a client, it might cause problems, depending on your application. =cut sub stop_read { my ($self) = @_; delete $self->{_rw}; } sub start_read { my ($self) = @_; unless ($self->{_rw} || $self->{_eof} || !$self->{fh}) { Scalar::Util::weaken $self; $self->{_rw} = AE::io $self->{fh}, 0, sub { my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf}); my $len = sysread $self->{fh}, $$rbuf, $self->{read_size}, length $$rbuf; if ($len > 0) { $self->{_activity} = $self->{_ractivity} = AE::now; if ($self->{tls}) { Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf); &_dotls ($self); } else { $self->_drain_rbuf; } if ($len == $self->{read_size}) { $self->{read_size} *= 2; $self->{read_size} = $self->{max_read_size} || MAX_READ_SIZE if $self->{read_size} > ($self->{max_read_size} || MAX_READ_SIZE); } } elsif (defined $len) { delete $self->{_rw}; $self->{_eof} = 1; $self->_drain_rbuf; } elsif ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK) { return $self->_error ($!, 1); } }; } } our $ERROR_SYSCALL; our $ERROR_WANT_READ; sub _tls_error { my ($self, $err) = @_; return $self->_error ($!, 1) if $err == Net::SSLeay::ERROR_SYSCALL (); my $err = Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ()); # reduce error string to look less scary $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /; if ($self->{_on_starttls}) { (delete $self->{_on_starttls})->($self, undef, $err); &_freetls; } else { &_freetls; $self->_error (Errno::EPROTO, 1, $err); } } # poll the write BIO and send the data if applicable # also decode read data if possible # this is basiclaly our TLS state machine # more efficient implementations are possible with openssl, # but not with the buggy and incomplete Net::SSLeay. sub _dotls { my ($self) = @_; my $tmp; while (length $self->{_tls_wbuf}) { if (($tmp = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) <= 0) { $tmp = Net::SSLeay::get_error ($self->{tls}, $tmp); return $self->_tls_error ($tmp) if $tmp != $ERROR_WANT_READ && ($tmp != $ERROR_SYSCALL || $!); last; } substr $self->{_tls_wbuf}, 0, $tmp, ""; } while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) { unless (length $tmp) { $self->{_on_starttls} and (delete $self->{_on_starttls})->($self, undef, "EOF during handshake"); # ??? &_freetls; if ($self->{on_stoptls}) { $self->{on_stoptls}($self); return; } else { # let's treat SSL-eof as we treat normal EOF delete $self->{_rw}; $self->{_eof} = 1; } } $self->{_tls_rbuf} .= $tmp; $self->_drain_rbuf; $self->{tls} or return; # tls session might have gone away in callback } $tmp = Net::SSLeay::get_error ($self->{tls}, -1); # -1 is not neccessarily correct, but Net::SSLeay doesn't tell us return $self->_tls_error ($tmp) if $tmp != $ERROR_WANT_READ && ($tmp != $ERROR_SYSCALL || $!); while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) { $self->{wbuf} .= $tmp; $self->_drain_wbuf; $self->{tls} or return; # tls session might have gone away in callback } $self->{_on_starttls} and Net::SSLeay::state ($self->{tls}) == Net::SSLeay::ST_OK () and (delete $self->{_on_starttls})->($self, 1, "TLS/SSL connection established"); } =item $handle->starttls ($tls[, $tls_ctx]) Instead of starting TLS negotiation immediately when the AnyEvent::Handle object is created, you can also do that at a later time by calling C. See the C constructor argument for general info. Starting TLS is currently an asynchronous operation - when you push some write data and then call C<< ->starttls >> then TLS negotiation will start immediately, after which the queued write data is then sent. This might change in future versions, so best make sure you have no outstanding write data when calling this method. The first argument is the same as the C constructor argument (either C<"connect">, C<"accept"> or an existing Net::SSLeay object). The second argument is the optional C object that is used when AnyEvent::Handle has to create its own TLS connection object, or a hash reference with C<< key => value >> pairs that will be used to construct a new context. The TLS connection object will end up in C<< $handle->{tls} >>, the TLS context in C<< $handle->{tls_ctx} >> after this call and can be used or changed to your liking. Note that the handshake might have already started when this function returns. Due to bugs in OpenSSL, it might or might not be possible to do multiple handshakes on the same stream. It is best to not attempt to use the stream after stopping TLS. This method may invoke callbacks (and therefore the handle might be destroyed after it returns). =cut our %TLS_CACHE; #TODO not yet documented, should we? sub starttls { my ($self, $tls, $ctx) = @_; Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught" if $self->{tls}; unless (defined $AnyEvent::TLS::VERSION) { eval { require Net::SSLeay; require AnyEvent::TLS; 1 } or return $self->_error (Errno::EPROTO, 1, "TLS support not available on this system"); } $self->{tls} = $tls; $self->{tls_ctx} = $ctx if @_ > 2; return unless $self->{fh}; $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); $tls = delete $self->{tls}; $ctx = $self->{tls_ctx}; local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session if ("HASH" eq ref $ctx) { if ($ctx->{cache}) { my $key = $ctx+0; $ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx; } else { $ctx = new AnyEvent::TLS %$ctx; } } $self->{tls_ctx} = $ctx || TLS_CTX (); $self->{tls} = $tls = $self->{tls_ctx}->_get_session ($tls, $self, $self->{peername}); # basically, this is deep magic (because SSL_read should have the same issues) # but the openssl maintainers basically said: "trust us, it just works". # (unfortunately, we have to hardcode constants because the abysmally misdesigned # and mismaintained ssleay-module didn't offer them for a decade or so). # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html # # in short: this is a mess. # # note that we do not try to keep the length constant between writes as we are required to do. # we assume that most (but not all) of this insanity only applies to non-blocking cases, # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to # have identity issues in that area. # Net::SSLeay::set_mode ($ssl, # (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) # | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); Net::SSLeay::set_mode ($tls, 1|2); $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); Net::SSLeay::BIO_write ($self->{_rbio}, $self->{rbuf}); $self->{rbuf} = ""; Net::SSLeay::set_bio ($tls, $self->{_rbio}, $self->{_wbio}); $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) } if $self->{on_starttls}; &_dotls; # need to trigger the initial handshake $self->start_read; # make sure we actually do read } =item $handle->stoptls Shuts down the SSL connection - this makes a proper EOF handshake by sending a close notify to the other side, but since OpenSSL doesn't support non-blocking shut downs, it is not guaranteed that you can re-use the stream afterwards. This method may invoke callbacks (and therefore the handle might be destroyed after it returns). =cut sub stoptls { my ($self) = @_; if ($self->{tls} && $self->{fh}) { Net::SSLeay::shutdown ($self->{tls}); &_dotls; # # we don't give a shit. no, we do, but we can't. no...#d# # # we, we... have to use openssl :/#d# # &_freetls;#d# } } sub _freetls { my ($self) = @_; return unless $self->{tls}; $self->{tls_ctx}->_put_session (delete $self->{tls}) if $self->{tls} > 0; delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)}; } =item $handle->resettls This rarely-used method simply resets and TLS state on the handle, usually causing data loss. One case where it may be useful is when you want to skip over the data in the stream but you are not interested in interpreting it, so data loss is no concern. =cut *resettls = \&_freetls; sub DESTROY { my ($self) = @_; &_freetls; my $linger = exists $self->{linger} ? $self->{linger} : 3600; if ($linger && length $self->{wbuf} && $self->{fh}) { my $fh = delete $self->{fh}; my $wbuf = delete $self->{wbuf}; my @linger; push @linger, AE::io $fh, 1, sub { my $len = syswrite $fh, $wbuf, length $wbuf; if ($len > 0) { substr $wbuf, 0, $len, ""; } elsif (defined $len || ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK)) { @linger = (); # end } }; push @linger, AE::timer $linger, 0, sub { @linger = (); }; } } =item $handle->destroy Shuts down the handle object as much as possible - this call ensures that no further callbacks will be invoked and as many resources as possible will be freed. Any method you will call on the handle object after destroying it in this way will be silently ignored (and it will return the empty list). Normally, you can just "forget" any references to an AnyEvent::Handle object and it will simply shut down. This works in fatal error and EOF callbacks, as well as code outside. It does I work in a read or write callback, so when you want to destroy the AnyEvent::Handle object from within such an callback. You I call C<< ->destroy >> explicitly in that case. Destroying the handle object in this way has the advantage that callbacks will be removed as well, so if those are the only reference holders (as is common), then one doesn't need to do anything special to break any reference cycles. The handle might still linger in the background and write out remaining data, as specified by the C option, however. =cut sub destroy { my ($self) = @_; $self->DESTROY; %$self = (); bless $self, "AnyEvent::Handle::destroyed"; } sub AnyEvent::Handle::destroyed::AUTOLOAD { #nop } =item $handle->destroyed Returns false as long as the handle hasn't been destroyed by a call to C<< ->destroy >>, true otherwise. Can be useful to decide whether the handle is still valid after some callback possibly destroyed the handle. For example, C<< ->push_write >>, C<< ->starttls >> and other methods can call user callbacks, which in turn can destroy the handle, so work can be avoided by checking sometimes: $hdl->starttls ("accept"); return if $hdl->destroyed; $hdl->push_write (... Note that the call to C will silently be ignored if the handle has been destroyed, so often you can just ignore the possibility of the handle being destroyed. =cut sub destroyed { 0 } sub AnyEvent::Handle::destroyed::destroyed { 1 } =item AnyEvent::Handle::TLS_CTX This function creates and returns the AnyEvent::TLS object used by default for TLS mode. The context is created by calling L without any arguments. =cut our $TLS_CTX; sub TLS_CTX() { $TLS_CTX ||= do { require AnyEvent::TLS; new AnyEvent::TLS } } =back =head1 NONFREQUENTLY ASKED QUESTIONS =over 4 =item I C the AnyEvent::Handle reference inside my callback and still get further invocations! That's because AnyEvent::Handle keeps a reference to itself when handling read or write callbacks. It is only safe to "forget" the reference inside EOF or error callbacks, from within all other callbacks, you need to explicitly call the C<< ->destroy >> method. =item Why is my C callback never called? Probably because your C callback is being called instead: When you have outstanding requests in your read queue, then an EOF is considered an error as you clearly expected some data. To avoid this, make sure you have an empty read queue whenever your handle is supposed to be "idle" (i.e. connection closes are O.K.). You can set an C handler that simply pushes the first read requests in the queue. See also the next question, which explains this in a bit more detail. =item How can I serve requests in a loop? Most protocols consist of some setup phase (authentication for example) followed by a request handling phase, where the server waits for requests and handles them, in a loop. There are two important variants: The first (traditional, better) variant handles requests until the server gets some QUIT command, causing it to close the connection first (highly desirable for a busy TCP server). A client dropping the connection is an error, which means this variant can detect an unexpected detection close. To handle this case, always make sure you have a non-empty read queue, by pushing the "read request start" handler on it: # we assume a request starts with a single line my @start_request; @start_request = (line => sub { my ($hdl, $line) = @_; ... handle request # push next request read, possibly from a nested callback $hdl->push_read (@start_request); }); # auth done, now go into request handling loop # now push the first @start_request $hdl->push_read (@start_request); By always having an outstanding C, the handle always expects some data and raises the C error when the connction is dropped unexpectedly. The second variant is a protocol where the client can drop the connection at any time. For TCP, this means that the server machine may run out of sockets easier, and in general, it means you cannot distinguish a protocl failure/client crash from a normal connection close. Nevertheless, these kinds of protocols are common (and sometimes even the best solution to the problem). Having an outstanding read request at all times is possible if you ignore C errors, but this doesn't help with when the client drops the connection during a request, which would still be an error. A better solution is to push the initial request read in an C callback. This avoids an error, as when the server doesn't expect data (i.e. is idly waiting for the next request, an EOF will not raise an error, but simply result in an C callback. It is also a bit slower and simpler: # auth done, now go into request handling loop $hdl->on_read (sub { my ($hdl) = @_; # called each time we receive data but the read queue is empty # simply start read the request $hdl->push_read (line => sub { my ($hdl, $line) = @_; ... handle request # do nothing special when the request has been handled, just # let the request queue go empty. }); }); =item I get different callback invocations in TLS mode/Why can't I pause reading? Unlike, say, TCP, TLS connections do not consist of two independent communication channels, one for each direction. Or put differently, the read and write directions are not independent of each other: you cannot write data unless you are also prepared to read, and vice versa. This means that, in TLS mode, you might get C or C callback invocations when you are not expecting any read data - the reason is that AnyEvent::Handle always reads in TLS mode. During the connection, you have to make sure that you always have a non-empty read-queue, or an C watcher. At the end of the connection (or when you no longer want to use it) you can call the C method. =item How do I read data until the other side closes the connection? If you just want to read your data into a perl scalar, the easiest way to achieve this is by setting an C callback that does nothing, clearing the C callback and in the C callback, the data will be in C<$_[0]{rbuf}>: $handle->on_read (sub { }); $handle->on_eof (undef); $handle->on_error (sub { my $data = delete $_[0]{rbuf}; }); Note that this example removes the C member from the handle object, which is not normally allowed by the API. It is expressly permitted in this case only, as the handle object needs to be destroyed afterwards. The reason to use C is that TCP connections, due to latencies and packets loss, might get closed quite violently with an error, when in fact all data has been received. It is usually better to use acknowledgements when transferring data, to make sure the other side hasn't just died and you got the data intact. This is also one reason why so many internet protocols have an explicit QUIT command. =item I don't want to destroy the handle too early - how do I wait until all data has been written? After writing your last bits of data, set the C callback and destroy the handle in there - with the default setting of C this will be called precisely when all data has been written to the socket: $handle->push_write (...); $handle->on_drain (sub { AE::log debug => "All data submitted to the kernel."; undef $handle; }); If you just want to queue some data and then signal EOF to the other side, consider using C<< ->push_shutdown >> instead. =item I want to contact a TLS/SSL server, I don't care about security. If your TLS server is a pure TLS server (e.g. HTTPS) that only speaks TLS, connect to it and then create the AnyEvent::Handle with the C parameter: tcp_connect $host, $port, sub { my ($fh) = @_; my $handle = new AnyEvent::Handle fh => $fh, tls => "connect", on_error => sub { ... }; $handle->push_write (...); }; =item I want to contact a TLS/SSL server, I do care about security. Then you should additionally enable certificate verification, including peername verification, if the protocol you use supports it (see L, C). E.g. for HTTPS: tcp_connect $host, $port, sub { my ($fh) = @_; my $handle = new AnyEvent::Handle fh => $fh, peername => $host, tls => "connect", tls_ctx => { verify => 1, verify_peername => "https" }, ... Note that you must specify the hostname you connected to (or whatever "peername" the protocol needs) as the C argument, otherwise no peername verification will be done. The above will use the system-dependent default set of trusted CA certificates. If you want to check against a specific CA, add the C (or C) arguments to C: tls_ctx => { verify => 1, verify_peername => "https", ca_file => "my-ca-cert.pem", }, =item I want to create a TLS/SSL server, how do I do that? Well, you first need to get a server certificate and key. You have three options: a) ask a CA (buy one, use cacert.org etc.) b) create a self-signed certificate (cheap. check the search engine of your choice, there are many tutorials on the net) or c) make your own CA (tinyca2 is a nice program for that purpose). Then create a file with your private key (in PEM format, see L), followed by the certificate (also in PEM format). The file should then look like this: -----BEGIN RSA PRIVATE KEY----- ...header data ... lots of base64'y-stuff -----END RSA PRIVATE KEY----- -----BEGIN CERTIFICATE----- ... lots of base64'y-stuff -----END CERTIFICATE----- The important bits are the "PRIVATE KEY" and "CERTIFICATE" parts. Then specify this file as C: tcp_server undef, $port, sub { my ($fh) = @_; my $handle = new AnyEvent::Handle fh => $fh, tls => "accept", tls_ctx => { cert_file => "my-server-keycert.pem" }, ... When you have intermediate CA certificates that your clients might not know about, just append them to the C. =back =head1 SUBCLASSING AnyEvent::Handle In many cases, you might want to subclass AnyEvent::Handle. To make this easier, a given version of AnyEvent::Handle uses these conventions: =over 4 =item * all constructor arguments become object members. At least initially, when you pass a C-argument to the constructor it will end up in C<< $handle->{tls} >>. Those members might be changed or mutated later on (for example C will hold the TLS connection object). =item * other object member names are prefixed with an C<_>. All object members not explicitly documented (internal use) are prefixed with an underscore character, so the remaining non-C<_>-namespace is free for use for subclasses. =item * all members not documented here and not prefixed with an underscore are free to use in subclasses. Of course, new versions of AnyEvent::Handle may introduce more "public" member variables, but that's just life. At least it is documented. =back =head1 AUTHOR Robin Redeker C<< >>, Marc Lehmann . =cut 1 AnyEvent-7.17/lib/AnyEvent/Debug.pm0000644000000000000000000005100212537713222015564 0ustar rootroot=head1 NAME AnyEvent::Debug - debugging utilities for AnyEvent =head1 SYNOPSIS use AnyEvent::Debug; # create an interactive shell into the program my $shell = AnyEvent::Debug::shell "unix/", "/home/schmorp/myshell"; # then on the shell: "socat readline /home/schmorp/myshell" =head1 DESCRIPTION This module provides functionality hopefully useful for debugging. At the moment, "only" an interactive shell is implemented. This shell allows you to interactively "telnet into" your program and execute Perl code, e.g. to look at global variables. =head1 FUNCTIONS =over 4 =cut package AnyEvent::Debug; use B (); use Carp (); use Errno (); use AnyEvent (); BEGIN { AnyEvent::common_sense } use AnyEvent::Util (); use AnyEvent::Socket (); use AnyEvent::Log (); our $TRACE = 1; # trace status our ($TRACE_LOGGER, $TRACE_ENABLED); # cache often-used strings, purely to save memory, at the expense of speed our %STRCACHE; =item $shell = AnyEvent::Debug::shell $host, $service This function binds on the given host and service port and returns a shell object, which determines the lifetime of the shell. Any number of connections are accepted on the port, and they will give you a very primitive shell that simply executes every line you enter. All commands will be executed "blockingly" with the socket C or C calls - higher performance APIs such as BSD's kqueue or the dreaded Linux epoll are usually badly thought-out hacks that are incompatible with fork in one way or another. Only L is fully fork-aware and ensures that you continue event-processing in both parent and child (or both, if you know what you are doing). This means that, in general, you cannot fork and do event processing in the child if the event library was initialised before the fork (which usually happens when the first AnyEvent watcher is created, or the library is loaded). If you have to fork, you must either do so I creating your first watcher OR you must not use AnyEvent at all in the child OR you must do something completely out of the scope of AnyEvent (see below). The problem of doing event processing in the parent I the child is much more complicated: even for backends that I fork-aware or fork-safe, their behaviour is not usually what you want: fork clones all watchers, that means all timers, I/O watchers etc. are active in both parent and child, which is almost never what you want. Using C to start worker children from some kind of manage prrocess is usually preferred, because it is much easier and cleaner, at the expense of having to have another binary. In addition to logical problems with fork, there are also implementation problems. For example, on POSIX systems, you cannot fork at all in Perl code if a thread (I am talking of pthreads here) was ever created in the process, and this is just the tip of the iceberg. In general, using fork from Perl is difficult, and attempting to use fork without an exec to implement some kind of parallel processing is almost certainly doomed. To safely fork and exec, you should use a module such as L that let's you safely fork and exec new processes. If you want to do multiprocessing using processes, you can look at the L module (and some related modules such as L, L and L). This module allows you to safely create subprocesses without any limitations - you can use X11 toolkits or AnyEvent in the children created by L safely and without any special precautions. =head1 SECURITY CONSIDERATIONS AnyEvent can be forced to load any event model via $ENV{PERL_ANYEVENT_MODEL}. While this cannot (to my knowledge) be used to execute arbitrary code or directly gain access, it can easily be used to make the program hang or malfunction in subtle ways, as AnyEvent watchers will not be active when the program uses a different event model than specified in the variable. You can make AnyEvent completely ignore this variable by deleting it before the first watcher gets created, e.g. with a C block: BEGIN { delete $ENV{PERL_ANYEVENT_MODEL} } use AnyEvent; Similar considerations apply to $ENV{PERL_ANYEVENT_VERBOSE}, as that can be used to probe what backend is used and gain other information (which is probably even less useful to an attacker than PERL_ANYEVENT_MODEL), and $ENV{PERL_ANYEVENT_STRICT}. Note that AnyEvent will remove I environment variables starting with C from C<%ENV> when it is loaded while taint mode is enabled. =head1 BUGS Perl 5.8 has numerous memleaks that sometimes hit this module and are hard to work around. If you suffer from memleaks, first upgrade to Perl 5.10 and check wether the leaks still show up. (Perl 5.10.0 has other annoying memleaks, such as leaking on C and C but it is usually not as pronounced). =head1 SEE ALSO Tutorial/Introduction: L. FAQ: L. Utility functions: L (misc. grab-bag), L (simply logging). Development/Debugging: L (stricter checking), L (interactive shell, watcher tracing). Supported event modules: L, L, L, L, L, L, L, L, L, L, L, L, L, L. Implementations: L, L, L, L, L, L, L, L, L, L, L, L, L. Non-blocking handles, pipes, stream sockets, TCP clients and servers: L, L, L. Asynchronous File I/O: L. Asynchronous DNS: L. Thread support: L, L, L, L. Nontrivial usage examples: L, L, L. =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/lib/AE.pm0000644000000000000000000001242411740210771013273 0ustar rootroot=head1 NAME AE - simpler/faster/newer/cooler AnyEvent API =head1 SYNOPSIS use AnyEvent; # not AE # file handle or descriptor readable my $w = AE::io $fh, 0, sub { ... }; # one-shot or repeating timers my $w = AE::timer $seconds, 0, sub { ... }; # once my $w = AE::timer $seconds, $interval, sub { ... }; # repeated print AE::now; # prints current event loop time print AE::time; # think Time::HiRes::time or simply CORE::time. # POSIX signal my $w = AE::signal TERM => sub { ... }; # child process exit my $w = AE::child $pid, sub { my ($pid, $status) = @_; ... }; # called when event loop idle (if applicable) my $w = AE::idle sub { ... }; my $cv = AE::cv; # stores whether a condition was flagged $cv->send; # wake up current and all future recv's $cv->recv; # enters "main loop" till $condvar gets ->send # use a condvar in callback mode: $cv->cb (sub { $_[0]->recv }); =head1 DESCRIPTION This module documents the new simpler AnyEvent API. The rationale for the new API is that experience with L shows that this API actually "works", despite its lack of extensibility, leading to a shorter, easier and faster API. The main differences from AnyEvent is that function calls are used instead of method calls, and that no named arguments are used. This makes calls to watcher creation functions really short, which can make a program more readable despite the lack of named parameters. Function calls also allow more static type checking than method calls, so many mistakes are caught at compile-time with this API. Also, some backends (Perl and EV) are so fast that the method call overhead is very noticeable (with EV it increases the execution time five- to six-fold, with Perl the method call overhead is about a factor of two). Note that the C API is an alternative to, not the future version of, the AnyEvent API. Both APIs can be used interchangeably and there are no plans to "switch", so if in doubt, feel free to use the L API in new code. As the AE API is complementary, not everything in the AnyEvent API is available, and you still need to use AnyEvent for the finer stuff. Also, you should not C directly, C will provide the AE namespace. At the moment, these functions will become slower then their method-call counterparts when using L or L::wrap. =head2 FUNCTIONS This section briefly describes the alternative watcher constructors and other functions available inside the C namespace. Semantics are not described here; please refer to the description of the function or method with the same name in the L manpage for the details. =over 4 =cut package AE; use AnyEvent (); # BEGIN { AnyEvent::common_sense } our $VERSION = $AnyEvent::VERSION; =item $w = AE::io $fh_or_fd, $watch_write, $cb Creates an I/O watcher that listens for read events (C<$watch_write> false) or write events (C<$watch_write> is true) on the file handle or file descriptor C<$fh_or_fd>. The callback C<$cb> is invoked as soon and as long as I/O of the type specified by C<$watch_write>) can be done on the file handle/descriptor. Example: wait until STDIN becomes readable. $stdin_ready = AE::io *STDIN, 0, sub { scalar }; Example: wait until STDOUT becomes writable and print something. $stdout_ready = AE::io *STDOUT, 1, sub { print STDOUT "woaw\n" }; =item $w = AE::timer $after, $interval, $cb Creates a timer watcher that invokes the callback C<$cb> after at least C<$after> second have passed (C<$after> can be negative or C<0>). If C<$interval> is C<0>, then the callback will only be invoked once, otherwise it must be a positive number of seconds that specifies the interval between successive invocations of the callback. Example: print "too late" after at least one second has passed. $timer_once = AE::timer 1, 0, sub { print "too late\n" }; Example: print "blubb" once a second, starting as soon as possible. $timer_repeated = AE::timer 0, 1, sub { print "blubb\n" }; =item $w = AE::signal $signame, $cb Invoke the callback C<$cb> each time one or more occurrences of the named signal C<$signame> are detected. =item $w = AE::child $pid, $cb Invokes the callback C<$cb> when the child with the given C<$pid> exits (or all children, when C<$pid> is zero). The callback will get the actual pid and exit status as arguments. =item $w = AE::idle $cb Invoke the callback C<$cb> each time the event loop is "idle" (has no events outstanding), but do not prevent the event loop from polling for more events. =item $cv = AE::cv =item $cv = AE::cv { BLOCK } Create a new condition variable. The first form is identical to C<< AnyEvent->condvar >>, the second form additionally sets the callback (as if the C method is called on the condition variable). =item AE::now Returns the current event loop time (may be cached by the event loop). =item AE::now_update Ensures that the current event loop time is up to date. =item AE::time Return the current time (not cached, always consults a hardware clock). =item AE::postpone { BLOCK } Exactly the same as C. =item AE::log $level, $msg[, @args] Exactly the same as C (or C). =back =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.17/mktest0000755000000000000000000000232413024015355013133 0ustar rootroot#!/bin/sh # this creates duplicate tests for each event loop, and then deletes those # that fail due to bugs in them. # also patches MANIFEST. ( cat <t/"$base"_$t done done if false; then ( grep -v ^t/6._ MANIFEST for t in t/6?_*; do echo $t done ) >MANIFEST~ && mv MANIFEST~ MANIFEST fi AnyEvent-7.17/constants.pl.PL0000755000000000000000000001215113050343764014572 0ustar rootroot#! perl # this file is unfortunately only executed at Makefile.PL time my ($fh, $oldstdout); BEGIN { open $fh, ">lib/AnyEvent/constants.pl" or die "lib/AnyEvent/constants.pl: $!\n"; $oldstdout = select $fh; print "# automatically generated from constants.pl.PL\n"; } { # from common::sense 3.74 use strict qw(vars subs); no warnings; use warnings qw(FATAL closed threads internal debugging pack malloc portable prototype inplace io pipe unpack glob digit printf layer reserved taint closure semicolon); no warnings qw(exec newline unopened); BEGIN { print "sub AnyEvent::common_sense {\n"; printf " local \$^W;\n"; printf " \${^WARNING_BITS} ^= \${^WARNING_BITS} ^ \"%s\";\n", join "", map "\\x$_", unpack "(H2)*", ${^WARNING_BITS}; # use strict, use utf8; printf " \$^H |= 0x%x;\n", $^H; print "}\n"; } } use Config; print "# generated for perl $] built for $Config{archname}\n"; # when built as part of perl, these are not available BEGIN { eval "use Socket ()" } BEGIN { eval "use Fcntl ()" } BEGIN { eval "use POSIX ()" } sub i($$) { print "sub $_[0](){", $_[1]*1, "}\n"; } sub n($$) { print "sub $_[0](){", (defined $_[1] ? $_[1]*1 : "undef"), "}\n"; } print "package AnyEvent;\n"; our $WIN32 = $^O =~ /mswin32/i; # used a lot i CYGWIN => $^O =~ /cygwin/i; i WIN32 => $WIN32; # add these purely to avoid loading Fcntl, which is slow and bloated. i F_SETFD => eval { Fcntl::F_SETFD() } || 2; i F_SETFL => eval { Fcntl::F_SETFL() } || 4; i O_NONBLOCK => eval { Fcntl::O_NONBLOCK() } || 04000; i FD_CLOEXEC => eval { Fcntl::FD_CLOEXEC() } || 1; print "package AnyEvent::Base;\n"; # add these purely to avoid loading POSIX, which is slow and bloated. i WNOHANG => eval { POSIX::WNOHANG() } || 1; print "package AnyEvent::IO;\n"; i O_RDONLY => eval { Fcntl::O_RDONLY() } || 0; i O_WRONLY => eval { Fcntl::O_WRONLY() } || 1; i O_RDWR => eval { Fcntl::O_RDWR () } || 2; i O_CREAT => eval { Fcntl::O_CREAT () } || 64; i O_EXCL => eval { Fcntl::O_EXCL () } || 128; i O_TRUNC => eval { Fcntl::O_TRUNC () } || 512; i O_APPEND => eval { Fcntl::O_APPEND() } || 1024; print "package AnyEvent::Util;\n"; # broken windows perls use undocumented error codes... if ($WIN32) { i WSAEINVAL => 10022; i WSAEWOULDBLOCK => 10035; i WSAEINPROGRESS => 10036; } else { # these should never match any errno value i WSAEINVAL => -1e99; i WSAEWOULDBLOCK => -1e99; i WSAEINPROGRESS => -1e99; } my $af_inet6; $af_inet6 ||= eval { Socket::AF_INET6 () }; # where it should be $af_inet6 ||= eval { require Socket6; Socket6::AF_INET6() }; # where it actually is ... # ... or isn't, because nobody has it installed $af_inet6 ||= 10 if $^O =~ /linux/; $af_inet6 ||= 23 if $^O =~ /cygwin/i; $af_inet6 ||= 23 if AnyEvent::WIN32; $af_inet6 ||= 24 if $^O =~ /openbsd|netbsd/; $af_inet6 ||= 28 if $^O =~ /freebsd/; #TODO: EDOM/ESPIPE #TODO: maybe move socket stuff to Socket::? i _AF_INET6 => $af_inet6; #i AF_UNIX => Socket::AF_UNIX (); #i SOCK_STREAM => Socket::SOCK_STREAM (); #i SOCK_DGRAM => Socket::SOCK_DGRAM (); #i SOL_SOCKET => Socket::SOL_SOCKET (); #i SO_REUSEADDR => Socket::SO_REUSEADDR (); #i SO_KEEPALIVE => Socket::SO_KEEPALIVE (); #i SO_OOBINLINE => Socket::SO_OOBINLINE (); #i IPPROTO_TCP => Socket::IPPROTO_TCP (); print "package AnyEvent::Socket;\n"; # more hardcoded os-specific constants - none # of these are available via any known module, but we # are forward-looking and try Socket:: anyways. my %const; while () { my ($os, $name, $default) = split /\s+/; $const{$name} ||= undef; # make sure it exists next unless $os eq $^O; my $value = eval "Socket::$name ()"; $value = eval $default unless defined $value; $const{$name} = $value; } for my $k (sort keys %const) { n $k, $const{$k}; } print "1;\n"; close $fh; select $oldstdout; 1 __DATA__ linux TCP_MAXSEG 2 linux TCP_CORK 3 linux TCP_KEEPIDLE 4 linux TCP_KEEPINTVL 5 linux TCP_KEEPCNT 6 linux TCP_SYNCNT 7 linux TCP_LINGER2 8 linux TCP_DEFER_ACCEPT 9 linux TCP_WINDOW_CLAMP 10 linux TCP_INFO 11 linux TCP_QUICKACK 12 linux TCP_CONGESTION 13 linux TCP_MD5SIG 14 linux TCP_FASTOPEN 23 linux MSG_DONTWAIT 0x0040 linux MSG_NOSIGNAL 0x4000 linux MSG_MORE 0x8000 linux MSG_FASTOPEN 0x20000000 netbsd TCP_MAXSEG 2 netbsd TCP_KEEPIDLE 3 netbsd TCP_NOPUSH 4 netbsd TCP_KEEPINTVL 5 netbsd TCP_KEEPCNT 6 netbsd TCP_KEEPINIT 7 netbsd TCP_NOOPT 8 netbsd TCP_MD5SIG 0x10 netbsd TCP_CONGESTION 0x20 netbsd MSG_NOSIGNAL 0x0400 cygwin TCP_MAXSEG 0x02 cygwin TCP_NOPUSH 0x04 cygwin TCP_NOOPT 0x08 freebsd TCP_MAXSEG 0x02 freebsd TCP_NOPUSH 0x04 freebsd TCP_NOOPT 0x08 freebsd TCP_MD5SIG 0x10 freebsd TCP_INFO 0x20 freebsd TCP_CONGESTION 0x40 freebsd MSG_NOSIGNAL 0x20000 solaris TCP_CORK 0x18 solaris TCP_LINGER2 0x1C solaris TCP_INIT_CWND 0x15 solaris TCP_KEEPALIVE 0x8 solaris TCP_MAXSEG 0x02 openbsd TCP_MAXSEG 0x02 openbsd TCP_MD5SIG 0x04 openbsd TCP_SACK_ENABLE 0x08 darwin TCP_MAXSEG 0x02 darwin TCP_NOPUSH 0x04 darwin TCP_NOOPT 0x08 darwin TCP_KEEPALIVE 0x10 darwin TCP_CONNECTIONTIMEOUT 0x20 AnyEvent-7.17/util/0000755000000000000000000000000013540302027012650 5ustar rootrootAnyEvent-7.17/util/tst_uts46data0000755000000000000000000000236412730442755015331 0ustar rootroot#!/opt/bin/perl # tests installed AnyEvent against IdnaTest.pl use common::sense; use utf8; no warnings 'utf8'; use Encode; use AnyEvent::Util; open my $fh, "GET http://www.unicode.org/Public/idna/9.0.0/IdnaTest.txt |" or die; while (<$fh>) { next unless /^[NB]/; # no "T", we implement non-transitional only chomp; utf8::decode $_ or die "utf8 decode error: $_\n"; s/\s*#.*//; s/\\u(d[8-b][0-9a-f]{2})\\u(d[c-f][0-9a-f]{2})/Encode::decode "utf-16be", pack "nn", hex $1, hex $2/ige; s/\\u([0-9a-fA-F]{4})/chr hex $1/ge; my ($type, $source, $tou, $toa, $nv8) = split /[ \t]*;[ \t]*/; $toa = lc $toa; $tou = $source unless length $tou; $toa = $tou unless length $toa; my $xtou = AnyEvent::Util::idn_to_unicode $source; my $xtoa = lc AnyEvent::Util::idn_to_ascii $source; $xtoa = "[error]" unless defined $xtoa; $xtou = "[error]" unless defined $xtou; if ($tou ne $xtou) { warn "$. TOU ERROR $type ($source expect $tou got $xtou) ($@)\n" unless $tou =~ /^\[/; } if ($toa ne $xtoa) { # use Data::Dump; ddx [$source, $toa, $xtoa] unless $toa =~ /^\[/; warn "$. TOA ERROR $type ($source expect <$toa|$tou> got $xtoa) ($@)\n" unless $toa =~ /^\[/; } } AnyEvent-7.17/util/gen_uts46data0000755000000000000000000000357512707236524015274 0ustar rootroot#!/opt/bin/perl # creates lib/AnyEvent/Util/uts46.pl - better do not run it! use common::sense; use utf8; no warnings 'utf8'; binmode STDOUT, ":utf8"; open my $fh, "GET http://www.unicode.org/Public/idna/9.0.0/IdnaMappingTable.txt |" or die; my $valid; my $imap; # index map \x00 char replacement while (<$fh>) { next unless /^[0-9A-F]/; /^ ([0-9A-F]{4,}) (?: \.\.([0-9A-F]{4,}) )? \s*;\s*(\S+) (?: \s*;\s*([0-9A-F ]+?) )? (?: \s*;[^;]+ )? \s* (?: \#.* )? $ /x or die "$_: unparsable"; my ($r1, $r2, $type, $map) = (hex $1, hex $2, $3, $4); my $R1 = chr $r1; my $R2 = chr $r2; $map = join "", map chr hex, split ' ', $map; $type = "valid" if $type eq "deviation"; # use non-transitional behaviour for deviation characters given ($type) { when (/^(?:disallowed|disallowed_STD3_valid|disallowed_STD3_mapped)$/) { # nop } when (/^(?:mapped|deviation|ignored)$/) { $map = "\x01$map" if $type eq "deviation"; $imap .= "\x00" . chr . $map for $r1 .. $r2 || $r1; } when (/^(?:valid)$/) { (vec $valid, $_, 1) = 1 for $r1 .. $r2 || $r1; } default { die "default: $R1,$R2,$type,$map;\n"; } } } open my $fh, ">lib/AnyEvent/Util/uts46data.pl" or die; binmode $fh, ":perlio"; print $fh "# autogenerated by util/gen_uts46data\n"; utf8::encode $imap; 0 > index $imap, "\x02" # it's not supposed to be anywhere in there or die "imap contains \\x02"; print $fh "\$uts46_imap = q\x02$imap\x00\x02;\n"; # try to find a valid quoting character - there usually are many legal combos for (1..127) { # stay out of utf-8 range if (0 >= index $valid, chr) { print $fh "\$uts46_valid = q", chr, $valid, chr, ";\n"; goto valid_ok; } } die "unable to found valid quoting character"; valid_ok:; print $fh "1;\n"; close $fh; AnyEvent-7.17/COPYING0000644000000000000000000000007610361724036012737 0ustar rootrootThis module is licensed under the same terms as perl itself. AnyEvent-7.17/README0000644000000000000000000030111713540302027012556 0ustar rootrootNAME AnyEvent - the DBI of event loop programming EV, Event, Glib, Tk, UV, Perl, Event::Lib, Irssi, rxvt-unicode, IO::Async, Qt, FLTK and POE are various supported event loops/environments. SYNOPSIS use AnyEvent; # if you prefer function calls, look at the AE manpage for # an alternative API. # file handle or descriptor readable my $w = AnyEvent->io (fh => $fh, poll => "r", cb => sub { ... }); # one-shot or repeating timers my $w = AnyEvent->timer (after => $seconds, cb => sub { ... }); my $w = AnyEvent->timer (after => $seconds, interval => $seconds, cb => ...); print AnyEvent->now; # prints current event loop time print AnyEvent->time; # think Time::HiRes::time or simply CORE::time. # POSIX signal my $w = AnyEvent->signal (signal => "TERM", cb => sub { ... }); # child process exit my $w = AnyEvent->child (pid => $pid, cb => sub { my ($pid, $status) = @_; ... }); # called when event loop idle (if applicable) my $w = AnyEvent->idle (cb => sub { ... }); my $w = AnyEvent->condvar; # stores whether a condition was flagged $w->send; # wake up current and all future recv's $w->recv; # enters "main loop" till $condvar gets ->send # use a condvar in callback mode: $w->cb (sub { $_[0]->recv }); INTRODUCTION/TUTORIAL This manpage is mainly a reference manual. If you are interested in a tutorial or some gentle introduction, have a look at the AnyEvent::Intro manpage. SUPPORT An FAQ document is available as AnyEvent::FAQ. There also is a mailinglist for discussing all things AnyEvent, and an IRC channel, too. See the AnyEvent project page at the Schmorpforge Ta-Sa Software Repository, at , for more info. WHY YOU SHOULD USE THIS MODULE (OR NOT) Glib, POE, IO::Async, Event... CPAN offers event models by the dozen nowadays. So what is different about AnyEvent? Executive Summary: AnyEvent is *compatible*, AnyEvent is *free of policy* and AnyEvent is *small and efficient*. First and foremost, *AnyEvent is not an event model* itself, it only interfaces to whatever event model the main program happens to use, in a pragmatic way. For event models and certain classes of immortals alike, the statement "there can only be one" is a bitter reality: In general, only one event loop can be active at the same time in a process. AnyEvent cannot change this, but it can hide the differences between those event loops. The goal of AnyEvent is to offer module authors the ability to do event programming (waiting for I/O or timer events) without subscribing to a religion, a way of living, and most importantly: without forcing your module users into the same thing by forcing them to use the same event model you use. For modules like POE or IO::Async (which is a total misnomer as it is actually doing all I/O *synchronously*...), using them in your module is like joining a cult: After you join, you are dependent on them and you cannot use anything else, as they are simply incompatible to everything that isn't them. What's worse, all the potential users of your module are *also* forced to use the same event loop you use. AnyEvent is different: AnyEvent + POE works fine. AnyEvent + Glib works fine. AnyEvent + Tk works fine etc. etc. but none of these work together with the rest: POE + EV? No go. Tk + Event? No go. Again: if your module uses one of those, every user of your module has to use it, too. But if your module uses AnyEvent, it works transparently with all event models it supports (including stuff like IO::Async, as long as those use one of the supported event loops. It is easy to add new event loops to AnyEvent, too, so it is future-proof). In addition to being free of having to use *the one and only true event model*, AnyEvent also is free of bloat and policy: with POE or similar modules, you get an enormous amount of code and strict rules you have to follow. AnyEvent, on the other hand, is lean and to the point, by only offering the functionality that is necessary, in as thin as a wrapper as technically possible. Of course, AnyEvent comes with a big (and fully optional!) toolbox of useful functionality, such as an asynchronous DNS resolver, 100% non-blocking connects (even with TLS/SSL, IPv6 and on broken platforms such as Windows) and lots of real-world knowledge and workarounds for platform bugs and differences. Now, if you *do want* lots of policy (this can arguably be somewhat useful) and you want to force your users to use the one and only event model, you should *not* use this module. DESCRIPTION AnyEvent provides a uniform interface to various event loops. This allows module authors to use event loop functionality without forcing module users to use a specific event loop implementation (since more than one event loop cannot coexist peacefully). The interface itself is vaguely similar, but not identical to the Event module. During the first call of any watcher-creation method, the module tries to detect the currently loaded event loop by probing whether one of the following modules is already loaded: EV, AnyEvent::Loop, Event, Glib, Tk, Event::Lib, Qt, POE. The first one found is used. If none are detected, the module tries to load the first four modules in the order given; but note that if EV is not available, the pure-perl AnyEvent::Loop should always work, so the other two are not normally tried. Because AnyEvent first checks for modules that are already loaded, loading an event model explicitly before first using AnyEvent will likely make that model the default. For example: use Tk; use AnyEvent; # .. AnyEvent will likely default to Tk The *likely* means that, if any module loads another event model and starts using it, all bets are off - this case should be very rare though, as very few modules hardcode event loops without announcing this very loudly. The pure-perl implementation of AnyEvent is called "AnyEvent::Loop". Like other event modules you can load it explicitly and enjoy the high availability of that event loop :) WATCHERS AnyEvent has the central concept of a *watcher*, which is an object that stores relevant data for each kind of event you are waiting for, such as the callback to call, the file handle to watch, etc. These watchers are normal Perl objects with normal Perl lifetime. After creating a watcher it will immediately "watch" for events and invoke the callback when the event occurs (of course, only when the event model is in control). Note that callbacks must not permanently change global variables potentially in use by the event loop (such as $_ or $[) and that callbacks must not "die". The former is good programming practice in Perl and the latter stems from the fact that exception handling differs widely between event loops. To disable a watcher you have to destroy it (e.g. by setting the variable you store it in to "undef" or otherwise deleting all references to it). All watchers are created by calling a method on the "AnyEvent" class. Many watchers either are used with "recursion" (repeating timers for example), or need to refer to their watcher object in other ways. One way to achieve that is this pattern: my $w; $w = AnyEvent->type (arg => value ..., cb => sub { # you can use $w here, for example to undef it undef $w; }); Note that "my $w; $w =" combination. This is necessary because in Perl, my variables are only visible after the statement in which they are declared. I/O WATCHERS $w = AnyEvent->io ( fh => , poll => <"r" or "w">, cb => , ); You can create an I/O watcher by calling the "AnyEvent->io" method with the following mandatory key-value pairs as arguments: "fh" is the Perl *file handle* (or a naked file descriptor) to watch for events (AnyEvent might or might not keep a reference to this file handle). Note that only file handles pointing to things for which non-blocking operation makes sense are allowed. This includes sockets, most character devices, pipes, fifos and so on, but not for example files or block devices. "poll" must be a string that is either "r" or "w", which creates a watcher waiting for "r"eadable or "w"ritable events, respectively. "cb" is the callback to invoke each time the file handle becomes ready. Although the callback might get passed parameters, their value and presence is undefined and you cannot rely on them. Portable AnyEvent callbacks cannot use arguments passed to I/O watcher callbacks. The I/O watcher might use the underlying file descriptor or a copy of it. You must not close a file handle as long as any watcher is active on the underlying file descriptor. Some event loops issue spurious readiness notifications, so you should always use non-blocking calls when reading/writing from/to your file handles. Example: wait for readability of STDIN, then read a line and disable the watcher. my $w; $w = AnyEvent->io (fh => \*STDIN, poll => 'r', cb => sub { chomp (my $input = ); warn "read: $input\n"; undef $w; }); TIME WATCHERS $w = AnyEvent->timer (after => , cb => ); $w = AnyEvent->timer ( after => , interval => , cb => , ); You can create a time watcher by calling the "AnyEvent->timer" method with the following mandatory arguments: "after" specifies after how many seconds (fractional values are supported) the callback should be invoked. "cb" is the callback to invoke in that case. Although the callback might get passed parameters, their value and presence is undefined and you cannot rely on them. Portable AnyEvent callbacks cannot use arguments passed to time watcher callbacks. The callback will normally be invoked only once. If you specify another parameter, "interval", as a strictly positive number (> 0), then the callback will be invoked regularly at that interval (in fractional seconds) after the first invocation. If "interval" is specified with a false value, then it is treated as if it were not specified at all. The callback will be rescheduled before invoking the callback, but no attempt is made to avoid timer drift in most backends, so the interval is only approximate. Example: fire an event after 7.7 seconds. my $w = AnyEvent->timer (after => 7.7, cb => sub { warn "timeout\n"; }); # to cancel the timer: undef $w; Example 2: fire an event after 0.5 seconds, then roughly every second. my $w = AnyEvent->timer (after => 0.5, interval => 1, cb => sub { warn "timeout\n"; }); TIMING ISSUES There are two ways to handle timers: based on real time (relative, "fire in 10 seconds") and based on wallclock time (absolute, "fire at 12 o'clock"). While most event loops expect timers to specified in a relative way, they use absolute time internally. This makes a difference when your clock "jumps", for example, when ntp decides to set your clock backwards from the wrong date of 2014-01-01 to 2008-01-01, a watcher that is supposed to fire "after a second" might actually take six years to finally fire. AnyEvent cannot compensate for this. The only event loop that is conscious of these issues is EV, which offers both relative (ev_timer, based on true relative time) and absolute (ev_periodic, based on wallclock time) timers. AnyEvent always prefers relative timers, if available, matching the AnyEvent API. AnyEvent has two additional methods that return the "current time": AnyEvent->time This returns the "current wallclock time" as a fractional number of seconds since the Epoch (the same thing as "time" or "Time::HiRes::time" return, and the result is guaranteed to be compatible with those). It progresses independently of any event loop processing, i.e. each call will check the system clock, which usually gets updated frequently. AnyEvent->now This also returns the "current wallclock time", but unlike "time", above, this value might change only once per event loop iteration, depending on the event loop (most return the same time as "time", above). This is the time that AnyEvent's timers get scheduled against. *In almost all cases (in all cases if you don't care), this is the function to call when you want to know the current time.* This function is also often faster then "AnyEvent->time", and thus the preferred method if you want some timestamp (for example, AnyEvent::Handle uses this to update its activity timeouts). The rest of this section is only of relevance if you try to be very exact with your timing; you can skip it without a bad conscience. For a practical example of when these times differ, consider Event::Lib and EV and the following set-up: The event loop is running and has just invoked one of your callbacks at time=500 (assume no other callbacks delay processing). In your callback, you wait a second by executing "sleep 1" (blocking the process for a second) and then (at time=501) you create a relative timer that fires after three seconds. With Event::Lib, "AnyEvent->time" and "AnyEvent->now" will both return 501, because that is the current time, and the timer will be scheduled to fire at time=504 (501 + 3). With EV, "AnyEvent->time" returns 501 (as that is the current time), but "AnyEvent->now" returns 500, as that is the time the last event processing phase started. With EV, your timer gets scheduled to run at time=503 (500 + 3). In one sense, Event::Lib is more exact, as it uses the current time regardless of any delays introduced by event processing. However, most callbacks do not expect large delays in processing, so this causes a higher drift (and a lot more system calls to get the current time). In another sense, EV is more exact, as your timer will be scheduled at the same time, regardless of how long event processing actually took. In either case, if you care (and in most cases, you don't), then you can get whatever behaviour you want with any event loop, by taking the difference between "AnyEvent->time" and "AnyEvent->now" into account. AnyEvent->now_update Some event loops (such as EV or AnyEvent::Loop) cache the current time for each loop iteration (see the discussion of AnyEvent->now, above). When a callback runs for a long time (or when the process sleeps), then this "current" time will differ substantially from the real time, which might affect timers and time-outs. When this is the case, you can call this method, which will update the event loop's idea of "current time". A typical example would be a script in a web server (e.g. "mod_perl") - when mod_perl executes the script, then the event loop will have the wrong idea about the "current time" (being potentially far in the past, when the script ran the last time). In that case you should arrange a call to "AnyEvent->now_update" each time the web server process wakes up again (e.g. at the start of your script, or in a handler). Note that updating the time *might* cause some events to be handled. SIGNAL WATCHERS $w = AnyEvent->signal (signal => , cb => ); You can watch for signals using a signal watcher, "signal" is the signal *name* in uppercase and without any "SIG" prefix, "cb" is the Perl callback to be invoked whenever a signal occurs. Although the callback might get passed parameters, their value and presence is undefined and you cannot rely on them. Portable AnyEvent callbacks cannot use arguments passed to signal watcher callbacks. Multiple signal occurrences can be clumped together into one callback invocation, and callback invocation will be synchronous. Synchronous means that it might take a while until the signal gets handled by the process, but it is guaranteed not to interrupt any other callbacks. The main advantage of using these watchers is that you can share a signal between multiple watchers, and AnyEvent will ensure that signals will not interrupt your program at bad times. This watcher might use %SIG (depending on the event loop used), so programs overwriting those signals directly will likely not work correctly. Example: exit on SIGINT my $w = AnyEvent->signal (signal => "INT", cb => sub { exit 1 }); Restart Behaviour While restart behaviour is up to the event loop implementation, most will not restart syscalls (that includes Async::Interrupt and AnyEvent's pure perl implementation). Safe/Unsafe Signals Perl signals can be either "safe" (synchronous to opcode handling) or "unsafe" (asynchronous) - the former might delay signal delivery indefinitely, the latter might corrupt your memory. AnyEvent signal handlers are, in addition, synchronous to the event loop, i.e. they will not interrupt your running perl program but will only be called as part of the normal event handling (just like timer, I/O etc. callbacks, too). Signal Races, Delays and Workarounds Many event loops (e.g. Glib, Tk, Qt, IO::Async) do not support attaching callbacks to signals in a generic way, which is a pity, as you cannot do race-free signal handling in perl, requiring C libraries for this. AnyEvent will try to do its best, which means in some cases, signals will be delayed. The maximum time a signal might be delayed is 10 seconds by default, but can be overriden via $ENV{PERL_ANYEVENT_MAX_SIGNAL_LATENCY} or $AnyEvent::MAX_SIGNAL_LATENCY - see the "ENVIRONMENT VARIABLES" section for details. All these problems can be avoided by installing the optional Async::Interrupt module, which works with most event loops. It will not work with inherently broken event loops such as Event or Event::Lib (and not with POE currently). For those, you just have to suffer the delays. CHILD PROCESS WATCHERS $w = AnyEvent->child (pid => , cb => ); You can also watch for a child process exit and catch its exit status. The child process is specified by the "pid" argument (on some backends, using 0 watches for any child process exit, on others this will croak). The watcher will be triggered only when the child process has finished and an exit status is available, not on any trace events (stopped/continued). The callback will be called with the pid and exit status (as returned by waitpid), so unlike other watcher types, you *can* rely on child watcher callback arguments. This watcher type works by installing a signal handler for "SIGCHLD", and since it cannot be shared, nothing else should use SIGCHLD or reap random child processes (waiting for specific child processes, e.g. inside "system", is just fine). There is a slight catch to child watchers, however: you usually start them *after* the child process was created, and this means the process could have exited already (and no SIGCHLD will be sent anymore). Not all event models handle this correctly (neither POE nor IO::Async do, see their AnyEvent::Impl manpages for details), but even for event models that *do* handle this correctly, they usually need to be loaded before the process exits (i.e. before you fork in the first place). AnyEvent's pure perl event loop handles all cases correctly regardless of when you start the watcher. This means you cannot create a child watcher as the very first thing in an AnyEvent program, you *have* to create at least one watcher before you "fork" the child (alternatively, you can call "AnyEvent::detect"). As most event loops do not support waiting for child events, they will be emulated by AnyEvent in most cases, in which case the latency and race problems mentioned in the description of signal watchers apply. Example: fork a process and wait for it my $done = AnyEvent->condvar; # this forks and immediately calls exit in the child. this # normally has all sorts of bad consequences for your parent, # so take this as an example only. always fork and exec, # or call POSIX::_exit, in real code. my $pid = fork or exit 5; my $w = AnyEvent->child ( pid => $pid, cb => sub { my ($pid, $status) = @_; warn "pid $pid exited with status $status"; $done->send; }, ); # do something else, then wait for process exit $done->recv; IDLE WATCHERS $w = AnyEvent->idle (cb => ); This will repeatedly invoke the callback after the process becomes idle, until either the watcher is destroyed or new events have been detected. Idle watchers are useful when there is a need to do something, but it is not so important (or wise) to do it instantly. The callback will be invoked only when there is "nothing better to do", which is usually defined as "all outstanding events have been handled and no new events have been detected". That means that idle watchers ideally get invoked when the event loop has just polled for new events but none have been detected. Instead of blocking to wait for more events, the idle watchers will be invoked. Unfortunately, most event loops do not really support idle watchers (only EV, Event and Glib do it in a usable fashion) - for the rest, AnyEvent will simply call the callback "from time to time". Example: read lines from STDIN, but only process them when the program is otherwise idle: my @lines; # read data my $idle_w; my $io_w = AnyEvent->io (fh => \*STDIN, poll => 'r', cb => sub { push @lines, scalar ; # start an idle watcher, if not already done $idle_w ||= AnyEvent->idle (cb => sub { # handle only one line, when there are lines left if (my $line = shift @lines) { print "handled when idle: $line"; } else { # otherwise disable the idle watcher again undef $idle_w; } }); }); CONDITION VARIABLES $cv = AnyEvent->condvar; $cv->send (); my @res = $cv->recv; If you are familiar with some event loops you will know that all of them require you to run some blocking "loop", "run" or similar function that will actively watch for new events and call your callbacks. AnyEvent is slightly different: it expects somebody else to run the event loop and will only block when necessary (usually when told by the user). The tool to do that is called a "condition variable", so called because they represent a condition that must become true. Now is probably a good time to look at the examples further below. Condition variables can be created by calling the "AnyEvent->condvar" method, usually without arguments. The only argument pair allowed is "cb", which specifies a callback to be called when the condition variable becomes true, with the condition variable as the first argument (but not the results). After creation, the condition variable is "false" until it becomes "true" by calling the "send" method (or calling the condition variable as if it were a callback, read about the caveats in the description for the "->send" method). Since condition variables are the most complex part of the AnyEvent API, here are some different mental models of what they are - pick the ones you can connect to: * Condition variables are like callbacks - you can call them (and pass them instead of callbacks). Unlike callbacks however, you can also wait for them to be called. * Condition variables are signals - one side can emit or send them, the other side can wait for them, or install a handler that is called when the signal fires. * Condition variables are like "Merge Points" - points in your program where you merge multiple independent results/control flows into one. * Condition variables represent a transaction - functions that start some kind of transaction can return them, leaving the caller the choice between waiting in a blocking fashion, or setting a callback. * Condition variables represent future values, or promises to deliver some result, long before the result is available. Condition variables are very useful to signal that something has finished, for example, if you write a module that does asynchronous http requests, then a condition variable would be the ideal candidate to signal the availability of results. The user can either act when the callback is called or can synchronously "->recv" for the results. You can also use them to simulate traditional event loops - for example, you can block your main program until an event occurs - for example, you could "->recv" in your main program until the user clicks the Quit button of your app, which would "->send" the "quit" event. Note that condition variables recurse into the event loop - if you have two pieces of code that call "->recv" in a round-robin fashion, you lose. Therefore, condition variables are good to export to your caller, but you should avoid making a blocking wait yourself, at least in callbacks, as this asks for trouble. Condition variables are represented by hash refs in perl, and the keys used by AnyEvent itself are all named "_ae_XXX" to make subclassing easy (it is often useful to build your own transaction class on top of AnyEvent). To subclass, use "AnyEvent::CondVar" as base class and call its "new" method in your own "new" method. There are two "sides" to a condition variable - the "producer side" which eventually calls "-> send", and the "consumer side", which waits for the send to occur. Example: wait for a timer. # condition: "wait till the timer is fired" my $timer_fired = AnyEvent->condvar; # create the timer - we could wait for, say # a handle becomign ready, or even an # AnyEvent::HTTP request to finish, but # in this case, we simply use a timer: my $w = AnyEvent->timer ( after => 1, cb => sub { $timer_fired->send }, ); # this "blocks" (while handling events) till the callback # calls ->send $timer_fired->recv; Example: wait for a timer, but take advantage of the fact that condition variables are also callable directly. my $done = AnyEvent->condvar; my $delay = AnyEvent->timer (after => 5, cb => $done); $done->recv; Example: Imagine an API that returns a condvar and doesn't support callbacks. This is how you make a synchronous call, for example from the main program: use AnyEvent::CouchDB; ... my @info = $couchdb->info->recv; And this is how you would just set a callback to be called whenever the results are available: $couchdb->info->cb (sub { my @info = $_[0]->recv; }); METHODS FOR PRODUCERS These methods should only be used by the producing side, i.e. the code/module that eventually sends the signal. Note that it is also the producer side which creates the condvar in most cases, but it isn't uncommon for the consumer to create it as well. $cv->send (...) Flag the condition as ready - a running "->recv" and all further calls to "recv" will (eventually) return after this method has been called. If nobody is waiting the send will be remembered. If a callback has been set on the condition variable, it is called immediately from within send. Any arguments passed to the "send" call will be returned by all future "->recv" calls. Condition variables are overloaded so one can call them directly (as if they were a code reference). Calling them directly is the same as calling "send". $cv->croak ($error) Similar to send, but causes all calls to "->recv" to invoke "Carp::croak" with the given error message/object/scalar. This can be used to signal any errors to the condition variable user/consumer. Doing it this way instead of calling "croak" directly delays the error detection, but has the overwhelming advantage that it diagnoses the error at the place where the result is expected, and not deep in some event callback with no connection to the actual code causing the problem. $cv->begin ([group callback]) $cv->end These two methods can be used to combine many transactions/events into one. For example, a function that pings many hosts in parallel might want to use a condition variable for the whole process. Every call to "->begin" will increment a counter, and every call to "->end" will decrement it. If the counter reaches 0 in "->end", the (last) callback passed to "begin" will be executed, passing the condvar as first argument. That callback is *supposed* to call "->send", but that is not required. If no group callback was set, "send" will be called without any arguments. You can think of "$cv->send" giving you an OR condition (one call sends), while "$cv->begin" and "$cv->end" giving you an AND condition (all "begin" calls must be "end"'ed before the condvar sends). Let's start with a simple example: you have two I/O watchers (for example, STDOUT and STDERR for a program), and you want to wait for both streams to close before activating a condvar: my $cv = AnyEvent->condvar; $cv->begin; # first watcher my $w1 = AnyEvent->io (fh => $fh1, cb => sub { defined sysread $fh1, my $buf, 4096 or $cv->end; }); $cv->begin; # second watcher my $w2 = AnyEvent->io (fh => $fh2, cb => sub { defined sysread $fh2, my $buf, 4096 or $cv->end; }); $cv->recv; This works because for every event source (EOF on file handle), there is one call to "begin", so the condvar waits for all calls to "end" before sending. The ping example mentioned above is slightly more complicated, as the there are results to be passed back, and the number of tasks that are begun can potentially be zero: my $cv = AnyEvent->condvar; my %result; $cv->begin (sub { shift->send (\%result) }); for my $host (@list_of_hosts) { $cv->begin; ping_host_then_call_callback $host, sub { $result{$host} = ...; $cv->end; }; } $cv->end; ... my $results = $cv->recv; This code fragment supposedly pings a number of hosts and calls "send" after results for all then have have been gathered - in any order. To achieve this, the code issues a call to "begin" when it starts each ping request and calls "end" when it has received some result for it. Since "begin" and "end" only maintain a counter, the order in which results arrive is not relevant. There is an additional bracketing call to "begin" and "end" outside the loop, which serves two important purposes: first, it sets the callback to be called once the counter reaches 0, and second, it ensures that "send" is called even when "no" hosts are being pinged (the loop doesn't execute once). This is the general pattern when you "fan out" into multiple (but potentially zero) subrequests: use an outer "begin"/"end" pair to set the callback and ensure "end" is called at least once, and then, for each subrequest you start, call "begin" and for each subrequest you finish, call "end". METHODS FOR CONSUMERS These methods should only be used by the consuming side, i.e. the code awaits the condition. $cv->recv Wait (blocking if necessary) until the "->send" or "->croak" methods have been called on $cv, while servicing other watchers normally. You can only wait once on a condition - additional calls are valid but will return immediately. If an error condition has been set by calling "->croak", then this function will call "croak". In list context, all parameters passed to "send" will be returned, in scalar context only the first one will be returned. Note that doing a blocking wait in a callback is not supported by any event loop, that is, recursive invocation of a blocking "->recv" is not allowed and the "recv" call will "croak" if such a condition is detected. This requirement can be dropped by relying on Coro::AnyEvent , which allows you to do a blocking "->recv" from any thread that doesn't run the event loop itself. Coro::AnyEvent is loaded automatically when Coro is used with AnyEvent, so code does not need to do anything special to take advantage of that: any code that would normally block your program because it calls "recv", be executed in an "async" thread instead without blocking other threads. Not all event models support a blocking wait - some die in that case (programs might want to do that to stay interactive), so *if you are using this from a module, never require a blocking wait*. Instead, let the caller decide whether the call will block or not (for example, by coupling condition variables with some kind of request results and supporting callbacks so the caller knows that getting the result will not block, while still supporting blocking waits if the caller so desires). You can ensure that "->recv" never blocks by setting a callback and only calling "->recv" from within that callback (or at a later time). This will work even when the event loop does not support blocking waits otherwise. $bool = $cv->ready Returns true when the condition is "true", i.e. whether "send" or "croak" have been called. $cb = $cv->cb ($cb->($cv)) This is a mutator function that returns the callback set (or "undef" if not) and optionally replaces it before doing so. The callback will be called when the condition becomes "true", i.e. when "send" or "croak" are called, with the only argument being the condition variable itself. If the condition is already true, the callback is called immediately when it is set. Calling "recv" inside the callback or at any later time is guaranteed not to block. Additionally, when the callback is invoked, it is also removed from the condvar (reset to "undef"), so the condvar does not keep a reference to the callback after invocation. SUPPORTED EVENT LOOPS/BACKENDS The following backend classes are part of the AnyEvent distribution (every class has its own manpage): Backends that are autoprobed when no other event loop can be found. EV is the preferred backend when no other event loop seems to be in use. If EV is not installed, then AnyEvent will fall back to its own pure-perl implementation, which is available everywhere as it comes with AnyEvent itself. AnyEvent::Impl::EV based on EV (interface to libev, best choice). AnyEvent::Impl::Perl pure-perl AnyEvent::Loop, fast and portable. Backends that are transparently being picked up when they are used. These will be used if they are already loaded when the first watcher is created, in which case it is assumed that the application is using them. This means that AnyEvent will automatically pick the right backend when the main program loads an event module before anything starts to create watchers. Nothing special needs to be done by the main program. AnyEvent::Impl::Event based on Event, very stable, few glitches. AnyEvent::Impl::Glib based on Glib, slow but very stable. AnyEvent::Impl::Tk based on Tk, very broken. AnyEvent::Impl::UV based on UV, innovated square wheels. AnyEvent::Impl::EventLib based on Event::Lib, leaks memory and worse. AnyEvent::Impl::POE based on POE, very slow, some limitations. AnyEvent::Impl::Irssi used when running within irssi. AnyEvent::Impl::IOAsync based on IO::Async. AnyEvent::Impl::Cocoa based on Cocoa::EventLoop. AnyEvent::Impl::FLTK based on FLTK (fltk 2 binding). Backends with special needs. Qt requires the Qt::Application to be instantiated first, but will otherwise be picked up automatically. As long as the main program instantiates the application before any AnyEvent watchers are created, everything should just work. AnyEvent::Impl::Qt based on Qt. Event loops that are indirectly supported via other backends. Some event loops can be supported via other modules: There is no direct support for WxWidgets (Wx) or Prima. WxWidgets has no support for watching file handles. However, you can use WxWidgets through the POE adaptor, as POE has a Wx backend that simply polls 20 times per second, which was considered to be too horrible to even consider for AnyEvent. Prima is not supported as nobody seems to be using it, but it has a POE backend, so it can be supported through POE. AnyEvent knows about both Prima and Wx, however, and will try to load POE when detecting them, in the hope that POE will pick them up, in which case everything will be automatic. Known event loops outside the AnyEvent distribution The following event loops or programs support AnyEvent by providing their own AnyEvent backend. They will be picked up automatically. urxvt::anyevent available to rxvt-unicode extensions GLOBAL VARIABLES AND FUNCTIONS These are not normally required to use AnyEvent, but can be useful to write AnyEvent extension modules. $AnyEvent::MODEL Contains "undef" until the first watcher is being created, before the backend has been autodetected. Afterwards it contains the event model that is being used, which is the name of the Perl class implementing the model. This class is usually one of the "AnyEvent::Impl::xxx" modules, but can be any other class in the case AnyEvent has been extended at runtime (e.g. in *rxvt-unicode* it will be "urxvt::anyevent"). AnyEvent::detect Returns $AnyEvent::MODEL, forcing autodetection of the event model if necessary. You should only call this function right before you would have created an AnyEvent watcher anyway, that is, as late as possible at runtime, and not e.g. during initialisation of your module. The effect of calling this function is as if a watcher had been created (specifically, actions that happen "when the first watcher is created" happen when calling detetc as well). If you need to do some initialisation before AnyEvent watchers are created, use "post_detect". $guard = AnyEvent::post_detect { BLOCK } Arranges for the code block to be executed as soon as the event model is autodetected (or immediately if that has already happened). The block will be executed *after* the actual backend has been detected ($AnyEvent::MODEL is set), so it is possible to do some initialisation only when AnyEvent is actually initialised - see the sources of AnyEvent::AIO to see how this is used. The most common usage is to create some global watchers, without forcing event module detection too early. For example, AnyEvent::AIO creates and installs the global IO::AIO watcher in a "post_detect" block to avoid autodetecting the event module at load time. If called in scalar or list context, then it creates and returns an object that automatically removes the callback again when it is destroyed (or "undef" when the hook was immediately executed). See AnyEvent::AIO for a case where this is useful. Example: Create a watcher for the IO::AIO module and store it in $WATCHER, but do so only do so after the event loop is initialised. our WATCHER; my $guard = AnyEvent::post_detect { $WATCHER = AnyEvent->io (fh => IO::AIO::poll_fileno, poll => 'r', cb => \&IO::AIO::poll_cb); }; # the ||= is important in case post_detect immediately runs the block, # as to not clobber the newly-created watcher. assigning both watcher and # post_detect guard to the same variable has the advantage of users being # able to just C if the watcher causes them grief. $WATCHER ||= $guard; @AnyEvent::post_detect This is a lower level interface then "AnyEvent::post_detect" (the function). This variable is mainly useful for modules that can do something useful when AnyEvent is used and thus want to know when it is initialised, but do not need to even load it by default. This array provides the means to hook into AnyEvent passively, without loading it. Here is how it works: If there are any code references in this array (you can "push" to it before or after loading AnyEvent), then they will be called directly after the event loop has been chosen. You should check $AnyEvent::MODEL before adding to this array, though: if it is defined then the event loop has already been detected, and the array will be ignored. Best use "AnyEvent::post_detect { BLOCK }" when your application allows it, as it takes care of these details. Example: To load Coro::AnyEvent whenever Coro and AnyEvent are used together, you could put this into Coro (this is the actual code used by Coro to accomplish this): if (defined $AnyEvent::MODEL) { # AnyEvent already initialised, so load Coro::AnyEvent require Coro::AnyEvent; } else { # AnyEvent not yet initialised, so make sure to load Coro::AnyEvent # as soon as it is push @AnyEvent::post_detect, sub { require Coro::AnyEvent }; } AnyEvent::postpone { BLOCK } Arranges for the block to be executed as soon as possible, but not before the call itself returns. In practise, the block will be executed just before the event loop polls for new events, or shortly afterwards. This function never returns anything (to make the "return postpone { ... }" idiom more useful. To understand the usefulness of this function, consider a function that asynchronously does something for you and returns some transaction object or guard to let you cancel the operation. For example, "AnyEvent::Socket::tcp_connect": # start a connection attempt unless one is active $self->{connect_guard} ||= AnyEvent::Socket::tcp_connect "www.example.net", 80, sub { delete $self->{connect_guard}; ... }; Imagine that this function could instantly call the callback, for example, because it detects an obvious error such as a negative port number. Invoking the callback before the function returns causes problems however: the callback will be called and will try to delete the guard object. But since the function hasn't returned yet, there is nothing to delete. When the function eventually returns it will assign the guard object to "$self->{connect_guard}", where it will likely never be deleted, so the program thinks it is still trying to connect. This is where "AnyEvent::postpone" should be used. Instead of calling the callback directly on error: $cb->(undef), return # signal error to callback, BAD! if $some_error_condition; It should use "postpone": AnyEvent::postpone { $cb->(undef) }, return # signal error to callback, later if $some_error_condition; AnyEvent::log $level, $msg[, @args] Log the given $msg at the given $level. If AnyEvent::Log is not loaded then this function makes a simple test to see whether the message will be logged. If the test succeeds it will load AnyEvent::Log and call "AnyEvent::Log::log" - consequently, look at the AnyEvent::Log documentation for details. If the test fails it will simply return. Right now this happens when a numerical loglevel is used and it is larger than the level specified via $ENV{PERL_ANYEVENT_VERBOSE}. If you want to sprinkle loads of logging calls around your code, consider creating a logger callback with the "AnyEvent::Log::logger" function, which can reduce typing, codesize and can reduce the logging overhead enourmously. AnyEvent::fh_block $filehandle AnyEvent::fh_unblock $filehandle Sets blocking or non-blocking behaviour for the given filehandle. WHAT TO DO IN A MODULE As a module author, you should "use AnyEvent" and call AnyEvent methods freely, but you should not load a specific event module or rely on it. Be careful when you create watchers in the module body - AnyEvent will decide which event module to use as soon as the first method is called, so by calling AnyEvent in your module body you force the user of your module to load the event module first. Never call "->recv" on a condition variable unless you *know* that the "->send" method has been called on it already. This is because it will stall the whole program, and the whole point of using events is to stay interactive. It is fine, however, to call "->recv" when the user of your module requests it (i.e. if you create a http request object ad have a method called "results" that returns the results, it may call "->recv" freely, as the user of your module knows what she is doing. Always). WHAT TO DO IN THE MAIN PROGRAM There will always be a single main program - the only place that should dictate which event model to use. If the program is not event-based, it need not do anything special, even when it depends on a module that uses an AnyEvent. If the program itself uses AnyEvent, but does not care which event loop is used, all it needs to do is "use AnyEvent". In either case, AnyEvent will choose the best available loop implementation. If the main program relies on a specific event model - for example, in Gtk2 programs you have to rely on the Glib module - you should load the event module before loading AnyEvent or any module that uses it: generally speaking, you should load it as early as possible. The reason is that modules might create watchers when they are loaded, and AnyEvent will decide on the event model to use as soon as it creates watchers, and it might choose the wrong one unless you load the correct one yourself. You can chose to use a pure-perl implementation by loading the "AnyEvent::Loop" module, which gives you similar behaviour everywhere, but letting AnyEvent chose the model is generally better. MAINLOOP EMULATION Sometimes (often for short test scripts, or even standalone programs who only want to use AnyEvent), you do not want to run a specific event loop. In that case, you can use a condition variable like this: AnyEvent->condvar->recv; This has the effect of entering the event loop and looping forever. Note that usually your program has some exit condition, in which case it is better to use the "traditional" approach of storing a condition variable somewhere, waiting for it, and sending it when the program should exit cleanly. OTHER MODULES The following is a non-exhaustive list of additional modules that use AnyEvent as a client and can therefore be mixed easily with other AnyEvent modules and other event loops in the same program. Some of the modules come as part of AnyEvent, the others are available via CPAN (see for a longer non-exhaustive list), and the list is heavily biased towards modules of the AnyEvent author himself :) AnyEvent::Util (part of the AnyEvent distribution) Contains various utility functions that replace often-used blocking functions such as "inet_aton" with event/callback-based versions. AnyEvent::Socket (part of the AnyEvent distribution) Provides various utility functions for (internet protocol) sockets, addresses and name resolution. Also functions to create non-blocking tcp connections or tcp servers, with IPv6 and SRV record support and more. AnyEvent::Handle (part of the AnyEvent distribution) Provide read and write buffers, manages watchers for reads and writes, supports raw and formatted I/O, I/O queued and fully transparent and non-blocking SSL/TLS (via AnyEvent::TLS). AnyEvent::DNS (part of the AnyEvent distribution) Provides rich asynchronous DNS resolver capabilities. AnyEvent::HTTP, AnyEvent::IRC, AnyEvent::XMPP, AnyEvent::GPSD, AnyEvent::IGS, AnyEvent::FCP Implement event-based interfaces to the protocols of the same name (for the curious, IGS is the International Go Server and FCP is the Freenet Client Protocol). AnyEvent::AIO (part of the AnyEvent distribution) Truly asynchronous (as opposed to non-blocking) I/O, should be in the toolbox of every event programmer. AnyEvent::AIO transparently fuses IO::AIO and AnyEvent together, giving AnyEvent access to event-based file I/O, and much more. AnyEvent::Fork, AnyEvent::Fork::RPC, AnyEvent::Fork::Pool, AnyEvent::Fork::Remote These let you safely fork new subprocesses, either locally or remotely (e.g.v ia ssh), using some RPC protocol or not, without the limitations normally imposed by fork (AnyEvent works fine for example). Dynamically-resized worker pools are obviously included as well. And they are quite tiny and fast as well - "abusing" AnyEvent::Fork just to exec external programs can easily beat using "fork" and "exec" (or even "system") in most programs. AnyEvent::Filesys::Notify AnyEvent is good for non-blocking stuff, but it can't detect file or path changes (e.g. "watch this directory for new files", "watch this file for changes"). The AnyEvent::Filesys::Notify module promises to do just that in a portbale fashion, supporting inotify on GNU/Linux and some weird, without doubt broken, stuff on OS X to monitor files. It can fall back to blocking scans at regular intervals transparently on other platforms, so it's about as portable as it gets. (I haven't used it myself, but it seems the biggest problem with it is it quite bad performance). AnyEvent::DBI Executes DBI requests asynchronously in a proxy process for you, notifying you in an event-based way when the operation is finished. AnyEvent::FastPing The fastest ping in the west. Coro Has special support for AnyEvent via Coro::AnyEvent, which allows you to simply invert the flow control - don't call us, we will call you: async { Coro::AnyEvent::sleep 5; # creates a 5s timer and waits for it print "5 seconds later!\n"; Coro::AnyEvent::readable *STDIN; # uses an I/O watcher my $line = ; # works for ttys AnyEvent::HTTP::http_get "url", Coro::rouse_cb; my ($body, $hdr) = Coro::rouse_wait; }; SIMPLIFIED AE API Starting with version 5.0, AnyEvent officially supports a second, much simpler, API that is designed to reduce the calling, typing and memory overhead by using function call syntax and a fixed number of parameters. See the AE manpage for details. ERROR AND EXCEPTION HANDLING In general, AnyEvent does not do any error handling - it relies on the caller to do that if required. The AnyEvent::Strict module (see also the "PERL_ANYEVENT_STRICT" environment variable, below) provides strict checking of all AnyEvent methods, however, which is highly useful during development. As for exception handling (i.e. runtime errors and exceptions thrown while executing a callback), this is not only highly event-loop specific, but also not in any way wrapped by this module, as this is the job of the main program. The pure perl event loop simply re-throws the exception (usually within "condvar->recv"), the Event and EV modules call "$Event/EV::DIED->()", Glib uses "install_exception_handler" and so on. ENVIRONMENT VARIABLES AnyEvent supports a number of environment variables that tune the runtime behaviour. They are usually evaluated when AnyEvent is loaded, initialised, or a submodule that uses them is loaded. Many of them also cause AnyEvent to load additional modules - for example, "PERL_ANYEVENT_DEBUG_WRAP" causes the AnyEvent::Debug module to be loaded. All the environment variables documented here start with "PERL_ANYEVENT_", which is what AnyEvent considers its own namespace. Other modules are encouraged (but by no means required) to use "PERL_ANYEVENT_SUBMODULE" if they have registered the AnyEvent::Submodule namespace on CPAN, for any submodule. For example, AnyEvent::HTTP could be expected to use "PERL_ANYEVENT_HTTP_PROXY" (it should not access env variables starting with "AE_", see below). All variables can also be set via the "AE_" prefix, that is, instead of setting "PERL_ANYEVENT_VERBOSE" you can also set "AE_VERBOSE". In case there is a clash btween anyevent and another program that uses "AE_something" you can set the corresponding "PERL_ANYEVENT_something" variable to the empty string, as those variables take precedence. When AnyEvent is first loaded, it copies all "AE_xxx" env variables to their "PERL_ANYEVENT_xxx" counterpart unless that variable already exists. If taint mode is on, then AnyEvent will remove *all* environment variables starting with "PERL_ANYEVENT_" from %ENV (or replace them with "undef" or the empty string, if the corresaponding "AE_" variable is set). The exact algorithm is currently: 1. if taint mode enabled, delete all PERL_ANYEVENT_xyz variables from %ENV 2. copy over AE_xyz to PERL_ANYEVENT_xyz unless the latter alraedy exists 3. if taint mode enabled, set all PERL_ANYEVENT_xyz variables to undef. This ensures that child processes will not see the "AE_" variables. The following environment variables are currently known to AnyEvent: "PERL_ANYEVENT_VERBOSE" By default, AnyEvent will log messages with loglevel 4 ("error") or higher (see AnyEvent::Log). You can set this environment variable to a numerical loglevel to make AnyEvent more (or less) talkative. If you want to do more than just set the global logging level you should have a look at "PERL_ANYEVENT_LOG", which allows much more complex specifications. When set to 0 ("off"), then no messages whatsoever will be logged with everything else at defaults. When set to 5 or higher ("warn"), AnyEvent warns about unexpected conditions, such as not being able to load the event model specified by "PERL_ANYEVENT_MODEL", or a guard callback throwing an exception - this is the minimum recommended level for use during development. When set to 7 or higher (info), AnyEvent reports which event model it chooses. When set to 8 or higher (debug), then AnyEvent will report extra information on which optional modules it loads and how it implements certain features. "PERL_ANYEVENT_LOG" Accepts rather complex logging specifications. For example, you could log all "debug" messages of some module to stderr, warnings and above to stderr, and errors and above to syslog, with: PERL_ANYEVENT_LOG=Some::Module=debug,+log:filter=warn,+%syslog:%syslog=error,syslog For the rather extensive details, see AnyEvent::Log. This variable is evaluated when AnyEvent (or AnyEvent::Log) is loaded, so will take effect even before AnyEvent has initialised itself. Note that specifying this environment variable causes the AnyEvent::Log module to be loaded, while "PERL_ANYEVENT_VERBOSE" does not, so only using the latter saves a few hundred kB of memory unless a module explicitly needs the extra features of AnyEvent::Log. "PERL_ANYEVENT_STRICT" AnyEvent does not do much argument checking by default, as thorough argument checking is very costly. Setting this variable to a true value will cause AnyEvent to load "AnyEvent::Strict" and then to thoroughly check the arguments passed to most method calls. If it finds any problems, it will croak. In other words, enables "strict" mode. Unlike "use strict" (or its modern cousin, "use common::sense", it is definitely recommended to keep it off in production. Keeping "PERL_ANYEVENT_STRICT=1" in your environment while developing programs can be very useful, however. "PERL_ANYEVENT_DEBUG_SHELL" If this env variable is nonempty, then its contents will be interpreted by "AnyEvent::Socket::parse_hostport" and "AnyEvent::Debug::shell" (after replacing every occurance of $$ by the process pid). The shell object is saved in $AnyEvent::Debug::SHELL. This happens when the first watcher is created. For example, to bind a debug shell on a unix domain socket in /tmp/debug.sock, you could use this: PERL_ANYEVENT_DEBUG_SHELL=/tmp/debug\$\$.sock perlprog # connect with e.g.: socat readline /tmp/debug123.sock Or to bind to tcp port 4545 on localhost: PERL_ANYEVENT_DEBUG_SHELL=127.0.0.1:4545 perlprog # connect with e.g.: telnet localhost 4545 Note that creating sockets in /tmp or on localhost is very unsafe on multiuser systems. "PERL_ANYEVENT_DEBUG_WRAP" Can be set to 0, 1 or 2 and enables wrapping of all watchers for debugging purposes. See "AnyEvent::Debug::wrap" for details. "PERL_ANYEVENT_MODEL" This can be used to specify the event model to be used by AnyEvent, before auto detection and -probing kicks in. It normally is a string consisting entirely of ASCII letters (e.g. "EV" or "IOAsync"). The string "AnyEvent::Impl::" gets prepended and the resulting module name is loaded and - if the load was successful - used as event model backend. If it fails to load then AnyEvent will proceed with auto detection and -probing. If the string ends with "::" instead (e.g. "AnyEvent::Impl::EV::") then nothing gets prepended and the module name is used as-is (hint: "::" at the end of a string designates a module name and quotes it appropriately). For example, to force the pure perl model (AnyEvent::Loop::Perl) you could start your program like this: PERL_ANYEVENT_MODEL=Perl perl ... "PERL_ANYEVENT_IO_MODEL" The current file I/O model - see AnyEvent::IO for more info. At the moment, only "Perl" (small, pure-perl, synchronous) and "IOAIO" (truly asynchronous) are supported. The default is "IOAIO" if AnyEvent::AIO can be loaded, otherwise it is "Perl". "PERL_ANYEVENT_PROTOCOLS" Used by both AnyEvent::DNS and AnyEvent::Socket to determine preferences for IPv4 or IPv6. The default is unspecified (and might change, or be the result of auto probing). Must be set to a comma-separated list of protocols or address families, current supported: "ipv4" and "ipv6". Only protocols mentioned will be used, and preference will be given to protocols mentioned earlier in the list. This variable can effectively be used for denial-of-service attacks against local programs (e.g. when setuid), although the impact is likely small, as the program has to handle connection and other failures anyways. Examples: "PERL_ANYEVENT_PROTOCOLS=ipv4,ipv6" - prefer IPv4 over IPv6, but support both and try to use both. "PERL_ANYEVENT_PROTOCOLS=ipv4" - only support IPv4, never try to resolve or contact IPv6 addresses. "PERL_ANYEVENT_PROTOCOLS=ipv6,ipv4" support either IPv4 or IPv6, but prefer IPv6 over IPv4. "PERL_ANYEVENT_HOSTS" This variable, if specified, overrides the /etc/hosts file used by AnyEvent::Socket"::resolve_sockaddr", i.e. hosts aliases will be read from that file instead. "PERL_ANYEVENT_EDNS0" Used by AnyEvent::DNS to decide whether to use the EDNS0 extension for DNS. This extension is generally useful to reduce DNS traffic, especially when DNSSEC is involved, but some (broken) firewalls drop such DNS packets, which is why it is off by default. Setting this variable to 1 will cause AnyEvent::DNS to announce EDNS0 in its DNS requests. "PERL_ANYEVENT_MAX_FORKS" The maximum number of child processes that "AnyEvent::Util::fork_call" will create in parallel. "PERL_ANYEVENT_MAX_OUTSTANDING_DNS" The default value for the "max_outstanding" parameter for the default DNS resolver - this is the maximum number of parallel DNS requests that are sent to the DNS server. "PERL_ANYEVENT_MAX_SIGNAL_LATENCY" Perl has inherently racy signal handling (you can basically choose between losing signals and memory corruption) - pure perl event loops (including "AnyEvent::Loop", when "Async::Interrupt" isn't available) therefore have to poll regularly to avoid losing signals. Some event loops are racy, but don't poll regularly, and some event loops are written in C but are still racy. For those event loops, AnyEvent installs a timer that regularly wakes up the event loop. By default, the interval for this timer is 10 seconds, but you can override this delay with this environment variable (or by setting the $AnyEvent::MAX_SIGNAL_LATENCY variable before creating signal watchers). Lower values increase CPU (and energy) usage, higher values can introduce long delays when reaping children or waiting for signals. The AnyEvent::Async module, if available, will be used to avoid this polling (with most event loops). "PERL_ANYEVENT_RESOLV_CONF" The absolute path to a resolv.conf-style file to use instead of /etc/resolv.conf (or the OS-specific configuration) in the default resolver, or the empty string to select the default configuration. "PERL_ANYEVENT_CA_FILE", "PERL_ANYEVENT_CA_PATH". When neither "ca_file" nor "ca_path" was specified during AnyEvent::TLS context creation, and either of these environment variables are nonempty, they will be used to specify CA certificate locations instead of a system-dependent default. "PERL_ANYEVENT_AVOID_GUARD" and "PERL_ANYEVENT_AVOID_ASYNC_INTERRUPT" When these are set to 1, then the respective modules are not loaded. Mostly good for testing AnyEvent itself. SUPPLYING YOUR OWN EVENT MODEL INTERFACE This is an advanced topic that you do not normally need to use AnyEvent in a module. This section is only of use to event loop authors who want to provide AnyEvent compatibility. If you need to support another event library which isn't directly supported by AnyEvent, you can supply your own interface to it by pushing, before the first watcher gets created, the package name of the event module and the package name of the interface to use onto @AnyEvent::REGISTRY. You can do that before and even without loading AnyEvent, so it is reasonably cheap. Example: push @AnyEvent::REGISTRY, [urxvt => urxvt::anyevent::]; This tells AnyEvent to (literally) use the "urxvt::anyevent::" package/class when it finds the "urxvt" package/module is already loaded. When AnyEvent is loaded and asked to find a suitable event model, it will first check for the presence of urxvt by trying to "use" the "urxvt::anyevent" module. The class should provide implementations for all watcher types. See AnyEvent::Impl::EV (source code), AnyEvent::Impl::Glib (Source code) and so on for actual examples. Use "perldoc -m AnyEvent::Impl::Glib" to see the sources. If you don't provide "signal" and "child" watchers than AnyEvent will provide suitable (hopefully) replacements. The above example isn't fictitious, the *rxvt-unicode* (a.k.a. urxvt) terminal emulator uses the above line as-is. An interface isn't included in AnyEvent because it doesn't make sense outside the embedded interpreter inside *rxvt-unicode*, and it is updated and maintained as part of the *rxvt-unicode* distribution. *rxvt-unicode* also cheats a bit by not providing blocking access to condition variables: code blocking while waiting for a condition will "die". This still works with most modules/usages, and blocking calls must not be done in an interactive application, so it makes sense. EXAMPLE PROGRAM The following program uses an I/O watcher to read data from STDIN, a timer to display a message once per second, and a condition variable to quit the program when the user enters quit: use AnyEvent; my $cv = AnyEvent->condvar; my $io_watcher = AnyEvent->io ( fh => \*STDIN, poll => 'r', cb => sub { warn "io event <$_[0]>\n"; # will always output chomp (my $input = ); # read a line warn "read: $input\n"; # output what has been read $cv->send if $input =~ /^q/i; # quit program if /^q/i }, ); my $time_watcher = AnyEvent->timer (after => 1, interval => 1, cb => sub { warn "timeout\n"; # print 'timeout' at most every second }); $cv->recv; # wait until user enters /^q/i REAL-WORLD EXAMPLE Consider the Net::FCP module. It features (among others) the following API calls, which are to freenet what HTTP GET requests are to http: my $data = $fcp->client_get ($url); # blocks my $transaction = $fcp->txn_client_get ($url); # does not block $transaction->cb ( sub { ... } ); # set optional result callback my $data = $transaction->result; # possibly blocks The "client_get" method works like "LWP::Simple::get": it requests the given URL and waits till the data has arrived. It is defined to be: sub client_get { $_[0]->txn_client_get ($_[1])->result } And in fact is automatically generated. This is the blocking API of Net::FCP, and it works as simple as in any other, similar, module. More complicated is "txn_client_get": It only creates a transaction (completion, result, ...) object and initiates the transaction. my $txn = bless { }, Net::FCP::Txn::; It also creates a condition variable that is used to signal the completion of the request: $txn->{finished} = AnyAvent->condvar; It then creates a socket in non-blocking mode. socket $txn->{fh}, ...; fcntl $txn->{fh}, F_SETFL, O_NONBLOCK; connect $txn->{fh}, ... and !$!{EWOULDBLOCK} and !$!{EINPROGRESS} and Carp::croak "unable to connect: $!\n"; Then it creates a write-watcher which gets called whenever an error occurs or the connection succeeds: $txn->{w} = AnyEvent->io (fh => $txn->{fh}, poll => 'w', cb => sub { $txn->fh_ready_w }); And returns this transaction object. The "fh_ready_w" callback gets called as soon as the event loop detects that the socket is ready for writing. The "fh_ready_w" method makes the socket blocking again, writes the request data and replaces the watcher by a read watcher (waiting for reply data). The actual code is more complicated, but that doesn't matter for this example: fcntl $txn->{fh}, F_SETFL, 0; syswrite $txn->{fh}, $txn->{request} or die "connection or write error"; $txn->{w} = AnyEvent->io (fh => $txn->{fh}, poll => 'r', cb => sub { $txn->fh_ready_r }); Again, "fh_ready_r" waits till all data has arrived, and then stores the result and signals any possible waiters that the request has finished: sysread $txn->{fh}, $txn->{buf}, length $txn->{$buf}; if (end-of-file or data complete) { $txn->{result} = $txn->{buf}; $txn->{finished}->send; $txb->{cb}->($txn) of $txn->{cb}; # also call callback } The "result" method, finally, just waits for the finished signal (if the request was already finished, it doesn't wait, of course, and returns the data: $txn->{finished}->recv; return $txn->{result}; The actual code goes further and collects all errors ("die"s, exceptions) that occurred during request processing. The "result" method detects whether an exception as thrown (it is stored inside the $txn object) and just throws the exception, which means connection errors and other problems get reported to the code that tries to use the result, not in a random callback. All of this enables the following usage styles: 1. Blocking: my $data = $fcp->client_get ($url); 2. Blocking, but running in parallel: my @datas = map $_->result, map $fcp->txn_client_get ($_), @urls; Both blocking examples work without the module user having to know anything about events. 3a. Event-based in a main program, using any supported event module: use EV; $fcp->txn_client_get ($url)->cb (sub { my $txn = shift; my $data = $txn->result; ... }); EV::run; 3b. The module user could use AnyEvent, too: use AnyEvent; my $quit = AnyEvent->condvar; $fcp->txn_client_get ($url)->cb (sub { ... $quit->send; }); $quit->recv; BENCHMARKS To give you an idea of the performance and overheads that AnyEvent adds over the event loops themselves and to give you an impression of the speed of various event loops I prepared some benchmarks. BENCHMARKING ANYEVENT OVERHEAD Here is a benchmark of various supported event models used natively and through AnyEvent. The benchmark creates a lot of timers (with a zero timeout) and I/O watchers (watching STDOUT, a pty, to become writable, which it is), lets them fire exactly once and destroys them again. Source code for this benchmark is found as eg/bench in the AnyEvent distribution. It uses the AE interface, which makes a real difference for the EV and Perl backends only. Explanation of the columns *watcher* is the number of event watchers created/destroyed. Since different event models feature vastly different performances, each event loop was given a number of watchers so that overall runtime is acceptable and similar between tested event loop (and keep them from crashing): Glib would probably take thousands of years if asked to process the same number of watchers as EV in this benchmark. *bytes* is the number of bytes (as measured by the resident set size, RSS) consumed by each watcher. This method of measuring captures both C and Perl-based overheads. *create* is the time, in microseconds (millionths of seconds), that it takes to create a single watcher. The callback is a closure shared between all watchers, to avoid adding memory overhead. That means closure creation and memory usage is not included in the figures. *invoke* is the time, in microseconds, used to invoke a simple callback. The callback simply counts down a Perl variable and after it was invoked "watcher" times, it would "->send" a condvar once to signal the end of this phase. *destroy* is the time, in microseconds, that it takes to destroy a single watcher. Results name watchers bytes create invoke destroy comment EV/EV 100000 223 0.47 0.43 0.27 EV native interface EV/Any 100000 223 0.48 0.42 0.26 EV + AnyEvent watchers Coro::EV/Any 100000 223 0.47 0.42 0.26 coroutines + Coro::Signal Perl/Any 100000 431 2.70 0.74 0.92 pure perl implementation Event/Event 16000 516 31.16 31.84 0.82 Event native interface Event/Any 16000 1203 42.61 34.79 1.80 Event + AnyEvent watchers IOAsync/Any 16000 1911 41.92 27.45 16.81 via IO::Async::Loop::IO_Poll IOAsync/Any 16000 1726 40.69 26.37 15.25 via IO::Async::Loop::Epoll Glib/Any 16000 1118 89.00 12.57 51.17 quadratic behaviour Tk/Any 2000 1346 20.96 10.75 8.00 SEGV with >> 2000 watchers POE/Any 2000 6951 108.97 795.32 14.24 via POE::Loop::Event POE/Any 2000 6648 94.79 774.40 575.51 via POE::Loop::Select Discussion The benchmark does *not* measure scalability of the event loop very well. For example, a select-based event loop (such as the pure perl one) can never compete with an event loop that uses epoll when the number of file descriptors grows high. In this benchmark, all events become ready at the same time, so select/poll-based implementations get an unnatural speed boost. Also, note that the number of watchers usually has a nonlinear effect on overall speed, that is, creating twice as many watchers doesn't take twice the time - usually it takes longer. This puts event loops tested with a higher number of watchers at a disadvantage. To put the range of results into perspective, consider that on the benchmark machine, handling an event takes roughly 1600 CPU cycles with EV, 3100 CPU cycles with AnyEvent's pure perl loop and almost 3000000 CPU cycles with POE. "EV" is the sole leader regarding speed and memory use, which are both maximal/minimal, respectively. When using the AE API there is zero overhead (when going through the AnyEvent API create is about 5-6 times slower, with other times being equal, so still uses far less memory than any other event loop and is still faster than Event natively). The pure perl implementation is hit in a few sweet spots (both the constant timeout and the use of a single fd hit optimisations in the perl interpreter and the backend itself). Nevertheless this shows that it adds very little overhead in itself. Like any select-based backend its performance becomes really bad with lots of file descriptors (and few of them active), of course, but this was not subject of this benchmark. The "Event" module has a relatively high setup and callback invocation cost, but overall scores in on the third place. "IO::Async" performs admirably well, about on par with "Event", even when using its pure perl backend. "Glib"'s memory usage is quite a bit higher, but it features a faster callback invocation and overall ends up in the same class as "Event". However, Glib scales extremely badly, doubling the number of watchers increases the processing time by more than a factor of four, making it completely unusable when using larger numbers of watchers (note that only a single file descriptor was used in the benchmark, so inefficiencies of "poll" do not account for this). The "Tk" adaptor works relatively well. The fact that it crashes with more than 2000 watchers is a big setback, however, as correctness takes precedence over speed. Nevertheless, its performance is surprising, as the file descriptor is dup()ed for each watcher. This shows that the dup() employed by some adaptors is not a big performance issue (it does incur a hidden memory cost inside the kernel which is not reflected in the figures above). "POE", regardless of underlying event loop (whether using its pure perl select-based backend or the Event module, the POE-EV backend couldn't be tested because it wasn't working) shows abysmal performance and memory usage with AnyEvent: Watchers use almost 30 times as much memory as EV watchers, and 10 times as much memory as Event (the high memory requirements are caused by requiring a session for each watcher). Watcher invocation speed is almost 900 times slower than with AnyEvent's pure perl implementation. The design of the POE adaptor class in AnyEvent can not really account for the performance issues, though, as session creation overhead is small compared to execution of the state machine, which is coded pretty optimally within AnyEvent::Impl::POE (and while everybody agrees that using multiple sessions is not a good approach, especially regarding memory usage, even the author of POE could not come up with a faster design). Summary * Using EV through AnyEvent is faster than any other event loop (even when used without AnyEvent), but most event loops have acceptable performance with or without AnyEvent. * The overhead AnyEvent adds is usually much smaller than the overhead of the actual event loop, only with extremely fast event loops such as EV does AnyEvent add significant overhead. * You should avoid POE like the plague if you want performance or reasonable memory usage. BENCHMARKING THE LARGE SERVER CASE This benchmark actually benchmarks the event loop itself. It works by creating a number of "servers": each server consists of a socket pair, a timeout watcher that gets reset on activity (but never fires), and an I/O watcher waiting for input on one side of the socket. Each time the socket watcher reads a byte it will write that byte to a random other "server". The effect is that there will be a lot of I/O watchers, only part of which are active at any one point (so there is a constant number of active fds for each loop iteration, but which fds these are is random). The timeout is reset each time something is read because that reflects how most timeouts work (and puts extra pressure on the event loops). In this benchmark, we use 10000 socket pairs (20000 sockets), of which 100 (1%) are active. This mirrors the activity of large servers with many connections, most of which are idle at any one point in time. Source code for this benchmark is found as eg/bench2 in the AnyEvent distribution. It uses the AE interface, which makes a real difference for the EV and Perl backends only. Explanation of the columns *sockets* is the number of sockets, and twice the number of "servers" (as each server has a read and write socket end). *create* is the time it takes to create a socket pair (which is nontrivial) and two watchers: an I/O watcher and a timeout watcher. *request*, the most important value, is the time it takes to handle a single "request", that is, reading the token from the pipe and forwarding it to another server. This includes deleting the old timeout and creating a new one that moves the timeout into the future. Results name sockets create request EV 20000 62.66 7.99 Perl 20000 68.32 32.64 IOAsync 20000 174.06 101.15 epoll IOAsync 20000 174.67 610.84 poll Event 20000 202.69 242.91 Glib 20000 557.01 1689.52 POE 20000 341.54 12086.32 uses POE::Loop::Event Discussion This benchmark *does* measure scalability and overall performance of the particular event loop. EV is again fastest. Since it is using epoll on my system, the setup time is relatively high, though. Perl surprisingly comes second. It is much faster than the C-based event loops Event and Glib. IO::Async performs very well when using its epoll backend, and still quite good compared to Glib when using its pure perl backend. Event suffers from high setup time as well (look at its code and you will understand why). Callback invocation also has a high overhead compared to the "$_->() for .."-style loop that the Perl event loop uses. Event uses select or poll in basically all documented configurations. Glib is hit hard by its quadratic behaviour w.r.t. many watchers. It clearly fails to perform with many filehandles or in busy servers. POE is still completely out of the picture, taking over 1000 times as long as EV, and over 100 times as long as the Perl implementation, even though it uses a C-based event loop in this case. Summary * The pure perl implementation performs extremely well. * Avoid Glib or POE in large projects where performance matters. BENCHMARKING SMALL SERVERS While event loops should scale (and select-based ones do not...) even to large servers, most programs we (or I :) actually write have only a few I/O watchers. In this benchmark, I use the same benchmark program as in the large server case, but it uses only eight "servers", of which three are active at any one time. This should reflect performance for a small server relatively well. The columns are identical to the previous table. Results name sockets create request EV 16 20.00 6.54 Perl 16 25.75 12.62 Event 16 81.27 35.86 Glib 16 32.63 15.48 POE 16 261.87 276.28 uses POE::Loop::Event Discussion The benchmark tries to test the performance of a typical small server. While knowing how various event loops perform is interesting, keep in mind that their overhead in this case is usually not as important, due to the small absolute number of watchers (that is, you need efficiency and speed most when you have lots of watchers, not when you only have a few of them). EV is again fastest. Perl again comes second. It is noticeably faster than the C-based event loops Event and Glib, although the difference is too small to really matter. POE also performs much better in this case, but is is still far behind the others. Summary * C-based event loops perform very well with small number of watchers, as the management overhead dominates. THE IO::Lambda BENCHMARK Recently I was told about the benchmark in the IO::Lambda manpage, which could be misinterpreted to make AnyEvent look bad. In fact, the benchmark simply compares IO::Lambda with POE, and IO::Lambda looks better (which shouldn't come as a surprise to anybody). As such, the benchmark is fine, and mostly shows that the AnyEvent backend from IO::Lambda isn't very optimal. But how would AnyEvent compare when used without the extra baggage? To explore this, I wrote the equivalent benchmark for AnyEvent. The benchmark itself creates an echo-server, and then, for 500 times, connects to the echo server, sends a line, waits for the reply, and then creates the next connection. This is a rather bad benchmark, as it doesn't test the efficiency of the framework or much non-blocking I/O, but it is a benchmark nevertheless. name runtime Lambda/select 0.330 sec + optimized 0.122 sec Lambda/AnyEvent 0.327 sec + optimized 0.138 sec Raw sockets/select 0.077 sec POE/select, components 0.662 sec POE/select, raw sockets 0.226 sec POE/select, optimized 0.404 sec AnyEvent/select/nb 0.085 sec AnyEvent/EV/nb 0.068 sec +state machine 0.134 sec The benchmark is also a bit unfair (my fault): the IO::Lambda/POE benchmarks actually make blocking connects and use 100% blocking I/O, defeating the purpose of an event-based solution. All of the newly written AnyEvent benchmarks use 100% non-blocking connects (using AnyEvent::Socket::tcp_connect and the asynchronous pure perl DNS resolver), so AnyEvent is at a disadvantage here, as non-blocking connects generally require a lot more bookkeeping and event handling than blocking connects (which involve a single syscall only). The last AnyEvent benchmark additionally uses AnyEvent::Handle, which offers similar expressive power as POE and IO::Lambda, using conventional Perl syntax. This means that both the echo server and the client are 100% non-blocking, further placing it at a disadvantage. As you can see, the AnyEvent + EV combination even beats the hand-optimised "raw sockets benchmark", while AnyEvent + its pure perl backend easily beats IO::Lambda and POE. And even the 100% non-blocking version written using the high-level (and slow :) AnyEvent::Handle abstraction beats both POE and IO::Lambda higher level ("unoptimised") abstractions by a large margin, even though it does all of DNS, tcp-connect and socket I/O in a non-blocking way. The two AnyEvent benchmarks programs can be found as eg/ae0.pl and eg/ae2.pl in the AnyEvent distribution, the remaining benchmarks are part of the IO::Lambda distribution and were used without any changes. SIGNALS AnyEvent currently installs handlers for these signals: SIGCHLD A handler for "SIGCHLD" is installed by AnyEvent's child watcher emulation for event loops that do not support them natively. Also, some event loops install a similar handler. Additionally, when AnyEvent is loaded and SIGCHLD is set to IGNORE, then AnyEvent will reset it to default, to avoid losing child exit statuses. SIGPIPE A no-op handler is installed for "SIGPIPE" when $SIG{PIPE} is "undef" when AnyEvent gets loaded. The rationale for this is that AnyEvent users usually do not really depend on SIGPIPE delivery (which is purely an optimisation for shell use, or badly-written programs), but "SIGPIPE" can cause spurious and rare program exits as a lot of people do not expect "SIGPIPE" when writing to some random socket. The rationale for installing a no-op handler as opposed to ignoring it is that this way, the handler will be restored to defaults on exec. Feel free to install your own handler, or reset it to defaults. RECOMMENDED/OPTIONAL MODULES One of AnyEvent's main goals is to be 100% Pure-Perl(tm): only perl (and its built-in modules) are required to use it. That does not mean that AnyEvent won't take advantage of some additional modules if they are installed. This section explains which additional modules will be used, and how they affect AnyEvent's operation. Async::Interrupt This slightly arcane module is used to implement fast signal handling: To my knowledge, there is no way to do completely race-free and quick signal handling in pure perl. To ensure that signals still get delivered, AnyEvent will start an interval timer to wake up perl (and catch the signals) with some delay (default is 10 seconds, look for $AnyEvent::MAX_SIGNAL_LATENCY). If this module is available, then it will be used to implement signal catching, which means that signals will not be delayed, and the event loop will not be interrupted regularly, which is more efficient (and good for battery life on laptops). This affects not just the pure-perl event loop, but also other event loops that have no signal handling on their own (e.g. Glib, Tk, Qt). Some event loops (POE, Event, Event::Lib) offer signal watchers natively, and either employ their own workarounds (POE) or use AnyEvent's workaround (using $AnyEvent::MAX_SIGNAL_LATENCY). Installing Async::Interrupt does nothing for those backends. EV This module isn't really "optional", as it is simply one of the backend event loops that AnyEvent can use. However, it is simply the best event loop available in terms of features, speed and stability: It supports the AnyEvent API optimally, implements all the watcher types in XS, does automatic timer adjustments even when no monotonic clock is available, can take avdantage of advanced kernel interfaces such as "epoll" and "kqueue", and is the fastest backend *by far*. You can even embed Glib/Gtk2 in it (or vice versa, see EV::Glib and Glib::EV). If you only use backends that rely on another event loop (e.g. "Tk"), then this module will do nothing for you. Guard The guard module, when used, will be used to implement "AnyEvent::Util::guard". This speeds up guards considerably (and uses a lot less memory), but otherwise doesn't affect guard operation much. It is purely used for performance. JSON and JSON::XS One of these modules is required when you want to read or write JSON data via AnyEvent::Handle. JSON is also written in pure-perl, but can take advantage of the ultra-high-speed JSON::XS module when it is installed. Net::SSLeay Implementing TLS/SSL in Perl is certainly interesting, but not very worthwhile: If this module is installed, then AnyEvent::Handle (with the help of AnyEvent::TLS), gains the ability to do TLS/SSL. Time::HiRes This module is part of perl since release 5.008. It will be used when the chosen event library does not come with a timing source of its own. The pure-perl event loop (AnyEvent::Loop) will additionally load it to try to use a monotonic clock for timing stability. AnyEvent::AIO (and IO::AIO) The default implementation of AnyEvent::IO is to do I/O synchronously, stopping programs while they access the disk, which is fine for a lot of programs. Installing AnyEvent::AIO (and its IO::AIO dependency) makes it switch to a true asynchronous implementation, so event processing can continue even while waiting for disk I/O. FORK Most event libraries are not fork-safe. The ones who are usually are because they rely on inefficient but fork-safe "select" or "poll" calls - higher performance APIs such as BSD's kqueue or the dreaded Linux epoll are usually badly thought-out hacks that are incompatible with fork in one way or another. Only EV is fully fork-aware and ensures that you continue event-processing in both parent and child (or both, if you know what you are doing). This means that, in general, you cannot fork and do event processing in the child if the event library was initialised before the fork (which usually happens when the first AnyEvent watcher is created, or the library is loaded). If you have to fork, you must either do so *before* creating your first watcher OR you must not use AnyEvent at all in the child OR you must do something completely out of the scope of AnyEvent (see below). The problem of doing event processing in the parent *and* the child is much more complicated: even for backends that *are* fork-aware or fork-safe, their behaviour is not usually what you want: fork clones all watchers, that means all timers, I/O watchers etc. are active in both parent and child, which is almost never what you want. Using "exec" to start worker children from some kind of manage prrocess is usually preferred, because it is much easier and cleaner, at the expense of having to have another binary. In addition to logical problems with fork, there are also implementation problems. For example, on POSIX systems, you cannot fork at all in Perl code if a thread (I am talking of pthreads here) was ever created in the process, and this is just the tip of the iceberg. In general, using fork from Perl is difficult, and attempting to use fork without an exec to implement some kind of parallel processing is almost certainly doomed. To safely fork and exec, you should use a module such as Proc::FastSpawn that let's you safely fork and exec new processes. If you want to do multiprocessing using processes, you can look at the AnyEvent::Fork module (and some related modules such as AnyEvent::Fork::RPC, AnyEvent::Fork::Pool and AnyEvent::Fork::Remote). This module allows you to safely create subprocesses without any limitations - you can use X11 toolkits or AnyEvent in the children created by AnyEvent::Fork safely and without any special precautions. SECURITY CONSIDERATIONS AnyEvent can be forced to load any event model via $ENV{PERL_ANYEVENT_MODEL}. While this cannot (to my knowledge) be used to execute arbitrary code or directly gain access, it can easily be used to make the program hang or malfunction in subtle ways, as AnyEvent watchers will not be active when the program uses a different event model than specified in the variable. You can make AnyEvent completely ignore this variable by deleting it before the first watcher gets created, e.g. with a "BEGIN" block: BEGIN { delete $ENV{PERL_ANYEVENT_MODEL} } use AnyEvent; Similar considerations apply to $ENV{PERL_ANYEVENT_VERBOSE}, as that can be used to probe what backend is used and gain other information (which is probably even less useful to an attacker than PERL_ANYEVENT_MODEL), and $ENV{PERL_ANYEVENT_STRICT}. Note that AnyEvent will remove *all* environment variables starting with "PERL_ANYEVENT_" from %ENV when it is loaded while taint mode is enabled. BUGS Perl 5.8 has numerous memleaks that sometimes hit this module and are hard to work around. If you suffer from memleaks, first upgrade to Perl 5.10 and check wether the leaks still show up. (Perl 5.10.0 has other annoying memleaks, such as leaking on "map" and "grep" but it is usually not as pronounced). SEE ALSO Tutorial/Introduction: AnyEvent::Intro. FAQ: AnyEvent::FAQ. Utility functions: AnyEvent::Util (misc. grab-bag), AnyEvent::Log (simply logging). Development/Debugging: AnyEvent::Strict (stricter checking), AnyEvent::Debug (interactive shell, watcher tracing). Supported event modules: AnyEvent::Loop, EV, EV::Glib, Glib::EV, Event, Glib::Event, Glib, Tk, Event::Lib, Qt, POE, FLTK, Cocoa::EventLoop, UV. Implementations: AnyEvent::Impl::EV, AnyEvent::Impl::Event, AnyEvent::Impl::Glib, AnyEvent::Impl::Tk, AnyEvent::Impl::Perl, AnyEvent::Impl::EventLib, AnyEvent::Impl::Qt, AnyEvent::Impl::POE, AnyEvent::Impl::IOAsync, AnyEvent::Impl::Irssi, AnyEvent::Impl::FLTK, AnyEvent::Impl::Cocoa, AnyEvent::Impl::UV. Non-blocking handles, pipes, stream sockets, TCP clients and servers: AnyEvent::Handle, AnyEvent::Socket, AnyEvent::TLS. Asynchronous File I/O: AnyEvent::IO. Asynchronous DNS: AnyEvent::DNS. Thread support: Coro, Coro::AnyEvent, Coro::EV, Coro::Event. Nontrivial usage examples: AnyEvent::GPSD, AnyEvent::IRC, AnyEvent::HTTP. AUTHOR Marc Lehmann http://anyevent.schmorp.de AnyEvent-7.17/Makefile.PL0000644000000000000000000001030213050322773013647 0ustar rootrootuse ExtUtils::MakeMaker; # AnyEvent perl event loop seems to work with 5.6, other modules not eval 'use Canary::Stability AnyEvent => 1, 5.008001'; print < { PREOP => 'pod2text lib/AnyEvent.pm | tee README >$(DISTVNAME)/README; chmod -R u=rwX,go=rX . ;', COMPRESS => 'gzip -9v', SUFFIX => '.gz', }, test => { TESTS => "t/*.t t/handle/*.t" }, NAME => "AnyEvent", VERSION_FROM => "lib/AnyEvent.pm", PMLIBDIRS => ["lib"], # PREREQ_PM => { # Task::Weaken => 0, # }, CONFIGURE_REQUIRES => { "ExtUtils::MakeMaker" => 6.52, "Canary::Stability" => 0 }, META_MERGE => { recommends => { "Task::Weaken" => 0, "Net::SSLeay" => 1.33, "JSON" => 2.09, "JSON::XS" => 2.2, "EV" => 4.00, "Guard" => 1.02, "Async::Interrupt" => 1.0, } }, PM => { 'lib/AE.pm' => '$(INST_LIB)/AE.pm', 'lib/AnyEvent.pm' => '$(INST_LIB)/AnyEvent.pm', 'lib/AnyEvent/DNS.pm' => '$(INST_LIB)/AnyEvent/DNS.pm', 'lib/AnyEvent/Debug.pm' => '$(INST_LIB)/AnyEvent/Debug.pm', 'lib/AnyEvent/FAQ.pod' => '$(INST_LIB)/AnyEvent/FAQ.pod', 'lib/AnyEvent/Handle.pm' => '$(INST_LIB)/AnyEvent/Handle.pm', 'lib/AnyEvent/Impl/Cocoa.pm' => '$(INST_LIB)/AnyEvent/Impl/Cocoa.pm', 'lib/AnyEvent/Impl/EV.pm' => '$(INST_LIB)/AnyEvent/Impl/EV.pm', 'lib/AnyEvent/Impl/Event.pm' => '$(INST_LIB)/AnyEvent/Impl/Event.pm', 'lib/AnyEvent/Impl/EventLib.pm' => '$(INST_LIB)/AnyEvent/Impl/EventLib.pm', 'lib/AnyEvent/Impl/FLTK.pm' => '$(INST_LIB)/AnyEvent/Impl/FLTK.pm', 'lib/AnyEvent/Impl/Glib.pm' => '$(INST_LIB)/AnyEvent/Impl/Glib.pm', 'lib/AnyEvent/Impl/IOAsync.pm' => '$(INST_LIB)/AnyEvent/Impl/IOAsync.pm', 'lib/AnyEvent/Impl/Irssi.pm' => '$(INST_LIB)/AnyEvent/Impl/Irssi.pm', 'lib/AnyEvent/Impl/POE.pm' => '$(INST_LIB)/AnyEvent/Impl/POE.pm', 'lib/AnyEvent/Impl/Perl.pm' => '$(INST_LIB)/AnyEvent/Impl/Perl.pm', 'lib/AnyEvent/Impl/Qt.pm' => '$(INST_LIB)/AnyEvent/Impl/Qt.pm', 'lib/AnyEvent/Impl/Tk.pm' => '$(INST_LIB)/AnyEvent/Impl/Tk.pm', 'lib/AnyEvent/Impl/UV.pm' => '$(INST_LIB)/AnyEvent/Impl/UV.pm', 'lib/AnyEvent/IO.pm' => '$(INST_LIB)/AnyEvent/IO.pm', 'lib/AnyEvent/IO/IOAIO.pm' => '$(INST_LIB)/AnyEvent/IO/IOAIO.pm', 'lib/AnyEvent/IO/Perl.pm' => '$(INST_LIB)/AnyEvent/IO/Perl.pm', 'lib/AnyEvent/Intro.pod' => '$(INST_LIB)/AnyEvent/Intro.pod', 'lib/AnyEvent/Log.pm' => '$(INST_LIB)/AnyEvent/Log.pm', 'lib/AnyEvent/Loop.pm' => '$(INST_LIB)/AnyEvent/Loop.pm', 'lib/AnyEvent/Socket.pm' => '$(INST_LIB)/AnyEvent/Socket.pm', 'lib/AnyEvent/Strict.pm' => '$(INST_LIB)/AnyEvent/Strict.pm', 'lib/AnyEvent/TLS.pm' => '$(INST_LIB)/AnyEvent/TLS.pm', 'lib/AnyEvent/Util.pm' => '$(INST_LIB)/AnyEvent/Util.pm', 'lib/AnyEvent/Util/idna.pl' => '$(INST_LIB)/AnyEvent/Util/idna.pl', 'lib/AnyEvent/Util/uts46data.pl' => '$(INST_LIB)/AnyEvent/Util/uts46data.pl', 'lib/AnyEvent/constants.pl' => '$(INST_ARCHLIB)/AnyEvent/constants.pl', }, ); AnyEvent-7.17/Changes0000644000000000000000000020727713540301265013210 0ustar rootrootRevision history for Perl extension AnyEvent. TODO: document TCP_*** constants TODO: add debug/trace logging to some modules TODO: use the eval-with-cb-call trick also to speed up JSON? TODO: FAQ: common pitfalls? invoke-before-return TODO: FAQ: scope-ids? hosts file order? TODO: AnyEvent::Handle with AnyEvent::IO? TODO: invalid. and localhost. specialcasing inside AEDNS and not AESocket (rfc6761) TODO: maybe implement env variable to give hosts precedence TODO: more formats for parse_ipv6 (single ipv6 address without port, ...p80, ...#80) TODO: inet_aton maybe pack C4? no, add a comment why not TODO: socket prepare callbacks, can they easily signal failure as well? TODO: Олег Г , empty A record response causes AnyEvent::resolve_sockaddr to eventually call pack_sockaddr with undef - broken dns server, but maybe improve the response. 7.17 Wed Sep 18 03:04:49 CEST 2019 - work around antique openssl version in RHEL 7 by formatting dh parameters differently (reported by several people). - add t/13_weaken.t. 7.16 Fri Jul 19 18:00:21 CEST 2019 - add ffdhe group dh parameters from RFC 7919, and use ffdhe3072 as new default, instead of schmorp1539. - AnyEvent::Log did not reassess logging status of AnyEvent::Log::logger's when contexts were changed with ->attach/detach/slaves, causing them to not log even though a recent attach should have caused them to log. - added some more logging configuration examples. - mention RFC 8482 in AnyEvent::DNS. 7.15 Tue Feb 26 03:07:42 CET 2019 - INCOMPATIBLE CHANGE: AnyEvent::Handle's tls_detect documentation gave separate major and minor versions, while code passed only a single value. This version follows the documentation and now passes separate major and minor values. - work around Net::SSLeay not having been ported to openssl 1.1, but many distributions compiling it against openssl 1.1, which unfortunately succeeds and results in a very broken module. - AnyEvent::DNS::dns_unpack now stores the original DNS packet in the __ member, to allow decoding of undecodable resouce records containing compressed domian names. - AnyEvent::Socket::parse_ipv6 would NOT, as advertised, accept ipv4 addresses. It now does and converts them to ipv4 mapped addresses. - support CAA records, based on patch by Steve Atkins. - add freenom and cloudflare nameservers as dns fallback. - AnyEvent::Strict would not properly ward against io watchers on files when the handle passed was a file descriptor. - document "internal" variables used by the dns en-/decoder to allow enterprising users to extend them in a semi-official way. 7.14 Sat Jun 24 01:44:19 CEST 2017 - fix a crash bug in AnyEvent::Handle with openssl 1.1.0 (patched by Paul Howarth and apparently tracked down by Mike McCauley). - AnyEvent::Handle->keepalive was documented (and defined) twice (found by Matt Merhar). - AnyEvent::Socket::tcp_bind/tcp_server would immediately unlink a unix listening socket unless a guard is used. Change this so that no cleanup will be performed unless a guard is used and document this more clearly. - make tcp_bind/tcp_server error messages more regular. - work around latest perl upstream breakage - this time, perl5porters were apparently bullied by a bogus CVE (CVE-2016-1238), and since distros stupidly apply anything that has "security fix" stamped on it, it's likely going to be a problem in practise (and working around it is trivial on windows and unix). - add TCP_FASTOPEN/MSG_FASTOPEN and MSG_NOSIGNAL/MSG_MORE/MSG_DONTWAIT to constants. - update warnings to common::sense 3.74 standards. 7.13 Sat Sep 17 04:31:49 CEST 2016 - Only call tlsext_host_name for non-empty common names (reported by Maxime Soulé). - log a (single) notice message if SNI is not supported. - upgrade to UTS-46:9.0.0 draft and switch to non-transitional behaviour, beating thunderbird, ie, edge, chrome and safari to it :) (see also https://bugzilla.mozilla.org/show_bug.cgi?id=1218179) - turns out the UTS-46 IDNA testcase failures were indeed bugs in the testcases and the specification and not in the code - the post-9.0.0 unicode files have all known problems fixed, so finally the AnyEvent IDNA implementation can pass the full IDNA testsuite - without needing a single fix :) - guarantee (and document) that condvar callbacks will be removed on invocation - important to avoid circular references. 7.12 Wed Jan 27 19:12:26 CET 2016 - use common name as hostname for tls connects, if Net::SSLeay supports SNI. - fix documentation of tls_autostart read type in AnyEvent::Handle, analyzed by Felix Ostmann. 7.11 Thu Jul 16 14:36:00 CEST 2015 - AnyEvent::Socket::parse_ipv6 could accept malformed ipv6 addresses (extra "::" at end and similar cases). - add a more explicit warning to AnyEvent::Handle that it doesn't work on files, people keep getting confused. - new function AnyEvent::Socket::tcp_bind. - new functions AnyEvent::fh_block and AnyEvent::fh_unblock. - aligned ipv6 address formatting with RFC 5952 (by not shortening a single :0: to ::). - added stability canary support. 7.09 Sat May 2 16:38:53 CEST 2015 - AnyEvent::Debug called an internal function (AnyEvent::Log::ft) that was renamed to AnyEvent::Log:format_time. uinder its old name (analyzed by Michael Stovenour). - update AnyEvent::DNS fallback resolver addresses: seems google effectively killed most other free dns resolvers, so remove them, but add cable and wireless (ecrc) since it was stable for 20 years or so, official or not, and there should be an alternative to google. - perl5porters broke windows error codes in 5.20, and mapped WSAEWOULDBLOCK on the (different) EWOULDBLOCK error code, and WSAEINPROGRESS into the incompatible ERINPROGRESS code, probably because they were so cool. They probably broke other error codes for no reason, too, but I didn't care for checking, it's too depressing. This version only works around the WSAEWOULDBLOCK issue, because I don't have a nice way to work around the WSAEINPROGRESS bug. 7.08 Wed Dec 10 05:27:17 CET 2014 - work around a newly introduced bug in Socket 2.011 (an errornous sun_length check) (analyzed by Maxime Soulé). - AnyEvent::TLS didn't load (but refer to) AnyEvent::Socket (analyzed by Ben Magistro). - AnyEvent::Strict will now confess, not croak. This is in line with it being a development/debugging tool. - work around a number of libglib bugs (debug builds of libglib enforce certain undocumented behaviour patterns such as not being able to remove a child watch source after it has fired, which we will try to emulate to avoid "criticals". what where they thinking...). - mention json security issues in AnyEvent::Handle, now that Douglas Crockford has foolishly and incompatibly changed JSON. - changed default dns resolver "max_outstanding" value from 1 to 10, the latter beinfg the intended value all along (reported by Ilya Chesnokov). - added new "AnyEvent::Impl::UV" interface module to the UV event lib (written by Mike Lowell). 7.07 Tue Dec 17 17:45:02 CET 2013 - the documentation for custom tls verify schemes was wrong. make it agree with the code (reported by Maxime Soulé). - added cbor read and write types to AnyEvent::Handle (using CBOR::XS). - work around an API change in openssl that could cause wrong tls connection aborts, likely on windows only (analyzed by sten). - calling AnyEvent->now_update with AnyEvent::Impl::Perl caused an endless loop (reported by Dietrich Rebmann). - add tlsv1_1 and tlsv1_2 protocols to AnyEvent::TLS (patch by Maxime Soulé). - document AnyEvent::Impl::IOAsync::set_loop and $AnyEvent::Impl::IOAsync::LOOP. Though only documented now, this functionality has _always_ been available. - force a toplevel domain name in t/81_hosts.t (analyzed by David Jack Wange Olrik). - document that AnyEvent::Log uses AnyEvent::IO. - warn about AnyEvent::Filesys::Notify performance. - praise the joys of AnyEvent::Fork::*. - time for an =encoding directive. - do no longer use JSON to create a default json coder, use JSON::XS or JSON::PP directly. 7.05 Wed Aug 21 10:38:08 CEST 2013 - uts46data.pl couldn't be found due to wrong naming of the file (reported by Fulko Hew). - handle lone \015's properly in AE::Handle's default line read (reported by various people). - untaint ip addresses found in /etc/hosts (patch by José Micó). - the memleak fix in 7.03 caused resolving via /etc/hosts to always fail on first use (reported and testcase by Andrew Whatson). - expose AnyEvent::Log::format_time, and allow users to redefine it. - expose AnyEvent::Log::default_format, and allow redefinition. - expose AnyEvent::Log::fatal_exit, to allow redefinition. - AnyEvent::Debug shell can now run coro shell commands, if available. - t/63* tests were wrongly in MANIFEST. - kernel.org's finger server went MIA, switch to freebsd.org and icculus.org. - clarify that IO::AIO and AnyEvent::AIO are needed for AnyEvent::IO to function asynchronously (reported by Daniel Carosone). - hard-disable $^W in most tests, it generates too much garbage output. - use a (hopefully) more future-proof method to emulate common::sense. - upgrade to UTS-46:6.2.0. - switch to INSTLIB from INSTLIBDIR, as INSTLIBDIR was wrongly documented. should not affect anything. 7.04 Thu Nov 15 02:23:58 CET 2012 - debugging code left in. 7.03 Thu Nov 15 02:16:11 CET 2012 - AnyEvent::Socket::inet_aton did not work when dns resolution was used to find the addresses (analyzed and patch by Maxime Soulé). - fix a memory leak in the /etc/hosts lookup code when hosts don't resolve and are not in hosts (analyzed by sten). 7.02 Tue Aug 14 04:27:58 CEST 2012 - AnyEvent::Util::run_cmd could block indefinitely (analyzed and test program by Yorhel). - verified that AnyEvent::Socket follows RFC5952. - try to parse "ADDR#PORT" in addition to "ADDR PORT". 7.01 Sun May 13 01:03:17 CEST 2012 - fail with EPROTO in AnyEvent::Handle wqhen TLS is requested but not available, instead of throwing an exception. - use File::Spec to get the tmpdir in t/*, to avoid needless failures on (most, not mine :) windows boxes. - new handle read types: tls_detect and tls_autostart. 7.0 Fri Apr 13 06:33:30 CEST 2012 - child watchers are broken in POE 1.352 (also many earlier versions) and there seems to be no way to work around it, as POE itself is inherently racy. Document this regression and add a delay in t/68_poe_03_child.t for the time being. - new module AnyEvent::IO, that is a frontend to either a pure-perl synchronous I/O implementation (AnyEvent::IO::Perl), or to the asynchronous I/O extension IO::AIO (AnyEvent::IO::IOAIO). - load /etc/hosts only when DNS has no answer. - stat /etc/hosts on every access and reload it if it changed. - load /etc/hosts via AnyEvent::IO - potentially asynchronous. - fix a buggy croak in the dh parameter reading in AnyEvent::TLS. - AnyEvent::Log log_to_file and log_to_path now use AnyEvent::IO. As a side effect, they now use true appending as opposed to libc appending, and the file might not have been opened when the function returns. - the default logging level was not properly documented in a variety of places, this has hopefully been rectified. - updated uts46data.pl for unicode 6.1.0. - made log messages generated by AnyEvent submodules not include the package name anymore, as it will be logged by default already. - upgrade to the trick used by common-sense 3.5 to work around extra warning torture/breakage under perl 5.15.x. - log messages by anyevent are now ucfirst, are usually full sentences and do no longer include the package name. - the storable read type would sometimes throw an exception instead of causing EBADMSG (analyzed by Maxime Soulé). - work around a bug in openssl 1.0.1 which enforces a minimum rsa keysize (reported by Paul Howarth). - documented Rocco fabricating statements about AnyEvent and me. 6.14 Tue Jan 31 20:00:24 CET 2012 - AnyEvent::Impl::Tk was broken due to a mysterious "die" inside, probably an editing mistake (reported by Darin McBride). 6.13 Thu Jan 12 07:27:01 CET 2012 - AnyEvent::Util::fork_call checked for POSIX availability in the wrong way, causing it to fail if POSIX wasn't loaded already (analysed by Rock Power). - AnyEvent::Handle::push_read (line => did pass $1 directly, so regex-matching inside the callback would change the parameter, despite $1 being dynamically scoped per-block. this perl bug is now being worked around (testcase by Cindy Wang). 6.12 Mon Dec 12 13:21:10 CET 2011 - $! was clobbered by subsequent calls in tcp_connect, due to the postpone not saving/restoring it (analyzed by Richard Garnish). 6.11 Tue Nov 22 10:36:05 CET 2011 - Tk cannot create windows when tainted unless you set a title, so set a dummy title for AnyEvent's dummy mainwindow. How dummy. - escape any nonprintable/nonascii characters when stringifying backtraces. - log the reason loading an interface module fails to load at level debug. 6.1 Tue Oct 4 19:44:30 CEST 2011 - INCOMPATIBLE CHANGE: the default log level is now "4" (error and above), and some messages inside AnyEvent have been elevated to higher log levels to print by default. - AnyEvent::log, unlike AnyEvent::Log::log, did not always exit on fatal. - work around yet another signal race bug, newly introduced by POE. My how that module sucks. - add google public ipv6 dns as fallback servers, so AE::DNS can finally support ipv6-only operation even with defaults (also use ::1 instead of 127.0.0.1). - give better guidelines on how to chose a logging level. - AnyEvent::Log can now cap (limit) log message priority by context. - AE::log will now save and restore $! and $@, so callers don't have to. - AE::Strict now checks that registered fds are still valid at regular intervals. - skip frequently called 'require' calls if the module appears loaded. - increase signal latency test timer considerably for poor little osx, which can't be bothered with basic posix functionality such as signal delivery. - mention some debugging aids in the tutorial. - new env variable PERL_ANYEVENT_MAX_SIGNAL_LATENCY. - private (%namespace) log contexts in PERL_ANYEVENT_LOG now have the name of the context as title. - AnyEvent::Strict would not restore read-write access to $_ when a callback died - this is a user bug, but since AE::Strict exists to help dbeugging... - detect the extremely evil IO::Async::Loop::AnyEvent module and refuse to work with it - the author is well aware of the issues but refuses to fix them. This extreme step has been taken because the module actively attacks the goals of AnyEvent and makes it harder for module authors to use AnyEvent. 6.02 Fri Aug 26 20:08:31 CEST 2011 - log_to_syslog now accepts facility strings. - log_to_syslog would not allow facilities - "$facility|$level" *literally* means that string. sheesh. - the CPAN parser got confused and thought we provide Sys::Syslog, try to work around. - renamed AnyEvent::Impl::FLTK2 to FLTK. 6.01 Fri Aug 26 07:04:11 CEST 2011 - INCOMPATIBLE CHANGE: AnyEvent::DNS resource records now include the TTL as fourth element - this affects ->resolve, ->request and ->dns_unpack indirectly. Convenience functions such as AnyEvent::DNS::{a,txt,mx,srv} are not affected, neither is AnyEvent::Socket. - INCOMPATIBLE CHANGE: backend authors now should not implement one_event or loop, but instead the AnyEvent::CondVar::_wait and _poll methods. - INCOMPATIBLE CHANGE: verbosity levels have been redefined, see AnyEvent (PERL_ANYEVENT_VERBOSE) and AnyEvent::Log for details. - DEPRECIATION: please change "use AnyEvent::Impl::Perl" to "use AnyEvent::Loop" and "AnyEvent::Impl::Perl::loop" to "AnyEvent::Loop::run" in your programs, for future compatibility. - *blush* idle watcher emulation was borked. - AnyEvent::Strict now checks the AE::xxx functions as well. - querying too long domain names would barf deep inside AnyEvent::DNS - since this is hard to avoid for applications, AnyEvent:.DNS::request now checks for for too long domain names explicitly and passes an undef to the callback instead (reported by James Bromberger). - make AnyEvent::Util more robust against EINTR (analyzed by Andrew Suffield). - new functions: AnyEvent::postpone, AnyEvent::log. - new module: AnyEvent::Log, for simple logging needs. - new env variable, PERL_ANYEVENT_LOG, for fine-grained logging config. - new env variable, PERL_ANYEVENT_DEBUG_SHELL, to automatically start a debug shell. - new env variable, PERL_ANYEVENT_DEBUG_WRAP, to automatically enable watcher instrumentation/wrapping (see AnyEvent::Debug::wrap). - new env variable, PERL_ANYEVENT_HOSTS, to override the place where /etc/hosts can be found. - an empty PERL_ANYEVENT_RESOLV_CONF now selects the default configuration. - env variables can now be specified using AE_xyz instead of PERL_ANYEVENT_xyz, subject to some rules. - lots of new AnyEvent::Debug functionality. - AnyEvent::Strict now checks for modifications of $_ by the callback (by setting it to readonly while executing the callback, if possible). - IO::Async sometimes cancels the wrong timer when you call cancel_timer. Invest extra overhead to work around this peculiar behaviour. - split the pure perl backend into a loop module and an impl module (AnyEvent::Loop and AnyEvent::Impl::Perl). - some read types (regex, netstring, json, storable) could errornously keep an AE::Handle object alive on their own (reported by Mohammad Toossi). - AnyEvent::Socket::resolve_sockaddr and all functions using it now supports /etc/hosts overrides. - add more workarounds around child watcher bugs in IO::Async and (newly introduced) in POE. - use glib child watchers and try to work around its limitations, if possible (based on a patch by Kevin Ryde). - add support for FLTK (fltk2), via AnyEvent::Impl::FLTK2. - many read types in AnyEvent::Handle would malfunction during transitions to TLS because of a "delete $self->{rbuf}". (reported by Gerald Galster). - improve condvar blocking wait performance (probably only noticable with faster backends), also make it easier for event loops that do not support blocking waits. - PERL_ANYEVENT_MODEL now also allows full module names, although the usefulness of this feature is not yet clear. - add tests for all supported event loops, conditional on PERL_ANYEVENT_LOOP_TESTS. - add t/80_ssltext.t. - no longer use AUTOLOAD for the initial loading (for no very good reason). - tcp_server now tries to unlink unix domain sockets when it gets destroyed. - do not run event loop detection multiple times when programs call their cached copies of AnyEvent::detect. - parse_hostport now accepts absolute paths als unix domain sockets. - suppress the idiotic warning inside POE by patching the POE::Kernel run flags instead of asking the user to jump through contortions. - add Task::Weaken as dependency (as recommends only at this time). - replace PF_UNSPEC by 0, for good old minix. 6.0 (not officially released, but was on CPAN for about 15 minutes :/) 5.34 Thu May 12 09:59:41 CEST 2011 - AE::TLS didn't support both cert_file and key at the same time, due to some copy&paste bug (reported and analyzed by vti). - improve AE::Handle timeout documentation slightly. 5.33 Mon Feb 7 21:51:41 CET 2011 - never appeared on CPAN, for unknown reasons. - AnyEvent::Handle on_connect_error - do not try to destroy a handle object when it's already gone (analyzed by Ryan Bullock). - update idna algorithm(s) to UTS#46 version 6.0.0. - preserve trailing dot in idn_to_ascii - testsuite says to preserve, uts46 says it's an error, and testsuite makes more sense. - remove leading dots in idn_to_ascii - testsuite says to remove, uts46 says it's an error, and testsuite makes more sense. - fixed a bug in idn ignored character processing. - passes the uts46 6.0.0 testsuite except for three cases which apparently are bugs in the testsuite itself. - passes the uts46 6.0.1 testsuite except for eleven cases which apparently are bugs in the testsuite itself. 5.31 Sun Jan 23 11:49:19 CET 2011 - work around a POE bug where POE would first poll for new events and invoke handlers BEFORE handling the message queue. - fix parsing of "domain" statement in resolv.conf (Johannes Plunien). - stop_read now does just that in TLS mode. see its documentation for caveats. - update to common::sense 3.4 warning set (some warnings in perl impose an arbitrary 32kb limit on regex matches, which affects AnyEvent::Handle). - AE::Handle had a broken rbuf_max method and missing wbuf_max method. - new experimental AE::Handle::resettls method. 5.3 Fri Dec 31 05:48:13 CET 2010 - major IOAsync patch by Paul Evans - 0.33 is required, as the major issues with IO::Async have been solved in that version, including the availabilty of a default loop! - implement new wbuf_max parameter for AnyEvent::Handle. - added Cocoa::EventLoop backend by Daisuke Murase. - the default testsuite now honors PERL_ANYEVENT_MODEL (Paul Evans). - clarify handle on_prepare documentation. - set CLOEXEC flag on parent-side fd's in AnyEvent::Util::run_cmd, to avoid leaking them to any child processes. - try to force files into the arch-dependend lib directory, for the half-"turly obsessive compulsive person"(s) that depend on it. 5.29 Sun Dec 5 10:49:21 CET 2010 - convert EV backend to EV 4.00 API (so better upgrade EV too). - AE::Handle: implement dynamic read_size adjustment, add max_read_size parameter, reduce default read_size to 2048. - add some FAQ entries for servers and/or on_eof vs. on_error. - work around OS bugs (cygwin again) when lingering in AE::Handle. - reduce memory usage slightly when connect was used in AE::Handle. - wrok around more segfaults in Tk. - document tls_ctx => undef as valid. - detect WNOHANG value at compiletime. - include some probably linux-only support for building AnyEvent as part of the perl core. - improve compatibility of t/08_idna.t to perl 5.8. - make AnyEvent::Strict truly optional (in case somebody builds a minimal perl...). 5.28 Wed Oct 13 04:14:23 CEST 2010 - due to a glitch, AnyEvent's internal getprotobyname wasn't actually used in tcp_server. - implement AnyEvent::CondVar->new method, which was documented but missing. - support autoloading of read types in unshift_read. - AnyEvent::Strict: do the test for invalid fh arguments differently, resulting in more informative error messages. - new AnyEvent::FAQ manpage. - clarify that you can actually call push_read etc. in on_read. - put keys and certs in /tmp, not into the current directory, and document this in the SECURITY CONSIDERATIONS sections of AnyEvent::TLS. - support ";" as resolv.conf comment character in AnyEvent::DNS, as requested by Ron Isaacson. - document $AnyEvent::DNS::RESOLVER variable. - incorporated major typo patches by Abhijit Menon-Sen. - AnyEvent::Handle now croaks when negative timeouts are passed. - add a shitload of TCP_xxx sockopt name constants to AnyEvent::Util, undocumented, but who knows when they might come in handy. 5.271 Tue Jun 8 12:05:46 CEST 2010 - backport to perl 5.8.x. 5.27 Sun Jun 6 12:12:05 CEST 2010 - postpone differently in AnyEvent::Socket now, as when not, canceling the connection attempt might fail (found by Felix Antonius Wilhelm Ostmann). - explicitly check for non-stream sockets in AE::Handle, too many clueless people fell into the trap of this somehow working. - simplified and reworked the "OTHER MODULES" section. - better/more condvar examples. 5.261 Wed Apr 28 16:13:36 CEST 2010 - AF_INET6 was not properly used from Socket6 during configuration time (found by Andy Grundman). 5.26 Mon Apr 12 04:49:35 CEST 2010 - don't generate spurious readyness notifications when select returns EINTR in the pure perl backend (analysed and testcase by Bas Denissen). - give same examples in SYNOPSIS sections of AnyEvent and AE. - provider faster implementations for AE::time/now/now_update for EV and Perl backends. - provide faster AE::cv and AE::time implementations for all backends. - no longer support lower/mixed-case signal names (this was never documented nor universally supported). - some more memory µ-optimisations, and somewhat less messy code to cope with both AnyEvent and AE APIs. 5.251 Sat Mar 13 00:58:21 CET 2010 - make test failed if it was run before make install on perl <= 5.8.8, and older versions of perl make our live very difficult, so write constants.pl during Makefile.PL time. 5.25 Sat Mar 13 00:23:14 CET 2010 - fix a race condition in AnyEvent::Handle that would cause a "bio_read: unsupported method" error (in _another_ ssl connection) after user code threw an exception. - added AnyEvent::Handle->destroyed method. - speed up AnyEvent::Socket::format_address and ::format_ipv6. - the AnyEvent::Util::fh_nonblocking function worked only by lucky accident on win32. - smaller and faster AnyEvent::Util::fh_nonblocking. - when the (required!) Time::HiRes module is missing, AnyEvent did not fall back to built-in time properly. - do not load Fcntl at runtime, saving memory and loading time. - precompile a number of constants and use them instead of runtime detection and eval. - free detection code after detection and similar memory optimisations. - Perl backend timer interval best effort drift has been improved (same algorithm as EV). - update unicode idna mapping table. 5.24 Tue Jan 5 11:39:43 CET 2010 - cygwin never reports errors from failed connects. 1.5 just gives you continous readyness and EAGAIN, 1.7 is even more broken and just hangs. work around both issues in a cygwin-specific hack. - improve idle watcher documentation slightly. 5.23 Sun Dec 20 23:48:00 CET 2009 - support IDNs in resolve_sockaddr, and therefore in tcp_connect. - implement punycode_encode/decode, idn_nameprep, idn_to_ascii and idn_to_unicode operations in AnyEvent::Util. - provide $AE::VERSION. - removed traces of "no strict 'refs'". 5.22 Sat Dec 5 03:51:13 CET 2009 - downgrade-or-fail in AnyEvent::Handle::push_write, to diagnose encoding failures earlier and more succinctly. (this works around bugs in perl, throwing away encoding info when passing scalar data to extensions). - add more examples to AnyEvent::Socket manpage. - upgrade internal warning set to the same as common::sense 2.03. - use pack "n/a*" for pre-5.8.9 perl compatibility in AnyEvent::DNS (John Beppu). - AnyEvent::Socket::inet_aton now properly supports ipv6, as documented. - add google public dns servers to fallback server set and make sure we load-balance properly between the three sets. also add all fallback dns servers, not just a random one, to each dns config. 5.21 Thu Nov 19 02:48:47 CET 2009 - fix a problem where socket constants were called with parameters (spotted by David Friedland). - fork_call never use'd POSIX (reported by Daisuke Maki). - improve perl 5.6 compatibility further (but it still won't work unless you rip out everything but the core). - prefer Net::DNS::Resolver over ipconfig, if installed, on win32. uses 10MB of RAM, but doesn't open a console window. *sigh*. 5.202 Wed Oct 14 22:35:44 CEST 2009 - AnyEvent::DNS would unexpectedly clobber $_ under windows (analysed by Matthias Waldorf). - AnyEvent::Handle::run_cmd can now pass the PID of the newly-created process, which is much less useful than it might sound (based on patch by Yann Kerherve). 5.201 Tue Sep 29 12:09:25 CEST 2009 - AnyEvent:Handle::on_starttls/on_stoptls methods were broken (reported by Torsten Foertsch). - common::sense 2.0 could cause tcp_server to throw an exception (analysed by elmex). 5.2 Mon Sep 14 07:04:49 CEST 2009 - INCOMPATIBLE CHANGE: do no longer support register_read_type and register_write_type in AnyEvent::Handle, instead support package names (the facility was mostly abused). - implement "packagename-as-read/write type" support in AnyEvent::Handle. - AnyEvent::Handle: new options "keepalive" and "oobinline". - oobinline set by default to avoid security issues. - the pure-perl event loop backend wrongly detected times() fallback support (spotted by Pavel Boldin). 5.12 Tue Sep 1 20:26:50 CEST 2009 - be more lenient when parsing resolv.conf files, as some people use hashmarks as comment indicator inside directives (reported by Michael S. Fischer). - use same set of warnings as common::sense 2.0. - fix a potential 32 bit overflow issue due to perl having problems with large hex constants in the Perl backend. - do not use the slower 5.6 version fo the enc_name code in AnyEvent::DNS by default. - fix some prototypes. - (optionally) require Async::Interrupt 1.02. - replace opendns fallbacks by verizon/level3 public dns servers. 5.112 Fri Aug 21 13:59:04 CEST 2009 - AnyEvent::Handle could cause hard crashes in Net::SSLeay when using starttls with an illegal/uncreatable tls context. - port to broken win32 perls. 5.111 Sun Aug 16 18:44:36 CEST 2009 - perl errornously requires sockaddr_un structures returned by the kernel to have a specific length. work around this bug by padding sockaddr_un structures (found to fail on OS X, as perl only uses the correct code for GNU/Linux, but likely to fail on other OSes as well). 5.11 Wed Aug 12 17:49:37 CEST 2009 - fixed a bug in run_cmd with input from filename. - create a json coder object when none is given in write direction to reduce dependency on JSON. 5.1 Tue Aug 11 03:17:32 CEST 2009 - tcp_connect now reports the correct error in $!, not an unrelated one (was broken since 4.91). - AE::Handle did not properly clear rtimeout/wtimeout watchers when retrying a tcp_connect. - new functions: AnyEvent::Util::run_cmd and close_all_fds_except. - fixed wrong documentation in AE::Socket. 5.01 Mon Aug 10 03:16:32 CEST 2009 - last release broke EV child watchers :/. 5.0 Sun Aug 9 17:32:09 CEST 2009 - officially introduce and document the AE API. - lowering the timeout at runtime did not have immediate effect in AnyEvent::Handle. - AE::Handle now has separate and independent read and write timeout settings. - probe for Guard module when AnyEvent::Util is loaded, not at runtime (Event doesn't like eval "use" from callbacks, and it avoids exporting the probe function). - Impl::IOAsync's io watchers did not use the filehandle emulation code to work around it's watcher limits. - work around IO::Async's problems with overloaded objects. - try to disable wearnings inside IO::Async, it's just too buggy. - do no longer use Event by default, only EV or Perl, Event is too buggy. - hackishly provide fast AE:: interface when EV or Perl is the backend. - inherit VERSION from AnyEvent::VERSION in most modules. 4.91 Thu Aug 6 15:42:45 CEST 2009 - AE::Handle::starttls could get out of sync when the read buffer already contains some TLS handshake. - AE::Handle did not properly free the TLS session, causing bigger memory leaks in Net::SSLeay than expected (reported by toaster). - AE::Socket::tcp_connect will now artificially delay invoking the callback to avoid returning after invoking the callback. - convert many internal watcher uses to AE API. 4.9 Sat Aug 1 11:07:01 CEST 2009 - Glib silently fails when registering a timeout with a negative value, so avoid that. - call condvar callback immediately when it is set after the condition is already signalled. - check rbuf_max condition only after trying to consume data. - normalise signal numbers to names when using the ae's signal handling, but do not document this (yet). - pure perl signal emulation did not properly set nonblocking mode on the signal pipe on win32 (this is unlikely to have caused any issues). - new module: AnyEvent::Debug. - AnyEvent::Strict now checks that a signal was specified by name (not name or number). - reduce memory footprint in typical cases by ~50kb by only compiling signal code when necessary. - add AnyEvent::Handle->rbuf_max. - grab the AE namespace for future new API, implement stubs for said future/alternative API. - new function: AnyEvent::Socket::format_hostport. 4.881 Tue Jul 28 12:51:53 CEST 2009 - work around a bug in local in pre-5.10 perls, causing AnyEvent::Handle to recurse when it should not (analysed by elmex). 4.88 Tue Jul 28 04:04:37 CEST 2009 - re-bless the handle into a dummy package after calling AnyEvent::Handle::destroy, so the user does not need to check for errors after every push_write etc. - do not attempt to run t/02_signals.t on obviously broken platforms. 4.87 Sun Jul 26 02:06:16 CEST 2009 - do not attempt to linger when there is no longer a valid fh. - enforce tls mode to be either accept or connect, do not simply segfault in Net::SSLeay. - AnyEvent::Handle can now call tcp_connect itself (new parameters connect, on_prepare, on_connect and on_connect_error). Updated tutorial accordingly. - add AnyEvent::Impl::Irssi backend. 4.86 Mon Jul 20 23:52:29 CEST 2009 - since the verbose warning is not enough, explicitly document that versions before 1.33 of Net::SSLeay are not secure. - work around signal handling races in Event and (...) Event::Lib. - try to align signal-race timer to full-second boundaries. - work around Tk not liking negative timeouts. - don't complain of different grades of environmental unfriendlyness in IO::Async. 4.85 Sat Jul 18 06:16:14 CEST 2009 - nail the signal race problem in perl once and for all (see $AnyEvent::MAX_SIGNAL_LATENCY). - take advantage of Async::Interrupt if it is available. - load Time::HiRes and Guard modules on demand only. - add optional/recommended modules section to AnyEvent documentation. - reduce memory usage considerably (and reduce startup penalty) by not using "strict", "warnings" and "overload" modules. - work around buggy windows/openbsd perls and provide EBADMSG and EPROTO ourselves when missing. - improve perl 5.6 compatibility of the core event loop. - made Net::SSLeay version 1.33 a soft requirement. 4.83 Fri Jul 17 16:56:26 CEST 2009 - implement AnyEvent::Socket::getprotobyname. - AnyEvent::CondVar's will now detect recursive blocking waits and will croak, as too many people fall into this trap. - AnyEvent::Handle will now call ->destroy on itself after executing the on_error callback, instead of doing some half-baked internal shutdown, for fatal errors. - clarify on_eof behaviour w.r.t. the read queue and on_read callbacks. - ignore some possible spurious wake-ups in tcp_connect. 4.82 Sat Jul 11 00:34:55 CEST 2009 - POE and Event backends didn't accept some callable objects as callbacks. - use Config module instead of POSIX module to detect signal names in AnyEvent::Strict and AnyEvent::Impl::EventLib, as the POSIX module doesn't even have all POSIX signals :/. - use more workarounds around the many refcnt/corruption bugs in Event::Lib. - work around a race condition in perl's select, causing t/03_child.t to rarely fail. 4.81 Thu Jul 9 10:30:30 CEST 2009 - AnyEvent::Handle didn't properly diagnose write errors (it expected -1 from syswrite, how lame... :). - support file descriptors in addition to file handles in AnyEvent->io. - new env variables: PERL_ANYEVENT_RESOLV_CONF, PERL_ANYEVENT_MAX_OUTSTANDING_DNS, PERL_ANYEVENT_CA_FILE and PERL_ANYEVENT_CA_PATH. - provide a sensible synopsis section for AnyEvent::TLS. - add a "supported backends" section to the manpage. - added simple io watcher test to testsuite, using a portable_socketpair. - tried to improve the stability of the Event::Lib backend, YMMV. 4.8 Mon Jul 6 23:45:16 CEST 2009 - AnyEvent::DNS did not properly follow CNAME records with uppercase targets. - AnyEvent::DNS would errornously return AAAA records with v4 mapped addresses (a faulty record) as ipv4 addresses, causing AnyEvent::Socket to throw an exception. - added new module AnyEvent::TLS for easier SSL/TLS context creation, with many options including hostname verification, secure default configuration, lots of documentation and, predefined diffie-hellman keys for perfect forward security and much more. get it while it's still fresh! - use AnyEvent::TLS in AnyEvent::Handle for context management. - load AnyEvent::Handle only on demand in AnyEvent::DNS, so AnyEvent::Socket users have smaller memory footprint in the common case. - add AnyEvent::Handle->push_shutdown method. - add an additional error message parameter to AnyEvent::Handle's on_error callback (for TLS, $! is still available). - add AnyEvent::Handle on_starttls/on_stoptls callbacks. - make AnyEvent::Handle more robust against early connection failures (during new), and return C in that case from the constructor. - AnyEvent::Handle will now try to load only JSON::XS first, then fall back to JSON. - format_ipv4/format_ipv6 are now exported by default, for symmetry, and because it was documented that way. 4.451 Fri Jul 3 00:28:58 CEST 2009 - do not clear rbuf when shutting down an AnyEvent::Handle object - doing so breaks AnyEvent::HTTP. 4.45 Mon Jun 29 22:59:26 CEST 2009 - a write error could cause AnyEvent::Handle to create an I/O watcher with an undefined $fh. - special-case mapped ipv4 addresses in both AnyEvent::Socket::format_address and parse_address, to treat them just like ipv4 addresses. - updated and overhauled the AnyEvent::Intro doc. - implement AnyEvent::Socket::format_ipv4/ipv6. - slightly speed up portable_pipe/socketpair. - expand condvar begin/end documentation. 4.42 Fri Jun 26 08:32:18 CEST 2009 - preliminary and neccesarily incomplete support for IO::Async. - reset SIGCHLD to DEFAULT when AnyEvent is loaded, in case it was set to IGNORE, to ensure we can catch child statuses even when the calling env acts stupidly. - updated benchmarks with IO::Async, which performs very well. 4.412 Wed Jun 24 01:35:57 CEST 2009 - support an "untaint" attribute for AnyEvent::DNS and set it on the default resolver. - implement and document AnyEvent::Impl::Perl::loop. - remove all anyevent-env variables from %ENV when running in tainted mode. - mention and extend the IO::Lambda benchmark. 4.411 Sun Jun 7 18:48:02 CEST 2009 - do not try to use F_SETFD on windows. 4.41 Thu May 14 06:40:11 CEST 2009 - work around issues in older perls (5.8.0?) when a signal handler is deleted from the %SIG hash. - use POSIX::_exit in child test, to avoid running destructors. - speed up CHLD handling by relying on SIGCHLD being synchronously delivered, even when we roll our own implementation. - AnyEvent::DNS: add the "dname" resource record name for cosmetic reasons. 4.4 Sun Apr 26 20:12:33 CEST 2009 - implemented idle watchers, where applicable. - AnyEvent->time died when Event backend was in use. - fix a memleak in the Tk backend. - sped up Tk timer handling. - clip negative "after" values to 0 in AnyEvent::Impl::Event to avoid spamming out warning messages. - fix Qt timers without interval. - avoid Qt zero-timeout special case, in old libqt's. 4.352 Mon Apr 20 16:31:11 CEST 2009 - fix AnyEvent::Strict error messages for child watchers. - fix/update Makefile.PL "recommends" versions. - add AnyEvent->now_update. 4.351 Sat Apr 11 07:56:14 CEST 2009 - actually make the signal pipe work under win32. - localise $! in signal handler to avoid changing $!, although perl itself does not seem to save/restore errno either. - set the cloexec flag on the signal pipe (normally set by perl too). 4.35 Fri Mar 27 11:48:20 CET 2009 - event models relying on AnyEvent's signal watcher emulation did invoke the callback asynchronously, contradicting documentation and causing signals to get lost (this includes AnyEvent's own event loop). AnyEvent now uses the standard pipe trick to make callback execution synchronous to the event loop. - AnyEvent::Handle didn't free TLS context data on DESTROY (patch by Pavel Shaydo). - work around the ever-incompatibly-changing API of MakeMaker. - document that changing global variables without restoring them is a bad idea in Perl (noted by Adam Rosenstein). - AnyEvent::Strict now barfs if ->io is passed a file. 4.34 Thu Feb 12 18:32:45 CET 2009 - separately buffer TLS read data, as otherwise the read queue could deadlock as receiving data is not expected while draining the read queue (which cna only happen with TLS). - raise EBADMSG error on JSON decoding errors. - fix some minor manpage bugs (reported by Maximilian Gaß). - speed up select bitmask parsing quite a bit in the pure perl backend. - use CORE::select instead of just select in AnyEvent::Impl::Perl. 4.331 Tue Jan 6 21:07:25 CET 2009 - socketpair fails on many vista machines because vista has completely broken accept/getpeername and getsockname functions, so we provide our own socketpair emulation that kind of works (AnyEvent::Util::portable_pipe). - new function: AnyEvent::Util::portable_socketpair. - take advantage of the Guard module if it exists. 4.33 Fri Nov 21 02:35:40 CET 2008 - AnyEvent::Strict did errornously flag a fileno of 0 as illegal. - reduce memory usage and slightly speed up the pure perl backend by only storing the file descriptor, not the file handle. - add missing autocork method to AnyEvent::Handle (reported by Adam Rosenstein). - AnyEvent::DNS->resolve errornously documented an $rcode result argument, but there isn't (spotted by Henrik Krohns). - the naked truth about Tk - it's basically unmaintained. 4.32 Mon Nov 3 22:46:32 CET 2008 - fix AnyEvent::Socket::resolve_sockaddr to properly support unix sockets again and choose a proper default for the socket type. - fix call to resolve_sockaddr in tcp_connect. 4.31 Thu Oct 30 04:41:48 CET 2008 - implemented AnyEvent::Handle->destroy method. - hint about unexpected effects in TLS mode. - speed up AnyEvent::Impl::Perl by using more arrays instead of hashes without the slightest loss of readability :) - work around a perl argument refcounting bug. - with some perl patches applied, AnyEvent now seems leak-free. 4.3 Fri Oct 3 09:18:43 CEST 2008 - AnyEvent will now install a no-op signal handler for SIGPIPE, unless one has been installed already. - warn about not loaidng AnyEvent::Impl::POE early enough (patch by Adam Rosenstein). - fixed a great number of bugs and corner cases in AnyEvent::Handle. - fix a bug in where in SSL connect mode, the client would first wait for some data by the server and otherwise hang. (reported and analysed in an absolutely exemplary manner by Adam Rosenstein). - fix a bug in where SSL EOF would not be treated as stream EOF, putting the connection into a hung state. (reported and analysed in an absolutely exemplary manner by Adam Rosenstein). - fix a potential segfault when the TLS context would go missing in a read callback (e.g. due to stoptls) - Net::SSLeay of course makes no type checking whatsoever. - AnyEvent::Handle will not stop the read watcher in TLS mode. - AnyEvent::Handle->stoptls will send a TLS close notify instead of simply destroying the stream now. - fix a bug where large blocks of data written in TLS mode would not be sent unless triggered by receives. - on_drain will now take the tls write buffer into account. - SSL operations have been streamlined a bit and should be faster now, more to come, though. - added a FAQ section, will document nontrivial issues in there. 4.234 Mon Sep 29 04:08:13 CEST 2008 - fix child watcher documentation: only child exits will be reported, no trace events. - mention SIGPIPE in AnyEvent::Handle. - perl backend will now use POSIX::times as monotonic clock when available and the monotonic clock option is not. - run even without Time::HiRes in some cases now, but do not provide sub-second accuracy (all *supported* perl versions have Time::HiRes). 4.233 Fri Aug 22 01:48:05 CEST 2008 - fix a bug in the testsuite, causing a hang. - clarified lots of AnyEvent::Handle constructor arguments. 4.232 Thu Aug 21 20:44:25 CEST 2008 - fix a bug in AnyEvent::Handle that could cause two fatal error callbacks on EOF, which caused AnyEvent::HTTP to signal success twice (testcase by Leon Brocard). - clarified on_eof/on_error documentation a bit. 4.231 Tue Jul 29 13:12:15 CEST 2008 - remove some debugging code left in AnyEvent::Util::fork_call (and no, it's impossible to implement with the broken windows perls without resource leaks or worse). 4.23 Tue Jul 29 12:19:59 CEST 2008 - document the first parameter passed to condvar callbacks to be the callback. - add AnyEvent::Socket::{ntoa,aton} aliases. - optimize the AE::Handle->push_read (line) for the default eol marker. - optimize push_read (packstring|storable) for small packets. - invoke on_error callback when no on_eof callback is set. - fix a bug in push_read (storable) of unknown impact. 4.22 Sun Jul 20 16:34:13 CEST 2008 - new function AnyEvent::Socket::parse_hostport. - as the bulkheads at microsoft can't even get getprotobyname reliably working on their shitty fucking broken os we need to hardcode some common protocol numbers in AnyEvent::Socket. How can people even bother with such a pile of shit as windows. 4.21 Thu Jul 17 14:40:05 CEST 2008 - INCOMPATIBLE CHANGE: AnyEvent::Util::fork_call now has a prototype which is incompatible to previous invocation syntax. - work around more windows perl bugs in fork_call. I cannot imagine why anybody would bother implementing fork in such an obviously unusable way. - avoid calling $do_retry if the request has already finished in AnyEvent::DNS, thus avoiding an exception (reported by Anatoly K. Sharifulin). 4.2 Sat Jul 12 22:42:11 CEST 2008 - support an "interval" argument for repeating timers. - fix a bug in the pure perl event loop that caused timers to be delayed under some circumstances. - implement optional argument checking via PERL_ANYEVENT_STRICT. - not importing anything from Event causes it to malfunction and not use Time::HiRes, work around this bug. - more bug workarounds against the endlessly broken Tk module, seems to work now on 32 bit machines, but less so on 64 bit. - minor optimisations applied to most backends. 4.161 Fri Jul 4 14:24:48 CEST 2008 - fixed the t/handle/02_write.t, it read after write, with the assumption that all data could be written before read (reported by Jim Razmus). 4.160 Thu Jul 3 04:02:21 CEST 2008 - re-registering signal watchers after unregistering one did not work if a backend falls back on AnyEvent's default implementation (also affected child watchers). - new AnyEvent::Handle options: autocork and no_delay. 4.152 Sun Jun 22 14:15:44 CEST 2008 - allow for 32-bit perls that implement shifts differently on different architectures in parse_ipv4 (reported and analysed by Keiichi DAIBA). 4.151 Fri Jun 6 17:34:24 CEST 2008 - make sure specifying _only_ on_read and never pushing reads works. 4.15 Fri Jun 6 13:00:46 CEST 2008 - the pure perl backend would keep some watchers alive when more than one watcher was registered for the same fd. - new "packstring" and "storable" read and write types for AnyEvent::Handle. - allow on_eof handler to be called after on_error with EPIPE returns. - do not immediately call on_read callback in handle constructor. 4.14 Thu Jun 5 20:29:31 CEST 2008 - Fixed a bug in DNS SRV priority sorting. - AnyEvent::Util::guard now reports runtime errors while executing the guard block as warnings. - handle 0-byte-reads just before EOF correctly in AnyEvent::Handle. 4.13 Thu Jun 5 00:47:59 CEST 2008 - AnyEvent::DNS only followed cname chains with length 2, contrary to documentation. bumped it up to 10, thanks to microsoft, the current broken-dns-config-king. - AnyEvent::DNS didn't check for socket return status but instead relied on perl not creating filehandles in that case - too bad it gives you a bogus file handle (reported and analysed by Vladimir Timofeev). - fix queue management logic in AnyEvent::Handle: when on_read was registered, the queue was empty and no progress could be made AnyEvent::Handle would enter an endless loop. - correctly start reading again when the handle became busy again after idling. - correctly treat tls shut-downs as EOF condition (for the time being, would be nice to have a callback for that). - correctly call eof callback under all conditions (hopefully). - the timeout callback did not expect that $self can go away any time. 4.12 Tue Jun 3 10:58:04 CEST 2008 - include AnyEvent::Intro, a tutorial for anyevent, anyevent::socket and anyevent::handle. - allow more options in on_error. 4.11 Fri May 30 23:42:25 CEST 2008 - INCOMPATIBLE CHANGE: replace ptr by real PTR lookup, provide reverse_lookup and reverse_verify to replace it, support v4mapped and v4compat addresses. - provide more documentation for the resolver class. - really replace longest run of :0: by :: in format_address, also properly convert :: and ::1 again. - support NAPTR record name and decode it. - implement random weight sampling for SRV records, as per rfc 2782. - correctly abort on srv-record targets of ".". - added AnyEvent::DNS::wait_for_slot. - in the unlikely event of a virtual circuit connection being invalidated by a delayed udp reply, AnyEvent::DNS could die. this has been fixed. - plug a probable memleak in the DNS vc code. - use configured timeout also for VC request phase. - implement timeout and max_outstanding methods for resolver class. - update version numbers in all modules. 4.1 Thu May 29 05:45:40 CEST 2008 - INCOMPATIBLE CHANGE: renamed xxx_ip functions to xxx_address which mirrors their purpose better (old names still available for a while). Also moved AnyEvent::DNS::addr to AnyEvent::Socket::resolve_sockaddr. - implement AnyEvent->time and AnyEvent->now. - fix IPv6 support in pack_sockaddr. - officially un-experimentalise all newly introduced code. - support unix domain sockets everywhere by specifying a host of "unix/" and the pathname as service. - implement an activity timeout in AnyEvent::Handle. - added a regex read type to AnyEvent::Handle. - added a json read/write type to AnyEvent::Handle. - always croak in on_error in AnyEvent::Handle. - document how to subclass AnyEvent::Handle. - implement AnyEvent::Util::fork_call. - add support for IPv6 nameservers and nameserver statements. - work around _yet_ _another_ windows perl bug in where empty select masks cause errors in the pure perl backend (this workaround cannot be implemented for the other event loops, but EV also works around this). - supply AnyEvent::Socket::address_type and make good use of it. - clarify and fix the Handle documentation w.r.t $self vs. $handle vs. callback arguments. - add some recommends to the META.yml. 4.05 Mon May 26 19:44:06 CEST 2008 - some platforms ignore the rfc and prepend an extra sa_len member to the sockaddr structure, cater for those. also use sockaddr_family, didn't know it was there, but comes in handy for the workaround. - undo the import WIN32 hack. 4.04 Mon May 26 08:03:31 CEST 2008 - try to work around yet another windows bug: failed connects are reported as if it were out-of-band data. windows users: you suck. Only EV, Glib, Event and the pure perl backend can handle this condition. - optimize write algorithm in AnyEvent::Handle. - properly parse PERL_ANYEVENT_PROTOCOLS and use the info correctly. - tcp_connect now properly iterates through all targets. - check wether IPv6 sockets can actually be created, otherwise, disable ipv6 support entirely. also hardcode some AF_INET6 constants for the sake of perl 5.8. - vastly improved nameserver/suffix detection algorithm for windows (still a hack...) - try to use a fallback dns server if no dns servers could be found. - splatter around some local $SIG{__DIE__}'s to work around bad die handlers. 4.03 Sun May 25 05:05:57 CEST 2008 - work around perl bugs on windows, where perl returns undocumented error codes for sysread, syswrite etc. - fix AnyEvent::Handle::unshift_read to really unshift and not push. - AnyEvent::Handle could sometimes stumble over 0-byte writes. - fix unpack_sockaddr, now works for AF_INET6 sockaddr's. - updated documentation. - lots of workarounds for perl 5.8 quirks. - implement a more flexible type system for both reads and writes in AnyEvent::Handle. - support IPv6 in tcp_server. - pass local hostname and port to the prepare callback in tcp_server. - make types extendable in AnyEvent::Handle. - croak, not die, in AnyEvent::Handle; 4.0 Sat May 24 19:58:08 CEST 2008 - added (experimental) AnyEvent::DNS module. - added (experimental) AnyEvent::Socket module. - added (experiemntal) support for TLS/SSL in AnyEvent::Handle. - make condvar->end call ->send as documented. - make condvar constructor support the documented cb => argument. - overload condvars so you can use them instead of code references. - support more of the POSIX forms instead of a pure dotted quad for verbatim ip addresses. - AnyEvent::Socket::inet_aton will use AnyEvent::DNS now and not fork anymore. - try very hard not to freeze on broken windows perls. - make on_eof optional in AnyEvent::Handle. - support service names in tcp_connect and tcp_server. - work around netbsd/openbsd bug causing unix sockets not to become writable until empty. - only make a dummy read for error detection when getpeername returns ENOTCONN. - defend AnyEvent::Util::inet_aton against Coro::LWP's brutal override. - new AnyEvent::Guard::cancel. 3.5 Sat May 17 23:17:14 CEST 2008 - gracefully deal with systems not defining CLOCK_MONOTONIC (as opposed to not supporting the clock itself, which worked in 3.41). - added AnyEvent::Util::tcp_connect and AnyEvent::Util::tcp_server helpers, to replace the ill-designed AnyEvent::Socket class. - added some examples (eg/connect, eg/handle). - added AnyEvent::Util::guard. - AnyEvent::Util now exports most of its functions. - fixed a bug in *_read_chunk, where the callback was called with $self as first and second argument. - simplified and fixed regex handling in AnyEvent::Handle::*_read_line. - fix manpage condvars examples to use new syntax. - considerably improve inet_aton with EV::ADNS backend to support cname chains (common dns configuration bug, e.g. with www.google.de) and aaaa records if no a record could be found. 3.41 Sun May 11 19:53:13 CEST 2008 - work around a bug in perl 5.8.8's local. Reported by Yi Ma Mao. 3.4 Sun May 11 00:29:25 CEST 2008 - complete re-implementation of condvars with a hopefully much more useful API (backward compatible functions exist but are undocumented). - AnyEvent::Handle fully rewritten with a hopefully more powerful API (still subject to change). - take advantage of CLOCK_MONOTONIC, if available, in AnyEvent::Impl::Perl. - provide AnyEvent::post_detect and @AnyEvent::post_detect, which allows module authors to avoid forcing event loop detection. (used by Coro::AIO, Coro::BDB, Coro::AnyEvent for example). - remove coro backends: Coro now provides generic support for AnyEvent via Coro::AnyEvent. 3.3 Mon Apr 28 09:51:06 CEST 2008 - added AnyEvent::Handle, AnyEvent::Socket and AnyEvent::Util modules. - fix a bug in the pure perl backend that kept watchers alive when multiple watchers were registered for the same fh/poll combo. - add a benchmark section showing AnyEvent overhead and comparing the different event loops with each other. - prefer pure perl over tk when autoprobing, as it's about as fast, but doesn't crash with many watchers. - declare Qt support non-experimental. - clarify the confusing section about the file descriptor being kept alive. - document the race between loading of an event module and child processes exiting. - support POE as "backend" (with some caveats, POE is not generic enough, and darn slow). - support Wx and Prima through POE. - optimise perl backend to use 20% less memory and take advantage of typical timeout behaviour. It can now compete with select/poll-based C event loops in most cases (it is usually faster than Event and Glib :). - roughly cut EV memory use in half and increase its speed by 30%, by removing undocumented functionality. Did something similar to other event loops where possible. 3.2 Thu Apr 24 10:10:40 CEST 2008 - do not die when anyevent watchers are destroyed while running callbacks in the pureperl backend (could only happen when two watchers are registered for the same fh/poll combo). - support autoloading for child watchers, was broken in all versions. - implement PERL_ANYEVENT_MODEL env variable. - (experimental) implement interface to the (very crashy/buggy) Event::Lib module. - (experimental) implement interface to the Qt module (cannot be autoprobed). - this release is IO:AnyEvent-proof. 3.12 Tue Apr 22 07:11:46 CEST 2008 - reinstate AUTHOR section that got lost somehow. - do not hang in the testsuite with badly broken perls (activestate, strawberry...), but instead diagnose the problem and continue. - use INT instead of CHLD in an attempt to support broken windows perls better (this decreases the test quality, unfortunately). - do not send the signal to the process group (no problem for CHLD, bad for INT :). 3.11 Sat Apr 19 06:57:31 CEST 2008 - major documentation rework. - document the fact that child watchers only watch for zombies. - fix the child watcher example. 3.1 Wed Apr 16 17:09:01 CEST 2008 - work around recurring bugs in Tk by dup'ing filehandles, the only method with good success chances on Tk (the bugs apparently don't get fixed anytime soon). - lift the restriction of only one watcher per fh direction (as the Tk bug workaround also lifts it and only Tk imposed such strong limits). - changed probe order to prefer coro adaptors. - explain why recursion into the event loop is not supported unless the backend supports it (only Coro::EV does without any restrictions...). - add simple manpages for all backend modules. 3.0 Mon Apr 7 21:30:23 CEST 2008 - Coro::Signal changed semantics, roll our own, also cleaning up the Coro implementation in general. - rename Coro backend to CoroEvent. - add some decision helping paragraph to the manpage that should help people to decide whether AnyEvent is the right thing for them. 2.9 Mon Jan 28 13:31:54 CET 2008 - update for EV 3.0 API changes. 2.8 Sun Nov 25 15:06:03 CET 2007 - waitpid can validly return 0. accept this fact of life instead of reporting it to any watchers. 2.7 Fri Nov 23 11:41:14 CET 2007 - force use of AnyEvent::Impl::Perl in testsuite, there is too much breakage outside AnyEvent. - deliver signals synchronously in AnyEvent::Impl::Perl or any other event loop that relies on AnyEvents child watcher emulation. *Could* help with hanging testsuite (except when Event or EV are installed). 2.6 Fri Nov 9 20:36:35 CET 2007 - fix bug in testsuite. - move EV adaptor modules to AnyEvent. - add Coro+EV adaptor module. 2.55 Tue Nov 6 17:41:32 CET 2007 - add EV to the list of supported event models. - do not auto-reset pid watchers, pass pid and status to them. - allow a pid of zero to watch for all children in child watchers. 2.54 Wed Jul 18 17:36:23 CEST 2007 - work around a perl bug that results in BEGIN not safe after errors--compilation aborted without any discernible reason or error message by once again not use'ing strict. 2.53 Sun Jul 8 10:51:53 CEST 2007 - make Glib interface work again (spotted by elmex). 2.52 Wed Mar 7 18:36:16 CET 2007 - child watchers stopped working permanently when all current child watchers were destroyed. 2.51 Mon Dec 11 21:33:24 CET 2006 - work around bugs in perl where eval "require Module" returns true even if the module couldn't be loaded :/. 2.5 Mon Dec 11 02:15:28 CET 2006 - avoid $AUTOLOAD because many perls corrupt it. - AnyEvent::detect forces autodetection. - implement signal watchers (experimental) (Tk does not support async signals (<= 804.027 at least), so they might get delayed indefinitely on Tk). - implement child watchers (experimental). - moved default condvar implementation into base module, simplifying most implementation modules. 2.1 Fri Nov 24 15:50:48 CET 2006 - better docs. - simple testsuite. - added AnyEvent->one_event method for special purposes. 2.0 Wed Nov 1 02:21:30 CET 2006 - INCOMPATIBLE CHANGE: poll can now either be "r" or "w" but not both. - INCOMPATIBLE CHANGE: io watcher callbacks have no arguments anymore. - EXPERIMENTAL: new pure-perl model added, AnyEvent now always finds a suitable event model. - improved documentation. - reduced cpu overhead. 1.02 Fri Jan 13 14:15:40 CET 2006 - add COPYING to clarify license. 1.01 Sun Jan 8 05:48:09 CET 2006 - correctly cancel Event timers, avoid memory leaks. 1.0 Sun Jan 8 05:40:58 CET 2006 - allow third-party interfaces to be added at runtime. - fix version number. 0.9 Fri Dec 30 02:25:41 CET 2005 - fixed errors in the documentation. - going back to using $VERSION as "load check", as suggested by Jörn Reder. Let's see why I stopped using this method. - add 'hup' to the list of events to receive for glib and generate 'rw' events for it, as some versions of glib seem to require this, while this breaks other (older) versions of glib. - implemented PERL_ANYEVENT_VERBOSE env variable. 0.3 Sun Dec 4 10:43:33 CET 2005 - no changes to the code. - fixed documentation. - clarified some corner cases. - vastly improved documentation with a long example. 0.2 Thu Dec 1 22:18:49 CET 2005 - check whether a valid method was called, to avoid endless loops. - move condvars into their own class (cleaner, safer). - don't die when some modules are not available. - Tk is too broken to allow for words. Will work once Tk works. 0.1 Thu Dec 1 19:44:57 CET 2005 - spiced up and cleaned up for release. 0.01 Tue Sep 21 18:12:09 CEST 2004 - original version; copied from Convert::Scalar. AnyEvent-7.17/MANIFEST0000644000000000000000000000527513540302027013035 0ustar rootrootMANIFEST COPYING Changes README Makefile.PL constants.pl.PL lib/AE.pm lib/AnyEvent.pm lib/AnyEvent/DNS.pm lib/AnyEvent/Debug.pm lib/AnyEvent/FAQ.pod lib/AnyEvent/Handle.pm lib/AnyEvent/Impl/Cocoa.pm lib/AnyEvent/Impl/EV.pm lib/AnyEvent/Impl/Event.pm lib/AnyEvent/Impl/EventLib.pm lib/AnyEvent/Impl/FLTK.pm lib/AnyEvent/Impl/Glib.pm lib/AnyEvent/Impl/IOAsync.pm lib/AnyEvent/Impl/Irssi.pm lib/AnyEvent/Impl/POE.pm lib/AnyEvent/Impl/Perl.pm lib/AnyEvent/Impl/Qt.pm lib/AnyEvent/Impl/Tk.pm lib/AnyEvent/Impl/UV.pm lib/AnyEvent/IO.pm lib/AnyEvent/IO/IOAIO.pm lib/AnyEvent/IO/Perl.pm lib/AnyEvent/Intro.pod lib/AnyEvent/Log.pm lib/AnyEvent/Loop.pm lib/AnyEvent/Socket.pm lib/AnyEvent/Strict.pm lib/AnyEvent/TLS.pm lib/AnyEvent/Util.pm lib/AnyEvent/Util/idna.pl lib/AnyEvent/Util/uts46data.pl t/00_load.t t/01_basic.t t/02_signals.t t/03_child.t t/04_condvar.t t/05_dns.t t/06_socket.t t/07_io.t t/08_idna.t t/09_multi.t t/10_loadall.t t/io_common t/11_io_perl.t t/12_io_ioaio.t t/13_weaken.t t/handle/01_readline.t t/handle/02_write.t t/handle/03_http_req.t t/handle/04_listen.t t/80_ssltest.t t/81_hosts.t eg/bench eg/runbench eg/bench2 eg/runbench2 eg/connect eg/listen eg/handle eg/ae0.pl eg/ae2.pl util/gen_uts46data util/tst_uts46data mktest builds the test scripts below t/61_fltk_01_basic.t t/61_fltk_02_signals.t t/61_fltk_03_child.t t/61_fltk_04_condvar.t t/61_fltk_05_dns.t t/61_fltk_07_io.t t/61_fltk_09_multi.t t/62_cocoa_01_basic.t t/62_cocoa_02_signals.t t/62_cocoa_03_child.t t/62_cocoa_04_condvar.t t/62_cocoa_05_dns.t t/62_cocoa_07_io.t t/62_cocoa_09_multi.t t/64_glib_01_basic.t t/64_glib_02_signals.t t/64_glib_03_child.t t/64_glib_04_condvar.t t/64_glib_05_dns.t t/64_glib_07_io.t t/64_glib_09_multi.t t/65_event_01_basic.t t/65_event_02_signals.t t/65_event_03_child.t t/65_event_04_condvar.t t/65_event_05_dns.t t/65_event_07_io.t t/65_event_09_multi.t t/66_ioasync_01_basic.t t/66_ioasync_02_signals.t t/66_ioasync_03_child.t t/66_ioasync_04_condvar.t t/66_ioasync_05_dns.t t/66_ioasync_07_io.t t/66_ioasync_09_multi.t t/67_tk_01_basic.t t/67_tk_02_signals.t t/67_tk_03_child.t t/67_tk_04_condvar.t t/67_tk_05_dns.t t/67_tk_07_io.t t/67_tk_09_multi.t t/68_poe_01_basic.t t/68_poe_02_signals.t t/68_poe_03_child.t t/68_poe_04_condvar.t t/68_poe_05_dns.t t/68_poe_07_io.t t/68_poe_09_multi.t t/69_ev_01_basic.t t/69_ev_02_signals.t t/69_ev_03_child.t t/69_ev_04_condvar.t t/69_ev_05_dns.t t/69_ev_07_io.t t/69_ev_09_multi.t t/70_uv_01_basic.t t/70_uv_02_signals.t t/70_uv_03_child.t t/70_uv_04_condvar.t t/70_uv_05_dns.t t/70_uv_07_io.t t/70_uv_09_multi.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) AnyEvent-7.17/META.yml0000644000000000000000000000110613540302027013142 0ustar rootroot--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: Canary::Stability: '0' ExtUtils::MakeMaker: '6.52' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150001' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: AnyEvent no_index: directory: - t - inc recommends: Async::Interrupt: '1' EV: '4' Guard: '1.02' JSON: '2.09' JSON::XS: '2.2' Net::SSLeay: '1.33' Task::Weaken: '0' version: 7.17 AnyEvent-7.17/META.json0000644000000000000000000000204413540302027013314 0ustar rootroot{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150001", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "AnyEvent", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "Canary::Stability" : "0", "ExtUtils::MakeMaker" : "6.52" } }, "runtime" : { "recommends" : { "Async::Interrupt" : "1", "EV" : "4", "Guard" : "1.02", "JSON" : "2.09", "JSON::XS" : "2.2", "Net::SSLeay" : "1.33", "Task::Weaken" : "0" } } }, "release_status" : "stable", "version" : 7.17 }