use strict;
use warnings;
-our $VERSION = "1.43";
+our $VERSION = "1.44";
XSLoader::load 'IO', $VERSION;
sub import {
unless ( $PERL_CORE or exists $Config{'i_poll'} ) {
my @inc = split( /\s+/, join( " ", $Config{'usrinc'}, $Config{'incpth'}, $Config{'locincpth'} ) );
- foreach $path (@inc) {
+ foreach my $path (@inc) {
if ( -f $path . "/poll.h" ) {
$define .= "-DI_POLL ";
last;
our @ISA = qw(IO::Handle);
-our $VERSION = "1.43";
+our $VERSION = "1.44";
our @EXPORT_OK = qw(sockatmark);
if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
require IO::Select;
- my $sel = new IO::Select $sock;
+ my $sel = IO::Select->new( $sock );
undef $!;
my($r,$w,$e) = IO::Select::select(undef,$sel,$sel,$timeout);
if(defined $timeout) {
require IO::Select;
- my $sel = new IO::Select $sock;
+ my $sel = IO::Select->new( $sock );
unless ($sel->can_read($timeout)) {
$@ = 'accept: timeout';
print "1..6\n";
my $i = 1;
foreach (qw(SEEK_SET SEEK_CUR SEEK_END _IOFBF _IOLBF _IONBF)) {
+ no strict 'refs';
my $d1 = defined(&{"IO::Handle::" . $_}) ? 1 : 0;
my $v1 = $d1 ? &{"IO::Handle::" . $_}() : undef;
my $v2 = IO::Handle::constant($_);
#!./perl
+use strict;
+use File::Temp qw( tempdir );
+use Cwd;
+
+no strict 'subs';
+
BEGIN {
require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl");
plan(16);
IO::Dir->import(DIR_UNLINK);
}
-use strict;
-use File::Temp qw( tempdir );
-use Cwd;
-
my $cwd = cwd();
{
print "ok 1\n";
-$dupout = IO::Handle->new->fdopen( \*STDOUT ,"w");
-$duperr = IO::Handle->new->fdopen( \*STDERR ,"w");
+my $dupout = IO::Handle->new->fdopen( \*STDOUT ,"w");
+my $duperr = IO::Handle->new->fdopen( \*STDERR ,"w");
-$stdout = \*STDOUT; bless $stdout, "IO::File"; # "IO::Handle";
-$stderr = \*STDERR; bless $stderr, "IO::Handle";
+my $stdout = \*STDOUT; bless $stdout, "IO::File"; # "IO::Handle";
+my $stderr = \*STDERR; bless $stderr, "IO::Handle";
$stdout->open( "Io.dup","w") || die "Can't open stdout";
$stderr->fdopen($stdout,"w");
print $stderr "ok 3\n";
# Since some systems don't have echo, we use Perl.
-$echo = qq{$^X -le "print q(ok %d)"};
+my $echo = qq{$^X -le "print q(ok %d)"};
-$cmd = sprintf $echo, 4;
+my $cmd = sprintf $echo, 4;
print `$cmd`;
$cmd = sprintf "$echo 1>&2", 5;
BEGIN {
$File = __FILE__;
- require strict; import strict;
+ require strict; strict->import();
}
use Test::More tests => 12;
package Multi;
require IO::Socket::INET;
-@ISA=qw(IO::Socket::INET);
+our @ISA=qw(IO::Socket::INET);
use Socket qw(inet_aton inet_ntoa unpack_sockaddr_in);
use IO::Socket;
-$listen = IO::Socket::INET->new(LocalAddr => 'localhost',
+my $listen = IO::Socket::INET->new(LocalAddr => 'localhost',
Listen => 2,
Proto => 'tcp',
Timeout => 5,
print "ok 1\n";
-$port = $listen->sockport;
+my $port = $listen->sockport;
-if($pid = fork()) {
+if (my $pid = fork()) {
- $sock = $listen->accept() or die "$!";
+ my $sock = $listen->accept() or die "$!";
print "ok 5\n";
print $sock->getline();
} elsif(defined $pid) {
- $sock = Multi->new(PeerPort => $port,
+ my $sock = Multi->new(PeerPort => $port,
Proto => 'tcp',
PeerAddr => 'localhost',
MultiHomed => 1,
$| = 1;
print "1..10\n";
+my $pipe;
+
if ($is_win32) {
print "ok $_ # skipped: $is_win32\n" for 1..4;
} else {
- $pipe = new IO::Pipe->reader($perl, '-e', 'print qq(not ok 1\n)');
+ $pipe = IO::Pipe->new()->reader($perl, '-e', 'print qq(not ok 1\n)');
while (<$pipe>) {
s/^not //;
print;
}
$pipe->close or print "# \$!=$!\nnot ";
print "ok 2\n";
- $cmd = 'BEGIN{$SIG{ALRM} = sub {print qq(not ok 4\n); exit}; alarm 10} s/not //';
- $pipe = new IO::Pipe->writer($perl, '-pe', $cmd);
+ my $cmd = 'BEGIN{$SIG{ALRM} = sub {print qq(not ok 4\n); exit}; alarm 10} s/not //';
+ $pipe = IO::Pipe->new()->writer($perl, '-pe', $cmd);
print $pipe "not ok 3\n" ;
$pipe->close or print "# \$!=$!\nnot ";
print "ok 4\n";
exit 0;
}
-$pipe = new IO::Pipe;
+$pipe = IO::Pipe->new();
-$pid = fork();
+my $pid = fork();
if($pid)
{
elsif(defined $pid)
{
$pipe->reader;
- $stdin = bless \*STDIN, "IO::Handle";
+ my $stdin = bless \*STDIN, "IO::Handle";
$stdin->fdopen($pipe,"r");
exec $^X, '-pne', 'tr/YX/ko/';
}
if ($is_win32) {
print "ok $_ # skipped: $is_win32\n" for 7..8;
} else {
- $pipe = new IO::Pipe;
- $pid = fork();
+ $pipe = IO::Pipe->new();
+ my $pid = fork();
if($pid)
{
{
$pipe->writer;
- $stdout = bless \*STDOUT, "IO::Handle";
+ my $stdout = bless \*STDOUT, "IO::Handle";
$stdout->fdopen($pipe,"w");
print STDOUT "not ok 7\n";
my @echo = 'echo';
if ($is_win32) {
print "ok $_ # skipped: $is_win32\n" for 9;
} else {
- $pipe = new IO::Pipe;
+ $pipe = IO::Pipe->new;
$pipe->writer;
$SIG{'PIPE'} = 'broken_pipe';
use IO::Handle;
use IO::Poll qw(/POLL/);
-my $poll = new IO::Poll;
+my $poll = IO::Poll->new();
my $stdout = \*STDOUT;
my $dupout = IO::Handle->new_from_fd(fileno($stdout),"w");
use IO::Select 1.09;
-my $sel = new IO::Select(\*STDIN);
+my $sel = IO::Select->new(\*STDIN);
$sel->add(4, 5) == 2 or print "not ";
print "ok 1\n";
$sel->add([\*STDOUT, 'foo']) == 1 or print "not ";
print "ok 2\n";
-@handles = $sel->handles;
+my @handles = $sel->handles;
print "not " unless $sel->count == 4 && @handles == 4;
print "ok 3\n";
#print $sel->as_string, "\n";
print "not " unless $sel->count == 0 && !defined($sel->bits);
print "ok 7\n";
-$sel = new IO::Select;
+$sel = IO::Select->new();
print "not " unless $sel->count == 0 && !defined($sel->bits);
print "ok 8\n";
goto POST_SOCKET;
}
-@a = $sel->can_read(); # should return immediately
+my @a = $sel->can_read(); # should return immediately
print "not " unless @a == 0;
print "ok 10\n";
print "not " unless @a == 3;
print "ok 13\n";
-($r, $w, $e) = @a;
+my ($r, $w, $e) = @a;
print "not " unless @$r == 0 && @$w == 1 && @$e == 0;
print "ok 14\n";
}
}
-my $has_perlio = find PerlIO::Layer 'perlio';
+my $has_perlio = PerlIO::Layer->find( 'perlio' );
$| = 1;
print "1..26\n";
use IO::Socket;
-$listen = IO::Socket::INET->new(LocalAddr => 'localhost',
+my $listen = IO::Socket::INET->new(LocalAddr => 'localhost',
Listen => 2,
Proto => 'tcp',
# some systems seem to need as much as 10,
exit 0;
}
-$port = $listen->sockport;
+my $port = $listen->sockport;
-if($pid = fork()) {
+if(my $pid = fork()) {
- $sock = $listen->accept() or die "accept failed: $!";
+ my $sock = $listen->accept() or die "accept failed: $!";
print "ok 2\n";
$sock->autoflush(1);
} elsif(defined $pid) {
- $sock = IO::Socket::INET->new(PeerPort => $port,
+ my $sock = IO::Socket::INET->new(PeerPort => $port,
Proto => 'tcp',
PeerAddr => 'localhost'
)
$listen = IO::Socket::INET->new(LocalAddr => 'localhost', Listen => '', Timeout => 15) or die "$!";
$port = $listen->sockport;
-if($pid = fork()) {
+if(my $pid = fork()) {
SERVER_LOOP:
while (1) {
- last SERVER_LOOP unless $sock = $listen->accept;
+ last SERVER_LOOP unless my $sock = $listen->accept;
while (<$sock>) {
last SERVER_LOOP if /^quit/;
last if /^done/;
$listen->close;
} elsif (defined $pid) {
# child, try various ways to connect
- $sock = IO::Socket::INET->new("localhost:$port")
+ my $sock = IO::Socket::INET->new("localhost:$port")
|| IO::Socket::INET->new("127.0.0.1:$port");
if ($sock) {
print "not " unless $sock->connected;
}
# Then test UDP sockets
-$server = IO::Socket->new(Domain => AF_INET,
+my $server = IO::Socket->new(Domain => AF_INET,
Proto => 'udp',
LocalAddr => 'localhost')
|| IO::Socket->new(Domain => AF_INET,
LocalAddr => '127.0.0.1');
$port = $server->sockport;
-if ($pid = fork()) {
+if (my $pid = fork()) {
my $buf;
$server->recv($buf, 100);
print $buf;
} elsif (defined($pid)) {
#child
- $sock = IO::Socket::INET->new(Proto => 'udp',
+ my $sock = IO::Socket::INET->new(Proto => 'udp',
PeerAddr => "localhost:$port")
|| IO::Socket::INET->new(Proto => 'udp',
PeerAddr => "127.0.0.1:$port");
### Set up some data to be transferred between the server and
### the client. We'll use own source code ...
#
-local @data;
+my @data;
if( !open( SRC, '<', $0)) {
print "not ok 15 - $!\n";
} else {
### TEST 16
### Start the server
#
-my $listen = IO::Socket::INET->new(LocalAddr => 'localhost', Listen => 2, Proto => 'tcp', Timeout => 15) ||
+$listen = IO::Socket::INET->new(LocalAddr => 'localhost', Listen => 2, Proto => 'tcp', Timeout => 15) ||
print "not ";
print "ok 16\n";
die if( !defined( $listen));
### TEST 18
### Get data from the server using a single stream
#
- $sock = IO::Socket::INET->new("localhost:$serverport")
+ my $sock = IO::Socket::INET->new("localhost:$serverport")
|| IO::Socket::INET->new("127.0.0.1:$serverport");
if ($sock) {
### Child
#
SERVER_LOOP: while (1) {
- last SERVER_LOOP unless $sock = $listen->accept;
+ last SERVER_LOOP unless my $sock = $listen->accept;
# Do not print ok/not ok for this binmode() since there's
# a race condition with our client, just die if we fail.
if ($has_perlio) { binmode($sock, ":utf8") or die }
# test Blocking option in constructor
-$sock = IO::Socket::INET->new(Blocking => 0)
+my $sock = IO::Socket::INET->new(Blocking => 0)
or print "not ";
print "ok 25\n";
END { unlink "./__taint__$$" }
use IO::File;
-my $x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+my $x = IO::File->new( "> ./__taint__$$" ) || die("Cannot open ./__taint__$$\n");
print $x "$$\n";
$x->close;
-$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+$x = IO::File->new( "< ./__taint__$$" ) || die("Cannot open ./__taint__$$\n");
chop(my $unsafe = <$x>);
eval { kill 0 * $unsafe };
SKIP: {
# We could have just done a seek on $x, but technically we haven't tested
# seek yet...
-$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+$x = IO::File->new( "< ./__taint__$$" ) || die("Cannot open ./__taint__$$\n");
$x->untaint;
ok(!$?); # Calling the method worked
chop($unsafe = <$x>);
#!./perl
+my $tell_file;
BEGIN {
$tell_file = "Makefile.PL";
}
use IO::File;
-$tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file");
+my $tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file");
binmode $tst; # its a nop unless it matters. Was only if ($^O eq 'MSWin32' or $^O eq 'dos');
if ($tst->eof) { print "not ok 1\n"; } else { print "ok 1\n"; }
-$firstline = <$tst>;
-$secondpos = tell;
+my $firstline = <$tst>;
+my $secondpos = tell;
-$x = 0;
+my $x = 0;
while (<$tst>) {
if (eof) {$x++;}
}
if ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; }
-$lastpos = tell;
+my $lastpos = tell;
unless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; }
}
}
-$PATH = "sock-$$";
+my $PATH = "sock-$$";
if ($^O eq 'os2') { # Can't create sockets with relative path...
require Cwd;
$| = 1;
print "1..5\n";
-$listen = IO::Socket::UNIX->new(Local => $PATH, Listen => 0);
+my $listen = IO::Socket::UNIX->new(Local => $PATH, Listen => 0);
# Sometimes UNIX filesystems are mounted for security reasons
# with "nodev" option which spells out "no" for creating UNIX
unless (defined $listen) {
eval { require File::Temp };
unless ($@) {
- import File::Temp 'mktemp';
+ File::Temp->import( 'mktemp' );
for my $TMPDIR ($ENV{TMPDIR}, "/tmp") {
if (defined $TMPDIR && -d $TMPDIR && -w $TMPDIR) {
$PATH = mktemp("$TMPDIR/sXXXXXXXX");
}
print "ok 1\n";
-if($pid = fork()) {
+if (my $pid = fork()) {
- $sock = $listen->accept();
+ my $sock = $listen->accept();
if (defined $sock) {
print "ok 2\n";
}
} elsif(defined $pid) {
- $sock = IO::Socket::UNIX->new(Peer => $PATH) or die "$!";
+ my $sock = IO::Socket::UNIX->new(Peer => $PATH) or die "$!";
print $sock "ok 3\n";
#!./perl
BEGIN {
- unless (find PerlIO::Layer 'perlio') {
+ unless ( PerlIO::Layer->find('perlio') ) {
print "1..0 # Skip: not perlio\n";
exit 0;
}
#!./perl
BEGIN {
- unless (find PerlIO::Layer 'perlio') {
+ unless ( PerlIO::Layer->find('perlio') ) {
print "1..0 # Skip: not perlio\n";
exit 0;
}
use IO::File;
use IO::Seekable;
-$x = new_tmpfile IO::File;
+my $x = IO::File->new_tmpfile();
ok($x, "new_tmpfile");
print $x "ok 2\n";
$x->seek(0,SEEK_SET);
$x->seek(0,SEEK_SET);
print $x "not ok 3\n";
-$p = $x->getpos;
+my $p = $x->getpos;
print $x "ok 3\n";
$x->flush;
$x->setpos($p);
https://perl5.git.perl.org / perl5.git / commitdiff