summaryrefslogtreecommitdiff
path: root/ext/IO
diff options
context:
space:
mode:
Diffstat (limited to 'ext/IO')
-rw-r--r--ext/IO/IO.xs45
-rw-r--r--ext/IO/lib/IO/Handle.pm4
-rw-r--r--ext/IO/lib/IO/Select.pm70
-rw-r--r--ext/IO/lib/IO/Socket.pm23
4 files changed, 82 insertions, 60 deletions
diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs
index 9dc09b2e01..82dce85cb1 100644
--- a/ext/IO/IO.xs
+++ b/ext/IO/IO.xs
@@ -1,13 +1,18 @@
#include "EXTERN.h"
+#define PERLIO_NOT_STDIO 1
#include "perl.h"
#include "XSUB.h"
+
#ifdef I_UNISTD
# include <unistd.h>
#endif
+#ifdef I_FCNTL
+# include <fcntl.h>
+#endif
typedef int SysRet;
-typedef FILE * InputStream;
-typedef FILE * OutputStream;
+typedef PerlIO * InputStream;
+typedef PerlIO * OutputStream;
static int
not_here(s)
@@ -62,12 +67,6 @@ IV *pval;
#else
return FALSE;
#endif
- if (strEQ(name, "SEEK_EOF"))
-#ifdef SEEK_EOF
- { *pval = SEEK_EOF; return TRUE; }
-#else
- return FALSE;
-#endif
break;
}
@@ -81,35 +80,27 @@ SV *
fgetpos(handle)
InputStream handle
CODE:
-#ifdef HAS_FGETPOS
if (handle) {
Fpos_t pos;
- fgetpos(handle, &pos);
+ PerlIO_getpos(handle, &pos);
ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
}
else {
ST(0) = &sv_undef;
errno = EINVAL;
}
-#else
- ST(0) = (SV *) not_here("IO::Seekable::fgetpos");
-#endif
SysRet
fsetpos(handle, pos)
InputStream handle
SV * pos
CODE:
-#ifdef HAS_FSETPOS
if (handle)
- RETVAL = fsetpos(handle, (Fpos_t*)SvPVX(pos));
+ RETVAL = PerlIO_setpos(handle, (Fpos_t*)SvPVX(pos));
else {
RETVAL = -1;
errno = EINVAL;
}
-#else
- RETVAL = (SysRet) not_here("IO::Seekable::fsetpos");
-#endif
OUTPUT:
RETVAL
@@ -119,7 +110,7 @@ OutputStream
new_tmpfile(packname = "IO::File")
char * packname
CODE:
- RETVAL = tmpfile();
+ RETVAL = PerlIO_tmpfile();
OUTPUT:
RETVAL
@@ -141,7 +132,7 @@ ungetc(handle, c)
int c
CODE:
if (handle)
- RETVAL = ungetc(c, handle);
+ RETVAL = PerlIO_ungetc(handle, c);
else {
RETVAL = -1;
errno = EINVAL;
@@ -154,7 +145,7 @@ ferror(handle)
InputStream handle
CODE:
if (handle)
- RETVAL = ferror(handle);
+ RETVAL = PerlIO_error(handle);
else {
RETVAL = -1;
errno = EINVAL;
@@ -167,7 +158,7 @@ fflush(handle)
OutputStream handle
CODE:
if (handle)
- RETVAL = Fflush(handle);
+ RETVAL = PerlIO_flush(handle);
else {
RETVAL = -1;
errno = EINVAL;
@@ -181,9 +172,11 @@ setbuf(handle, buf)
char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
CODE:
if (handle)
+#ifdef PERLIO_IS_STDIO
setbuf(handle, buf);
-
-
+#else
+ not_here("IO::Handle::setbuf");
+#endif
SysRet
setvbuf(handle, buf, type, size)
@@ -192,6 +185,7 @@ setvbuf(handle, buf, type, size)
int type
int size
CODE:
+#ifdef PERLIO_IS_STDIO
#ifdef _IOFBF /* Should be HAS_SETVBUF once Configure tests for that */
if (handle)
RETVAL = setvbuf(handle, buf, type, size);
@@ -202,6 +196,9 @@ setvbuf(handle, buf, type, size)
#else
RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
#endif /* _IOFBF */
+#else
+ not_here("IO::Handle::setvbuf");
+#endif
OUTPUT:
RETVAL
diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm
index aaba77c056..f2086049cf 100644
--- a/ext/IO/lib/IO/Handle.pm
+++ b/ext/IO/lib/IO/Handle.pm
@@ -186,7 +186,7 @@ require Exporter;
@FileHandle::ISA = qw(IO::Handle);
-$VERSION = sprintf("%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/);
@EXPORT_OK = qw(
autoflush
@@ -259,8 +259,6 @@ sub new_from_fd {
IO::Handle::fdopen($fh, @_)
or return undef;
bless $fh, $class;
- $fh->_ref_fd;
- $fh;
}
# FileHandle::DESTROY use to call close(). This creates a problem
diff --git a/ext/IO/lib/IO/Select.pm b/ext/IO/lib/IO/Select.pm
index 208be0cf53..ed8c2bb983 100644
--- a/ext/IO/lib/IO/Select.pm
+++ b/ext/IO/lib/IO/Select.pm
@@ -49,7 +49,9 @@ handle with the same C<fileno> is specified then only the last one is cached.
=item remove ( HANDLES )
-Remove all the given handles from the object.
+Remove all the given handles from the object. This method also works
+by the C<fileno> of the handles. So the exact handles that were added
+need not be passed, just handles that have an equivalent C<fileno>
=item can_read ( [ TIMEOUT ] )
@@ -66,6 +68,12 @@ Same as C<can_read> except check for handles that can be written to.
Same as C<can_read> except check for handles that have an error condition, for
example EOF.
+=item count ()
+
+Returns the number of handles that the object will check for when
+one of the C<can_> methods is called or the object is passed to
+the C<select> static method.
+
=item select ( READ, WRITE, ERROR [, TIMEOUT ] )
C<select> is a static method, that is you call it with the package name
@@ -132,12 +140,16 @@ $VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
@ISA = qw(Exporter); # This is only so we can do version checking
+sub VEC_BITS {0}
+sub FD_COUNT {1}
+sub FIRST_FD {2}
+
sub new
{
my $self = shift;
my $type = ref($self) || $self;
- my $vec = bless [''], $type;
+ my $vec = bless [undef,0], $type;
$vec->add(@_)
if @_;
@@ -150,14 +162,19 @@ sub add
my $vec = shift;
my $f;
+ $vec->[VEC_BITS] = '' unless defined $vec->[VEC_BITS];
+
foreach $f (@_)
{
my $fn = $f =~ /^\d+$/ ? $f : fileno($f);
next
unless defined $fn;
- vec($vec->[0],$fn++,1) = 1;
- $vec->[$fn] = $f;
+ vec($vec->[VEC_BITS],$fn,1) = 1;
+ $vec->[FD_COUNT] += 1
+ unless defined $vec->[$fn+FIRST_FD];
+ $vec->[$fn+FIRST_FD] = $f;
}
+ $vec->[VEC_BITS] = undef unless $vec->count;
}
sub remove
@@ -170,9 +187,11 @@ sub remove
my $fn = $f =~ /^\d+$/ ? $f : fileno($f);
next
unless defined $fn;
- vec($vec->[0],$fn++,1) = 0;
- $vec->[$fn] = undef;
+ vec($vec->[VEC_BITS],$fn,1) = 0;
+ $vec->[$fn+FIRST_FD] = undef;
+ $vec->[FD_COUNT] -= 1;
}
+ $vec->[VEC_BITS] = undef unless $vec->count;
}
sub can_read
@@ -180,7 +199,7 @@ sub can_read
my $vec = shift;
my $timeout = shift;
- my $r = $vec->[0];
+ my $r = $vec->[VEC_BITS] or return ();
select($r,undef,undef,$timeout) > 0
? _handles($vec, $r)
@@ -192,7 +211,7 @@ sub can_write
my $vec = shift;
my $timeout = shift;
- my $w = $vec->[0];
+ my $w = $vec->[VEC_BITS] or return ();
select(undef,$w,undef,$timeout) > 0
? _handles($vec, $w)
@@ -204,13 +223,19 @@ sub has_error
my $vec = shift;
my $timeout = shift;
- my $e = $vec->[0];
+ my $e = $vec->[VEC_BITS] or return ();
select(undef,undef,$e,$timeout) > 0
? _handles($vec, $e)
: ();
}
+sub count
+{
+ my $vec = shift;
+ $vec->[FD_COUNT];
+}
+
sub _max
{
my($a,$b,$c) = @_;
@@ -231,28 +256,28 @@ sub select
my($r,$w,$e,$t) = @_;
my @result = ();
- my $rb = defined $r ? $r->[0] : undef;
- my $wb = defined $w ? $e->[0] : undef;
- my $eb = defined $e ? $w->[0] : undef;
+ my $rb = defined $r ? $r->[VEC_BITS] : undef;
+ my $wb = defined $w ? $e->[VEC_BITS] : undef;
+ my $eb = defined $e ? $w->[VEC_BITS] : undef;
if(select($rb,$wb,$eb,$t) > 0)
{
my @r = ();
my @w = ();
my @e = ();
- my $i = _max(defined $r ? scalar(@$r) : 0,
- defined $w ? scalar(@$w) : 0,
- defined $e ? scalar(@$e) : 0);
+ my $i = _max(defined $r ? scalar(@$r)-1 : 0,
+ defined $w ? scalar(@$w)-1 : 0,
+ defined $e ? scalar(@$e)-1 : 0);
- for( ; $i > 0 ; $i--)
+ for( ; $i >= FIRST_FD ; $i--)
{
- my $j = $i - 1;
+ my $j = $i - FIRST_FD;
push(@r, $r->[$i])
- if defined $r->[$i] && vec($rb, $j, 1);
+ if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
push(@w, $w->[$i])
- if defined $w->[$i] && vec($wb, $j, 1);
+ if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
push(@e, $e->[$i])
- if defined $e->[$i] && vec($eb, $j, 1);
+ if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
}
@result = (\@r, \@w, \@e);
@@ -267,14 +292,15 @@ sub _handles
my @h = ();
my $i;
- for($i = scalar(@$vec) - 1 ; $i > 0 ; $i--)
+ for($i = scalar(@$vec) - 1 ; $i >= FIRST_FD ; $i--)
{
next unless defined $vec->[$i];
push(@h, $vec->[$i])
- if vec($bits,$i - 1,1);
+ if vec($bits,$i - FIRST_FD,1);
}
@h;
}
1;
+
diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm
index be81d9a64e..5f2a8ef76a 100644
--- a/ext/IO/lib/IO/Socket.pm
+++ b/ext/IO/lib/IO/Socket.pm
@@ -76,7 +76,8 @@ use Exporter;
@ISA = qw(IO::Handle);
# This one will turn 1.2 => 1.02 and 1.2.3 => 1.0203 and so on ...
-$VERSION = do{my @r=(q$Revision: 1.8$=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
+
+$VERSION = do{my @r=(q$Revision: 1.9 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
sub import {
my $pkg = shift;
@@ -131,7 +132,7 @@ sub connect {
local($SIG{ALRM}) = $timeout ? sub { undef $fh; }
: $SIG{ALRM} || 'DEFAULT';
- eval {
+ eval {
croak 'connect: Bad address'
if(@_ == 2 && !defined $_[1]);
@@ -140,17 +141,17 @@ sub connect {
$timeout = 0;
}
- my $ok = eval { connect($fh, $addr) };
+ my $ok = connect($fh, $addr);
alarm(0)
if($timeout);
- croak "connect: timeout"
- unless defined $fh;
-
- undef $fh unless $ok;
+ croak "connect: timeout"
+ unless defined $fh;
+ undef $fh unless $ok;
};
+
$fh;
}
@@ -544,14 +545,14 @@ Graham Barr <Graham.Barr@tiuk.ti.com>
=head1 REVISION
-$Revision: 1.8 $
+$Revision: 1.9 $
The VERSION is derived from the revision turning each number after the
first dot into a 2 digit number so
- Revision 1.8 => VERSION 1.08
- Revision 1.2.3 => VERSION 1.0203
-
+ Revision 1.8 => VERSION 1.08
+ Revision 1.2.3 => VERSION 1.0203
+
=head1 COPYRIGHT
Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
View Lorry Controller Status