lib/AnyEvent/Util.pm

=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<AnyEvent::Util::> prefix are exported
by default.

=over 4

=cut

package AnyEvent::Util;

no warnings;
use strict;

use Carp ();
use Errno ();
use Socket ();

use AnyEvent ();

use base 'Exporter';

our @EXPORT = qw(fh_nonblocking guard fork_call portable_pipe portable_socketpair);
our @EXPORT_OK = qw(AF_INET6 WSAEWOULDBLOCK WSAEINPROGRESS WSAEINVAL WSAWOULDBLOCK);

our $VERSION = 4.45;

BEGIN {
   my $posix = 1 * eval { local $SIG{__DIE__}; require POSIX };
   eval "sub POSIX() { $posix }";
}

BEGIN {
   # TODO remove this once not used anymore
   *socket_inet_aton = \&Socket::inet_aton; # take a copy, in case Coro::LWP overrides it
}

BEGIN {
   my $af_inet6 = eval { local $SIG{__DIE__}; &Socket::AF_INET6 };

   # uhoh
   $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/;

   $af_inet6 && socket my $ipv6_socket, $af_inet6, &Socket::SOCK_STREAM, 0 # check if they can be created
      or $af_inet6 = 0;

   eval "sub AF_INET6() { $af_inet6 }"; die if $@;

   delete $AnyEvent::PROTOCOL{ipv6} unless $af_inet6;
}

BEGIN {
   # broken windows perls use undocumented error codes...
   if (AnyEvent::WIN32) {
      eval "sub WSAEINVAL()      { 10022 }";
      eval "sub WSAEWOULDBLOCK() { 10035 }";
      eval "sub WSAWOULDBLOCK() { 10035 }"; # TODO remove here and from @export_ok
      eval "sub WSAEINPROGRESS() { 10036 }";
   } else {
      # these should never match any errno value
      eval "sub WSAEINVAL()      { -1e99 }";
      eval "sub WSAEWOULDBLOCK() { -1e99 }";
      eval "sub WSAWOULDBLOCK() { -1e99 }"; # TODO
      eval "sub WSAEINPROGRESS() { -1e99 }";
   }
}

=item ($r, $w) = portable_pipe

Calling C<pipe> 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<pipe> everywhere else).

See C<portable_socketpair>, below, for a bidirectional "pipe".

Returns the empty list on any errors.

=item ($fh1, $fh2) = portable_socketpair

Just like C<portable_pipe>, above, but returns a bidirectional pipe
(usually by calling C<socketpair> 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

sub _win32_socketpair {
   # 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);
   }

   ()
}

sub portable_pipe() {
   return _win32_socketpair
      if AnyEvent::WIN32;

   my ($r, $w);

   pipe $r, $w
      or return;

   ($r, $w);
}

sub portable_socketpair() {
   return _win32_socketpair
      if AnyEvent::WIN32;

   socketpair my $fh1, my $fh2, &Socket::AF_UNIX, &Socket::SOCK_STREAM, &Socket::PF_UNSPEC
      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<Storable>).

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 C<undef>ined.

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<fork_calls> 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<IO::AIO>).

   fork_call {
      open my $fh, "</etc/passwd"
         or die "passwd: $!";
      local $/;
      <$fh>
   } sub {
      my ($passwd) = @_;
      ...
   };

=item $AnyEvent::Util::MAX_FORKS [default: 10]

The maximum number of child processes that C<fork_call> will fork in
parallel. Any additional requests will be queued until a slot becomes free
again.

The environment variable C<PERL_ANYEVENT_MAX_FORKS> 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;

   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 = AnyEvent->io (fh => $r, poll => 'r', cb => sub {
            my $len = sysread $r, $buf, 65536, length $buf;

            if ($len <= 0) {
               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 if $len <= 0;

            $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::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.

=cut

sub fh_nonblocking($$) {
   my ($fh, $nb) = @_;

   require Fcntl;

   if (AnyEvent::WIN32) {
      $nb = (! ! $nb) + 0;
      ioctl $fh, 0x8004667e, \$nb; # FIONBIO
   } else {
      fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0;
   }
}

=item $guard = guard { CODE }

This function creates a special object that, when called, 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<Guard> module will be used to implement this function, if it is
available. Otherwise a pure-perl implementation is used.

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 (eval "use Guard 0.5; 1") {
      *guard = \&Guard::guard;
   } else {
      *AnyEvent::Util::guard::DESTROY = sub {
         local $@;

         eval {
            local $SIG{__DIE__};
            ${$_[0]}->();
         };

         warn "runtime error in AnyEvent::guard callback: $@" if $@;
      };

      *AnyEvent::Util::guard::cancel = sub ($) {
         ${$_[0]} = sub { };
      };

      *guard = sub (&) {
         bless \(my $cb = shift), "AnyEvent::Util::guard"
      }
   }
}

1;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.79
Committed:	Mon Jun 29 21:00:32 2009 UTC (17 years ago) by root
Branch:	MAIN
CVS Tags:	rel-4_45
Changes since 1.78:	+1 -1 lines
Log Message:	* empty log message *
#	Content
1	=head1 NAME
2
3	AnyEvent::Util - various utility functions.
4
5	=head1 SYNOPSIS
6
7	use AnyEvent::Util;
8
9	=head1 DESCRIPTION
10
11	This module implements various utility functions, mostly replacing
12	well-known functions by event-ised counterparts.
13
14	All functions documented without C<AnyEvent::Util::> prefix are exported
15	by default.
16
17	=over 4
18
19	=cut
20
21	package AnyEvent::Util;
22
23	no warnings;
24	use strict;
25
26	use Carp ();
27	use Errno ();
28	use Socket ();
29
30	use AnyEvent ();
31
32	use base 'Exporter';
33
34	our @EXPORT = qw(fh_nonblocking guard fork_call portable_pipe portable_socketpair);
35	our @EXPORT_OK = qw(AF_INET6 WSAEWOULDBLOCK WSAEINPROGRESS WSAEINVAL WSAWOULDBLOCK);
36
37	our $VERSION = 4.45;
38
39	BEGIN {
40	my $posix = 1 * eval { local $SIG{__DIE__}; require POSIX };
41	eval "sub POSIX() { $posix }";
42	}
43
44	BEGIN {
45	# TODO remove this once not used anymore
46	*socket_inet_aton = \&Socket::inet_aton; # take a copy, in case Coro::LWP overrides it
47	}
48
49	BEGIN {
50	my $af_inet6 = eval { local $SIG{__DIE__}; &Socket::AF_INET6 };
51
52	# uhoh
53	$af_inet6 \|\|= 10 if $^O =~ /linux/;
54	$af_inet6 \|\|= 23 if $^O =~ /cygwin/i;
55	$af_inet6 \|\|= 23 if AnyEvent::WIN32;
56	$af_inet6 \|\|= 24 if $^O =~ /openbsd\|netbsd/;
57	$af_inet6 \|\|= 28 if $^O =~ /freebsd/;
58
59	$af_inet6 && socket my $ipv6_socket, $af_inet6, &Socket::SOCK_STREAM, 0 # check if they can be created
60	or $af_inet6 = 0;
61
62	eval "sub AF_INET6() { $af_inet6 }"; die if $@;
63
64	delete $AnyEvent::PROTOCOL{ipv6} unless $af_inet6;
65	}
66
67	BEGIN {
68	# broken windows perls use undocumented error codes...
69	if (AnyEvent::WIN32) {
70	eval "sub WSAEINVAL() { 10022 }";
71	eval "sub WSAEWOULDBLOCK() { 10035 }";
72	eval "sub WSAWOULDBLOCK() { 10035 }"; # TODO remove here and from @export_ok
73	eval "sub WSAEINPROGRESS() { 10036 }";
74	} else {
75	# these should never match any errno value
76	eval "sub WSAEINVAL() { -1e99 }";
77	eval "sub WSAEWOULDBLOCK() { -1e99 }";
78	eval "sub WSAWOULDBLOCK() { -1e99 }"; # TODO
79	eval "sub WSAEINPROGRESS() { -1e99 }";
80	}
81	}
82
83	=item ($r, $w) = portable_pipe
84
85	Calling C<pipe> in Perl is portable - except it doesn't really work on
86	sucky windows platforms (at least not with most perls - cygwin's perl
87	notably works fine): On windows, you actually get two file handles you
88	cannot use select on.
89
90	This function gives you a pipe that actually works even on the broken
91	windows platform (by creating a pair of TCP sockets on windows, so do not
92	expect any speed from that, and using C<pipe> everywhere else).
93
94	See C<portable_socketpair>, below, for a bidirectional "pipe".
95
96	Returns the empty list on any errors.
97
98	=item ($fh1, $fh2) = portable_socketpair
99
100	Just like C<portable_pipe>, above, but returns a bidirectional pipe
101	(usually by calling C<socketpair> to create a local loopback socket pair,
102	except on windows, where it again returns two interconnected TCP sockets).
103
104	Returns the empty list on any errors.
105
106	=cut
107
108	sub _win32_socketpair {
109	# perl's socketpair emulation fails on many vista machines, because
110	# vista returns fantasy port numbers.
111
112	for (1..10) {
113	socket my $l, &Socket::AF_INET, &Socket::SOCK_STREAM, 0
114	or next;
115
116	bind $l, Socket::pack_sockaddr_in 0, "\x7f\x00\x00\x01"
117	or next;
118
119	my $sa = getsockname $l
120	or next;
121
122	listen $l, 1
123	or next;
124
125	socket my $r, &Socket::AF_INET, &Socket::SOCK_STREAM, 0
126	or next;
127
128	bind $r, Socket::pack_sockaddr_in 0, "\x7f\x00\x00\x01"
129	or next;
130
131	connect $r, $sa
132	or next;
133
134	accept my $w, $l
135	or next;
136
137	# vista has completely broken peername/sockname that return
138	# fantasy ports. this combo seems to work, though.
139	#
140	(Socket::unpack_sockaddr_in getpeername $r)[0]
141	== (Socket::unpack_sockaddr_in getsockname $w)[0]
142	or (($! = WSAEINVAL), next);
143
144	# vista example (you can't make this shit up...):
145	#(Socket::unpack_sockaddr_in getsockname $r)[0] == 53364
146	#(Socket::unpack_sockaddr_in getpeername $r)[0] == 53363
147	#(Socket::unpack_sockaddr_in getsockname $w)[0] == 53363
148	#(Socket::unpack_sockaddr_in getpeername $w)[0] == 53365
149
150	return ($r, $w);
151	}
152
153	()
154	}
155
156	sub portable_pipe() {
157	return _win32_socketpair
158	if AnyEvent::WIN32;
159
160	my ($r, $w);
161
162	pipe $r, $w
163	or return;
164
165	($r, $w);
166	}
167
168	sub portable_socketpair() {
169	return _win32_socketpair
170	if AnyEvent::WIN32;
171
172	socketpair my $fh1, my $fh2, &Socket::AF_UNIX, &Socket::SOCK_STREAM, &Socket::PF_UNSPEC
173	or return;
174
175	($fh1, $fh2)
176	}
177
178	=item fork_call { CODE } @args, $cb->(@res)
179
180	Executes the given code block asynchronously, by forking. Everything the
181	block returns will be transferred to the calling process (by serialising and
182	deserialising via L<Storable>).
183
184	If there are any errors, then the C<$cb> will be called without any
185	arguments. In that case, either C<$@> contains the exception (and C<$!> is
186	irrelevant), or C<$!> contains an error number. In all other cases, C<$@>
187	will be C<undef>ined.
188
189	The code block must not ever call an event-polling function or use
190	event-based programming that might cause any callbacks registered in the
191	parent to run.
192
193	Win32 spoilers: Due to the endlessly sucky and broken native windows
194	perls (there is no way to cleanly exit a child process on that platform
195	that doesn't also kill the parent), you have to make sure that your main
196	program doesn't exit as long as any C<fork_calls> are still in progress,
197	otherwise the program won't exit. Also, on most windows platforms some
198	memory will leak for every invocation. We are open for improvements that
199	don't require XS hackery.
200
201	Note that forking can be expensive in large programs (RSS 200MB+). On
202	windows, it is abysmally slow, do not expect more than 5..20 forks/s on
203	that sucky platform (note this uses perl's pseudo-threads, so avoid those
204	like the plague).
205
206	Example: poor man's async disk I/O (better use L<IO::AIO>).
207
208	fork_call {
209	open my $fh, "</etc/passwd"
210	or die "passwd: $!";
211	local $/;
212	<$fh>
213	} sub {
214	my ($passwd) = @_;
215	...
216	};
217
218	=item $AnyEvent::Util::MAX_FORKS [default: 10]
219
220	The maximum number of child processes that C<fork_call> will fork in
221	parallel. Any additional requests will be queued until a slot becomes free
222	again.
223
224	The environment variable C<PERL_ANYEVENT_MAX_FORKS> is used to initialise
225	this value.
226
227	=cut
228
229	our $MAX_FORKS = int 1 * $ENV{PERL_ANYEVENT_MAX_FORKS};
230	$MAX_FORKS = 10 if $MAX_FORKS <= 0;
231
232	my $forks;
233	my @fork_queue;
234
235	sub _fork_schedule;
236	sub _fork_schedule {
237	require Storable;
238
239	while ($forks < $MAX_FORKS) {
240	my $job = shift @fork_queue
241	or last;
242
243	++$forks;
244
245	my $coderef = shift @$job;
246	my $cb = pop @$job;
247
248	# gimme a break...
249	my ($r, $w) = portable_pipe
250	or ($forks and last) # allow failures when we have at least one job
251	or die "fork_call: $!";
252
253	my $pid = fork;
254
255	if ($pid != 0) {
256	# parent
257	close $w;
258
259	my $buf;
260
261	my $ww; $ww = AnyEvent->io (fh => $r, poll => 'r', cb => sub {
262	my $len = sysread $r, $buf, 65536, length $buf;
263
264	if ($len <= 0) {
265	undef $ww;
266	close $r;
267	--$forks;
268	_fork_schedule;
269
270	my $result = eval { Storable::thaw ($buf) };
271	$result = [$@] unless $result;
272	$@ = shift @$result;
273
274	$cb->(@$result);
275
276	# work around the endlessly broken windows perls
277	kill 9, $pid if AnyEvent::WIN32;
278
279	# clean up the pid
280	waitpid $pid, 0;
281	}
282	});
283
284	} elsif (defined $pid) {
285	# child
286	close $r;
287
288	my $result = eval {
289	local $SIG{__DIE__};
290
291	Storable::freeze ([undef, $coderef->(@$job)])
292	};
293
294	$result = Storable::freeze (["$@"])
295	if $@;
296
297	# windows forces us to these contortions
298	my $ofs;
299
300	while () {
301	my $len = (length $result) - $ofs
302	or last;
303
304	$len = syswrite $w, $result, $len < 65536 ? $len : 65536, $ofs;
305
306	last if $len <= 0;
307
308	$ofs += $len;
309	}
310
311	# on native windows, _exit KILLS YOUR FORKED CHILDREN!
312	if (AnyEvent::WIN32) {
313	shutdown $w, 1; # signal parent to please kill us
314	sleep 10; # give parent a chance to clean up
315	sysread $w, my $buf, 1; # this might detect the parent exiting in some cases.
316	}
317	POSIX::_exit (0);
318	exit 1;
319
320	} elsif (($! != &Errno::EAGAIN && $! != &Errno::ENOMEM) \|\| !$forks) {
321	# we ignore some errors as long as we can run at least one job
322	# maybe we should wait a few seconds and retry instead
323	die "fork_call: $!";
324	}
325	}
326	}
327
328	sub fork_call(&@) {
329	push @fork_queue, [@_];
330	_fork_schedule;
331	}
332
333	END {
334	if (AnyEvent::WIN32) {
335	while ($forks) {
336	@fork_queue = ();
337	AnyEvent->one_event;
338	}
339	}
340	}
341
342	# to be removed
343	sub dotted_quad($) {
344	$_[0] =~ /^(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
345	\.(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
346	\.(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
347	\.(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)$/x
348	}
349
350	# just a forwarder
351	sub inet_aton {
352	require AnyEvent::Socket;
353	*inet_aton = \&AnyEvent::Socket::inet_aton;
354	goto &inet_aton
355	}
356
357	=item fh_nonblocking $fh, $nonblocking
358
359	Sets the blocking state of the given filehandle (true == nonblocking,
360	false == blocking). Uses fcntl on anything sensible and ioctl FIONBIO on
361	broken (i.e. windows) platforms.
362
363	=cut
364
365	sub fh_nonblocking($$) {
366	my ($fh, $nb) = @_;
367
368	require Fcntl;
369
370	if (AnyEvent::WIN32) {
371	$nb = (! ! $nb) + 0;
372	ioctl $fh, 0x8004667e, \$nb; # FIONBIO
373	} else {
374	fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0;
375	}
376	}
377
378	=item $guard = guard { CODE }
379
380	This function creates a special object that, when called, will execute the
381	code block.
382
383	This is often handy in continuation-passing style code to clean up some
384	resource regardless of where you break out of a process.
385
386	The L<Guard> module will be used to implement this function, if it is
387	available. Otherwise a pure-perl implementation is used.
388
389	You can call one method on the returned object:
390
391	=item $guard->cancel
392
393	This simply causes the code block not to be invoked: it "cancels" the
394	guard.
395
396	=cut
397
398	BEGIN {
399	if (eval "use Guard 0.5; 1") {
400	*guard = \&Guard::guard;
401	} else {
402	*AnyEvent::Util::guard::DESTROY = sub {
403	local $@;
404
405	eval {
406	local $SIG{__DIE__};
407	${$_[0]}->();
408	};
409
410	warn "runtime error in AnyEvent::guard callback: $@" if $@;
411	};
412
413	*AnyEvent::Util::guard::cancel = sub ($) {
414	${$_[0]} = sub { };
415	};
416
417	*guard = sub (&) {
418	bless \(my $cb = shift), "AnyEvent::Util::guard"
419	}
420	}
421	}
422
423	1;
424
425	=back
426
427	=head1 AUTHOR
428
429	Marc Lehmann <schmorp@schmorp.de>
430	http://home.schmorp.de/
431
432	=cut
433