Coro/Coro/Util.pm

=head1 NAME

Coro::Util - various utility functions.

=head1 SYNOPSIS

 use Coro::Util;

=head1 DESCRIPTION

This module implements various utility functions, mostly replacing perl
functions by non-blocking counterparts.

This module is an AnyEvent user. Refer to the L<AnyEvent|AnyEvent>
documentation to see how to integrate it into your own programs.

=over 4

=cut

package Coro::Util;

use strict;

no warnings "uninitialized";

use AnyEvent;

use Coro::State;
use Coro::Semaphore;

use base 'Exporter';

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

our $VERSION = 2.0;

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

my $jobs = new Coro::Semaphore $MAXPARALLEL;

sub _do_asy(&;@) {
   my $sub = shift;
   $jobs->down;
   my $fh;
   if (0 == open $fh, "-|") {
      syswrite STDOUT, join "\0", map { unpack "H*", $_ } &$sub;
      Coro::State::_exit 0;
   }
   my $buf;
   my $current = $Coro::current;
   my $w; $w = AnyEvent->io (fh => $fh, poll => 'r', cb => sub {
      sysread $fh, $buf, 16384, length $buf
         and return;

      undef $w;
      $current->ready;
   });
   Coro::schedule;
   $jobs->up;
   my @r = map { pack "H*", $_ } split /\0/, $buf;
   wantarray ? @r : $r[0];
}

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]?)$/
}

=item gethostbyname, gethostbyaddr

Work exactly like their perl counterparts, but do not block. Currently
this is being implemented with forking, so it's not exactly low-cost.

=cut

my $netdns = eval { die; require Net::DNS::Resolver; new Net::DNS::Resolver; };

sub gethostbyname($) {
   if ($netdns) {
      #$netdns->query($_[0]);
      die;
   } else {
      _do_asy { gethostbyname $_[0] } @_
   }
}

sub gethostbyaddr($$) {
   if ($netdns) {
      die;
   } else {
      _do_asy { gethostbyaddr $_[0], $_[1] } @_
   }
}

=item Coro::Util::inet_aton

Works almost exactly like its Socket counterpart, except that it does not
block. Is implemented with forking, so not exactly low-cost.

=cut

use Socket;

our $inet_aton = \&Socket::inet_aton;

sub inet_aton {
   require Socket;

   if (dotted_quad $_[0]) {
      $inet_aton->($_[0])
   } else {
      _do_asy { $inet_aton->($_[0]) } @_
   }
}

1;

=head1 AUTHOR

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

=cut

Revision:	1.5
Committed:	Sun Nov 5 02:01:24 2006 UTC (17 years, 7 months ago) by root
Branch:	MAIN
CVS Tags:	rel-2_5, stack_sharing
Changes since 1.4:	+37 -8 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Coro::Util - various utility functions.
4
5			=head1 SYNOPSIS
6
7			use Coro::Util;
8
9			=head1 DESCRIPTION
10
11			This module implements various utility functions, mostly replacing perl
12			functions by non-blocking counterparts.
13
14	root	1.4	This module is an AnyEvent user. Refer to the L<AnyEvent\|AnyEvent>
15			documentation to see how to integrate it into your own programs.
16
17	root	1.1	=over 4
18
19			=cut
20
21			package Coro::Util;
22
23	root	1.5	use strict;
24
25	root	1.4	no warnings "uninitialized";
26
27			use AnyEvent;
28	root	1.1
29	root	1.4	use Coro::State;
30	root	1.1	use Coro::Semaphore;
31
32			use base 'Exporter';
33
34	root	1.5	our @EXPORT = qw(gethostbyname gethostbyaddr);
35			our @EXPORT_OK = qw(inet_aton);
36	root	1.1
37	root	1.5	our $VERSION = 2.0;
38	root	1.1
39	root	1.5	our $MAXPARALLEL = 16; # max. number of parallel jobs
40	root	1.1
41			my $jobs = new Coro::Semaphore $MAXPARALLEL;
42
43			sub _do_asy(&;@) {
44			my $sub = shift;
45			$jobs->down;
46			my $fh;
47			if (0 == open $fh, "-\|") {
48			syswrite STDOUT, join "\0", map { unpack "H*", $_ } &$sub;
49	root	1.4	Coro::State::_exit 0;
50	root	1.1	}
51			my $buf;
52	root	1.4	my $current = $Coro::current;
53			my $w; $w = AnyEvent->io (fh => $fh, poll => 'r', cb => sub {
54			sysread $fh, $buf, 16384, length $buf
55			and return;
56
57			undef $w;
58			$current->ready;
59			});
60			Coro::schedule;
61	root	1.1	$jobs->up;
62			my @r = map { pack "H*", $_ } split /\0/, $buf;
63			wantarray ? @r : $r[0];
64			}
65
66	root	1.5	sub dotted_quad($) {
67			$_[0] =~ /^(25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
68			\.(25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
69			\.(25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)
70			\.(25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)$/
71			}
72
73	root	1.1	=item gethostbyname, gethostbyaddr
74
75			Work exactly like their perl counterparts, but do not block. Currently
76	root	1.5	this is being implemented with forking, so it's not exactly low-cost.
77	root	1.1
78			=cut
79
80	root	1.4	my $netdns = eval { die; require Net::DNS::Resolver; new Net::DNS::Resolver; };
81
82	root	1.1	sub gethostbyname($) {
83	root	1.4	if ($netdns) {
84			#$netdns->query($_[0]);
85			die;
86			} else {
87	root	1.5	_do_asy { gethostbyname $_[0] } @_
88	root	1.4	}
89	root	1.1	}
90
91			sub gethostbyaddr($$) {
92	root	1.4	if ($netdns) {
93			die;
94			} else {
95	root	1.5	_do_asy { gethostbyaddr $_[0], $_[1] } @_
96			}
97			}
98
99			=item Coro::Util::inet_aton
100
101			Works almost exactly like its Socket counterpart, except that it does not
102			block. Is implemented with forking, so not exactly low-cost.
103
104			=cut
105
106			use Socket;
107
108			our $inet_aton = \&Socket::inet_aton;
109
110			sub inet_aton {
111			require Socket;
112
113			if (dotted_quad $_[0]) {
114			$inet_aton->($_[0])
115			} else {
116			_do_asy { $inet_aton->($_[0]) } @_
117	root	1.4	}
118	root	1.1	}
119
120			1;
121
122			=head1 AUTHOR
123
124	root	1.4	Marc Lehmann <schmorp@schmorp.de>
125			http://home.schmorp.de/
126	root	1.1
127			=cut
128