From: Jarkko Hietaniemi Date: Mon, 26 Mar 2001 00:23:38 +0000 (+0000) Subject: Implement IO::Socket::atmark(), inspired by Lincoln Stein's X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=63a347c7a3ed87c3e11eda9e379b25371182e278;p=p5sagit%2Fp5-mst-13.2.git Implement IO::Socket::atmark(), inspired by Lincoln Stein's IO::Sockatmark(). p4raw-id: //depot/perl@9354 --- diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs index 942a799..4987b3d 100644 --- a/ext/IO/IO.xs +++ b/ext/IO/IO.xs @@ -17,6 +17,12 @@ # include #endif +#ifndef SIOCATMARK +# ifdef I_SYS_SOCKIO +# include +# endif +#endif + #ifdef PerlIO typedef int SysRet; typedef PerlIO * InputStream; @@ -262,7 +268,6 @@ CODE: MODULE = IO PACKAGE = IO::Handle PREFIX = f - int ungetc(handle, c) InputStream handle @@ -408,6 +413,32 @@ fsync(handle) RETVAL +MODULE = IO PACKAGE = IO::Socket + +SysRet +sockatmark (sock) + InputStream sock + PROTOTYPE: $ + PREINIT: + int fd,flag,result; + CODE: + { + fd = PerlIO_fileno(sock); +#ifdef HAS_SOCKATMARK + flag = sockatmark(fd); +#else +# ifdef SIOCATMARK + if (ioctl(fd, SIOCATMARK, &flag) != 0) + XSRETURN_UNDEF; +# else + not_here("IO::Socket::atmark"); +# endif + RETVAL = flag; +#endif + } + OUTPUT: + RETVAL + BOOT: { HV *stash; @@ -471,3 +502,4 @@ BOOT: newCONSTSUB(stash,"SEEK_END", newSViv(SEEK_END)); #endif } + diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm index b8da092..4199da2 100644 --- a/ext/IO/lib/IO/Socket.pm +++ b/ext/IO/lib/IO/Socket.pm @@ -6,13 +6,13 @@ package IO::Socket; -require 5.005_64; +require v5.6; use IO::Handle; use Socket 1.3; use Carp; use strict; -our(@ISA, $VERSION); +our(@ISA, $VERSION, @EXPORT_OK); use Exporter; use Errno; @@ -23,12 +23,18 @@ require IO::Socket::UNIX if ($^O ne 'epoc'); @ISA = qw(IO::Handle); -$VERSION = "1.26"; +$VERSION = "1.27"; + +@EXPORT_OK = qw(sockatmark); sub import { my $pkg = shift; - my $callpkg = caller; - Exporter::export 'Socket', $callpkg, @_; + if ($_[0] eq 'sockatmark') { # not very extensible but for now, fast + Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark'); + } else { + my $callpkg = caller; + Exporter::export 'Socket', $callpkg, @_; + } } sub new { @@ -258,6 +264,12 @@ sub sockopt { : $sock->setsockopt(SOL_SOCKET,@_); } +sub atmark { + @_ == 1 or croak 'usage: $sock->atmark()'; + my($sock) = @_; + sockatmark($sock); +} + sub timeout { @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])'; my($sock,$val) = @_; @@ -376,26 +388,32 @@ Additional methods that are provided are: =over 4 -=item timeout([VAL]) +=item atmark -Set or get the timeout value associated with this socket. If called without -any arguments then the current setting is returned. If called with an argument -the current setting is changed and the previous value returned. +True if the socket is currently positioned at the urgent data mark, +false otherwise. -=item sockopt(OPT [, VAL]) + use IO::Socket; -Unified method to both set and get options in the SOL_SOCKET level. If called -with one argument then getsockopt is called, otherwise setsockopt is called. + my $sock = IO::Socket::INET->new('some_server'); + $sock->read(1024,$data) until $sock->atmark; -=item sockdomain +Note: this is a reasonably new addition to the family of socket +functions, so all systems may not support this yet. If it is +unsupported by the system, an attempt to use this method will +abort the program. -Returns the numerical number for the socket domain type. For example, for -a AF_INET socket the value of &AF_INET will be returned. +The atmark() functionality is also exportable as sockatmark() function: -=item socktype + use IO::Socket 'sockatmark'; -Returns the numerical number for the socket type. For example, for -a SOCK_STREAM socket the value of &SOCK_STREAM will be returned. +This allows for a more traditional use of sockatmark() as a procedural +socket function. + +=item connected + +If the socket is in a connected state the the peer address is returned. +If the socket is not in a connected state then undef will be returned. =item protocol @@ -403,10 +421,26 @@ Returns the numerical number for the protocol being used on the socket, if known. If the protocol is unknown, as with an AF_UNIX socket, zero is returned. -=item connected +=item sockdomain -If the socket is in a connected state the the peer address is returned. -If the socket is not in a connected state then undef will be returned. +Returns the numerical number for the socket domain type. For example, for +a AF_INET socket the value of &AF_INET will be returned. + +=item sockopt(OPT [, VAL]) + +Unified method to both set and get options in the SOL_SOCKET level. If called +with one argument then getsockopt is called, otherwise setsockopt is called. + +=item socktype + +Returns the numerical number for the socket type. For example, for +a SOCK_STREAM socket the value of &SOCK_STREAM will be returned. + +=item timeout([VAL]) + +Set or get the timeout value associated with this socket. If called without +any arguments then the current setting is returned. If called with an argument +the current setting is changed and the previous value returned. =back @@ -416,8 +450,8 @@ L, L, L, L =head1 AUTHOR -Graham Barr. Currently maintained by the Perl Porters. Please report all -bugs to . +Graham Barr. atmark() by Lincoln Stein. Currently maintained by the +Perl Porters. Please report all bugs to . =head1 COPYRIGHT @@ -425,4 +459,9 @@ Copyright (c) 1997-8 Graham Barr . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. +The atmark() implementation: Copyright 2001, Lincoln Stein . +This module is distributed under the same terms as Perl itself. +Feel free to use, modify and redistribute it as long as you retain +the correct attribution. + =cut