+# IO::Socket.pm
#
+# Copyright (c) 1997-8 Graham Barr <gbarr@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.
package IO::Socket;
-=head1 NAME
-
-IO::Socket - supply object methods for sockets
-
-=head1 SYNOPSIS
-
- use IO::Socket;
-
-=head1 DESCRIPTION
-
-C<IO::Socket> provides an object interface to creating and using sockets. It
-is built upon the L<IO::Handle> interface and inherits all the methods defined
-by L<IO::Handle>.
-
-C<IO::Socket> only defines methods for those operations which are common to all
-types of socket. Operations which are specified to a socket in a particular
-domain have methods defined in sub classes of C<IO::Socket>
-
-See L<perlfunc> for complete descriptions of each of the following
-supported C<IO::Seekable> methods, which are just front ends for the
-corresponding built-in functions:
-
- socket
- socketpair
- bind
- listen
- accept
- send
- recv
- peername (getpeername)
- sockname (getsockname)
+require 5.005_64;
-Some methods take slightly different arguments to those defined in L<perlfunc>
-in attempt to make the interface more flexible. These are
-
-=item accept([PKG])
-
-perform the system call C<accept> on the socket and return a new object. The
-new object will be created in the same class as the listen socket, unless
-C<PKG> is specified. This object can be used to communicate with the client
-that was trying to connect. In a scalar context the new socket is returned,
-or undef upon failure. In an array context a two-element array is returned
-containing the new socket and the peer address, the list will
-be empty upon failure.
-
-Additional methods that are provided are
-
-=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.
-
-=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
-
-=cut
-
-
-require 5.000;
-
-use Config;
use IO::Handle;
use Socket 1.3;
use Carp;
use strict;
-use vars qw(@ISA @EXPORT_OK $VERSION);
+our(@ISA, $VERSION);
use Exporter;
+use Errno;
-@ISA = qw(IO::Handle);
+# legacy
+
+require IO::Socket::INET;
+require IO::Socket::UNIX if ($^O ne 'epoc');
-# This one will turn 1.2 => 1.02 and 1.2.3 => 1.0203 and so on ...
+@ISA = qw(IO::Handle);
-$VERSION = do{my @r=(q$Revision: 1.9 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
+$VERSION = "1.26";
sub import {
my $pkg = shift;
sub new {
my($class,%arg) = @_;
- my $fh = $class->SUPER::new();
+ my $sock = $class->SUPER::new();
- ${*$fh}{'io_socket_timeout'} = delete $arg{Timeout};
+ $sock->autoflush(1);
- return scalar(%arg) ? $fh->configure(\%arg)
- : $fh;
+ ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
+
+ return scalar(%arg) ? $sock->configure(\%arg)
+ : $sock;
+}
+
+my @domain2pkg;
+
+sub register_domain {
+ my($p,$d) = @_;
+ $domain2pkg[$d] = $p;
}
sub configure {
- croak 'IO::Socket: Cannot configure a generic socket';
+ my($sock,$arg) = @_;
+ my $domain = delete $arg->{Domain};
+
+ croak 'IO::Socket: Cannot configure a generic socket'
+ unless defined $domain;
+
+ croak "IO::Socket: Unsupported socket domain"
+ unless defined $domain2pkg[$domain];
+
+ croak "IO::Socket: Cannot configure socket in domain '$domain'"
+ unless ref($sock) eq "IO::Socket";
+
+ bless($sock, $domain2pkg[$domain]);
+ $sock->configure($arg);
}
sub socket {
- @_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)';
- my($fh,$domain,$type,$protocol) = @_;
+ @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
+ my($sock,$domain,$type,$protocol) = @_;
- socket($fh,$domain,$type,$protocol) or
+ socket($sock,$domain,$type,$protocol) or
return undef;
- ${*$fh}{'io_socket_type'} = $type;
- $fh;
+ ${*$sock}{'io_socket_domain'} = $domain;
+ ${*$sock}{'io_socket_type'} = $type;
+ ${*$sock}{'io_socket_proto'} = $protocol;
+
+ $sock;
}
sub socketpair {
- @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)';
+ @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
my($class,$domain,$type,$protocol) = @_;
- my $fh1 = $class->new();
- my $fh2 = $class->new();
+ my $sock1 = $class->new();
+ my $sock2 = $class->new();
- socketpair($fh1,$fh1,$domain,$type,$protocol) or
+ socketpair($sock1,$sock2,$domain,$type,$protocol) or
return ();
- ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type;
+ ${*$sock1}{'io_socket_type'} = ${*$sock2}{'io_socket_type'} = $type;
+ ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
- ($fh1,$fh2);
+ ($sock1,$sock2);
}
sub connect {
- @_ == 2 || @_ == 3 or croak 'usage: $fh->connect(NAME) or $fh->connect(PORT, ADDR)';
- my $fh = shift;
- my $addr = @_ == 1 ? shift : sockaddr_in(@_);
- my $timeout = ${*$fh}{'io_socket_timeout'};
- local($SIG{ALRM}) = $timeout ? sub { undef $fh; }
- : $SIG{ALRM} || 'DEFAULT';
-
- eval {
- croak 'connect: Bad address'
- if(@_ == 2 && !defined $_[1]);
-
- if($timeout) {
- defined $Config{d_alarm} && defined alarm($timeout) or
- $timeout = 0;
- }
-
- my $ok = connect($fh, $addr);
-
- alarm(0)
- if($timeout);
+ @_ == 2 or croak 'usage: $sock->connect(NAME)';
+ my $sock = shift;
+ my $addr = shift;
+ my $timeout = ${*$sock}{'io_socket_timeout'};
+ my $err;
+ my $blocking;
+ $blocking = $sock->blocking(0) if $timeout;
+
+ if (!connect($sock, $addr)) {
+ if ($timeout && $!{EINPROGRESS}) {
+ require IO::Select;
+
+ my $sel = new IO::Select $sock;
+
+ if (!$sel->can_write($timeout)) {
+ $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+ $@ = "connect: timeout";
+ }
+ elsif(!connect($sock,$addr) && not $!{EISCONN}) {
+ # Some systems refuse to re-connect() to
+ # an already open socket and set errno to EISCONN.
+ $err = $!;
+ $@ = "connect: $!";
+ }
+ }
+ else {
+ $err = $!;
+ $@ = "connect: $!";
+ }
+ }
- croak "connect: timeout"
- unless defined $fh;
+ $sock->blocking(1) if $blocking;
- undef $fh unless $ok;
- };
+ $! = $err if $err;
- $fh;
+ $err ? undef : $sock;
}
sub bind {
- @_ == 2 || @_ == 3 or croak 'usage: $fh->bind(NAME) or $fh->bind(PORT, ADDR)';
- my $fh = shift;
- my $addr = @_ == 1 ? shift : sockaddr_in(@_);
+ @_ == 2 or croak 'usage: $sock->bind(NAME)';
+ my $sock = shift;
+ my $addr = shift;
- return bind($fh, $addr) ? $fh
- : undef;
+ return bind($sock, $addr) ? $sock
+ : undef;
}
sub listen {
- @_ >= 1 && @_ <= 2 or croak 'usage: $fh->listen([QUEUE])';
- my($fh,$queue) = @_;
+ @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
+ my($sock,$queue) = @_;
$queue = 5
unless $queue && $queue > 0;
- return listen($fh, $queue) ? $fh
- : undef;
+ return listen($sock, $queue) ? $sock
+ : undef;
}
sub accept {
- @_ == 1 || @_ == 2 or croak 'usage $fh->accept([PKG])';
- my $fh = shift;
- my $pkg = shift || $fh;
- my $timeout = ${*$fh}{'io_socket_timeout'};
+ @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
+ my $sock = shift;
+ my $pkg = shift || $sock;
+ my $timeout = ${*$sock}{'io_socket_timeout'};
my $new = $pkg->new(Timeout => $timeout);
my $peer = undef;
- eval {
- if($timeout) {
- my $fdset = "";
- vec($fdset, $fh->fileno,1) = 1;
- croak "accept: timeout"
- unless select($fdset,undef,undef,$timeout);
- }
- $peer = accept($new,$fh);
- };
-
- return wantarray ? defined $peer ? ($new, $peer)
- : ()
- : defined $peer ? $new
- : undef;
+ if($timeout) {
+ require IO::Select;
+
+ my $sel = new IO::Select $sock;
+
+ unless ($sel->can_read($timeout)) {
+ $@ = 'accept: timeout';
+ $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+ return;
+ }
+ }
+
+ $peer = accept($new,$sock)
+ or return;
+
+ return wantarray ? ($new, $peer)
+ : $new;
}
sub sockname {
- @_ == 1 or croak 'usage: $fh->sockname()';
+ @_ == 1 or croak 'usage: $sock->sockname()';
getsockname($_[0]);
}
sub peername {
- @_ == 1 or croak 'usage: $fh->peername()';
- my($fh) = @_;
- getpeername($fh)
- || ${*$fh}{'io_socket_peername'}
+ @_ == 1 or croak 'usage: $sock->peername()';
+ my($sock) = @_;
+ getpeername($sock)
+ || ${*$sock}{'io_socket_peername'}
|| undef;
}
+sub connected {
+ @_ == 1 or croak 'usage: $sock->connected()';
+ my($sock) = @_;
+ getpeername($sock);
+}
+
sub send {
- @_ >= 2 && @_ <= 4 or croak 'usage: $fh->send(BUF, [FLAGS, [TO]])';
- my $fh = $_[0];
+ @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
+ my $sock = $_[0];
my $flags = $_[2] || 0;
- my $peer = $_[3] || $fh->peername;
+ my $peer = $_[3] || $sock->peername;
croak 'send: Cannot determine peer address'
unless($peer);
- my $r = send($fh, $_[1], $flags, $peer);
+ my $r = defined(getpeername($sock))
+ ? send($sock, $_[1], $flags)
+ : send($sock, $_[1], $flags, $peer);
# remember who we send to, if it was sucessful
- ${*$fh}{'io_socket_peername'} = $peer
+ ${*$sock}{'io_socket_peername'} = $peer
if(@_ == 4 && defined $r);
$r;
}
sub recv {
- @_ == 3 || @_ == 4 or croak 'usage: $fh->recv(BUF, LEN [, FLAGS])';
+ @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
my $sock = $_[0];
my $len = $_[2];
my $flags = $_[3] || 0;
${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
}
+sub shutdown {
+ @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
+ my($sock, $how) = @_;
+ shutdown($sock, $how);
+}
sub setsockopt {
- @_ == 4 or croak '$fh->setsockopt(LEVEL, OPTNAME)';
+ @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME)';
setsockopt($_[0],$_[1],$_[2],$_[3]);
}
my $intsize = length(pack("i",0));
sub getsockopt {
- @_ == 3 or croak '$fh->getsockopt(LEVEL, OPTNAME)';
+ @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
my $r = getsockopt($_[0],$_[1],$_[2]);
# Just a guess
$r = unpack("i", $r)
}
sub sockopt {
- my $fh = shift;
- @_ == 1 ? $fh->getsockopt(SOL_SOCKET,@_)
- : $fh->setsockopt(SOL_SOCKET,@_);
+ my $sock = shift;
+ @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
+ : $sock->setsockopt(SOL_SOCKET,@_);
}
sub timeout {
- @_ == 1 || @_ == 2 or croak 'usage: $fh->timeout([VALUE])';
- my($fh,$val) = @_;
- my $r = ${*$fh}{'io_socket_timeout'} || undef;
+ @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
+ my($sock,$val) = @_;
+ my $r = ${*$sock}{'io_socket_timeout'} || undef;
- ${*$fh}{'io_socket_timeout'} = 0 + $val
+ ${*$sock}{'io_socket_timeout'} = 0 + $val
if(@_ == 2);
$r;
}
-sub socktype {
- @_ == 1 or croak '$fh->socktype()';
- ${*{$_[0]}}{'io_socket_type'} || undef;
+sub sockdomain {
+ @_ == 1 or croak 'usage: $sock->sockdomain()';
+ my $sock = shift;
+ ${*$sock}{'io_socket_domain'};
}
-=head1 SUB-CLASSES
-
-=cut
-
-##
-## AF_INET
-##
-
-package IO::Socket::INET;
-
-use strict;
-use vars qw(@ISA $VERSION);
-use Socket;
-use Carp;
-use Exporter;
-
-@ISA = qw(IO::Socket);
-
-my %socket_type = ( tcp => SOCK_STREAM,
- udp => SOCK_DGRAM,
- );
-
-=head2 IO::Socket::INET
-
-C<IO::Socket::INET> provides a constructor to create an AF_INET domain socket
-and some related methods. The constructor can take the following options
-
- PeerAddr Remote host address
- PeerPort Remote port or service
- LocalPort Local host bind port
- LocalAddr Local host bind address
- Proto Protocol name (eg tcp udp etc)
- Type Socket type (SOCK_STREAM etc)
- Listen Queue size for listen
- Timeout Timeout value for various operations
-
-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
-
-Only one of C<Type> or C<Proto> needs to be specified, one will be assumed
-from the other.
-
-=head2 METHODS
-
-=item sockaddr()
-
-Return the address part of the sockaddr structure for the socket
-
-=item sockport()
-
-Return the port number that the socket is using on the local host
-
-=item sockhost()
-
-Return the address part of the sockaddr structure for the socket in a
-text form xx.xx.xx.xx
-
-=item peeraddr(), peerport(), peerhost()
-
-Same as for the sock* functions, but returns the data about the peer
-host instead of the local host.
-
-=cut
-
-
-sub _sock_info {
- my($addr,$port,$proto) = @_;
- my @proto = ();
- my @serv = ();
-
- $port = $1
- if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
-
- if(defined $proto) {
- @proto = $proto =~ m,\D, ? getprotobyname($proto)
- : getprotobynumber($proto);
+sub socktype {
+ @_ == 1 or croak 'usage: $sock->socktype()';
+ my $sock = shift;
+ ${*$sock}{'io_socket_type'}
+}
- $proto = $proto[2] || undef;
- }
+sub protocol {
+ @_ == 1 or croak 'usage: $sock->protocol()';
+ my($sock) = @_;
+ ${*$sock}{'io_socket_proto'};
+}
- if(defined $port) {
- $port =~ s,\((\d+)\)$,,;
+1;
- my $defport = $1 || undef;
- my $pnum = ($port =~ m,^(\d+)$,)[0];
+__END__
- @serv= getservbyname($port, $proto[0] || "")
- if($port =~ m,\D,);
+=head1 NAME
- $port = $pnum || $serv[2] || $defport || undef;
+IO::Socket - Object interface to socket communications
- $proto = (getprotobyname($serv[3]))[2] || undef
- if @serv && !$proto;
- }
+=head1 SYNOPSIS
- return ($addr || undef,
- $port || undef,
- $proto || undef
- );
-}
+ use IO::Socket;
-sub configure {
- my($fh,$arg) = @_;
- my($lport,$rport,$laddr,$raddr,$proto,$type);
+=head1 DESCRIPTION
+C<IO::Socket> provides an object interface to creating and using sockets. It
+is built upon the L<IO::Handle> interface and inherits all the methods defined
+by L<IO::Handle>.
- ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
- $arg->{LocalPort},
- $arg->{Proto});
+C<IO::Socket> only defines methods for those operations which are common to all
+types of socket. Operations which are specified to a socket in a particular
+domain have methods defined in sub classes of C<IO::Socket>
- $laddr = defined $laddr ? inet_aton($laddr)
- : INADDR_ANY;
+C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
- unless(exists $arg->{Listen}) {
- ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
- $arg->{PeerPort},
- $proto);
- }
+=head1 CONSTRUCTOR
- croak 'IO::Socket: Cannot determine protocol'
- unless($proto);
+=over 4
- my $pname = (getprotobynumber($proto))[0];
- $type = $arg->{Type} || $socket_type{$pname};
+=item new ( [ARGS] )
- $fh->socket(AF_INET, $type, $proto) or
- return undef;
+Creates an C<IO::Socket>, which is a reference to a
+newly created symbol (see the C<Symbol> package). C<new>
+optionally takes arguments, these arguments are in key-value pairs.
+C<new> only looks for one key C<Domain> which tells new which domain
+the socket will be in. All other arguments will be passed to the
+configuration method of the package for that domain, See below.
- $fh->bind($lport || 0, $laddr) or
- return undef;
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
- if(exists $arg->{Listen}) {
- $fh->listen($arg->{Listen} || 5) or
- return undef;
- }
- else {
- croak "IO::Socket: Cannot determine remote port"
- unless($rport || $type == SOCK_DGRAM);
+As of VERSION 1.18 all IO::Socket objects have autoflush turned on
+by default. This was not the case with earlier releases.
- if($type == SOCK_STREAM || defined $raddr) {
- croak "IO::Socket: Bad peer address"
- unless defined $raddr;
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
- $fh->connect($rport,inet_aton($raddr)) or
- return undef;
- }
- }
+=back
- $fh;
-}
+=head1 METHODS
-sub sockaddr {
- @_ == 1 or croak 'usage: $fh->sockaddr()';
- my($fh) = @_;
- (sockaddr_in($fh->sockname))[1];
-}
+See L<perlfunc> for complete descriptions of each of the following
+supported C<IO::Socket> methods, which are just front ends for the
+corresponding built-in functions:
-sub sockport {
- @_ == 1 or croak 'usage: $fh->sockport()';
- my($fh) = @_;
- (sockaddr_in($fh->sockname))[0];
-}
+ socket
+ socketpair
+ bind
+ listen
+ accept
+ send
+ recv
+ peername (getpeername)
+ sockname (getsockname)
+ shutdown
-sub sockhost {
- @_ == 1 or croak 'usage: $fh->sockhost()';
- my($fh) = @_;
- inet_ntoa($fh->sockaddr);
-}
+Some methods take slightly different arguments to those defined in L<perlfunc>
+in attempt to make the interface more flexible. These are
-sub peeraddr {
- @_ == 1 or croak 'usage: $fh->peeraddr()';
- my($fh) = @_;
- (sockaddr_in($fh->peername))[1];
-}
+=over 4
-sub peerport {
- @_ == 1 or croak 'usage: $fh->peerport()';
- my($fh) = @_;
- (sockaddr_in($fh->peername))[0];
-}
+=item accept([PKG])
-sub peerhost {
- @_ == 1 or croak 'usage: $fh->peerhost()';
- my($fh) = @_;
- inet_ntoa($fh->peeraddr);
-}
+perform the system call C<accept> on the socket and return a new object. The
+new object will be created in the same class as the listen socket, unless
+C<PKG> is specified. This object can be used to communicate with the client
+that was trying to connect. In a scalar context the new socket is returned,
+or undef upon failure. In a list context a two-element array is returned
+containing the new socket and the peer address; the list will
+be empty upon failure.
-##
-## AF_UNIX
-##
+=item socketpair(DOMAIN, TYPE, PROTOCOL)
-package IO::Socket::UNIX;
+Call C<socketpair> and return a list of two sockets created, or an
+empty list on failure.
-use strict;
-use vars qw(@ISA $VERSION);
-use Socket;
-use Carp;
-use Exporter;
+=back
-@ISA = qw(IO::Socket);
+Additional methods that are provided are:
-=head2 IO::Socket::UNIX
+=over 4
-C<IO::Socket::UNIX> provides a constructor to create an AF_UNIX domain socket
-and some related methods. The constructor can take the following options
+=item timeout([VAL])
- Type Type of socket (eg SOCK_STREAM or SOCK_DGRAM)
- Local Path to local fifo
- Peer Path to peer fifo
- Listen Create a listen socket
+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.
-=head2 METHODS
+=item sockopt(OPT [, VAL])
-=item hostpath()
+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.
-Returns the pathname to the fifo at the local end
+=item sockdomain
-=item peerpath()
+Returns the numerical number for the socket domain type. For example, for
+a AF_INET socket the value of &AF_INET will be returned.
-Returns the pathanme to the fifo at the peer end
+=item socktype
-=cut
+Returns the numerical number for the socket type. For example, for
+a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
-sub configure {
- my($fh,$arg) = @_;
- my($bport,$cport);
+=item protocol
- my $type = $arg->{Type} || SOCK_STREAM;
+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.
- $fh->socket(AF_UNIX, $type, 0) or
- return undef;
+=item connected
- if(exists $arg->{Local}) {
- my $addr = sockaddr_un($arg->{Local});
- $fh->bind($addr) or
- return undef;
- }
- if(exists $arg->{Listen}) {
- $fh->listen($arg->{Listen} || 5) or
- return undef;
- }
- elsif(exists $arg->{Peer}) {
- my $addr = sockaddr_un($arg->{Peer});
- $fh->connect($addr) or
- return undef;
- }
+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.
- $fh;
-}
+=back
-sub hostpath {
- @_ == 1 or croak 'usage: $fh->hostpath()';
- (sockaddr_un($_[0]->hostname))[0];
-}
+=head1 SEE ALSO
-sub peerpath {
- @_ == 1 or croak 'usage: $fh->peerpath()';
- (sockaddr_un($_[0]->peername))[0];
-}
+L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
=head1 AUTHOR
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$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
+Graham Barr. Currently maintained by the Perl Porters. Please report all
+bugs to <perl5-porters@perl.org>.
=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.
+Copyright (c) 1997-8 Graham Barr <gbarr@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.
=cut
-
-1; # Keep require happy