summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorPerl 5 Porters <perl5-porters@africa.nicoh.com>1997-01-25 15:58:00 +1200
committerChip Salzenberg <chip@atlantic.net>1997-01-25 15:58:00 +1200
commit774d564bb7dd1ed64ca0d7e534aa67e93f991f02 (patch)
tree2e8fac95be59aed598a9217a2911632612d07854 /ext
parent9e3a2af888982d0a201149cbcdbf3feb6771acb4 (diff)
parentbbad36071d5a6d4be3588f0f10c88247439076d8 (diff)
downloadperl-774d564bb7dd1ed64ca0d7e534aa67e93f991f02.tar.gz
[inseparable changes from patch from perl5.003_22 to perl5.003_23]perl-5.003_23
BUILD PROCESS Subject: Make configure.gnu a copy of configure; make configure writea From: Chip Salzenberg <chip@atlantic.net> Files: MANIFEST configure.gnu Subject: Regen Configure with metaconfig: +ARCHNAME, -FILE_filbuf From: Chip Salzenberg <chip@perl.com> Files: Configure config_H config_h.SH hints/lynxos.sh os2/diff.configure os2/os2ish.h plan9/config.plan9 sv.c utils/perlbug.PL vms/config.vms vms/fndvers.com Subject: Compile with optimization when testing memory functions From: Chip Salzenberg <chip@atlantic.net> Files: Configure CORE LANGUAGE CHANGES Subject: Disallow changing $_[0] in __DIE__ handlers From: Chip Salzenberg <chip@atlantic.net> Files: pod/perlfunc.pod util.c Subject: Fix overloading with inheritance and AUTOLOAD Date: Mon, 20 Jan 1997 17:26:32 -0500 (EST) From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: gv.c lib/diagnostics.pm lib/overload.pm pod/perldebug.pod pod/perldiag.pod pod/perlfunc.pod pod/perlop.pod pod/perlre.pod pod/perltoc.pod pod/perlxs.pod Msg-ID: <199701202226.RAA05072@monk.mps.ohio-state.edu> (applied based on p5p patch as commit e7ea3e70155d0bea30720ba41eb6bb6742aac0d1) Subject: Nested here-docs Date: Mon, 20 Jan 1997 15:13:42 -0800 From: Larry Wall <larry@wall.org> Files: toke.c Msg-ID: <199701202313.PAA11693@wall.org> (applied based on p5p patch as commit fd2d0953290ddd46f0820dbd6c87245486b7ab28) Subject: Revert $^X to old behavior (plus HP-UX bug fix) From: Chip Salzenberg <chip@atlantic.net> Files: hints/hpux.sh toke.c Subject: Protect against '0' in 'stmt while <HANDLE>' From: Chip Salzenberg <chip@atlantic.net> Files: op.c Subject: Don't warn when closure uses var at file scope From: Chip Salzenberg <chip@atlantic.net> Files: op.c CORE PORTABILITY Subject: VMS patches for _22 Date: Mon, 20 Jan 1997 22:50:21 -0500 (EST) From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> Files: ext/POSIX/POSIX.xs lib/ExtUtils/MM_VMS.pm lib/ExtUtils/xsubpp lib/Test/Harness.pm toke.c vms/Makefile vms/descrip.mms vms/genconfig.pl vms/perly_c.vms vms/vmsish.h x2p/a2p.h vms/Makefile vms/config.vms vms/descrip.mms vms/perly_c.vms private-msgid: <01IEGBJ2TMYS003PCL@hmivax.humgen.upenn.edu> Subject: Plan9 update From: Luther Huffman <lutherh@stratcom.com> Files: plan9/config.plan9 plan9/mkfile Subject: hints & Configure changes to build perl on DC/OSx Date: Thu, 16 Jan 1997 16:43:52 -0800 From: Stephen Zander <stephen.zander@interlock.mckesson.com> Files: Configure MANIFEST hints/dcosx.sh Msg-ID: <199701170043.QAA25985@wsbip1.mckesson.com> (applied based on p5p patch as commit 23f8769697279d7912be5943de9fdf93f6aa3013) DOCUMENTATION Subject: Additional docs for __DIE__ and __WARN__ From: Gurusamy Sarathy <gsar@engin.umich.edu> Files: pod/perlfunc.pod pod/perlrun.pod pod/perlvar.pod Subject: Document #line directive Date: Fri, 24 Jan 1997 04:08:44 -0500 From: Gurusamy Sarathy <gsar@engin.umich.edu> Files: pod/perlsyn.pod pod/perltoc.pod private-msgid: <199701240908.EAA23846@aatma.engin.umich.edu> Subject: delta for perldelta Date: Fri, 24 Jan 1997 07:57:43 -0800 From: Tom Christiansen <tchrist@mox.perl.com> Files: pod/perlnews.pod pod/perltoc.pod private-msgid: <804.854121463@jinete> Subject: Updates to perldelta Date: Mon, 20 Jan 1997 06:48:49 -0500 (EST) From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: pod/perlnews.pod pod/perltoc.pod private-msgid: <199701211610.LAA06227@monk.mps.ohio-state.edu> Subject: perlnews.pod diff for the Fcntl Date: Tue, 21 Jan 1997 18:00:56 +0200 (EET) From: Jarkko Hietaniemi <jhi@cc.hut.fi> Files: pod/perlnews.pod private-msgid: <199701211600.SAA30117@alpha.hut.fi> Subject: Rename perlnews -> perldelta per Tom's request From: Chip Salzenberg <chip@atlantic.net> Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod pod/perldelta.pod pod/perltoc.pod pod/roffitall LIBRARY AND EXTENSIONS Subject: Refresh IO to 1.15 (plus DESTROY and new_tmpfile fixes) From: Chip Salzenberg <chip@atlantic.net> Files: ext/IO/lib/IO/File.pm ext/IO/lib/IO/Handle.pm ext/IO/lib/IO/Pipe.pm ext/IO/lib/IO/Seekable.pm ext/IO/lib/IO/Socket.pm t/lib/io_pipe.t Subject: Allow IO.xs to remain at 1.15 while $VERSION is 1.1501 From: Chip Salzenberg <chip@atlantic.net> Files: XSUB.h ext/IO/Makefile.PL ext/IO/lib/IO/Handle.pm Subject: Add E* and SA_* constants Date: Wed, 22 Jan 1997 21:36:07 -0500 From: Roderick Schertler <roderick@gate.net> Files: ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs private-msgid: <23338.853986967@eeyore.ibcinc.com> OTHER CORE CHANGES Subject: Make PERL5LIB and -I work like C<use lib> Date: Thu, 23 Jan 1997 15:23:27 +0000 From: Tim Bunce <Tim.Bunce@ig.co.uk> Files: lib/lib.pm perl.c private-msgid: <9701231523.AA26613@toad.ig.co.uk> Subject: Fix /\G.a/ From: Chip Salzenberg <chip@atlantic.net> Files: regcomp.c regcomp.h regexec.c regexp.h toke.c Subject: Extend stack in pp_undef (!) From: Chip Salzenberg <chip@atlantic.net> Files: pp.c Subject: Allow for sub to be redefined while executing From: Chip Salzenberg <chip@atlantic.net> Files: cop.h pp_hot.c t/op/misc.t Subject: Eliminate redundant flag CVf_FORMAT From: Chip Salzenberg <chip@atlantic.net> Files: cv.h op.c perl.c perly.c perly.y proto.h sv.c toke.c Subject: Generate IVs when possible in abs() and int() From: Chip Salzenberg <chip@atlantic.net> Files: pp.c Subject: Efficiency patchlet for pp_aassign() Date: Mon, 20 Jan 1997 22:05:39 -0500 (EST) From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: pp_hot.c Msg-ID: <199701210305.WAA05451@monk.mps.ohio-state.edu> (applied based on p5p patch as commit 7e42bd57a6867e174bc3bc555c3268b485940a98) Subject: Remove "suidperl security patch" message From: Chip Salzenberg <chip@atlantic.net> Files: perl.c TESTS Subject: Fix tests of $^X and $0 to work with QNX From: Chip Salzenberg <chip@atlantic.net> Files: t/lib/io_pipe.t t/lib/open2.t t/lib/open3.t t/op/magic.t Subject: Patch tests for systems without fork() Date: Thu, 23 Jan 1997 23:51:28 +0100 From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de> Files: t/io/pipe.t t/lib/filehand.t t/lib/io_pipe.t t/lib/io_sock.t t/lib/open2.t t/lib/open3.t t/op/fork.t private-msgid: <77724697@Armageddon.meb.uni-bonn.de> Subject: Test patches for OS/2 Date: Thu, 16 Jan 1997 23:48:18 -0500 (EST) From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: os2/OS2/ExtAttr/t/os2_ea.t os2/OS2/PrfDB/t/os2_prfdb.t os2/OS2/REXX/t/rx_cmprt.t os2/OS2/REXX/t/rx_dllld.t os2/OS2/REXX/t/rx_objcall.t os2/OS2/REXX/t/rx_sql.test os2/OS2/REXX/t/rx_tiesql.test os2/OS2/REXX/t/rx_tievar.t os2/OS2/REXX/t/rx_tieydb.t os2/OS2/REXX/t/rx_varset.t os2/OS2/REXX/t/rx_vrexx.t t/README t/cmd/while.t t/comp/colon.t t/comp/multiline.t t/io/argv.t t/lib/anydbm.t t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t t/op/cmp.t t/op/magic.t Msg-ID: <199701170448.XAA28948@monk.mps.ohio-state.edu> (applied based on p5p patch as commit bbad36071d5a6d4be3588f0f10c88247439076d8) UTILITIES Subject: Translate \200 to &#200; in pod2html From: Chip Salzenberg <chip@atlantic.net> Files: pod/pod2html.PL Subject: VMS patches: '.com' extension on scripts Date: Fri, 24 Jan 1997 18:42:29 -0500 (EST) From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> Files: pod/checkpods.PL pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL utils/splain.PL vms/Makefile vms/descrip.mms x2p/find2perl.PL x2p/s2p.PL private-msgid: <01IELNPDLYJM003E7J@hmivax.humgen.upenn.edu>
Diffstat (limited to 'ext')
-rw-r--r--ext/IO/Makefile.PL1
-rw-r--r--ext/IO/lib/IO/File.pm13
-rw-r--r--ext/IO/lib/IO/Handle.pm56
-rw-r--r--ext/IO/lib/IO/Pipe.pm235
-rw-r--r--ext/IO/lib/IO/Socket.pm45
-rw-r--r--ext/POSIX/POSIX.pm31
-rw-r--r--ext/POSIX/POSIX.pod17
-rw-r--r--ext/POSIX/POSIX.xs296
8 files changed, 507 insertions, 187 deletions
diff --git a/ext/IO/Makefile.PL b/ext/IO/Makefile.PL
index eb059bf8e7..4a34be61fb 100644
--- a/ext/IO/Makefile.PL
+++ b/ext/IO/Makefile.PL
@@ -4,4 +4,5 @@ WriteMakefile(
MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'lib/IO/Handle.pm',
+ XS_VERSION => 1.15
);
diff --git a/ext/IO/lib/IO/File.pm b/ext/IO/lib/IO/File.pm
index e44d77f1fe..0f8df001de 100644
--- a/ext/IO/lib/IO/File.pm
+++ b/ext/IO/lib/IO/File.pm
@@ -11,12 +11,12 @@ IO::File - supply object methods for filehandles
use IO::File;
$fh = new IO::File;
- if ($fh->open "< file") {
+ if ($fh->open("< file")) {
print <$fh>;
$fh->close;
}
- $fh = new IO::File "> FOO";
+ $fh = new IO::File "> file";
if (defined $fh) {
print $fh "bar\n";
$fh->close;
@@ -31,13 +31,12 @@ IO::File - supply object methods for filehandles
$fh = new IO::File "file", O_WRONLY|O_APPEND;
if (defined $fh) {
print $fh "corge\n";
- undef $fh; # automatically closes the file
- }
- $pos = $fh->getpos;
- $fh->setpos $pos;
+ $pos = $fh->getpos;
+ $fh->setpos($pos);
- $fh->setvbuf($buffer_var, _IOLBF, 1024);
+ undef $fh; # automatically closes the file
+ }
autoflush STDOUT 1;
diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm
index 03118ee55e..135351fac0 100644
--- a/ext/IO/lib/IO/Handle.pm
+++ b/ext/IO/lib/IO/Handle.pm
@@ -1,3 +1,4 @@
+
package IO::Handle;
=head1 NAME
@@ -9,39 +10,33 @@ IO::Handle - supply object methods for I/O handles
use IO::Handle;
$fh = new IO::Handle;
- if ($fh->open "< file") {
- print <$fh>;
- $fh->close;
- }
-
- $fh = new IO::Handle "> FOO";
- if (defined $fh) {
- print $fh "bar\n";
+ if ($fh->fdopen(fileno(STDIN),"r")) {
+ print $fh->getline;
$fh->close;
}
- $fh = new IO::Handle "file", "r";
- if (defined $fh) {
- print <$fh>;
- undef $fh; # automatically closes the file
- }
-
- $fh = new IO::Handle "file", O_WRONLY|O_APPEND;
- if (defined $fh) {
- print $fh "corge\n";
- undef $fh; # automatically closes the file
+ $fh = new IO::Handle;
+ if ($fh->fdopen(fileno(STDOUT),"w")) {
+ $fh->print("Some text\n");
}
- $pos = $fh->getpos;
- $fh->setpos $pos;
-
$fh->setvbuf($buffer_var, _IOLBF, 1024);
+ undef $fh; # automatically closes the file if it's open
+
autoflush STDOUT 1;
=head1 DESCRIPTION
-C<IO::Handle> is the base class for all other IO handle classes.
+C<IO::Handle> is the base class for all other IO handle classes. It is
+not intended that objects of C<IO::Handle> would be created directly,
+but instead C<IO::Handle> is inherited from by several other classes
+in the IO hierarchy.
+
+If you are reading this documentation, looking for a replacement for
+the C<FileHandle> package, then I suggest you read the documentation
+for C<IO::File>
+
A C<IO::Handle> object is a reference to a symbol (see the C<Symbol> package)
=head1 CONSTRUCTOR
@@ -167,7 +162,7 @@ module keeps a C<timeout> variable in 'io_socket_timeout'.
L<perlfunc>,
L<perlop/"I/O Operators">,
-L<FileHandle>
+L<IO::File>
=head1 BUGS
@@ -184,7 +179,7 @@ Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
require 5.000;
use strict;
-use vars qw($VERSION @EXPORT_OK $AUTOLOAD @ISA);
+use vars qw($VERSION $XS_VERSION @EXPORT_OK $AUTOLOAD @ISA);
use Carp;
use Symbol;
use SelectSaver;
@@ -192,7 +187,8 @@ use SelectSaver;
require Exporter;
@ISA = qw(Exporter);
-$VERSION = "1.1402";
+$VERSION = "1.1501";
+$XS_VERSION = "1.15";
@EXPORT_OK = qw(
autoflush
@@ -231,7 +227,7 @@ $VERSION = "1.1402";
require DynaLoader;
@IO::ISA = qw(DynaLoader);
-bootstrap IO $VERSION;
+bootstrap IO $XS_VERSION;
sub AUTOLOAD {
if ($AUTOLOAD =~ /::(_?[a-z])/) {
@@ -314,14 +310,8 @@ sub fdopen {
sub close {
@_ == 1 or croak 'usage: $fh->close()';
my($fh) = @_;
- my $r = close($fh);
-
- # This may seem as though it should be in IO::Pipe, but the
- # object gets blessed out of IO::Pipe when reader/writer is called
- waitpid(${*$fh}{'io_pipe_pid'},0)
- if(defined ${*$fh}{'io_pipe_pid'});
- $r;
+ close($fh);
}
################################################
diff --git a/ext/IO/lib/IO/Pipe.pm b/ext/IO/lib/IO/Pipe.pm
index 34cb0daad2..499856a6c6 100644
--- a/ext/IO/lib/IO/Pipe.pm
+++ b/ext/IO/lib/IO/Pipe.pm
@@ -1,7 +1,145 @@
+# IO::Pipe.pm
#
+# Copyright (c) 1996 Graham Barr <Graham.Barr@tiuk.ti.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::Pipe;
+require 5.000;
+
+use IO::Handle;
+use strict;
+use vars qw($VERSION);
+use Carp;
+use Symbol;
+
+$VERSION = "1.09";
+
+sub new {
+ my $type = shift;
+ my $class = ref($type) || $type || "IO::Pipe";
+ @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
+
+ my $me = bless gensym(), $class;
+
+ my($readfh,$writefh) = @_ ? @_ : $me->handles;
+
+ pipe($readfh, $writefh)
+ or return undef;
+
+ @{*$me} = ($readfh, $writefh);
+
+ $me;
+}
+
+sub handles {
+ @_ == 1 or croak 'usage: $pipe->handles()';
+ (IO::Pipe::End->new(), IO::Pipe::End->new());
+}
+
+my $do_spawn = $^O eq 'os2';
+
+sub _doit {
+ my $me = shift;
+ my $rw = shift;
+
+ my $pid = $do_spawn ? 0 : fork();
+
+ if($pid) { # Parent
+ return $pid;
+ }
+ elsif(defined $pid) { # Child or spawn
+ my $fh;
+ my $io = $rw ? \*STDIN : \*STDOUT;
+ my ($mode, $save) = $rw ? "r" : "w";
+ if ($do_spawn) {
+ require Fcntl;
+ $save = IO::Handle->new_from_fd($io, $mode);
+ # Close in child:
+ fcntl(shift, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
+ $fh = $rw ? ${*$me}[0] : ${*$me}[1];
+ } else {
+ shift;
+ $fh = $rw ? $me->reader() : $me->writer(); # close the other end
+ }
+ bless $io, "IO::Handle";
+ $io->fdopen($fh, $mode);
+
+ if ($do_spawn) {
+ $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
+ my $err = $!;
+
+ $io->fdopen($save, $mode);
+ $save->close or croak "Cannot close $!";
+ croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
+ return $pid;
+ } else {
+ exec @_ or
+ croak "IO::Pipe: Cannot exec: $!";
+ }
+ }
+ else {
+ croak "IO::Pipe: Cannot fork: $!";
+ }
+
+ # NOT Reached
+}
+
+sub reader {
+ @_ >= 1 or croak 'usage: $pipe->reader()';
+ my $me = shift;
+ my $fh = ${*$me}[0];
+ my $pid = $me->_doit(0, $fh, @_)
+ if(@_);
+
+ close ${*$me}[1];
+ bless $me, ref($fh);
+ *{*$me} = *{*$fh}; # Alias self to handle
+ bless $fh; # Really wan't un-bless here
+ ${*$me}{'io_pipe_pid'} = $pid
+ if defined $pid;
+
+ $me;
+}
+
+sub writer {
+ @_ >= 1 or croak 'usage: $pipe->writer()';
+ my $me = shift;
+ my $fh = ${*$me}[1];
+ my $pid = $me->_doit(1, $fh, @_)
+ if(@_);
+
+ close ${*$me}[0];
+ bless $me, ref($fh);
+ *{*$me} = *{*$fh}; # Alias self to handle
+ bless $fh; # Really wan't un-bless here
+ ${*$me}{'io_pipe_pid'} = $pid
+ if defined $pid;
+
+ $me;
+}
+
+package IO::Pipe::End;
+
+use vars qw(@ISA);
+
+@ISA = qw(IO::Handle);
+
+sub close {
+ my $fh = shift;
+ my $r = $fh->SUPER::close(@_);
+
+ waitpid(${*$fh}{'io_pipe_pid'},0)
+ if(defined ${*$fh}{'io_pipe_pid'});
+
+ $r;
+}
+
+1;
+
+__END__
+
=head1 NAME
IO::pipe - supply object methods for pipes
@@ -79,7 +217,7 @@ is called and C<ARGS> are passed to exec.
This method is called during construction by C<IO::Pipe::new>
on the newly created C<IO::Pipe> object. It returns an array of two objects
-blessed into C<IO::Handle>, or a subclass thereof.
+blessed into C<IO::Pipe::End>, or a subclass thereof.
=back
@@ -93,101 +231,8 @@ Graham Barr <bodg@tiuk.ti.com>
=head1 COPYRIGHT
-Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
+Copyright (c) 1996 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
-
-require 5.000;
-use strict;
-use vars qw($VERSION);
-use Carp;
-use Symbol;
-require IO::Handle;
-
-$VERSION = "1.08";
-
-sub new {
- my $type = shift;
- my $class = ref($type) || $type || "IO::Pipe";
- @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
-
- my $me = bless gensym(), $class;
-
- my($readfh,$writefh) = @_ ? @_ : $me->handles;
-
- pipe($readfh, $writefh)
- or return undef;
-
- @{*$me} = ($readfh, $writefh);
-
- $me;
-}
-
-sub handles {
- @_ == 1 or croak 'usage: $pipe->handles()';
- (IO::Handle->new(), IO::Handle->new());
-}
-
-sub _doit {
- my $me = shift;
- my $rw = shift;
-
- my $pid = fork();
-
- if($pid) { # Parent
- return $pid;
- }
- elsif(defined $pid) { # Child
- my $fh = $rw ? $me->reader() : $me->writer();
- my $io = $rw ? \*STDIN : \*STDOUT;
-
- bless $io, "IO::Handle";
- $io->fdopen($fh, $rw ? "r" : "w");
- exec @_ or
- croak "IO::Pipe: Cannot exec: $!";
- }
- else {
- croak "IO::Pipe: Cannot fork: $!";
- }
-
- # NOT Reached
-}
-
-sub reader {
- @_ >= 1 or croak 'usage: $pipe->reader()';
- my $me = shift;
- my $fh = ${*$me}[0];
- my $pid = $me->_doit(0,@_)
- if(@_);
-
- close(${*$me}[1]);
- bless $me, ref($fh);
- *{*$me} = *{*$fh}; # Alias self to handle
- bless $fh, 'IO::Pipe::DeadEnd'; # Really wan't un-bless here
- ${*$me}{'io_pipe_pid'} = $pid
- if defined $pid;
-
- $me;
-}
-
-sub writer {
- @_ >= 1 or croak 'usage: $pipe->writer()';
- my $me = shift;
- my $fh = ${*$me}[1];
- my $pid = $me->_doit(1,@_)
- if(@_);
-
- close(${*$me}[0]);
- bless $me, ref($fh);
- *{*$me} = *{*$fh}; # Alias self to handle
- bless $fh, 'IO::Pipe::DeadEnd'; # Really wan't un-bless here
- ${*$me}{'io_pipe_pid'} = $pid
- if defined $pid;
-
- $me;
-}
-
-1;
-
diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm
index 6a69c6b624..264d1ac076 100644
--- a/ext/IO/lib/IO/Socket.pm
+++ b/ext/IO/lib/IO/Socket.pm
@@ -1,4 +1,8 @@
+# IO::Socket.pm
#
+# Copyright (c) 1996 Graham Barr <Graham.Barr@tiuk.ti.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;
@@ -114,7 +118,7 @@ use Exporter;
@ISA = qw(IO::Handle);
-$VERSION = "1.15";
+$VERSION = "1.16";
sub import {
my $pkg = shift;
@@ -136,16 +140,7 @@ my @domain2pkg = ();
sub register_domain {
my($p,$d) = @_;
- $domain2pkg[$d] = bless \$d, $p;
-}
-
-sub _domain2pkg {
- my $domain = shift;
-
- croak "Unsupported socket domain"
- unless defined $domain2pkg[$domain];
-
- $domain2pkg[$domain]
+ $domain2pkg[$d] = $p;
}
sub configure {
@@ -155,12 +150,13 @@ sub configure {
croak 'IO::Socket: Cannot configure a generic socket'
unless defined $domain;
- my $class = ref(_domain2pkg($domain));
+ croak "IO::Socket: Unsupported socket domain"
+ unless defined $domain2pkg[$domain];
croak "IO::Socket: Cannot configure socket in domain '$domain'"
unless ref($fh) eq "IO::Socket";
- bless($fh, $class);
+ bless($fh, $domain2pkg[$domain]);
$fh->configure;
}
@@ -168,18 +164,13 @@ sub socket {
@_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)';
my($fh,$domain,$type,$protocol) = @_;
- if(!defined ${*$fh}{'io_socket_domain'}
- || !ref(${*$fh}{'io_socket_domain'})
- || ${${*$fh}{'io_socket_domain'}} != $domain) {
- my $pkg =
- ${*$fh}{'io_socket_domain'} = _domain2pkg($domain);
- }
-
socket($fh,$domain,$type,$protocol) or
return undef;
- ${*$fh}{'io_socket_type'} = $type;
- ${*$fh}{'io_socket_proto'} = $protocol;
+ ${*$fh}{'io_socket_domain'} = $domain;
+ ${*$fh}{'io_socket_type'} = $type;
+ ${*$fh}{'io_socket_proto'} = $protocol;
+
$fh;
}
@@ -352,7 +343,7 @@ sub timeout {
sub sockdomain {
@_ == 1 or croak 'usage: $fh->sockdomain()';
my $fh = shift;
- ${${*$fh}{'io_socket_domain'}}
+ ${*$fh}{'io_socket_domain'};
}
sub socktype {
@@ -549,9 +540,6 @@ sub configure {
my $pname = (getprotobynumber($proto))[0];
$type = $arg->{Type} || $socket_type{$pname};
- my $domain = AF_INET;
- ${*$fh}{'io_socket_domain'} = bless \$domain;
-
$fh->socket(AF_INET, $type, $proto) or
return _error($fh,"$!");
@@ -667,9 +655,6 @@ sub configure {
my $type = $arg->{Type} || SOCK_STREAM;
- my $domain = AF_UNIX;
- ${*$fh}{'io_socket_domain'} = bless \$domain;
-
$fh->socket(AF_UNIX, $type, 0) or
return undef;
@@ -713,7 +698,7 @@ Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
=head1 COPYRIGHT
-Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
+Copyright (c) 1996 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.
diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm
index b095ffebe7..ce315dcf7c 100644
--- a/ext/POSIX/POSIX.pm
+++ b/ext/POSIX/POSIX.pm
@@ -22,11 +22,19 @@ $VERSION = "1.00" ;
dirent_h => [qw()],
- errno_h => [qw(E2BIG EACCES EAGAIN EBADF EBUSY ECHILD EDEADLK EDOM
- EEXIST EFAULT EFBIG EINTR EINVAL EIO EISDIR EMFILE
- EMLINK ENAMETOOLONG ENFILE ENODEV ENOENT ENOEXEC ENOLCK
- ENOMEM ENOSPC ENOSYS ENOTDIR ENOTEMPTY ENOTTY ENXIO
- EPERM EPIPE ERANGE EROFS ESPIPE ESRCH EXDEV errno)],
+ errno_h => [qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
+ EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
+ ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
+ EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
+ EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
+ EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
+ ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
+ ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
+ ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
+ EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
+ ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
+ ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
+ EUSERS EWOULDBLOCK EXDEV errno)],
fcntl_h => [qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK
F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK
@@ -72,12 +80,13 @@ $VERSION = "1.00" ;
setjmp_h => [qw(longjmp setjmp siglongjmp sigsetjmp)],
- signal_h => [qw(SA_NOCLDSTOP SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE
- SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV
- SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2
- SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK
- raise sigaction signal sigpending sigprocmask
- sigsuspend)],
+ signal_h => [qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK
+ SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM
+ SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL
+ SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN
+ SIGTTOU SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR
+ SIG_IGN SIG_SETMASK SIG_UNBLOCK raise sigaction signal
+ sigpending sigprocmask sigsuspend)],
stdarg_h => [qw()],
diff --git a/ext/POSIX/POSIX.pod b/ext/POSIX/POSIX.pod
index 34597d1bd5..fba225f5b9 100644
--- a/ext/POSIX/POSIX.pod
+++ b/ext/POSIX/POSIX.pod
@@ -1576,7 +1576,16 @@ _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL _SC_NGROUPS_MAX _SC_OPEN_M
=item Constants
-E2BIG EACCES EAGAIN EBADF EBUSY ECHILD EDEADLK EDOM EEXIST EFAULT EFBIG EINTR EINVAL EIO EISDIR EMFILE EMLINK ENAMETOOLONG ENFILE ENODEV ENOENT ENOEXEC ENOLCK ENOMEM ENOSPC ENOSYS ENOTDIR ENOTEMPTY ENOTTY ENXIO EPERM EPIPE ERANGE EROFS ESPIPE ESRCH EXDEV
+E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT EAGAIN EALREADY EBADF
+EBUSY ECHILD ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ
+EDOM EDQUOT EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS EINTR
+EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE ENAMETOOLONG
+ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODEV ENOENT ENOEXEC
+ENOLCK ENOMEM ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
+ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE
+EPROCLIM EPROTONOSUPPORT EPROTOTYPE ERANGE EREMOTE ERESTART EROFS
+ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS
+ETXTBSY EUSERS EWOULDBLOCK EXDEV
=back
@@ -1636,7 +1645,11 @@ HUGE_VAL
=item Constants
-SA_NOCLDSTOP SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK
+SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK SA_RESETHAND SA_RESTART
+SA_SIGINFO SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT
+SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU
+SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK
+SIG_UNBLOCK
=back
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 6354dc3db5..42aeb3bb93 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -47,6 +47,9 @@
# include <libdef.h> /* LIB$_INVARG constant */
# include <lib$routines.h> /* prototype for lib$ediv() */
# include <starlet.h> /* prototype for sys$gettim() */
+# if DECC_VERSION < 50000000
+# define pid_t int /* old versions of DECC miss this in types.h */
+# endif
# undef mkfifo /* #defined in perl.h */
# define mkfifo(a,b) (not_here("mkfifo"),-1)
@@ -624,12 +627,36 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "EADDRINUSE"))
+#ifdef EADDRINUSE
+ return EADDRINUSE;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "EADDRNOTAVAIL"))
+#ifdef EADDRNOTAVAIL
+ return EADDRNOTAVAIL;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "EAFNOSUPPORT"))
+#ifdef EAFNOSUPPORT
+ return EAFNOSUPPORT;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "EAGAIN"))
#ifdef EAGAIN
return EAGAIN;
#else
goto not_there;
#endif
+ if (strEQ(name, "EALREADY"))
+#ifdef EALREADY
+ return EALREADY;
+#else
+ goto not_there;
+#endif
break;
case 'B':
if (strEQ(name, "EBADF"))
@@ -676,6 +703,24 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "ECONNABORTED"))
+#ifdef ECONNABORTED
+ return ECONNABORTED;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ECONNREFUSED"))
+#ifdef ECONNREFUSED
+ return ECONNREFUSED;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ECONNRESET"))
+#ifdef ECONNRESET
+ return ECONNRESET;
+#else
+ goto not_there;
+#endif
break;
case 'D':
if (strEQ(name, "EDEADLK"))
@@ -684,12 +729,24 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "EDESTADDRREQ"))
+#ifdef EDESTADDRREQ
+ return EDESTADDRREQ;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "EDOM"))
#ifdef EDOM
return EDOM;
#else
goto not_there;
#endif
+ if (strEQ(name, "EDQUOT"))
+#ifdef EDQUOT
+ return EDQUOT;
+#else
+ goto not_there;
+#endif
break;
case 'E':
if (strEQ(name, "EEXIST"))
@@ -713,7 +770,27 @@ int arg;
goto not_there;
#endif
break;
+ case 'H':
+ if (strEQ(name, "EHOSTDOWN"))
+#ifdef EHOSTDOWN
+ return EHOSTDOWN;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "EHOSTUNREACH"))
+#ifdef EHOSTUNREACH
+ return EHOSTUNREACH;
+#else
+ goto not_there;
+#endif
+ break;
case 'I':
+ if (strEQ(name, "EINPROGRESS"))
+#ifdef EINPROGRESS
+ return EINPROGRESS;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "EINTR"))
#ifdef EINTR
return EINTR;
@@ -732,12 +809,24 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "EISCONN"))
+#ifdef EISCONN
+ return EISCONN;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "EISDIR"))
#ifdef EISDIR
return EISDIR;
#else
goto not_there;
#endif
+ if (strEQ(name, "ELOOP"))
+#ifdef ELOOP
+ return ELOOP;
+#else
+ goto not_there;
+#endif
break;
case 'M':
if (strEQ(name, "EMFILE"))
@@ -752,29 +841,71 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "EMSGSIZE"))
+#ifdef EMSGSIZE
+ return EMSGSIZE;
+#else
+ goto not_there;
+#endif
break;
case 'N':
+ if (strEQ(name, "ENETDOWN"))
+#ifdef ENETDOWN
+ return ENETDOWN;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ENETRESET"))
+#ifdef ENETRESET
+ return ENETRESET;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ENETUNREACH"))
+#ifdef ENETUNREACH
+ return ENETUNREACH;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ENOBUFS"))
+#ifdef ENOBUFS
+ return ENOBUFS;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ENOEXEC"))
+#ifdef ENOEXEC
+ return ENOEXEC;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "ENOMEM"))
#ifdef ENOMEM
return ENOMEM;
#else
goto not_there;
#endif
+ if (strEQ(name, "ENOPROTOOPT"))
+#ifdef ENOPROTOOPT
+ return ENOPROTOOPT;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "ENOSPC"))
#ifdef ENOSPC
return ENOSPC;
#else
goto not_there;
#endif
- if (strEQ(name, "ENOEXEC"))
-#ifdef ENOEXEC
- return ENOEXEC;
+ if (strEQ(name, "ENOTBLK"))
+#ifdef ENOTBLK
+ return ENOTBLK;
#else
goto not_there;
#endif
- if (strEQ(name, "ENOTTY"))
-#ifdef ENOTTY
- return ENOTTY;
+ if (strEQ(name, "ENOTCONN"))
+#ifdef ENOTCONN
+ return ENOTCONN;
#else
goto not_there;
#endif
@@ -790,6 +921,18 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "ENOTSOCK"))
+#ifdef ENOTSOCK
+ return ENOTSOCK;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ENOTTY"))
+#ifdef ENOTTY
+ return ENOTTY;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "ENFILE"))
#ifdef ENFILE
return ENFILE;
@@ -840,6 +983,12 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "EOPNOTSUPP"))
+#ifdef EOPNOTSUPP
+ return EOPNOTSUPP;
+#else
+ goto not_there;
+#endif
break;
case 'P':
if (strEQ(name, "EPERM"))
@@ -848,12 +997,36 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "EPFNOSUPPORT"))
+#ifdef EPFNOSUPPORT
+ return EPFNOSUPPORT;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "EPIPE"))
#ifdef EPIPE
return EPIPE;
#else
goto not_there;
#endif
+ if (strEQ(name, "EPROCLIM"))
+#ifdef EPROCLIM
+ return EPROCLIM;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "EPROTONOSUPPORT"))
+#ifdef EPROTONOSUPPORT
+ return EPROTONOSUPPORT;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "EPROTOTYPE"))
+#ifdef EPROTOTYPE
+ return EPROTOTYPE;
+#else
+ goto not_there;
+#endif
break;
case 'R':
if (strEQ(name, "ERANGE"))
@@ -862,6 +1035,18 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "EREMOTE"))
+#ifdef EREMOTE
+ return EREMOTE;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ERESTART"))
+#ifdef ERESTART
+ return ERESTART;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "EROFS"))
#ifdef EROFS
return EROFS;
@@ -870,6 +1055,18 @@ int arg;
#endif
break;
case 'S':
+ if (strEQ(name, "ESHUTDOWN"))
+#ifdef ESHUTDOWN
+ return ESHUTDOWN;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ESOCKTNOSUPPORT"))
+#ifdef ESOCKTNOSUPPORT
+ return ESOCKTNOSUPPORT;
+#else
+ goto not_there;
+#endif
if (strEQ(name, "ESPIPE"))
#ifdef ESPIPE
return ESPIPE;
@@ -882,7 +1079,49 @@ int arg;
#else
goto not_there;
#endif
+ if (strEQ(name, "ESTALE"))
+#ifdef ESTALE
+ return ESTALE;
+#else
+ goto not_there;
+#endif
break;
+ case 'T':
+ if (strEQ(name, "ETIMEDOUT"))
+#ifdef ETIMEDOUT
+ return ETIMEDOUT;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ETOOMANYREFS"))
+#ifdef ETOOMANYREFS
+ return ETOOMANYREFS;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ETXTBSY"))
+#ifdef ETXTBSY
+ return ETXTBSY;
+#else
+ goto not_there;
+#endif
+ break;
+ case 'U':
+ if (strEQ(name, "EUSERS"))
+#ifdef EUSERS
+ return EUSERS;
+#else
+ goto not_there;
+#endif
+ break;
+ case 'W':
+ if (strEQ(name, "EWOULDBLOCK"))
+#ifdef EWOULDBLOCK
+ return EWOULDBLOCK;
+#else
+ goto not_there;
+#endif
+ break;
case 'X':
if (strEQ(name, "EXIT_FAILURE"))
#ifdef EXIT_FAILURE
@@ -1769,12 +2008,51 @@ int arg;
#else
goto not_there;
#endif
- if (strEQ(name, "SA_NOCLDSTOP"))
+ if (strnEQ(name, "SA_", 3)) {
+ if (strEQ(name, "SA_NOCLDSTOP"))
#ifdef SA_NOCLDSTOP
- return SA_NOCLDSTOP;
+ return SA_NOCLDSTOP;
#else
- goto not_there;
+ goto not_there;
#endif
+ if (strEQ(name, "SA_NOCLDWAIT"))
+#ifdef SA_NOCLDWAIT
+ return SA_NOCLDWAIT;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "SA_NODEFER"))
+#ifdef SA_NODEFER
+ return SA_NODEFER;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "SA_ONSTACK"))
+#ifdef SA_ONSTACK
+ return SA_ONSTACK;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "SA_RESETHAND"))
+#ifdef SA_RESETHAND
+ return SA_RESETHAND;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "SA_RESTART"))
+#ifdef SA_RESTART
+ return SA_RESTART;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "SA_SIGINFO"))
+#ifdef SA_SIGINFO
+ return SA_SIGINFO;
+#else
+ goto not_there;
+#endif
+ break;
+ }
if (strEQ(name, "SCHAR_MAX"))
#ifdef SCHAR_MAX
return SCHAR_MAX;