dslinux/user/perl/ext/IO ChangeLog IO.pm IO.xs Makefile.PL README poll.c poll.h
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 17:59:25 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/ext/IO
In directory antilope:/tmp/cvs-serv17422/ext/IO
Added Files:
ChangeLog IO.pm IO.xs Makefile.PL README poll.c poll.h
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: Makefile.PL ---
use ExtUtils::MakeMaker;
use Config qw(%Config);
WriteMakefile(
VERSION_FROM => "IO.pm",
NAME => "IO",
OBJECT => '$(O_FILES)',
MAN3PODS => {}, # Pods will be built by installman.
);
--- NEW FILE: ChangeLog ---
IO 1.22 -- Mon Sep 5 10:29:35 CDT 2005
* Update with changes made in perl core distribution
Change 173 on 1998/07/14 by <gbarr at pobox.com> (Graham Barr)
IO::Socket
- Added method connected
IO.xs
- Added check that file * is not null
t/io_udp.t
- Added check for connected
- Made change to catch recv not returning the address, and added a fix to
ensure test does not hang
t/io_sock.t
- Added check for connected.
Change 137 on 1998/05/21 by <gbarr at pobox.com> (Graham Barr)
IO::Socket::INET
- Added checks to all peer* and host* methods for undef
Change 134 on 1998/05/09 by <gbarr at pobox.com> (Graham Barr)
t/io_sock.t
- fix race condition on Solaris & SunOS
IO::Handle
- Applied patch from Gisle Aas <gisle at aas.no> for
documentation update
- Applied patch from Kuma <tgy at chocobo.org>
changed input_line_number to be on a per-handle basis.
IO::File
- Applied patch from Gisle Aas <gisle at aas.no> for
documentation update
IO::Seekable
- Applied patch from Gisle Aas <gisle at aas.no> for
documentation update
added sysseek
IO, IO::Socket::INET
- documentation update
IO.xs
- Applied patch from Gisle Aas <gisle at aas.no> for
blocking
Change 133 on 1998/05/09 by <gbarr at pobox.com> (Graham Barr)
t/io_sock.t
- Added checks for blocking()
Sun Apr 12 1998 <gbarr at pobox.com> (Graham Barr)
IO.xs
- enclosed newCONSTSUB in #ifdef as _64 now defines it.
Thu Mar 19 1998 <gbarr at pobox.com> (Graham Barr)
All
- Changed copyright/distribution policy back to be the same as perl
Sun Feb 15 1998 <gbarr at pobox.com> (Graham Barr)
IO::Socket
- Fix to ->accept, accept() returns false on error not undef.
*** Release 1.19
Thu Feb 5 1998 <gbarr at pobox.com> (Graham Barr)
All
- change copyright notice
IO::Socket::INET
- changed configure to accept PeerHost and LocalHost as well as the
PeerAddr and LocalAddr arguments.
Mon Feb 2 1998 <gbarr at pobox.com> (Graham Barr)
IO::Handle
- Added printflush so that flush.pl can be depreciated
IO::Socket
- Remove C<use Config> statement as it was not needed
Tue Jan 27 1998 <gbarr at pobox.com> (Graham Barr)
IO::Socket::INET
- removed carp if $^W
*** Patch 1.1804
Sat Jan 17 1998 <gbarr at pobox.com> (Graham Barr)
t/io_sock.t
- Replaced C<Listen => 0> with C<LocalAddr => 'localhost'>
IO/Socket/INET.pm
- Modified the MultiHomed code. Now each address for a given host has
a timeout of C<Timeout>.
- added _get_addr method for doing hostname lookups. Now Net::DNS can be
use by sub-classing IO::Socket::INET, Thanks Gisle Aas
t/io_multihomed.t
- new test added. Thanks Gisle Aas.
*** Patch 1.1803
Mon Nov 17 1997 <gbarr at pobox.com> (Graham Barr)
poll.c
- Added #ifdef I_* tests
IO::Socket
- Changed initialization of @domain2pkg to fix problem of Domain option
not working
- Added patch for multi-homed hosts, Thanks to Gisle Aas <gisle at aas.no>
IO::Socket::INET
- Change default proto to getprotobyname instead of 'tcp' constant string
- Added patch for multi-homed hosts, Thanks to Gisle Aas <gisle at aas.no>
t/io_sock.t
- Change to test fix for Domain problem fixed in IO::Socket and be
more comprehensive, Thanks to Gisle Aas <gisle at aas.no>
t/io_unix.t
- New test, Thanks to Gisle Aas <gisle at aas.no>
*** Patch 1.1802
Wed Nov 12 1997 <gbarr at pobox.com> (Graham Barr)
t/io_poll.t
- test 4 made an assumption that was not portable, fixed.
*** Patch 1.1801
Wed Oct 22 1997 <gbarr at pobox.com> (Graham Barr)
IO.xs
- change #ifdef's to allow compilation with 5.002
IO::Socket
- Fix to ensure that socket is not returned as non-blocking
unless the user asks for it
t/io_udp.t
- Fix to stop endless loop
*** Release 1.18
Mon Oct 13 1997 <gbarr at pobox.com> (Graham Barr)
IO.xs, IO::Handle
- 1.17 broke compatability with 5.003, small tweaks to restore
compatability
t/io_const.t
- Added new test to ensure backwards compatability with constants
is not broken
Wed Oct 8 1997 <gbarr at pobox.com> (Graham Barr)
IO.xs
- Added #define's to cope with argument changes to start_subparse
from 5.003_22, _23 and _24
IO::Select
- Renamed has_error to be has_exception which is more correct,
has_error is a wrapper around has_exception with a warning if
$^W is set.
Makefile.PL
- Remove 'linkext' option to WriteMakefile so that static linking
should work properly, cannot remember why I added it.
Sun Oct 5 1997 <gbarr at pobox.com> (Graham Barr)
IO::Pipe
- GLOB assignment does not copy the fileno while under -T
added checks for undefined fileno, and added fdopen
- reader and write can now be called as static methods
Makefile.PL
- Attempt to locate <poll.h> and define I_POLL if found
*** Release 1.17
Fri Sep 26 1997 <gbarr at pobox.com> (Graham Barr)
IO.xs
- Fix bug in _poll for ANSI C compilers
IO::Socket
- Split IO::Socket::INET and IO::Socket::UNIX into separate files
IO::File
- Patch to open() for when file is in current directory.
*** Release 1.16
Mon 15 Sep 1997 <gbarr at pobox.com> Graham Barr
o New modules
- IO::Dir
- IO::Poll
o IO::Socket
- Changed new to call autoflush on the new socket
- IO::Socket::INET->new now accepts a single argument
- IO::Socket::INET default to protocol 'tcp'
o IO::File
- Added doc for new_tmpfile
o IO::Handle
- Removed use of AutoLoader for constants, constants are
now defined as constant XS subs
- Added fsync, but will not be avaliable for use
unless HAS_FSYNC is defined, perls configure does not define
this yet.
- Moved bootstrap of IO.xs to IO.pm. IO::Handle no longer
contains an AUTOLOAD sub in it's ISA hier
o IO::Seekable
- Remove clearerr, as it is defined in IO.xs
o IO.xs
- Patched IO.xs with patch from Chip for setvbuf warning
- Added XS sub "constant" for backwards compatability
o Misc
- Fixed IO::Socket::configure, it was not passing $arg to domain
specific package
- Changed all $fh variables in IO::Handle to $io and all $fh
variables in IO::Socket to $sock as Chip suggested
- Fixed usage messages to be consistant
*** Release 1.15
Sun 19 Jan 1997 <bodg at tiuk.ti.com> Graham Barr
o Updated PODs for IO::Handle and IO::File
o Modified IO.xs so that DESTROY gets called on IO::File
objects that were created with IO::File->new_tmpfile
o Modified the domain2pkg code in IO::Socket so that it
does not use blessd refs
o Created a new package IO::Pipe::End so that pipe specific
stuff can be moved out of IO::Handle.
o Added Ilya's OS/2 changes to Pipe.pm and io_pipe.t
o These changes happened somtime before the release of 1.15
- added shutdown to IO::Socket
- modified connect to not use alarm
- modified accept and connect to use IO::Select
*** Release 1.14
Tue 24 Dec 1996 <bodg at tiuk.ti.com> Graham Barr
o Updated to patches in perl core dist.
o Added C<use strict> to all modules
o Modified t/io_sock.t, hopefully the race condition has gone
o Added close statements to reader/writer in IO::Pipe
o IO::Handle::syswrite was calling sysread, fixed :-)
*** Release 1.12
Thu 19 Sep 1996 <bodg at tiuk.ti.com> Graham Barr
o Modified IO.xs so that it will compile with pre perlio version
of perl (ie pre perl5.003_02)
o Modified IO::Socket::send so not to pass 4 arguments to send
if the socket is connected
*** Release 1.10
Mon 11 Sep 1996 <bodg at tiuk.ti.com> Graham Barr
o Fixed a bug in IO::Socket which caused DESTROY to be called
on a partly initialised connection
o Changed IO.xs to use Perlio
o Modified usage message to report correct package
o Added IO::File::new changes from Chip, to allow PERM to be passed
o Added sysread and syswrite methods to IO::Handle
o Updated documentation
o Fixed a bug in IO::Select that caused a hang if the last handle
was removed.
o Added count method to IO::Select
o Renamed and modified tests so that they can be copied into the
perl distribution
o Added fcntl and ioctl methods to IO::Handle
Thu 25 Jul 1996 <bodg at tiuk.ti.com> Graham Barr
o It is now not necessary to call the domain sub-classes of
IO::Socket. when connect is called it notes the domain.
Domain specific methods, which are normally non-critical, are
called via this note-ing.
o Added methods to IO::Socket to retrieve the domain, type and
protocol of a given socket
Tue 23 Jul 1996 <bodg at tiuk.ti.com> Graham Barr
o IO::Socket::connect changed how we do timeouts, as it did not work
o IO::Handle::new_from_fd removed method call to _ref_fd, which was
a leftover from FileHandle
Fri 28 Jun 1996 <bodg at tiuk.ti.com> Graham Barr
o Modified IO::Socket::UNIX::configure to default to using a socket
type of SOCK_STREAM if no type is specified.
--- NEW FILE: poll.c ---
/*
* poll.c
*
* Copyright (c) 1997-8 Graham Barr <gbarr at pobox.com>. All rights reserved.
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
*
* For systems that do not have the poll() system call (for example Linux
* kernels < v2.1.23) try to emulate it as closely as possible using select()
*
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "poll.h"
#ifdef I_SYS_TIME
# include <sys/time.h>
#endif
#ifdef I_TIME
# include <time.h>
#endif
#include <sys/types.h>
#if defined(HAS_SOCKET) && !defined(VMS) && !defined(ultrix) /* VMS handles sockets via vmsish.h, ULTRIX dies of socket struct redefinitions */
# include <sys/socket.h>
#endif
#include <sys/stat.h>
#include <errno.h>
#ifdef HAS_SELECT
#ifdef I_SYS_SELECT
#include <sys/select.h>
#endif
#endif
#ifdef EMULATE_POLL_WITH_SELECT
# define POLL_CAN_READ (POLLIN | POLLRDNORM )
# define POLL_CAN_WRITE (POLLOUT | POLLWRNORM | POLLWRBAND )
# define POLL_HAS_EXCP (POLLRDBAND | POLLPRI )
# define POLL_EVENTS_MASK (POLL_CAN_READ | POLL_CAN_WRITE | POLL_HAS_EXCP)
int
poll(struct pollfd *fds, unsigned long nfds, int timeout)
{
int i,err;
fd_set rfd,wfd,efd,ifd;
struct timeval timebuf;
struct timeval *tbuf = (struct timeval *)0;
int n = 0;
int count;
FD_ZERO(&ifd);
again:
FD_ZERO(&rfd);
FD_ZERO(&wfd);
FD_ZERO(&efd);
for(i = 0 ; i < (int)nfds ; i++) {
int events = fds[i].events;
int fd = fds[i].fd;
fds[i].revents = 0;
if(fd < 0 || FD_ISSET(fd, &ifd))
continue;
if(fd > n)
n = fd;
if(events & POLL_CAN_READ)
FD_SET(fd, &rfd);
if(events & POLL_CAN_WRITE)
FD_SET(fd, &wfd);
if(events & POLL_HAS_EXCP)
FD_SET(fd, &efd);
}
if(timeout >= 0) {
timebuf.tv_sec = timeout / 1000;
timebuf.tv_usec = (timeout % 1000) * 1000;
tbuf = &timebuf;
}
err = select(n+1,&rfd,&wfd,&efd,tbuf);
if(err < 0) {
#ifdef HAS_FSTAT
if(errno == EBADF) {
for(i = 0 ; i < nfds ; i++) {
struct stat buf;
if((fstat(fds[i].fd,&buf) < 0) && (errno == EBADF)) {
FD_SET(fds[i].fd, &ifd);
goto again;
}
}
}
#endif /* HAS_FSTAT */
return err;
}
count = 0;
for(i = 0 ; i < (int)nfds ; i++) {
int revents = (fds[i].events & POLL_EVENTS_MASK);
int fd = fds[i].fd;
if(fd < 0)
continue;
if(FD_ISSET(fd, &ifd))
revents = POLLNVAL;
else {
if(!FD_ISSET(fd, &rfd))
revents &= ~POLL_CAN_READ;
if(!FD_ISSET(fd, &wfd))
revents &= ~POLL_CAN_WRITE;
if(!FD_ISSET(fd, &efd))
revents &= ~POLL_HAS_EXCP;
}
if((fds[i].revents = revents) != 0)
count++;
}
return count;
}
#endif /* EMULATE_POLL_WITH_SELECT */
/* gcc for SunOS 4 produces code from an empty (code/symbolwise)
* source code file that makes the SunOS 4.x /usr/bin/ld fail with
* ld: poll.o: premature EOF
* To avoid this, have at least something in here. */
#if defined(__sun) && !defined(__SVR4) && defined(__GNUC__)
static int dummy;
#endif
--- NEW FILE: poll.h ---
/*
* poll.h
*
* Copyright (c) 1997-8 Graham Barr <gbarr at pobox.com>. All rights reserved.
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
*
*/
#ifndef POLL_H
# define POLL_H
#if (defined(HAS_POLL) && defined(I_POLL)) || defined(POLLWRBAND)
# include <poll.h>
#else
#ifdef HAS_SELECT
/* We shall emulate poll using select */
#define EMULATE_POLL_WITH_SELECT
#ifdef poll
# undef poll
#endif
#define poll Perl_my_poll
typedef struct pollfd {
int fd;
short events;
short revents;
} pollfd_t;
#define POLLIN 0x0001
#define POLLPRI 0x0002
#define POLLOUT 0x0004
#define POLLRDNORM 0x0040
#define POLLWRNORM POLLOUT
#define POLLRDBAND 0x0080
#define POLLWRBAND 0x0100
#define POLLNORM POLLRDNORM
/* Return ONLY events (NON testable) */
#define POLLERR 0x0008
#define POLLHUP 0x0010
#define POLLNVAL 0x0020
int poll (struct pollfd *, unsigned long, int);
#ifndef HAS_POLL
# define HAS_POLL
#endif
#endif /* HAS_SELECT */
#endif /* I_POLL */
#endif /* POLL_H */
--- NEW FILE: README ---
This is the perl5 IO distribution.
This distribution is included in the perl5 core distribution. You should
only need to install this distribution if it is newer than your perl
installation.
To install this distribution you will need access rights to the perl
install ation on your system, as it overwrites your currently installed
version of IO.
This distribution relies upon the Socket module (version 1.3), which is
avaliable from CPAN. Although you should not need to get this if your
version of perl is fairly recent, as Socket is also distributed in the
core perl distribution.
If you do not have the required modules, you will see a warning when
the Makefile is built.
To build, test and install this distribution type:
perl Makefile.PL
make test
make install
Share and Enjoy!
Graham Barr <gbarr at pobox.com>
--- NEW FILE: IO.pm ---
#
package IO;
use XSLoader ();
use Carp;
use strict;
use warnings;
our $VERSION = "1.22";
XSLoader::load 'IO', $VERSION;
sub import {
shift;
warnings::warnif('deprecated', qq{Parameterless "use IO" deprecated})
if @_ == 0 ;
my @l = @_ ? @_ : qw(Handle Seekable File Pipe Socket Dir);
eval join("", map { "require IO::" . (/(\w+)/)[0] . ";\n" } @l)
or croak $@;
}
1;
__END__
=head1 NAME
IO - load various IO modules
=head1 SYNOPSIS
use IO qw(Handle File); # loads IO modules, here IO::Handle, IO::File
use IO; # DEPRECATED
=head1 DESCRIPTION
C<IO> provides a simple mechanism to load several of the IO modules
in one go. The IO modules belonging to the core are:
IO::Handle
IO::Seekable
IO::File
IO::Pipe
IO::Socket
IO::Dir
IO::Select
IO::Poll
Some other IO modules don't belong to the perl core but can be loaded
as well if they have been installed from CPAN. You can discover which
ones exist by searching for "^IO::" on http://search.cpan.org.
For more information on any of these modules, please see its respective
documentation.
=head1 DEPRECATED
use IO; # loads all the modules listed below
The loaded modules are IO::Handle, IO::Seekable, IO::File, IO::Pipe,
IO::Socket, IO::Dir. You should instead explicitly import the IO
modules you want.
=cut
--- NEW FILE: IO.xs ---
/*
* Copyright (c) 1997-8 Graham Barr <gbarr at pobox.com>. All rights reserved.
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
*/
#define PERL_EXT_IO
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#define PERLIO_NOT_STDIO 1
#include "perl.h"
#include "XSUB.h"
#include "poll.h"
#ifdef I_UNISTD
# include <unistd.h>
#endif
#if defined(I_FCNTL) || defined(HAS_FCNTL)
# include <fcntl.h>
#endif
#ifndef SIOCATMARK
# ifdef I_SYS_SOCKIO
# include <sys/sockio.h>
# endif
#endif
#ifdef PerlIO
#if defined(MACOS_TRADITIONAL) && defined(USE_SFIO)
#define PERLIO_IS_STDIO 1
#undef setbuf
#undef setvbuf
#define setvbuf _stdsetvbuf
#define setbuf(f,b) ( __sf_setbuf(f,b) )
#endif
typedef int SysRet;
typedef PerlIO * InputStream;
typedef PerlIO * OutputStream;
#else
#define PERLIO_IS_STDIO 1
typedef int SysRet;
typedef FILE * InputStream;
typedef FILE * OutputStream;
#endif
#define MY_start_subparse(fmt,flags) start_subparse(fmt,flags)
#ifndef gv_stashpvn
#define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
#endif
#ifndef __attribute__noreturn__
# define __attribute__noreturn__
#endif
#ifndef NORETURN_FUNCTION_END
# define NORETURN_FUNCTION_END /* NOT REACHED */ return 0
#endif
static int not_here(const char *s) __attribute__noreturn__;
static int
not_here(const char *s)
{
croak("%s not implemented on this architecture", s);
NORETURN_FUNCTION_END;
}
#ifndef PerlIO
#define PerlIO_fileno(f) fileno(f)
#endif
static int
io_blocking(pTHX_ InputStream f, int block)
{
#if defined(HAS_FCNTL)
int RETVAL;
if(!f) {
errno = EBADF;
return -1;
}
RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0);
if (RETVAL >= 0) {
int mode = RETVAL;
int newmode = mode;
#ifdef O_NONBLOCK
/* POSIX style */
# ifndef O_NDELAY
# define O_NDELAY O_NONBLOCK
# endif
/* Note: UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY
* after a successful F_SETFL of an O_NONBLOCK. */
RETVAL = RETVAL & (O_NONBLOCK | O_NDELAY) ? 0 : 1;
if (block == 0) {
newmode &= ~O_NDELAY;
newmode |= O_NONBLOCK;
} else if (block > 0) {
newmode &= ~(O_NDELAY|O_NONBLOCK);
}
#else
/* Not POSIX - better have O_NDELAY or we can't cope.
* for BSD-ish machines this is an acceptable alternative
* for SysV we can't tell "would block" from EOF but that is
* the way SysV is...
*/
RETVAL = RETVAL & O_NDELAY ? 0 : 1;
if (block == 0) {
newmode |= O_NDELAY;
} else if (block > 0) {
newmode &= ~O_NDELAY;
}
#endif
if (newmode != mode) {
const int ret = fcntl(PerlIO_fileno(f),F_SETFL,newmode);
if (ret < 0)
RETVAL = ret;
}
}
return RETVAL;
#else
return -1;
#endif
}
MODULE = IO PACKAGE = IO::Seekable PREFIX = f
void
fgetpos(handle)
InputStream handle
CODE:
if (handle) {
#ifdef PerlIO
ST(0) = sv_newmortal();
#if PERL_VERSION < 8
Fpos_t pos;
if (PerlIO_getpos(handle, &pos) != 0) {
ST(0) = &PL_sv_undef;
}
else {
sv_setpvn(ST(0), (char *)&pos, sizeof(Fpos_t));
}
#else
if (PerlIO_getpos(handle, ST(0)) != 0) {
ST(0) = &PL_sv_undef;
}
#endif
#else
Fpos_t pos;
if (fgetpos(handle, &pos)) {
ST(0) = &PL_sv_undef;
} else {
ST(0) = sv_2mortal(newSVpvn((char*)&pos, sizeof(Fpos_t)));
}
#endif
}
else {
errno = EINVAL;
ST(0) = &PL_sv_undef;
}
SysRet
fsetpos(handle, pos)
InputStream handle
SV * pos
CODE:
if (handle) {
#ifdef PerlIO
#if PERL_VERSION < 8
char *p;
STRLEN len;
if (SvOK(pos) && (p = SvPV(pos,len)) && len == sizeof(Fpos_t)) {
RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
}
else {
RETVAL = -1;
errno = EINVAL;
}
#else
RETVAL = PerlIO_setpos(handle, pos);
#endif
#else
char *p;
STRLEN len;
if ((p = SvPV(pos,len)) && len == sizeof(Fpos_t)) {
RETVAL = fsetpos(handle, (Fpos_t*)p);
}
else {
RETVAL = -1;
errno = EINVAL;
}
#endif
}
else {
RETVAL = -1;
errno = EINVAL;
}
OUTPUT:
RETVAL
MODULE = IO PACKAGE = IO::File PREFIX = f
void
new_tmpfile(packname = "IO::File")
char * packname
PREINIT:
OutputStream fp;
GV *gv;
CODE:
#ifdef PerlIO
fp = PerlIO_tmpfile();
#else
fp = tmpfile();
#endif
gv = (GV*)SvREFCNT_inc(newGVgen(packname));
hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
if (do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) {
ST(0) = sv_2mortal(newRV((SV*)gv));
sv_bless(ST(0), gv_stashpv(packname, TRUE));
SvREFCNT_dec(gv); /* undo increment in newRV() */
}
else {
ST(0) = &PL_sv_undef;
SvREFCNT_dec(gv);
}
MODULE = IO PACKAGE = IO::Poll
void
_poll(timeout,...)
int timeout;
PPCODE:
{
#ifdef HAS_POLL
const int nfd = (items - 1) / 2;
SV *tmpsv = NEWSV(999,nfd * sizeof(struct pollfd));
struct pollfd *fds = (struct pollfd *)SvPVX(tmpsv);
int i,j,ret;
for(i=1, j=0 ; j < nfd ; j++) {
fds[j].fd = SvIV(ST(i));
i++;
fds[j].events = (short)SvIV(ST(i));
i++;
fds[j].revents = 0;
}
if((ret = poll(fds,nfd,timeout)) >= 0) {
for(i=1, j=0 ; j < nfd ; j++) {
sv_setiv(ST(i), fds[j].fd); i++;
sv_setiv(ST(i), fds[j].revents); i++;
}
}
SvREFCNT_dec(tmpsv);
XSRETURN_IV(ret);
#else
not_here("IO::Poll::poll");
#endif
}
MODULE = IO PACKAGE = IO::Handle PREFIX = io_
void
io_blocking(handle,blk=-1)
InputStream handle
int blk
PROTOTYPE: $;$
CODE:
{
const int ret = io_blocking(aTHX_ handle, items == 1 ? -1 : blk ? 1 : 0);
if(ret >= 0)
XSRETURN_IV(ret);
else
XSRETURN_UNDEF;
}
MODULE = IO PACKAGE = IO::Handle PREFIX = f
int
ungetc(handle, c)
InputStream handle
int c
CODE:
if (handle)
#ifdef PerlIO
RETVAL = PerlIO_ungetc(handle, c);
#else
RETVAL = ungetc(c, handle);
#endif
else {
RETVAL = -1;
errno = EINVAL;
}
OUTPUT:
RETVAL
int
ferror(handle)
InputStream handle
CODE:
if (handle)
#ifdef PerlIO
RETVAL = PerlIO_error(handle);
#else
RETVAL = ferror(handle);
#endif
else {
RETVAL = -1;
errno = EINVAL;
}
OUTPUT:
RETVAL
int
clearerr(handle)
InputStream handle
CODE:
if (handle) {
#ifdef PerlIO
PerlIO_clearerr(handle);
#else
clearerr(handle);
#endif
RETVAL = 0;
}
else {
RETVAL = -1;
errno = EINVAL;
}
OUTPUT:
RETVAL
int
untaint(handle)
SV * handle
CODE:
#ifdef IOf_UNTAINT
IO * io;
io = sv_2io(handle);
if (io) {
IoFLAGS(io) |= IOf_UNTAINT;
RETVAL = 0;
}
else {
#endif
RETVAL = -1;
errno = EINVAL;
#ifdef IOf_UNTAINT
}
#endif
OUTPUT:
RETVAL
SysRet
fflush(handle)
OutputStream handle
CODE:
if (handle)
#ifdef PerlIO
RETVAL = PerlIO_flush(handle);
#else
RETVAL = Fflush(handle);
#endif
else {
RETVAL = -1;
errno = EINVAL;
}
OUTPUT:
RETVAL
void
setbuf(handle, ...)
OutputStream handle
CODE:
if (handle)
#ifdef PERLIO_IS_STDIO
{
char *buf = items == 2 && SvPOK(ST(1)) ?
sv_grow(ST(1), BUFSIZ) : 0;
setbuf(handle, buf);
}
#else
not_here("IO::Handle::setbuf");
#endif
SysRet
setvbuf(...)
CODE:
if (items != 4)
Perl_croak(aTHX_ "Usage: IO::Handle::setvbuf(handle, buf, type, size)");
#if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF)
{
OutputStream handle = 0;
char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
int type;
int size;
if (items == 4) {
handle = IoOFP(sv_2io(ST(0)));
buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
type = (int)SvIV(ST(2));
size = (int)SvIV(ST(3));
}
if (!handle) /* Try input stream. */
handle = IoIFP(sv_2io(ST(0)));
if (items == 4 && handle)
RETVAL = setvbuf(handle, buf, type, size);
else {
RETVAL = -1;
errno = EINVAL;
}
}
#else
RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
#endif
OUTPUT:
RETVAL
SysRet
fsync(handle)
OutputStream handle
CODE:
#ifdef HAS_FSYNC
if(handle)
RETVAL = fsync(PerlIO_fileno(handle));
else {
RETVAL = -1;
errno = EINVAL;
}
#else
RETVAL = (SysRet) not_here("IO::Handle::sync");
#endif
OUTPUT:
RETVAL
MODULE = IO PACKAGE = IO::Socket
SysRet
sockatmark (sock)
InputStream sock
PROTOTYPE: $
PREINIT:
int fd;
CODE:
{
fd = PerlIO_fileno(sock);
#ifdef HAS_SOCKATMARK
RETVAL = sockatmark(fd);
#else
{
int flag = 0;
# ifdef SIOCATMARK
# if defined(NETWARE) || defined(WIN32)
if (ioctl(fd, SIOCATMARK, (void*)&flag) != 0)
# else
if (ioctl(fd, SIOCATMARK, &flag) != 0)
# endif
XSRETURN_UNDEF;
# else
not_here("IO::Socket::atmark");
# endif
RETVAL = flag;
}
#endif
}
OUTPUT:
RETVAL
BOOT:
{
HV *stash;
/*
* constant subs for IO::Poll
*/
stash = gv_stashpvn("IO::Poll", 8, TRUE);
#ifdef POLLIN
newCONSTSUB(stash,"POLLIN",newSViv(POLLIN));
#endif
#ifdef POLLPRI
newCONSTSUB(stash,"POLLPRI", newSViv(POLLPRI));
#endif
#ifdef POLLOUT
newCONSTSUB(stash,"POLLOUT", newSViv(POLLOUT));
#endif
#ifdef POLLRDNORM
newCONSTSUB(stash,"POLLRDNORM", newSViv(POLLRDNORM));
#endif
#ifdef POLLWRNORM
newCONSTSUB(stash,"POLLWRNORM", newSViv(POLLWRNORM));
#endif
#ifdef POLLRDBAND
newCONSTSUB(stash,"POLLRDBAND", newSViv(POLLRDBAND));
#endif
#ifdef POLLWRBAND
newCONSTSUB(stash,"POLLWRBAND", newSViv(POLLWRBAND));
#endif
#ifdef POLLNORM
newCONSTSUB(stash,"POLLNORM", newSViv(POLLNORM));
#endif
#ifdef POLLERR
newCONSTSUB(stash,"POLLERR", newSViv(POLLERR));
#endif
#ifdef POLLHUP
newCONSTSUB(stash,"POLLHUP", newSViv(POLLHUP));
#endif
#ifdef POLLNVAL
newCONSTSUB(stash,"POLLNVAL", newSViv(POLLNVAL));
#endif
/*
* constant subs for IO::Handle
*/
stash = gv_stashpvn("IO::Handle", 10, TRUE);
#ifdef _IOFBF
newCONSTSUB(stash,"_IOFBF", newSViv(_IOFBF));
#endif
#ifdef _IOLBF
newCONSTSUB(stash,"_IOLBF", newSViv(_IOLBF));
#endif
#ifdef _IONBF
newCONSTSUB(stash,"_IONBF", newSViv(_IONBF));
#endif
#ifdef SEEK_SET
newCONSTSUB(stash,"SEEK_SET", newSViv(SEEK_SET));
#endif
#ifdef SEEK_CUR
newCONSTSUB(stash,"SEEK_CUR", newSViv(SEEK_CUR));
#endif
#ifdef SEEK_END
newCONSTSUB(stash,"SEEK_END", newSViv(SEEK_END));
#endif
}
More information about the dslinux-commit
mailing list