Daniel Dragan <bulk88@hotmail.com>
Daniel Frederick Crisman <daniel@crisman.org>
Daniel Grisinger <dgris@dimensional.com>
-Daniel Kahn Gillmor <dkg@fifthhorseman.net>
Daniel Lieberman <daniel@bitpusher.com>
Daniel MuiƱo <dmuino@afip.gov.ar>
Daniel P. Berrange <dan@berrange.com>
dist/IO/poll.c IO poll() emulation using select()
dist/IO/poll.h IO poll() emulation using select()
dist/IO/README IO extension maintenance notice
-dist/IO/t/cachepropagate-tcp.t See if IO::Socket duplication works
-dist/IO/t/cachepropagate-udp.t See if IO::Socket duplication works
-dist/IO/t/cachepropagate-unix.t See if IO::Socket duplication works
dist/IO/t/io_const.t See if constants from IO work
dist/IO/t/io_dir.t See if directory-related methods from IO work
dist/IO/t/io_dup.t See if dup()-related methods from IO work
- dist/IO/poll.c
- dist/IO/poll.h
- dist/IO/README
- - dist/IO/t/cachepropagate-tcp.t
- - dist/IO/t/cachepropagate-udp.t
- - dist/IO/t/cachepropagate-unix.t
- dist/IO/t/IO.t
- dist/IO/t/io_const.t
- dist/IO/t/io_dir.t
OBJECT => '$(O_FILES)',
ABSTRACT => 'Perl core IO modules',
AUTHOR => 'Graham Barr <gbarr@cpan.org>',
- PREREQ_PM => {
- 'Test::More' => 0,
- },
( $PERL_CORE
? ()
: (
@ISA = qw(IO::Handle);
-$VERSION = "1.35";
+$VERSION = "1.34";
@EXPORT_OK = qw(sockatmark);
sub sockdomain {
@_ == 1 or croak 'usage: $sock->sockdomain()';
my $sock = shift;
- if (!defined(${*$sock}{'io_socket_domain'})) {
- my $addr = $sock->sockname();
- ${*$sock}{'io_socket_domain'} = sockaddr_family($addr)
- if (defined($addr));
- }
${*$sock}{'io_socket_domain'};
}
sub socktype {
@_ == 1 or croak 'usage: $sock->socktype()';
my $sock = shift;
- ${*$sock}{'io_socket_type'} = $sock->sockopt(Socket::SO_TYPE)
- if (!defined(${*$sock}{'io_socket_type'}) && defined(eval{Socket::SO_TYPE}));
${*$sock}{'io_socket_type'}
}
sub protocol {
@_ == 1 or croak 'usage: $sock->protocol()';
my($sock) = @_;
- ${*$sock}{'io_socket_proto'} = $sock->sockopt(Socket::SO_PROTOCOL)
- if (!defined(${*$sock}{'io_socket_proto'}) && defined(eval{Socket::SO_PROTOCOL}));
${*$sock}{'io_socket_proto'};
}
+++ /dev/null
-#!/usr/bin/perl
-
-use warnings;
-use strict;
-
-use IO::Socket;
-use IO::Socket::INET;
-use Socket;
-use Config;
-use Test::More;
-
-plan tests => 8;
-
-my $listener = IO::Socket::INET->new(Listen => 1,
- LocalAddr => '127.0.0.1',
- Proto => 'tcp');
-ok(defined($listener), 'socket created');
-
-my $port = $listener->sockport();
-
-my $p = $listener->protocol();
-ok(defined($p), 'protocol defined');
-my $d = $listener->sockdomain();
-ok(defined($d), 'domain defined');
-my $s = $listener->socktype();
-ok(defined($s), 'type defined');
-
-SKIP: {
- $Config{d_pseudofork} || $Config{d_fork}
- or skip("no fork", 4);
- my $cpid = fork();
- if (0 == $cpid) {
- # the child:
- sleep(1);
- my $connector = IO::Socket::INET->new(PeerAddr => '127.0.0.1',
- PeerPort => $port,
- Proto => 'tcp');
- exit(0);
- } else {;
- ok(defined($cpid), 'spawned a child');
- }
-
- my $new = $listener->accept();
-
- is($new->sockdomain(), $d, 'domain match');
- SKIP: {
- skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
- is($new->protocol(), $p, 'protocol match');
- }
- SKIP: {
- skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
- is($new->socktype(), $s, 'type match');
- }
-
- wait();
-}
+++ /dev/null
-#!/usr/bin/perl
-
-use warnings;
-use strict;
-
-use IO::Socket;
-use IO::Socket::INET;
-use Socket;
-use Test::More;
-
-plan tests => 7;
-
-my $listener = IO::Socket::INET->new(LocalAddr => '127.0.0.1',
- Proto => 'udp');
-ok(defined($listener), 'socket created');
-
-my $p = $listener->protocol();
-ok(defined($p), 'protocol defined');
-my $d = $listener->sockdomain();
-ok(defined($d), 'domain defined');
-my $s = $listener->socktype();
-ok(defined($s), 'type defined');
-
-my $new = IO::Socket::INET->new_from_fd($listener->fileno(), 'r+');
-
-is($new->sockdomain(), $d, 'domain match');
-SKIP: {
- skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
- is($new->protocol(), $p, 'protocol match');
-}
-SKIP: {
- skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
- is($new->socktype(), $s, 'type match');
-}
+++ /dev/null
-#!/usr/bin/perl
-
-use warnings;
-use strict;
-
-use File::Temp qw(tempdir);
-use File::Spec::Functions;
-use IO::Socket;
-use IO::Socket::UNIX;
-use Socket;
-use Config;
-use Test::More;
-
-plan tests => 15;
-
-SKIP: {
- skip "UNIX domain sockets not implemented on $^O", 15 if ($^O =~ m/^(?:qnx|nto|vos|MSWin32)$/);
-
- my $socketpath = catfile(tempdir( CLEANUP => 1 ), 'testsock');
-
- # start testing stream sockets:
-
- my $listener = IO::Socket::UNIX->new(Type => SOCK_STREAM,
- Listen => 1,
- Local => $socketpath);
- ok(defined($listener), 'stream socket created');
-
- my $p = $listener->protocol();
- ok(defined($p), 'protocol defined');
- my $d = $listener->sockdomain();
- ok(defined($d), 'domain defined');
- my $s = $listener->socktype();
- ok(defined($s), 'type defined');
-
- SKIP: {
- $Config{d_pseudofork} || $Config{d_fork}
- or skip("no fork", 4);
- my $cpid = fork();
- if (0 == $cpid) {
- # the child:
- sleep(1);
- my $connector = IO::Socket::UNIX->new(Peer => $socketpath);
- exit(0);
- } else {
- ok(defined($cpid), 'spawned a child');
- }
-
- my $new = $listener->accept();
-
- is($new->sockdomain(), $d, 'domain match');
- SKIP: {
- skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
- is($new->protocol(), $p, 'protocol match');
- }
- SKIP: {
- skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
- is($new->socktype(), $s, 'type match');
- }
-
- unlink($socketpath);
- wait();
- }
-
- # now test datagram sockets:
- $listener = IO::Socket::UNIX->new(Type => SOCK_DGRAM,
- Local => $socketpath);
- ok(defined($listener), 'datagram socket created');
-
- $p = $listener->protocol();
- ok(defined($p), 'protocol defined');
- $d = $listener->sockdomain();
- ok(defined($d), 'domain defined');
- $s = $listener->socktype();
- ok(defined($s), 'type defined');
-
- my $new = IO::Socket::UNIX->new_from_fd($listener->fileno(), 'r+');
-
- is($new->sockdomain(), $d, 'domain match');
- SKIP: {
- skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
- is($new->protocol(), $p, 'protocol match');
- }
- SKIP: {
- skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
- is($new->socktype(), $s, 'type match');
- }
- unlink($socketpath);
-}