AnyEvent-7.13/0000755000000000000000000000000012767125611011703 5ustar rootrootAnyEvent-7.13/lib/0000755000000000000000000000000012767125611012451 5ustar rootrootAnyEvent-7.13/lib/AnyEvent/0000755000000000000000000000000012767125611014202 5ustar rootrootAnyEvent-7.13/lib/AnyEvent/Loop.pm0000644000000000000000000002404412210400176015436 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.13/lib/AnyEvent/Impl/0000755000000000000000000000000012767125611015103 5ustar rootrootAnyEvent-7.13/lib/AnyEvent/Impl/POE.pm0000644000000000000000000003556711740210771016074 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.13/lib/AnyEvent/Impl/IOAsync.pm0000644000000000000000000001644612251671453016757 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.13/lib/AnyEvent/Impl/Perl.pm0000644000000000000000000000325712207455226016347 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.13/lib/AnyEvent/Impl/EventLib.pm0000644000000000000000000001013511740210771017141 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.13/lib/AnyEvent/Impl/Event.pm0000644000000000000000000000416211740210771016515 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.13/lib/AnyEvent/Impl/Glib.pm0000644000000000000000000001113512377613174016322 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.13/lib/AnyEvent/Impl/EV.pm0000644000000000000000000000370511740210771015750 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.13/lib/AnyEvent/Impl/Qt.pm0000644000000000000000000000605411740210771016022 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.13/lib/AnyEvent/Impl/Irssi.pm0000644000000000000000000000675211740210771016534 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.13/lib/AnyEvent/Impl/FLTK.pm0000644000000000000000000000606611740210771016201 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.13/lib/AnyEvent/Impl/Tk.pm0000644000000000000000000001062112176042343016011 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.13/lib/AnyEvent/Impl/UV.pm0000644000000000000000000000727712377644742016020 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.13/lib/AnyEvent/Impl/Cocoa.pm0000644000000000000000000000266011740210771016461 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.13/lib/AnyEvent/Socket.pm0000644000000000000000000011664412675617133016007 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 =cut sub parse_ipv6($) { # quick test to avoid longer processing my $n = $_[0] =~ y/://; return undef if $n < 2 || $n > 8; 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 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 mapped IPv4 in IPv6 address (:ffff::), then it will be treated as an IPv4 address. If you don't want that, you have to call C and/or C manually. 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_ipv4 || &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 conservative, 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. If called in non-void context, then this function returns a guard object whose lifetime it tied to the TCP server: If the object gets destroyed, the server will be stopped (but existing accepted connections will not be affected). Regardless, 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>. The guard only protects the set-up phase, it isn't used after C<$done_cb> has been invoked. =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 "AnyEvent::Socket::tcp_server: 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_server/socket: address family not supported" if AnyEvent::WIN32 && $af == AF_UNIX; socket $state{fh}, $af, SOCK_STREAM, 0 or Carp::croak "tcp_server/socket: $!"; if ($af == AF_INET || $af == AF_INET6) { setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1 or Carp::croak "tcp_server/so_reuseaddr: $!" unless AnyEvent::WIN32; # work around windows bug unless ($service =~ /^\d*$/) { $service = (getservbyname $service, "tcp")[2] or Carp::croak "$service: service unknown" } } elsif ($af == AF_UNIX) { unlink $service; } bind $state{fh}, pack_sockaddr $service, $ipn or Carp::croak "bind: $!"; if ($af == AF_UNIX) { my $fh = $state{fh}; my $ino = (stat $fh)[1]; $state{unlink} = guard { # this is racy, but is not designed to be foolproof, just best-effort unlink $service if $ino == (stat $fh)[1]; }; } AnyEvent::fh_unblock $state{fh}; my $len; if ($prepare) { my ($service, $host) = unpack_sockaddr getsockname $state{fh}; $len = $prepare && $prepare->($state{fh}, format_address $host, $service); } $len ||= 128; listen $state{fh}, $len or Carp::croak "listen: $!"; $done->(\%state); defined wantarray ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency : () } 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.13/lib/AnyEvent/IO.pm0000644000000000000000000005307712176051510015051 0ustar rootroot=head1 NAME AnyEvent::IO - the DBI of asynchronous I/O implementations =head1 SYNOPSIS use AnyEvent::IO; # load /etc/passwd, call clalback 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.13/lib/AnyEvent/Util.pm0000644000000000000000000006575112707236404015470 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 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.13/lib/AnyEvent/Strict.pm0000644000000000000000000001350612402430537016005 0ustar rootroot=head1 NAME AnyEvent::Strict - force strict mode on for the whole process =head1 SYNOPSIS use AnyEvent::Strict; # strict mode now switched on =head1 DESCRIPTION This module implements AnyEvent's strict mode. Loading it makes AnyEvent check all arguments to AnyEvent-methods, at the expense of being slower (often the argument checking takes longer than the actual function). It also wraps all callbacks to check for modifications of C<$_>, which indicates a programming bug inside the watcher callback. Normally, you don't load this module yourself but instead use it indirectly via the C environment variable (see L). However, this module can be loaded manually at any time. =cut package AnyEvent::Strict; use Carp qw(confess); use Errno (); use POSIX (); $Carp::Internal{AE} = 1; $Carp::Internal{AnyEvent::Strict} = 1; use AnyEvent (); BEGIN { AnyEvent::common_sense } AnyEvent::_isa_hook 1 => "AnyEvent::Strict", 1; BEGIN { if (defined &Internals::SvREADONLY) { # readonly available (at least 5.8.9+, working better in 5.10.1+) *wrap = sub { my $cb = shift; sub { local $_; Internals::SvREADONLY $_, 1; &$cb; } }; } else { # or not :/ my $magic = []; # a unique magic value *wrap = sub { my $cb = shift; sub { local $_ = $magic; &$cb; if (!ref $_ || $_ != $magic) { require AnyEvent::Debug; die "callback $cb (" . AnyEvent::Debug::cb2str ($cb) . ") modified \$_ without restoring it.\n"; } } }; } } our (@FD_INUSE, $FD_I); our $FD_CHECK_W = AE::timer 4, 4, sub { my $cnt = (@FD_INUSE < 100 * 10 ? int @FD_INUSE * 0.1 : 100) || 10; if ($FD_I <= 0) { #pop @FD_INUSE while @FD_INUSE && !$FD_INUSE[-1]; $FD_I = @FD_INUSE or return; # empty } $cnt = $FD_I if $cnt > $FD_I; eval { do { !$FD_INUSE[--$FD_I] or (POSIX::lseek $FD_I, 0, 1) != -1 or $! != Errno::EBADF or die; } while --$cnt; 1 } or AE::log crit => "File descriptor $FD_I registered with AnyEvent but prematurely closed, event loop might malfunction."; }; sub io { my $class = shift; my (%arg, $fh, $cb, $fd) = @_; ref $arg{cb} or confess "AnyEvent->io called with illegal cb argument '$arg{cb}'"; $cb = wrap delete $arg{cb}; $arg{poll} =~ /^[rw]$/ or confess "AnyEvent->io called with illegal poll argument '$arg{poll}'"; $fh = delete $arg{fh}; if ($fh =~ /^\s*\d+\s*$/) { $fd = $fh; $fh = AnyEvent::_dupfh $arg{poll}, $fh; } else { defined eval { $fd = fileno $fh } or confess "AnyEvent->io called with illegal fh argument '$fh'"; } -f $fh and confess "AnyEvent->io called with fh argument pointing to a file"; delete $arg{poll}; confess "AnyEvent->io called with unsupported parameter(s) " . join ", ", keys %arg if keys %arg; ++$FD_INUSE[$fd]; bless [ $fd, $class->SUPER::io (@_, cb => $cb) ], "AnyEvent::Strict::io"; } sub AnyEvent::Strict::io::DESTROY { --$FD_INUSE[$_[0][0]]; } sub timer { my $class = shift; my %arg = @_; ref $arg{cb} or confess "AnyEvent->timer called with illegal cb argument '$arg{cb}'"; my $cb = wrap delete $arg{cb}; exists $arg{after} or confess "AnyEvent->timer called without mandatory 'after' parameter"; delete $arg{after}; !$arg{interval} or $arg{interval} > 0 or confess "AnyEvent->timer called with illegal interval argument '$arg{interval}'"; delete $arg{interval}; confess "AnyEvent->timer called with unsupported parameter(s) " . join ", ", keys %arg if keys %arg; $class->SUPER::timer (@_, cb => $cb) } sub signal { my $class = shift; my %arg = @_; ref $arg{cb} or confess "AnyEvent->signal called with illegal cb argument '$arg{cb}'"; my $cb = wrap delete $arg{cb}; defined AnyEvent::Base::sig2num $arg{signal} and $arg{signal} == 0 or confess "AnyEvent->signal called with illegal signal name '$arg{signal}'"; delete $arg{signal}; confess "AnyEvent->signal called with unsupported parameter(s) " . join ", ", keys %arg if keys %arg; $class->SUPER::signal (@_, cb => $cb) } sub child { my $class = shift; my %arg = @_; ref $arg{cb} or confess "AnyEvent->child called with illegal cb argument '$arg{cb}'"; my $cb = wrap delete $arg{cb}; $arg{pid} =~ /^-?\d+$/ or confess "AnyEvent->child called with malformed pid value '$arg{pid}'"; delete $arg{pid}; confess "AnyEvent->child called with unsupported parameter(s) " . join ", ", keys %arg if keys %arg; $class->SUPER::child (@_, cb => $cb) } sub idle { my $class = shift; my %arg = @_; ref $arg{cb} or confess "AnyEvent->idle called with illegal cb argument '$arg{cb}'"; my $cb = wrap delete $arg{cb}; confess "AnyEvent->idle called with unsupported parameter(s) " . join ", ", keys %arg if keys %arg; $class->SUPER::idle (@_, cb => $cb) } sub condvar { my $class = shift; my %arg = @_; !exists $arg{cb} or ref $arg{cb} or confess "AnyEvent->condvar called with illegal cb argument '$arg{cb}'"; my @cb = exists $arg{cb} ? (cb => wrap delete $arg{cb}) : (); confess "AnyEvent->condvar called with unsupported parameter(s) " . join ", ", keys %arg if keys %arg; $class->SUPER::condvar (@cb); } sub time { my $class = shift; @_ and confess "AnyEvent->time wrongly called with paramaters"; $class->SUPER::time (@_) } sub now { my $class = shift; @_ and confess "AnyEvent->now wrongly called with paramaters"; $class->SUPER::now (@_) } =head1 AUTHOR Marc Lehmann http://anyevent.schmorp.de =cut 1 AnyEvent-7.13/lib/AnyEvent/Log.pm0000644000000000000000000013114712671170413015262 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 temperature is too hot!"; AE::log error => "Division by zero attempted."; AE::log warn => "Couldn't delete the file."; AE::log note => "Wanted 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 logging for the current package to errors and higher only AnyEvent::Log::ctx->level ("error"); # set logging level to suppress anything below "notice" $AnyEvent::Log::FILTER->level ("notice"); # 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 packlage 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 $_ } @_; } sub detach { my $ctx = shift; delete $ctx->[2]{$_+0} for map { AnyEvent::Log::ctx $_ } @_; } sub slaves { undef $_[0][2]; &attach; } =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.13/lib/AnyEvent/IO/0000755000000000000000000000000012767125611014511 5ustar rootrootAnyEvent-7.13/lib/AnyEvent/IO/IOAIO.pm0000644000000000000000000000652311740210771015705 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.13/lib/AnyEvent/IO/Perl.pm0000644000000000000000000000503211740210771015741 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.13/lib/AnyEvent/Util/0000755000000000000000000000000012767125611015117 5ustar rootrootAnyEvent-7.13/lib/AnyEvent/Util/uts46data.pl0000644000000000000000000017602512767125406017310 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.13/lib/AnyEvent/Util/idna.pl0000644000000000000000000000573211737215626016400 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.13/lib/AnyEvent/FAQ.pod0000644000000000000000000001215611737215626015324 0ustar rootroot=head1 NAME AnyEvent::FAQ - frequently asked questions The newest version of this document can be found at L. =head2 My program exits before doing anything, what's going on? Programmers new to event-based programming often forget that you can actually do other stuff while "waiting" for an event to occur and therefore forget to actually wait when they do not, in fact, have anything else to do. Here is an example: use AnyEvent; my $timer = AnyEvent->timer (after => 5, cb => sub { say "hi" }); The expectation might be for the program to print "hi" after 5 seconds and then probably to exit. However, if you run this, your program will exit almost instantly: Creating the timer does not wait for it, instead the C method returns immediately and perl executes the rest of the program. But there is nothing left to execute, so perl exits. To force AnyEvent to wait for something, use a condvar: use AnyEvent; my $quit_program = AnyEvent->condvar; my $timer = AnyEvent->timer (after => 5, cb => sub { $quit_program->send }); $quit_program->recv; Here the program doesn't immediately exit, because it first waits for the "quit_program" condition. In most cases, your main program should call the event library "loop" function directly: use EV; use AnyEvent; ... EV::loop; =head2 Why is my C callback never called? Tricky: C (and a few other functions in L) is critically sensitive to the caller context. In void context, it will just do its thing and eventually call the callback. In any other context, however, it will return a special "guard" object - when it is destroyed (e.g. when you don't store it but throw it away), tcp_connect will no longer try to connect or call any callbacks. Often this happens when the C call is at the end of a function: sub do_connect { tcp_connect "www.example.com", 80, sub { ... lengthy code }; } Then the caller decides whether there is a void context or not. One can avoid these cases by explicitly returning nothing: sub do_connect { tcp_connect "www.example.com", 80, sub { ... lengthy code }; () # return nothing } =head2 Why do some backends use a lot of CPU in C<< AE::cv->recv >>? Many people try out this simple program, or its equivalent: use AnyEvent; AnyEvent->condvar->recv; They are then shocked to see that this basically idles with the Perl backend, but uses 100% CPU with the EV backend, which is supposed to be sooo efficient. The key to understand this is to understand that the above program is actually I: Nothing calls C<< ->send >> on the condvar, ever. Worse, there are no event watchers whatsoever. Basically, it creates a deadlock: there is no way to make progress, this program doesn't do anything useful, and this will not change in the future: it is already an ex-parrot. Some backends react to this by freezing, some by idling, and some do a 100% CPU loop. Since this program is not useful (and behaves as documented with all backends, as AnyEvent makes no CPU time guarantees), this shouldn't be a big deal: as soon as your program actually implements I, the CPU usage will be normal. =head2 Why does this FAQ not deal with L questions? Because L has a NONFAQ on its own that already deals with common issues. =head2 How can I combine L applications with AnyEvent? Well, not in the same OS thread, that's for sure :) What you can do is create another ithread (or fork) and run AnyEvent inside that thread, or better yet, run all your GUI code in a second ithread. For example, you could load L and L, then create a portable socketpair for GUI->AnyEvent communication. Then fork/create a new ithread, in there, create a Window and send the C<< $WINDOW->{-Handle} >> to the AnyEvent ithread so it can C. GUI to AnyEvent communication could work by pushing some data into a L and writing a byte into the socket. The AnyEvent watcher on the other side will then look at the queue. AnyEvent to GUI communications can also use a L, but to wake up the GUI thread, it would instead use C<< Win32::GUI::PostMessage $WINDOW, 1030, 0, "" >>, and the GUI thread would listen for these messages by using C<< $WINDOW->Hook (1030 (), sub { ... }) >>. =head2 My callback dies and... It must not - part of the contract betwene AnyEvent and user code is that callbacks do not throw exceptions (and don't do even more evil things, such as using C outside a loop :). If your callback might die sometimes, you need to use C. If you want to track down such a case and you can reproduce it, you can enable wrapping (by calling C<< L::wrap >> or by setting C before starting your program). This will wrap every callback into an eval and will report any exception complete with a backtrace and some information about which watcher died, where it was created and so on. =head1 Author Marc Lehmann . AnyEvent-7.13/lib/AnyEvent/Debug.pm0000644000000000000000000005100212537713222015560 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.13/lib/AE.pm0000644000000000000000000001242411740210771013267 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.13/t/0000755000000000000000000000000012767125611012146 5ustar rootrootAnyEvent-7.13/t/70_uv_07_io.t0000644000000000000000000000355112377641775014307 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.13/t/handle/0000755000000000000000000000000012767125611013401 5ustar rootrootAnyEvent-7.13/t/handle/03_http_req.t0000644000000000000000000000215611737233440015716 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.13/t/handle/02_write.t0000644000000000000000000000325411625611266015223 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.13/t/handle/04_listen.t0000644000000000000000000000226411625611213015361 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.13/t/handle/01_readline.t0000644000000000000000000000414411625611251015644 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.13/t/65_event_05_dns.t0000644000000000000000000000142012377641775015146 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.13/t/02_signals.t0000644000000000000000000000114311616053637014273 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.13/t/64_glib_04_condvar.t0000644000000000000000000000374212377641775015621 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.13/t/62_cocoa_05_dns.t0000644000000000000000000000142012377641775015106 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.13/t/67_tk_09_multi.t0000644000000000000000000000741212377641775015026 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.13/t/80_ssltest.t0000644000000000000000000001622711753566372014362 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.13/t/70_uv_05_dns.t0000644000000000000000000000141212377641775014454 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.13/t/65_event_04_condvar.t0000644000000000000000000000374412377641775016030 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.13/t/08_idna.t0000644000000000000000000000202311506522416013544 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.13/t/81_hosts.t0000644000000000000000000000146412206633610013777 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.13/t/62_cocoa_04_condvar.t0000644000000000000000000000374412377641775015770 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.13/t/61_fltk_05_dns.t0000644000000000000000000000141612377641775014766 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.13/t/69_ev_07_io.t0000644000000000000000000000355112377641775014277 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.13/t/04_condvar.t0000644000000000000000000000340311623251250014257 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.13/t/61_fltk_07_io.t0000644000000000000000000000355512377641775014621 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.13/t/68_poe_07_io.t0000644000000000000000000000356312377641775014452 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.13/t/65_event_09_multi.t0000644000000000000000000000742012377641775015526 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.13/t/00_load.t0000644000000000000000000000120711161333137013540 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.13/t/10_loadall.t0000644000000000000000000000067111734442712014244 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.13/t/70_uv_01_basic.t0000644000000000000000000000115112377641775014745 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.13/t/69_ev_01_basic.t0000644000000000000000000000115112377641775014735 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.13/t/64_glib_03_child.t0000644000000000000000000000571312377641775015247 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.13/t/12_io_ioaio.t0000644000000000000000000000021511734710010014404 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.13/t/69_ev_05_dns.t0000644000000000000000000000141212377641775014444 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.13/t/09_multi.t0000644000000000000000000000705712012340265013771 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.13/t/03_child.t0000644000000000000000000000535411735232632013723 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.13/t/68_poe_03_child.t0000644000000000000000000000572112377641775015120 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.13/t/68_poe_04_condvar.t0000644000000000000000000000375012377641775015472 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.13/t/62_cocoa_03_child.t0000644000000000000000000000571512377641775015416 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.13/t/66_ioasync_07_io.t0000644000000000000000000000356312377641775015332 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.13/t/68_poe_02_signals.t0000644000000000000000000000151012377641775015464 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.13/t/61_fltk_01_basic.t0000644000000000000000000000115512377641775015257 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.13/t/67_tk_07_io.t0000644000000000000000000000355112377641775014301 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.13/t/70_uv_09_multi.t0000644000000000000000000000741212377641775015034 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.13/t/65_event_01_basic.t0000644000000000000000000000115712377641775015446 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.13/t/66_ioasync_01_basic.t0000644000000000000000000000116312377641775015770 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.13/t/64_glib_05_dns.t0000644000000000000000000000141612377641775014746 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.13/t/70_uv_04_condvar.t0000644000000000000000000000373612377641775015336 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.13/t/61_fltk_02_signals.t0000644000000000000000000000150212377641775015633 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.13/t/66_ioasync_05_dns.t0000644000000000000000000000142412377641775015477 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.13/t/62_cocoa_07_io.t0000644000000000000000000000355712377641775014750 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.13/t/62_cocoa_02_signals.t0000644000000000000000000000150412377641775015762 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.13/t/64_glib_02_signals.t0000644000000000000000000000150212377641775015613 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.13/t/68_poe_01_basic.t0000644000000000000000000000116312377641775015110 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.13/t/65_event_03_child.t0000644000000000000000000000571512377641775015456 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.13/t/06_socket.t0000644000000000000000000000176611230205472014126 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.13/t/05_dns.t0000644000000000000000000000105711506522416013420 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.13/t/61_fltk_09_multi.t0000644000000000000000000000741612377641775015346 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.13/t/io_common0000644000000000000000000000466111742042430014044 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.13/t/64_glib_01_basic.t0000644000000000000000000000115512377641775015237 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.13/t/07_io.t0000644000000000000000000000321611616053653013250 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.13/t/69_ev_04_condvar.t0000644000000000000000000000373612377641775015326 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.13/t/67_tk_02_signals.t0000644000000000000000000000147612377641775015331 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.13/t/64_glib_07_io.t0000644000000000000000000000355512377641775014601 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.13/t/69_ev_03_child.t0000644000000000000000000000570712377641775014754 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.13/t/64_glib_09_multi.t0000644000000000000000000000741612377641775015326 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.13/t/69_ev_09_multi.t0000644000000000000000000000741212377641775015024 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.13/t/69_ev_02_signals.t0000644000000000000000000000147612377641775015327 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.13/t/67_tk_03_child.t0000644000000000000000000000570712377641775014756 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.13/t/65_event_02_signals.t0000644000000000000000000000150412377641775016022 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.13/t/11_io_perl.t0000644000000000000000000000006111734672707014270 0ustar rootrootuse AnyEvent::IO::Perl; require "./t/io_common"; AnyEvent-7.13/t/68_poe_09_multi.t0000644000000000000000000000742412377641775015177 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.13/t/67_tk_04_condvar.t0000644000000000000000000000373612377641775015330 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.13/t/61_fltk_03_child.t0000644000000000000000000000571312377641775015267 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.13/t/01_basic.t0000644000000000000000000000061611506522416013711 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.13/t/70_uv_03_child.t0000644000000000000000000000570712377641775014764 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.13/t/61_fltk_04_condvar.t0000644000000000000000000000374212377641775015641 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.13/t/67_tk_05_dns.t0000644000000000000000000000141212377641775014446 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.13/t/62_cocoa_01_basic.t0000644000000000000000000000115712377641775015406 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.13/t/62_cocoa_09_multi.t0000644000000000000000000000742012377641775015466 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.13/t/66_ioasync_04_condvar.t0000644000000000000000000000375012377641775016352 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.13/t/68_poe_05_dns.t0000644000000000000000000000142412377641775014617 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.13/t/67_tk_01_basic.t0000644000000000000000000000115112377641775014737 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.13/t/66_ioasync_03_child.t0000644000000000000000000000572112377641775016000 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.13/t/65_event_07_io.t0000644000000000000000000000355712377641775015010 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.13/t/70_uv_02_signals.t0000644000000000000000000000147612377641775015337 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.13/t/66_ioasync_09_multi.t0000644000000000000000000000742412377641775016057 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.13/t/66_ioasync_02_signals.t0000644000000000000000000000151012377641775016344 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.13/Changes0000644000000000000000000020101212767125607013177 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: hosts read multiple times for initial concurrent tcp_connect's? 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.13/util/0000755000000000000000000000000012767125611012660 5ustar rootrootAnyEvent-7.13/util/tst_uts46data0000755000000000000000000000236412730442755015325 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.13/util/gen_uts46data0000755000000000000000000000357512707236524015270 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.13/Makefile.PL0000644000000000000000000001030012767125461013652 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.13/MANIFEST0000644000000000000000000000525712767125611013045 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/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.13/eg/0000755000000000000000000000000012767125611012276 5ustar rootrootAnyEvent-7.13/eg/bench0000755000000000000000000000257611236560601013305 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.13/eg/ae0.pl0000644000000000000000000000214411236561004013267 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.13/eg/connect0000755000000000000000000000123011161333137013640 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.13/eg/ae2.pl0000644000000000000000000000160111236561004013266 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.13/eg/runbench20000755000000000000000000000134711004511422014075 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.13/eg/listen0000755000000000000000000000146411161333137013516 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.13/eg/handle0000755000000000000000000000122411236560616013454 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.13/eg/runbench0000755000000000000000000000154611004511422014014 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.13/eg/bench20000755000000000000000000000221511004511422013343 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.13/mktest0000755000000000000000000000226512377641771013154 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.13/constants.pl.PL0000755000000000000000000001172012176330363014566 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.7 use strict qw(vars subs); no warnings; use warnings qw(FATAL closed threads internal debugging pack malloc portable prototype inplace io pipe unpack deprecated 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 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 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 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.13/README0000644000000000000000000030034112767125611012564 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 available backend classes are (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. 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), but *before* any watchers have been created, so it is possible to e.g. patch @AnyEvent::ISA or do other initialisations - see the sources of AnyEvent::Strict or 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 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. 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. 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.13/COPYING0000644000000000000000000000007610361724036012733 0ustar rootrootThis module is licensed under the same terms as perl itself. AnyEvent-7.13/META.yml0000644000000000000000000000112212767125611013150 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.1, 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' requires: {} version: 7.13 AnyEvent-7.13/META.json0000644000000000000000000000207512767125611013330 0ustar rootroot{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.1, 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" }, "requires" : {} } }, "release_status" : "stable", "version" : 7.13 }