lib/AnyEvent/Util.pm

=head1 NAME

AnyEvent::Util - various utility functions.

=head1 SYNOPSIS

 use AnyEvent::Util;

 inet_aton $name, $cb->($ipn || undef);

=head1 DESCRIPTION

This module implements various utility functions, mostly replacing
well-known functions by event-ised counterparts.

=over 4

=cut

package AnyEvent::Util;

use strict;

no warnings "uninitialized";

use Socket ();

use AnyEvent;

use base 'Exporter';

#our @EXPORT = qw(gethostbyname gethostbyaddr);
our @EXPORT_OK = qw(inet_aton);

our $VERSION = '1.0';

our $MAXPARALLEL = 16; # max. number of parallel jobs

our $running;
our @queue;

sub _schedule;
sub _schedule {
   return unless @queue;
   return if $running >= $MAXPARALLEL;

   ++$running;
   my ($cb, $sub, @args) = @{shift @queue};

   if (eval { local $SIG{__DIE__}; require POSIX }) {
      my $pid = open my $fh, "-|";

      if (!defined $pid) {
         die "fork: $!";
      } elsif (!$pid) {
         syswrite STDOUT, join "\0", map { unpack "H*", $_ } $sub->(@args);
         POSIX::_exit (0);
      }

      my $w; $w = AnyEvent->io (fh => $fh, poll => 'r', cb => sub {
         --$running;
         _schedule;
         undef $w;

         my $buf;
         sysread $fh, $buf, 16384, length $buf;
         $cb->(map { pack "H*", $_ } split /\0/, $buf);
      });
   } else {
      $cb->($sub->(@args));
   }
}

sub _do_asy {
   push @queue, [@_];
   _schedule;
}

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
}

my $has_ev_adns;

sub has_ev_adns {
   ($has_ev_adns ||= do {
      my $model = AnyEvent::detect;
      (($model eq "AnyEvent::Impl::CoroEV" or $model eq "AnyEvent::Impl::EV")
       && eval { local $SIG{__DIE__}; require EV::ADNS })
         ? 2 : 1 # so that || always detects as true
   }) - 1  # 2 => true, 1 => false
}

=item AnyEvent::Util::inet_aton $name_or_address, $cb->($binary_address_or_undef)

Works almost exactly like its Socket counterpart, except that it uses a
callback.

=cut

sub inet_aton {
   my ($name, $cb) = @_;

   if (&dotted_quad) {
      $cb->(Socket::inet_aton $name);
   } elsif ($name eq "localhost") { # rfc2606 et al.
      $cb->(v127.0.0.1);
   } elsif (&has_ev_adns) {
      EV::ADNS::submit ($name, &EV::ADNS::r_addr, 0, sub {
         my (undef, undef, @a) = @_;
         $cb->(@a ? Socket::inet_aton $a[0] : undef);
      });
   } else {
      _do_asy $cb, sub { Socket::inet_aton $_[0] }, @_;
   }
}

=item AnyEvent::Util::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 ($^O eq "MSWin32") {
      $nb = (! ! $nb) + 0;
      ioctl $fh, 0x8004667e, \$nb; # FIONBIO
   } else {
      fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0;
   }
}

1;

=back

=head1 AUTHOR

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

=cut

Revision:	1.6
Committed:	Fri May 2 15:36:10 2008 UTC (16 years, 2 months ago) by root
Branch:	MAIN
Changes since 1.5:	+23 -0 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::Util - various utility functions.
4
5			=head1 SYNOPSIS
6
7			use AnyEvent::Util;
8
9	root	1.4	inet_aton $name, $cb->($ipn \|\| undef);
10	root	1.1
11			=head1 DESCRIPTION
12
13			This module implements various utility functions, mostly replacing
14			well-known functions by event-ised counterparts.
15
16			=over 4
17
18			=cut
19
20			package AnyEvent::Util;
21
22			use strict;
23
24			no warnings "uninitialized";
25
26			use Socket ();
27
28			use AnyEvent;
29
30			use base 'Exporter';
31
32			#our @EXPORT = qw(gethostbyname gethostbyaddr);
33	root	1.4	our @EXPORT_OK = qw(inet_aton);
34	root	1.1
35			our $VERSION = '1.0';
36
37			our $MAXPARALLEL = 16; # max. number of parallel jobs
38
39			our $running;
40			our @queue;
41
42			sub _schedule;
43			sub _schedule {
44			return unless @queue;
45			return if $running >= $MAXPARALLEL;
46
47			++$running;
48			my ($cb, $sub, @args) = @{shift @queue};
49
50	root	1.2	if (eval { local $SIG{__DIE__}; require POSIX }) {
51	root	1.1	my $pid = open my $fh, "-\|";
52
53			if (!defined $pid) {
54			die "fork: $!";
55			} elsif (!$pid) {
56			syswrite STDOUT, join "\0", map { unpack "H*", $_ } $sub->(@args);
57			POSIX::_exit (0);
58			}
59
60			my $w; $w = AnyEvent->io (fh => $fh, poll => 'r', cb => sub {
61			--$running;
62			_schedule;
63			undef $w;
64
65			my $buf;
66			sysread $fh, $buf, 16384, length $buf;
67			$cb->(map { pack "H*", $_ } split /\0/, $buf);
68			});
69			} else {
70			$cb->($sub->(@args));
71			}
72			}
73
74			sub _do_asy {
75			push @queue, [@_];
76			_schedule;
77			}
78
79			sub dotted_quad($) {
80			$_[0] =~ /^(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
81			\.(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
82			\.(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
83			\.(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)$/x
84			}
85
86			my $has_ev_adns;
87
88			sub has_ev_adns {
89			($has_ev_adns \|\|= do {
90			my $model = AnyEvent::detect;
91			(($model eq "AnyEvent::Impl::CoroEV" or $model eq "AnyEvent::Impl::EV")
92	root	1.3	&& eval { local $SIG{__DIE__}; require EV::ADNS })
93			? 2 : 1 # so that \|\| always detects as true
94			}) - 1 # 2 => true, 1 => false
95	root	1.1	}
96
97			=item AnyEvent::Util::inet_aton $name_or_address, $cb->($binary_address_or_undef)
98
99			Works almost exactly like its Socket counterpart, except that it uses a
100			callback.
101
102			=cut
103
104			sub inet_aton {
105			my ($name, $cb) = @_;
106
107			if (&dotted_quad) {
108			$cb->(Socket::inet_aton $name);
109	root	1.6	} elsif ($name eq "localhost") { # rfc2606 et al.
110			$cb->(v127.0.0.1);
111	root	1.4	} elsif (&has_ev_adns) {
112	root	1.5	EV::ADNS::submit ($name, &EV::ADNS::r_addr, 0, sub {
113	root	1.4	my (undef, undef, @a) = @_;
114	root	1.1	$cb->(@a ? Socket::inet_aton $a[0] : undef);
115			});
116			} else {
117			_do_asy $cb, sub { Socket::inet_aton $_[0] }, @_;
118			}
119			}
120
121	root	1.6	=item AnyEvent::Util::fh_nonblocking $fh, $nonblocking
122
123			Sets the blocking state of the given filehandle (true == nonblocking,
124			false == blocking). Uses fcntl on anything sensible and ioctl FIONBIO on
125			broken (i.e. windows) platforms.
126
127			=cut
128
129			sub fh_nonblocking($$) {
130			my ($fh, $nb) = @_;
131
132			require Fcntl;
133
134			if ($^O eq "MSWin32") {
135			$nb = (! ! $nb) + 0;
136			ioctl $fh, 0x8004667e, \$nb; # FIONBIO
137			} else {
138			fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0;
139			}
140			}
141
142	root	1.1	1;
143
144			=back
145
146			=head1 AUTHOR
147
148			Marc Lehmann <schmorp@schmorp.de>
149			http://home.schmorp.de/
150
151			=cut
152