From: Chip Salzenberg Date: Thu, 19 Dec 1996 23:14:00 +0000 (+1200) Subject: [shell changes from patch from perl5.003_12 to perl5.003_13] X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f2f8ca5cb610536301ae36c7b4b93a2fb345342e;p=p5sagit%2Fp5-mst-13.2.git [shell changes from patch from perl5.003_12 to perl5.003_13] Change from running these commands: # be sure that new tests are executable touch t/lib/open2.t t/lib/open3.t chmod +x t/lib/open2.t t/lib/open3.t # get rid of old file rm -f lib/Net/Socket.pm # ready to patch exit 0 --- diff --git a/lib/Net/Socket.pm b/lib/Net/Socket.pm deleted file mode 100644 index d24e625..0000000 --- a/lib/Net/Socket.pm +++ /dev/null @@ -1,332 +0,0 @@ -package Net::Socket; - -=head1 NAME - -Net::Socket - TEMPORARY Socket filedescriptor class, so Net::FTP still -works while IO::Socket is having a re-fit - -=head1 DESCRIPTION - -NO TEXT --- THIS MODULE IS TEMPORARY - -=cut - -require 5.001; -use Socket 1.3; -use Carp; -require Exporter; - -@ISA = qw(Exporter); -@EXPORT_OK = @Socket::EXPORT; - -$VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/); -sub Version { $VERSION } - -## -## Really WANT FileHandle::new to return this !!! -## -my $seq = 0; -sub _gensym { - my $pkg = @_ ? ref($_[0]) || $_[0] : ""; - local *{$pkg . "::GLOB" . ++$seq}; - \delete ${$pkg . "::"}{'GLOB' . $seq}; -} - -my %socket_type = ( - tcp => SOCK_STREAM, - udp => SOCK_DGRAM, - rpc => SOCK_DGRAM, -); - -# Peer => remote host name for a 'connect' socket -# Proto => specifiy protocol by it self (but override by Service) -# Service => require service eg 'ftp' or 'ftp/tcp', overrides Proto -# Port => port num for connect eg 'ftp' or 21, defaults to Service -# Bind => port to bind to, defaults to INADDR_ANY -# Listen => queue size for listen -# -# if Listen is defined then a listen socket is created, else if the socket -# type, which is derived from the protocol, is SOCK_STREAM then a connect -# is called - -=head2 new( %args ) - -The new constructor takes its arguments in the form of a hash. Accepted -arguments are - - Peer => remote host name for a 'connect' socket - Proto => specifiy protocol by it self (but override by Service) - Service => require service eg 'ftp' or 'ftp/tcp', overrides Proto - Port => port num for connect eg 'ftp' or 21, defaults to Service - Bind => port to bind to, defaults to INADDR_ANY - Listen => queue size for listen - -=cut - -sub new { - my $pkg = shift; - my %arg = @_; - - my $proto = $arg{Proto} || ""; - my $bindport = $arg{Bind} || 0; - my $servport = $arg{Port} || 0; - - my $service = $arg{Service} || $servport || $bindport; - - ($service,$proto) = split(m,/,, $service) - if $service =~ m,/,; - - my @serv = $service =~ /\D/ ? getservbyname($service,$proto) - : getservbyport($service,$proto); - - $proto = $proto || $serv[3]; - - croak "cannot determine protocol" - unless $proto; - - my @proto = $proto =~ /\D/ ? getprotobyname($proto) - : getprotobynumber($proto); - - croak "unknown protocol" - unless @proto; - - my $type = $arg{Type} || $socket_type{$proto[0]} or - croak "Unknown socket type"; - - my $bindaddr = exists $arg{Addr} ? inet_aton($arg{Addr}) - : INADDR_ANY; - - croak "bad bind address $arg{Addr}" - unless $bindaddr; - - my $sock = bless _gensym(), ref($pkg) || $pkg; - - socket($sock, AF_INET, $type, $proto[2]) or - croak "socket: $!"; - - $bindport = (getservbyname($bindport,$proto))[2] - if $bindport =~ /\D/; - - bind($sock, sockaddr_in($bindport, $bindaddr)) or - croak "bind: $!"; - - if(defined $arg{Listen}) - { - my $queue = $arg{Listen} || 1; - - listen($sock, $queue) or - croak "listen: $!"; - } - else - { - $servport = $serv[2] || 0 - unless $servport =~ /^\d+$/ && $servport > 0; - - croak "cannot determine port" - unless($servport); - - my $destaddr = defined $arg{Peer} ? inet_aton($arg{Peer}) - : undef; - - my $peername = defined $destaddr ? sockaddr_in($servport,$destaddr) - : undef; - - - if($type == SOCK_STREAM || $destaddr) - { - croak "bad peer address" - unless defined $destaddr; - - connect($sock, $peername) or - croak "connect: $!"; - - ${*$sock}{Peername} = getpeername($sock); - } - else - { - ${*$sock}{Peername} = $peername; - } - } - - ${*$sock}{Sockname} = getsockname($sock); - - $sock; -} - -=head2 autoflush( [$val] ) - -Set the file descriptor to autoflush, depending on C<$val> - -=cut - -sub autoflush { - my $sock = shift; - my $val = @_ ? shift : 0; - - select((select($sock), $| = $val)[$[]); -} - -=head2 accept - -perform the system call C on the socket and return a new Net::Socket -object. This object can be used to communicate with the client that was trying -to connect. - -=cut - -sub accept { - my $sock = shift; - - my $new = bless _gensym(); - - accept($new,$sock) or - croak "accept: $!"; - - ${*$new}{Peername} = getpeername($new) or - croak "getpeername: $!"; - - ${*$new}{Sockname} = getsockname($new) or - croak "getsockname: $!"; - - $new; -} - -=head2 close - -Close the file descriptor - -=cut - -sub close { - my $sock = shift; - - delete ${*$sock}{Sockname}; - delete ${*$sock}{Peername}; - - close($sock); -} - -=head2 dup - -Create a duplicate of the socket object - -=cut - -sub dup { - my $sock = shift; - my $dup = bless _gensym(), ref($sock); - - if(open($dup,">&" . fileno($sock))) { - # Copy all the internals - ${*$dup} = ${*$sock}; - @{*$dup} = @{*$sock}; - %{*$dup} = %{*$sock}; - } - else { - undef $dup; - } - - $dup; -} - -# Some info about the local socket - -=head2 sockname - -Return a packed sockaddr structure for the socket - -=head2 sockaddr - -Return the address part of the sockaddr structure for the socket - -=head2 sockport - -Return the port number that the socket is using on the local host - -=head2 sockhost - -Return the address part of the sockaddr structure for the socket in a -text form xx.xx.xx.xx - -=cut - -sub sockname { my $sock = shift; ${*$sock}{Sockname} } -sub sockaddr { (sockaddr_in(shift->sockname))[1]} -sub sockport { (sockaddr_in(shift->sockname))[0]} -sub sockhost { inet_ntoa( shift->sockaddr);} - -# Some info about the remote socket, for connect-d sockets - -=head2 peername, peeraddr, peerport, peerhost - -Same as for the sock* functions, but returns the data about the peer -host instead of the local host. - -=cut - -sub peername { my $sock = shift; ${*$sock}{Peername} or croak "no peer" } -sub peeraddr { (sockaddr_in(shift->peername))[1]} -sub peerport { (sockaddr_in(shift->peername))[0]} -sub peerhost { inet_ntoa( shift->peeraddr);} - -=head2 send( $buf [, $flags [, $to]] ) - -For a udp socket, send the contents of C<$buf> to the remote host C<$to> using -flags C<$flags>. - -If C<$to> is not specified then the data is sent to the host which the socket -last communicated with, ie sent to or recieved from. - -If C<$flags> is ommited then 0 is used - -=cut - -sub send { - my $sock = shift; - local *buf = \$_[0]; shift; - my $flags = shift || 0; - my $to = shift || $sock->peername; - - # remember who we send to - ${*$sock}{Peername} = $to; - - send($sock, $buf, $flags, $to); -} - -=head2 recv( $buf, $len [, $flags] ) - -Receive C<$len> bytes of data from the socket and place into C<$buf> - -If C<$flags> is ommited then 0 is used - -=cut - -sub recv { - my $sock = shift; - local *buf = \$_[0]; shift; - my $len = shift; - my $flags = shift || 0; - - # remember who we recv'd from - ${*$sock}{Peername} = recv($sock, $buf='', $len, $flags); -} - -=head1 AUTHOR - -Graham Barr - -=head1 REVISION - -$Revision: 1.2 $ - -=head1 COPYRIGHT - -Copyright (c) 1995 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. - -=cut - -1; # Keep require happy - - diff --git a/t/lib/open2.t b/t/lib/open2.t new file mode 100755 index 0000000..e69de29 diff --git a/t/lib/open3.t b/t/lib/open3.t new file mode 100755 index 0000000..e69de29