perl 5.002perl-5.002

[editor's note: changes seem to be mostly module updates,
documentation changes and some perl API macro additions]

8 files changed, 470 insertions, 130 deletions

diff --git a/vms/descrip.mms b/vms/descrip.mms
index d34245c8fc..04fcfeb108 100644
--- a/vms/descrip.mms
+++ b/vms/descrip.mms
@@ -1,5 +1,5 @@
 # Descrip.MMS for perl5 on VMS
-# Last revised 17-Jan-1995 by Charles Bailey  bailey@genetics.upenn.edu
+# Last revised 22-Feb-1996 by Charles Bailey  bailey@genetics.upenn.edu
 #
 #: This file uses MMS syntax, and can be processed using DEC's MMS product,
 #: or the free MMK clone (available by ftp at ftp.spc.edu).  If you want to
@@ -230,6 +230,9 @@ CRTL = []crtl.opt
 CRTLOPTS =,$(CRTL)/Options
 
 .SUFFIXES
+
+.ifdef LINK_ONLY
+.else
 .SUFFIXES $(O) .c .xs
 
 .xs.c :
@@ -242,12 +245,14 @@ CRTLOPTS =,$(CRTL)/Options
 .xs$(O) :
 	$(XSUBPP) $(MMS$SOURCE) >$(MMS$SOURCE_NAME).c
 	$(CC) $(CFLAGS) $(MMS$SOURCE_NAME).c
+.endif
+
 
 all : base extras archcorefiles preplibrary perlpods
 	@ $(NOOP)
 base : miniperl$(E) perl$(E)
 	@ $(NOOP)
-extras : FileHandle Safe libmods utils podxform
+extras : Fcntl FileHandle Safe libmods utils podxform
 	@ $(NOOP)
 libmods : [.lib]Config.pm [.lib.$(ARCH)]Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm 
 	@ $(NOOP)
@@ -286,29 +291,38 @@ $(DBG)libperl$(OLB) : $(obj)
 perlmain.c : miniperlmain.c $(MINIPERL_EXE) [.vms]writemain.pl
 	$(MINIPERL) [.VMS]Writemain.pl "$(EXT)"
 
-perl$(E) : perlmain$(O), perlshr$(E), $(MINIPERL_EXE)
+$(DBG)perl$(E) : perlmain$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE)
 	@ @[.vms]genopt "PerlShr.Opt/Write" "|" "''F$Environment("Default")'$(DBG)PerlShr$(E)/Share"
 .ifdef gnuc
 	@ @[.vms]genopt "PerlShr.Opt/Append" "|" "$(LIBS1)|$(LIBS2)"
 .endif
 	Link $(LINKFLAGS)/Exe=$(DBG)$(MMS$TARGET) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option
-perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts
+
+$(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts
 	Link /NoTrace$(LINKFLAGS)/Share=$(DBG)$(MMS$TARGET) $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option
+
 # The following files are built in one go by gen_shrfls.pl:
 #  perlshr_attr.opt, $(DBG)perlshr_bld.opt - VAX and AXP
 #  perlshr_gbl*.mar, perlshr_gbl*$(O) - VAX only
+# The song and dance with gen_shrfls.opt accomodates DCL's 255 character
+# line length limit.
 .ifdef PIPES_BROKEN
 # This is a backup target used only with older versions of the DECCRTL which
 # can't deal with pipes properly.  See ReadMe.VMS for details.
 $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL)
 	$(CC) $(CFLAGS)/NoObject/NoList/PreProcess=perl.i perl.h
-	$(MINIPERL) [.vms]gen_shrfls.pl "~~NOCC~~perl.i~~$(CC)$(CFLAGS)" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)"
-	@ Delete/NoLog/NoConfirm perl.i;
+	@ $(MINIPERL) -e "print join('|',@ARGV),'|';" "~~NOCC~~perl.i~~$(CC)$(CFLAGS)" >gen_shrfls.opt
+	@ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt
+	$(MINIPERL) [.vms]gen_shrfls.pl -f gen_shrfls.opt
+	@ Delete/NoLog/NoConfirm perl.i;, gen_shrfls.opt;
 	@ If F$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;*
 	@ Copy NLA0: $(DBG)perlshr_xtras.ts
 .else
 $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL)
-	$(MINIPERL) [.vms]gen_shrfls.pl "$(CC)$(CFLAGS)" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)"
+	@ $(MINIPERL) -e "print join('|',@ARGV),'|';" "$(CC)$(CFLAGS)" >gen_shrfls.opt
+	@ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt
+	$(MINIPERL) [.vms]gen_shrfls.pl -f gen_shrfls.opt
+	@ Delete/NoLog/NoConfirm gen_shrfls.opt;
 	@ If F$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;*
 	@ Copy NLA0: $(DBG)perlshr_xtras.ts
 .endif
@@ -317,8 +331,12 @@ $(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(
 	Create/Directory [.lib.$(ARCH)]
 	Copy $(MMS$SOURCE) $(MMS$TARGET)
 
+# Once again, we accomodate DCL's 255 character buffer
 [.lib]config.pm : [.vms]config.vms [.vms]genconfig.pl $(MINIPERL_EXE)
-	$(MINIPERL) [.VMS]GenConfig.Pl cc=$(CC)$(CFLAGS) ldflags=$(LINKFLAGS) obj_ext=$(O) exe_ext=$(E) lib_ext=$(OLB)
+	@ $(MINIPERL) -e "print join('|',@ARGV),'|';" "cc=$(CC)$(CFLAGS)" >genconfig.opt
+	@ $(MINIPERL) -e "print join('|',@ARGV),'|';" "ldflags=$(LINKFLAGS)|obj_ext=$(O)|exe_ext=$(E)|lib_ext=$(OLB)" >>genconfig.opt
+	$(MINIPERL) [.VMS]GenConfig.Pl -f genconfig.opt
+	@ Delete/NoLog/NoConfirm genconfig.opt;
 	$(MINIPERL) ConfigPM.
 
 [.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs $(MINIPERL_EXE)
@@ -335,6 +353,7 @@ Safe : [.lib]Safe.pm [.lib.auto]Safe$(E)
 	@ $(NOOP)
 
 [.lib]Safe.pm : [.ext.Safe]Descrip.MMS
+	@ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
 	@ Set Default [.ext.Safe]
 	$(MMS)
 	@ Set Default [--]
@@ -347,12 +366,13 @@ Safe : [.lib]Safe.pm [.lib.auto]Safe$(E)
 # Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
 # ${@} necessary to distract different versions of MM[SK]/make
 [.ext.Safe]Descrip.MMS : [.ext.Safe]Makefile.PL [.lib.$(ARCH)]Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
-	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Safe]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" 2>_nla0:
+	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Safe]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" 2>_nla0:
 
 FileHandle : [.lib]FileHandle.pm [.lib.auto]FileHandle$(E)
 	@ $(NOOP)
 
 [.lib]FileHandle.pm : [.ext.FileHandle]Descrip.MMS
+	@ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
 	@ Set Default [.ext.FileHandle]
 	$(MMS)
 	@ Set Default [--]
@@ -365,7 +385,26 @@ FileHandle : [.lib]FileHandle.pm [.lib.auto]FileHandle$(E)
 # Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
 # ${@} necessary to distract different versions of MM[SK]/make
 [.ext.FileHandle]Descrip.MMS : [.ext.FileHandle]Makefile.PL [.lib.$(ARCH)]Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
-	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.FileHandle]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" 2>_nla0:
+	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.FileHandle]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" 2>_nla0:
+
+Fcntl : [.lib]Fcntl.pm [.lib.auto]Fcntl$(E)
+	@ $(NOOP)
+
+[.lib]Fcntl.pm : [.ext.Fcntl]Descrip.MMS
+	@ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+	@ Set Default [.ext.Fcntl]
+	$(MMS)
+	@ Set Default [--]
+
+[.lib.auto]Fcntl$(E) : [.ext.Fcntl]Descrip.MMS
+	@ Set Default [.ext.Fcntl]
+	$(MMS)
+	@ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.Fcntl]Descrip.MMS : [.ext.Fcntl]Makefile.PL [.lib.$(ARCH)]Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
+	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]" 2>_nla0:
 
 [.lib.VMS]Filespec.pm : [.vms.ext]Filespec.pm
 	@ If F$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS]
@@ -557,8 +596,18 @@ printconfig :
         @ @[.vms]myconfig "$(CC)" "$(CFLAGS)" "$(LINKFLAGS)" "$(LIBS1)" "$(LIBS2)" "$(SOCKLIB)" "$(EXT)" "$(DBG)"
 
 .ifdef SOCKET
+
+.ifdef LINK_ONLY
+.else
 $(SOCKOBJ) : $(SOCKC) $(SOCKH)
 
+[.ext.Socket]Socket$(O) : [.ext.Socket]Socket.c
+	$(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$SOURCE)
+
+[.ext.Socket]Socket.c : [.ext.Socket]Socket.xs $(MINIPERL_EXE)
+	$(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET)
+.endif # !LINK_ONLY
+
 vmsish.h : $(SOCKH)
 
 $(SOCKC) : [.vms]$(SOCKC)
@@ -567,12 +616,6 @@ $(SOCKC) : [.vms]$(SOCKC)
 $(SOCKH) : [.vms]$(SOCKH)
 	Copy/Log/NoConfirm [.vms]$(SOCKH) []$(SOCKH)
 
-[.ext.Socket]Socket.c : [.ext.Socket]Socket.xs $(MINIPERL_EXE)
-	$(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET)
-
-[.ext.Socket]Socket$(O) : [.ext.Socket]Socket.c
-	$(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$SOURCE)
-
 [.lib]Socket.pm : [.ext.Socket]Socket.pm
 	Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET)
 .endif
@@ -607,8 +650,11 @@ perly.h : [.vms]perly_h.vms
 # 	rename y.tab.h perly.h
 # 	$(INSTPERL) [.vms]vms_yfix.pl perly.c perly.h [.vms]perly_c.vms [.vms]perly_h.vms
 
+.ifdef LINK_ONLY
+.else
 perly$(O) : perly.c, perly.h, $(h)
 	$(CC) $(CFLAGS) $(MMS$SOURCE)
+.endif
 
 test : all
 	- @[.VMS]Test.Com
@@ -714,6 +760,8 @@ $(ARCHAUTO)time.stamp :
 	@ If F$Search("[.lib.$(ARCH)]auto.dir").eqs."" Then Create/Directory $(ARCHAUTO)
 	@ If F$Search("$(MMS$TARGET)").eqs."" Then Copy/NoConfirm _NLA0: $(MMS$TARGET)
 
+.ifdef LINK_ONLY
+.else
 # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
 av$(O) : EXTERN.h
 av$(O) : av.c
@@ -1340,6 +1388,7 @@ globals$(O) : scope.h
 globals$(O) : sv.h
 globals$(O) : vmsish.h
 globals$(O) : util.h
+.endif # !LINK_ONLY
 
 config.h : [.vms]config.vms
 	Copy/Log/NoConfirm [.vms]config.vms []config.h
@@ -1409,6 +1458,9 @@ clean : tidy
 	- If F$Search("[.Ext.Socket]Socket.C").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket.C;*
 	- If F$Search("[.VMS.Ext...]*.C").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*.C;*
 	- If F$Search("[.VMS.Ext...]*$(O)").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*$(O);*
+	Set Default [.ext.Fcntl]
+	- $(MMS) clean
+	Set Default [--]
 	Set Default [.ext.FileHandle]
 	- $(MMS) clean
 	Set Default [--]
@@ -1428,6 +1480,9 @@ realclean : clean
 	- If F$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;*
 	- If F$Search("[.lib.pod]perldoc.").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.;*
 	- If F$Search("[.lib.pod]pod2*.").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.;*
+	Set Default [.ext.Fcntl]
+	- $(MMS) realclean
+	Set Default [--]
 	Set Default [.ext.FileHandle]
 	- $(MMS) realclean
 	Set Default [--]
diff --git a/vms/ext/Filespec.pm b/vms/ext/Filespec.pm
index c690ccaee2..3ce67aafda 100644
--- a/vms/ext/Filespec.pm
+++ b/vms/ext/Filespec.pm
@@ -25,7 +25,7 @@ candelete('my:[VMS.or.Unix]file.specification');
 This package provides routines to simplify conversion between VMS and
 Unix syntax when processing file specifications.  This is useful when
 porting scripts designed to run under either OS, and also allows you
-to take advantage of conveniences provided by either syntax (e.g.
+to take advantage of conveniences provided by either syntax (I<e.g.>
 ability to easily concatenate Unix-style specifications).  In
 addition, it provides an additional file test routine, C<candelete>,
 which determines whether you have delete access to a file.
@@ -53,6 +53,12 @@ directory path (e.g [---.foo] when in dev:[dir.sub]) will cause
 errors.  In general, any legal file specification will be converted
 properly, but garbage input tends to produce garbage output.  
 
+Each of these routines is prototyped as taking a single scalar
+argument, so you can use them as unary operators in complex
+expressions (as long as you don't use the C<&> form of
+subroutine call, which bypasses prototype checking).
+
+
 The routines provided are:
 
 =head2 vmsify
@@ -104,11 +110,13 @@ C<candelete> becomes part of the Perl core.
 
 =head1 REVISION
 
-This document was last revised 08-Dec-1995, for Perl 5.002.
+This document was last revised 22-Feb-1996, for Perl 5.002.
 
 =cut
 
 package VMS::Filespec;
+require 5.002;
+
 
 # If you want to use this package on a non-VMS system,
 # uncomment the following line.
@@ -182,7 +190,7 @@ sub rmsexpand {
   $fspec;
 }  
 
-sub vmsify {
+sub vmsify ($) {
   my($fspec) = @_;
   my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs);
 
@@ -215,7 +223,7 @@ sub vmsify {
   }
 }
 
-sub unixify {
+sub unixify ($) {
   my($fspec) = @_;
 
   return $fspec if $fspec !~ m#[:>\]]#;
@@ -244,7 +252,7 @@ sub unixify {
 }
 
 
-sub fileify {
+sub fileify ($) {
   my($path) = @_;
 
   if (!$path) { return undef }
@@ -279,7 +287,7 @@ sub fileify {
   }
 }
 
-sub pathify {
+sub pathify ($) {
   my($fspec) = @_;
 
   if (!$fspec) { return undef }
@@ -304,15 +312,15 @@ sub pathify {
   }
 }
 
-sub vmspath {
+sub vmspath ($) {
   pathify(vmsify($_[0]));
 }
 
-sub unixpath {
+sub unixpath ($) {
   pathify(unixify($_[0]));
 }
 
-sub candelete {
+sub candelete ($) {
   my($fspec) = @_;
   my($parent);
 
diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl
index e39b7c2630..56ebc4b7da 100644
--- a/vms/gen_shrfls.pl
+++ b/vms/gen_shrfls.pl
@@ -34,11 +34,24 @@
 #     (i.e. /Define=DEBUGGING,EMBED,MULTIPLICITY)?
 #
 # Author: Charles Bailey  bailey@genetics.upenn.edu
-# Revised:  4-Dec-1995
+# Revised: 20-Feb-1996
 
 require 5.000;
 
 $debug = $ENV{'GEN_SHRFLS_DEBUG'};
+
+if ($ARGV[0] eq '-f') {
+  open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n";
+  print "Input taken from file $ARGV[1]\n" if $debug;
+  @ARGV = ();
+  while (<INP>) {
+    chomp;
+    push(@ARGV,split(/\|/,$_));
+  }
+  close INP;
+  print "Read input data | ",join(' | ',@ARGV)," |\n" if $debug > 1;
+}
+
 $cc_cmd = shift @ARGV;
 
 # Someday, we'll have $GetSyI built into perl . . .
@@ -75,7 +88,7 @@ if ($docc) {
   else { die "$0: Can't find perl.h\n"; }
 }
 else { 
-  ($junk,$ccvers,$cpp_file,$cc_cmd) = split(/~~/,$cc_cmd,4);
+  ($junk,$junk,$cpp_file,$cc_cmd) = split(/~~/,$cc_cmd,4);
   $isgcc = $cc_cmd =~ /case_hack/i
            or 0;  # for nice debug output
   $isvaxc = (!$isgcc && $cc_cmd !~ /standard=/i)
@@ -158,7 +171,7 @@ if ($docc) {
     or die "$0: Can't preprocess ${dir}perl.h: $!\n";
 }
 else {
-  open(CPP,"$cpp_file") or die "$0: Can't read $cpp_file: $!\n";
+  open(CPP,"$cpp_file") or die "$0: Can't read preprocessed file $cpp_file: $!\n";
 }
 LINE: while (<CPP>) {
   while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
@@ -320,7 +333,7 @@ if ($isvax) {
 # Linker wants /Include and /Library on different lines
 print OPTBLD "$libperl/Include=($incstr)\n";
 print OPTBLD "$libperl/Library\n";
-open(RTLOPT,$rtlopt) or die "$0: Can't read $rtlopt: $!\n";
+open(RTLOPT,$rtlopt) or die "$0: Can't read options file $rtlopt: $!\n";
 while (<RTLOPT>) { print OPTBLD; }
 close RTLOPT;
 close OPTBLD;
diff --git a/vms/genconfig.pl b/vms/genconfig.pl
index 781a0b72a7..d4194bd3e1 100644
--- a/vms/genconfig.pl
+++ b/vms/genconfig.pl
@@ -12,6 +12,15 @@
 unshift(@INC,'lib');  # In case someone didn't define Perl_Root
                       # before the build
 
+if ($ARGV[0] eq '-f') {
+  open(ARGS,$ARGV[1]) or die "Can't read data from $ARGV[1]: $!\n";
+  @ARGV = ();
+  while (<ARGS>) {
+    push(@ARGV,split(/\|/,$_));
+  }
+  close ARGS;
+}
+
 if (-f "config.vms") { $infile = "config.vms"; $outdir = "[-]"; }
 elsif (-f "[.vms]config.vms") { $infile = "[.vms]config.vms"; $outdir = "[]"; }
 elsif (-f "config.h") { $infile = "config.h"; $outdir = "[]";}
@@ -194,6 +203,7 @@ $archlib = &VMS::Filespec::vmspath($privlib);
 $installarchlib = &VMS::Filespec::vmspath($installprivlib);
 $sitearch = &VMS::Filespec::vmspath($sitelib);
 $archlib =~ s#\]#.VMS_$archsufx\]#;
+$sitearch =~ s#\]#.VMS_$archsufx\]#;
 print OUT "oldarchlib='$archlib'\n";
 print OUT "oldarchlibexp='$archlib'\n";
 ($vers = $]) =~ tr/./_/;
diff --git a/vms/perlvms.pod b/vms/perlvms.pod
index 47ee3d3afd..377d97f6fe 100644
--- a/vms/perlvms.pod
+++ b/vms/perlvms.pod
@@ -242,45 +242,6 @@ documented L<perl>, except that the element
 separator is '|' instead of ':'.  The directory
 specifications may use either VMS or Unix syntax.
 
-=head1 %ENV 
-
-Reading the elements of the %ENV array returns the 
-translation of the logical name specified by the key, 
-according to the normal search order of access modes and 
-logical name tables.  If you append a semicolon to the
-logical name, followed by an integer, that integer is
-used as the translation index for the logical name,
-so that you can look up successive values for search
-list logical names.  For instance, if you say
-
-   $  Define STORY  once,upon,a,time,there,was
-   $  perl -e "for ($i = 0; $i <= 6; $i++) " -
-   _$ -e "{ print $ENV{'foo'.$i},' '}"
-
-Perl will print C<ONCE UPON A TIME THERE WAS>.
-
-The %ENV keys C<home>, C<path>,C<term>, and C<user>
-return the CRTL "environment variables" of the same
-names, if these logical names are not defined.  The
-key C<default> returns the current default device
-and directory specification, regardless of whether
-there is a logical name DEFAULT defined..
-
-Setting an element of %ENV defines a supervisor-mode logical 
-name in the process logical name table.  C<Undef>ing or 
-C<delete>ing an element of %ENV deletes the equivalent user-
-mode or supervisor-mode logical name from the process logical 
-name table.  If you use C<undef>, the %ENV element remains 
-empty.  If you use C<delete>, another attempt is made at 
-logical name translation after the deletion, so an inner-mode 
-logical name or a name in another logical name table will 
-replace the logical name just deleted.  It is not possible
-at present to define a search list logical name via %ENV.
-
-In all operations on %ENV, the key string is treated as if it 
-were entirely uppercase, regardless of the case actually 
-specified in the Perl expression.
-
 =head1 Perl functions
 
 As of the time this document was last revised, the following 
@@ -558,6 +519,67 @@ and you invoked Perl with the C<-w> switch, a warning will be issued.)
 
 The FLAGS argument is ignored in all cases.
 
+=head1 Perl variables
+
+=item %ENV 
+
+Reading the elements of the %ENV array returns the 
+translation of the logical name specified by the key, 
+according to the normal search order of access modes and 
+logical name tables.  If you append a semicolon to the
+logical name, followed by an integer, that integer is
+used as the translation index for the logical name,
+so that you can look up successive values for search
+list logical names.  For instance, if you say
+
+   $  Define STORY  once,upon,a,time,there,was
+   $  perl -e "for ($i = 0; $i <= 6; $i++) " -
+   _$ -e "{ print $ENV{'foo'.$i},' '}"
+
+Perl will print C<ONCE UPON A TIME THERE WAS>.
+
+The %ENV keys C<home>, C<path>,C<term>, and C<user>
+return the CRTL "environment variables" of the same
+names, if these logical names are not defined.  The
+key C<default> returns the current default device
+and directory specification, regardless of whether
+there is a logical name DEFAULT defined..
+
+Setting an element of %ENV defines a supervisor-mode logical 
+name in the process logical name table.  C<Undef>ing or 
+C<delete>ing an element of %ENV deletes the equivalent user-
+mode or supervisor-mode logical name from the process logical 
+name table.  If you use C<undef>, the %ENV element remains 
+empty.  If you use C<delete>, another attempt is made at 
+logical name translation after the deletion, so an inner-mode 
+logical name or a name in another logical name table will 
+replace the logical name just deleted.  It is not possible
+at present to define a search list logical name via %ENV.
+
+In all operations on %ENV, the key string is treated as if it 
+were entirely uppercase, regardless of the case actually 
+specified in the Perl expression.
+
+=item $?
+
+Since VMS status values are 32 bits wide, the value of C<$?>
+is simply the final status value of the last subprocess to
+complete.  This differs from the behavior of C<$?> under Unix,
+and under VMS' POSIX environment, in that the low-order 8 bits
+of C<$?> do not specify whether the process terminated normally
+or due to a signal, and you do not need to shift C<$?> 8 bits
+to the right in order to find the process' exit status.
+
+=item $!
+
+The string value of C<$!> is that returned by the CRTL's
+strerror() function, so it will include the VMS message for
+VMS-specific errors.  The numeric value of C<$!> is the
+value of C<errno>, except if errno is EVMSERR, in which
+case C<$!> contains the value of vaxc$errno.  Setting C<$!>
+always sets errno to the value specified, and sets vaxc$errno
+to 4 (NONAME-F-NOMSG).
+
 =head1 Revision date
 
 This document was last updated on 16-Dec-1994, for Perl 5, 
diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index 86449982b7..9904682399 100644
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -1319,7 +1319,7 @@ dEXT int yyerrflag;
 dEXT int yychar;
 dEXT YYSTYPE yyval;
 dEXT YYSTYPE yylval;
-#line 572 "perly.y"
+#line 571 "perly.y"
  /* PROGRAM */
 #line 1394 "y_tab.c"
 #define YYABORT goto yyabort
@@ -2084,19 +2084,18 @@ break;
 case 122:
 #line 455 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
-			    append_elem(OP_LIST,
-				yyvsp[0].opval, newCVREF(0,scalar(yyvsp[-1].opval)))); }
+			    append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
 break;
 case 123:
-#line 459 "perly.y"
+#line 458 "perly.y"
 { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
 break;
 case 124:
-#line 461 "perly.y"
+#line 460 "perly.y"
 { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); }
 break;
 case 125:
-#line 463 "perly.y"
+#line 462 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB,
 			    OPf_SPECIAL|OPf_STACKED,
 			    prepend_elem(OP_LIST,
@@ -2106,7 +2105,7 @@ case 125:
 				)),Nullop)); dep();}
 break;
 case 126:
-#line 471 "perly.y"
+#line 470 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB,
 			    OPf_SPECIAL|OPf_STACKED,
 			    append_elem(OP_LIST,
@@ -2117,138 +2116,138 @@ case 126:
 				)))); dep();}
 break;
 case 127:
-#line 480 "perly.y"
+#line 479 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
 			    prepend_elem(OP_LIST,
 				scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();}
 break;
 case 128:
-#line 484 "perly.y"
+#line 483 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
 			    prepend_elem(OP_LIST,
 				yyvsp[-1].opval,
 				scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();}
 break;
 case 129:
-#line 489 "perly.y"
+#line 488 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
 			    hints |= HINT_BLOCK_SCOPE; }
 break;
 case 130:
-#line 492 "perly.y"
+#line 491 "perly.y"
 { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
 break;
 case 131:
-#line 494 "perly.y"
+#line 493 "perly.y"
 { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
 break;
 case 132:
-#line 496 "perly.y"
+#line 495 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, 0); }
 break;
 case 133:
-#line 498 "perly.y"
+#line 497 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
 case 134:
-#line 500 "perly.y"
+#line 499 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
 case 135:
-#line 502 "perly.y"
+#line 501 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
 			    append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
 break;
 case 136:
-#line 505 "perly.y"
+#line 504 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, 0); }
 break;
 case 137:
-#line 507 "perly.y"
+#line 506 "perly.y"
 { yyval.opval = newOP(yyvsp[-2].ival, 0); }
 break;
 case 138:
-#line 509 "perly.y"
+#line 508 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, 0,
 				scalar(yyvsp[0].opval)); }
 break;
 case 139:
-#line 512 "perly.y"
+#line 511 "perly.y"
 { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); }
 break;
 case 140:
-#line 514 "perly.y"
+#line 513 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
 break;
 case 141:
-#line 516 "perly.y"
+#line 515 "perly.y"
 { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); }
 break;
 case 142:
-#line 518 "perly.y"
+#line 517 "perly.y"
 { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); }
 break;
 case 145:
-#line 524 "perly.y"
+#line 523 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 146:
-#line 526 "perly.y"
+#line 525 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 147:
-#line 530 "perly.y"
+#line 529 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 148:
-#line 532 "perly.y"
+#line 531 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 149:
-#line 534 "perly.y"
+#line 533 "perly.y"
 { yyval.opval = yyvsp[-1].opval; }
 break;
 case 150:
-#line 538 "perly.y"
+#line 537 "perly.y"
 { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
 break;
 case 151:
-#line 542 "perly.y"
+#line 541 "perly.y"
 { yyval.opval = newSVREF(yyvsp[0].opval); }
 break;
 case 152:
-#line 546 "perly.y"
+#line 545 "perly.y"
 { yyval.opval = newAVREF(yyvsp[0].opval); }
 break;
 case 153:
-#line 550 "perly.y"
+#line 549 "perly.y"
 { yyval.opval = newHVREF(yyvsp[0].opval); }
 break;
 case 154:
-#line 554 "perly.y"
+#line 553 "perly.y"
 { yyval.opval = newAVREF(yyvsp[0].opval); }
 break;
 case 155:
-#line 558 "perly.y"
+#line 557 "perly.y"
 { yyval.opval = newGVREF(0,yyvsp[0].opval); }
 break;
 case 156:
-#line 562 "perly.y"
+#line 561 "perly.y"
 { yyval.opval = scalar(yyvsp[0].opval); }
 break;
 case 157:
-#line 564 "perly.y"
+#line 563 "perly.y"
 { yyval.opval = scalar(yyvsp[0].opval);  }
 break;
 case 158:
-#line 566 "perly.y"
+#line 565 "perly.y"
 { yyval.opval = scope(yyvsp[0].opval); }
 break;
 case 159:
-#line 569 "perly.y"
+#line 568 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-#line 2237 "y_tab.c"
+#line 2236 "y_tab.c"
     }
     yyssp -= yym;
     yystate = *yyssp;
diff --git a/vms/vms.c b/vms/vms.c
index dcb8685828..073bf56470 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -1190,7 +1190,7 @@ static char *do_tounixspec(char *spec, char *buf, int ts)
     if (cp1) {
       for (cp1++; *cp1 == '-'; cp1++) dashes++; /* VMS  '-' ==> Unix '../' */
     }
-    New(7015,rslt,retlen+1+2*dashes,char);
+    New(7015,rslt,retlen+2+2*dashes,char);
   }
   else rslt = __tounixspec_retbuf;
   if (strchr(spec,'/') != NULL) {
@@ -1207,12 +1207,16 @@ static char *do_tounixspec(char *spec, char *buf, int ts)
     strcpy(rslt,spec);
     return rslt;
   }
-  if (*cp2 != '[') {
+  if (*cp2 != '[' && *cp2 != '<') {
     *(cp1++) = '/';
   }
   else {  /* the VMS spec begins with directories */
     cp2++;
-    if (*cp2 == '-') {
+    if (*cp2 == ']' || *cp2 == '>') {
+      strcpy(rslt,"./");
+      return rslt;
+    }
+    else if (*cp2 == '-') {
       while (*cp2 == '-') {
         *(cp1++) = '.'; *(cp1++) = '.'; *(cp1++) = '/';
         cp2++;
@@ -1693,7 +1697,7 @@ getredirection(int *ac, char ***av)
 	
     /* Check for input from a pipe (mailbox) */
 
-    if (1 == isapipe(0))
+    if (in == NULL && 1 == isapipe(0))
 	{
 	char mbxname[L_tmpnam];
 	long int bufsize;
@@ -1704,11 +1708,6 @@ getredirection(int *ac, char ***av)
 	/* Input from a pipe, reopen it in binary mode to disable	*/
 	/* carriage control processing.	 				*/
 
-	if (in != NULL)
-	    {
-	    fprintf(stderr,"'|' and '<' may not both be specified on command line");
-	    exit(LIB$_INVARGORD);
-	    }
 	fgetname(stdin, mbxname,1);
 	mbxnam.dsc$a_pointer = mbxname;
 	mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer);	
@@ -2986,7 +2985,7 @@ cando_by_name(I32 bit, I32 effective, char *fname)
   static char usrname[L_cuserid];
   static struct dsc$descriptor_s usrdsc =
          {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, usrname};
-
+  char vmsname[NAM$C_MAXRSS+1], fileified[NAM$C_MAXRSS+1];
   unsigned long int objtyp = ACL$C_FILE, access, retsts, privused, iosb[2];
   unsigned short int retlen;
   struct dsc$descriptor_s namdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
@@ -2997,12 +2996,21 @@ cando_by_name(I32 bit, I32 effective, char *fname)
          {0,0,0,0}};
 
   if (!fname || !*fname) return FALSE;
+  if (!do_tovmsspec(fname,vmsname,1)) return FALSE;
+  retlen = namdsc.dsc$w_length = strlen(vmsname);
+  namdsc.dsc$a_pointer = vmsname;
+  if (vmsname[retlen-1] == ']' || vmsname[retlen-1] == '>' ||
+      vmsname[retlen-1] == ':') {
+    if (!do_fileify_dirspec(vmsname,fileified,1)) return FALSE;
+    namdsc.dsc$w_length = strlen(fileified);
+    namdsc.dsc$a_pointer = fileified;
+  }
+
   if (!usrdsc.dsc$w_length) {
     cuserid(usrname);
     usrdsc.dsc$w_length = strlen(usrname);
   }
-  namdsc.dsc$w_length = strlen(fname);
-  namdsc.dsc$a_pointer = fname;
+
   switch (bit) {
     case S_IXUSR:
     case S_IXGRP:
@@ -3126,6 +3134,158 @@ my_getlogin()
 /*}}}*/
 
 
+/*  rmscopy - copy a file using VMS RMS routines
+ *
+ *  Copies contents and attributes of spec_in to spec_out, except owner
+ *  and protection information.  Name and type of spec_in are used as
+ *  defaults for spec_out.  Returns 1 on success; returns 0 and sets
+ *  errno and vaxc$errno on failure.
+ *
+ *  Copyright 1996 by Charles Bailey <bailey@genetics.upenn.edu>.
+ *  Incorporates, with permission, some code from EZCOPY by Tim Adye
+ *  <T.J.Adye@rl.ac.uk>.  Permission is given to use and distribute this
+ *  code under the same terms as Perl itself.  (See the GNU General Public
+ *  License or the Perl Artistic License supplied as part of the Perl
+ *  distribution.)
+ */
+/*{{{int rmscopy(char *src, char *dst)*/
+int
+rmscopy(char *spec_in, char *spec_out)
+{
+    char vmsin[NAM$C_MAXRSS+1], vmsout[NAM$C_MAXRSS+1], esa[NAM$C_MAXRSS],
+         rsa[NAM$C_MAXRSS], ubf[32256];
+    unsigned long int i, sts, sts2;
+    struct FAB fab_in, fab_out;
+    struct RAB rab_in, rab_out;
+    struct NAM nam;
+    struct XABDAT xabdat;
+    struct XABFHC xabfhc;
+    struct XABRDT xabrdt;
+    struct XABSUM xabsum;
+
+    if (!spec_in  || !*spec_in  || !do_tovmsspec(spec_in,vmsin,1) ||
+        !spec_out || !*spec_out || !do_tovmsspec(spec_out,vmsout,1)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      return 0;
+    }
+
+    fab_in = cc$rms_fab;
+    fab_in.fab$l_fna = vmsin;
+    fab_in.fab$b_fns = strlen(vmsin);
+    fab_in.fab$b_shr = FAB$M_SHRPUT | FAB$M_UPI;
+    fab_in.fab$b_fac = FAB$M_BIO | FAB$M_GET;
+    fab_in.fab$l_fop = FAB$M_SQO;
+    fab_in.fab$l_nam =  &nam;
+    fab_in.fab$l_xab = (void*) &xabdat;
+
+    nam = cc$rms_nam;
+    nam.nam$l_rsa = rsa;
+    nam.nam$b_rss = sizeof(rsa);
+    nam.nam$l_esa = esa;
+    nam.nam$b_ess = sizeof (esa);
+    nam.nam$b_esl = nam.nam$b_rsl = 0;
+
+    xabdat = cc$rms_xabdat;        /* To get creation date */
+    xabdat.xab$l_nxt = (void*) &xabfhc;
+
+    xabfhc = cc$rms_xabfhc;        /* To get record length */
+    xabfhc.xab$l_nxt = (void*) &xabsum;
+
+    xabsum = cc$rms_xabsum;        /* To get key and area information */
+
+    if (!((sts = sys$open(&fab_in)) & 1)) {
+      set_vaxc_errno(sts);
+      switch (sts) {
+        case RMS$_FNF:
+        case RMS$_DIR:
+          set_errno(ENOENT); break;
+        case RMS$_DEV:
+          set_errno(ENODEV); break;
+        case RMS$_SYN:
+          set_errno(EINVAL); break;
+        case RMS$_PRV:
+          set_errno(EACCES); break;
+        default:
+          set_errno(EVMSERR);
+      }
+      return 0;
+    }
+
+    fab_out = fab_in;
+    fab_out.fab$w_ifi = 0;
+    fab_out.fab$b_fac = FAB$M_BIO | FAB$M_PUT;
+    fab_out.fab$b_shr = FAB$M_SHRGET | FAB$M_UPI;
+    fab_out.fab$l_fop = FAB$M_SQO;
+    fab_out.fab$l_fna = vmsout;
+    fab_out.fab$b_fns = strlen(vmsout);
+    fab_out.fab$l_dna = nam.nam$l_name;
+    fab_out.fab$b_dns = nam.nam$l_name ? nam.nam$b_name + nam.nam$b_type : 0;
+    if (!((sts = sys$create(&fab_out)) & 1)) {
+      set_vaxc_errno(sts);
+      switch (sts) {
+        case RMS$_DIR:
+          set_errno(ENOENT); break;
+        case RMS$_DEV:
+          set_errno(ENODEV); break;
+        case RMS$_SYN:
+          set_errno(EINVAL); break;
+        case RMS$_PRV:
+          set_errno(EACCES); break;
+        default:
+          set_errno(EVMSERR);
+      }
+      return 0;
+    }
+    fab_out.fab$l_fop |= FAB$M_DLT;  /* in case we have to bail out */
+    /* sys$close() will process xabrdt, not xabdat */
+    xabrdt = cc$rms_xabrdt;
+    xabrdt.xab$q_rdt = xabdat.xab$q_rdt;
+    fab_out.fab$l_xab = &xabrdt;
+
+    rab_in = cc$rms_rab;
+    rab_in.rab$l_fab = &fab_in;
+    rab_in.rab$l_rop = RAB$M_BIO;
+    rab_in.rab$l_ubf = ubf;
+    rab_in.rab$w_usz = sizeof ubf;
+    if (!((sts = sys$connect(&rab_in)) & 1)) {
+      sys$close(&fab_in); sys$close(&fab_out);
+      set_errno(EVMSERR); set_vaxc_errno(sts);
+      return 0;
+    }
+
+    rab_out = cc$rms_rab;
+    rab_out.rab$l_fab = &fab_out;
+    rab_out.rab$l_rbf = ubf;
+    if (!((sts = sys$connect(&rab_out)) & 1)) {
+      sys$close(&fab_in); sys$close(&fab_out);
+      set_errno(EVMSERR); set_vaxc_errno(sts);
+      return 0;
+    }
+
+    while ((sts = sys$read(&rab_in))) {  /* always true  */
+      if (sts == RMS$_EOF) break;
+      rab_out.rab$w_rsz = rab_in.rab$w_rsz;
+      if (!(sts & 1) || !((sts = sys$write(&rab_out)) & 1)) {
+        sys$close(&fab_in); sys$close(&fab_out);
+        set_errno(EVMSERR); set_vaxc_errno(sts);
+        return 0;
+      }
+    }
+
+    fab_out.fab$l_fop &= ~FAB$M_DLT;  /* We got this far; keep the output */
+    sys$close(&fab_in);  sys$close(&fab_out);
+    sts = (fab_in.fab$l_sts & 1) ? fab_out.fab$l_sts : fab_in.fab$l_sts;
+    if (!(sts & 1)) {
+      set_errno(EVMSERR); set_vaxc_errno(sts);
+      return 0;
+    }
+
+    return 1;
+
+}  /* end of rmscopy() */
+/*}}}*/
+
+
 /***  The following glue provides 'hooks' to make some of the routines
  * from this file available from Perl.  These routines are sufficiently
  * basic, and are required sufficiently early in the build process,
@@ -3217,12 +3377,80 @@ void
 candelete_fromperl(CV *cv)
 {
   dXSARGS;
-  char vmsspec[NAM$C_MAXRSS+1];
+  char fspec[NAM$C_MAXRSS+1], *fsp;
+  SV *mysv;
+  IO *io;
 
   if (items != 1) croak("Usage: VMS::Filespec::candelete(spec)");
-  if (do_tovmsspec(SvPV(ST(0),na),buf,0) && cando_by_name(S_IDUSR,0,buf))
-    ST(0) = &sv_yes;
-  else ST(0) = &sv_no;
+
+  mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
+  if (SvTYPE(mysv) == SVt_PVGV) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),fspec)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+    fsp = fspec;
+  }
+  else {
+    if (mysv != ST(0) || !(fsp = SvPV(mysv,na)) || !*fsp) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+  }
+
+  ST(0) = cando_by_name(S_IDUSR,0,fsp) ? &sv_yes : &sv_no;
+  XSRETURN(1);
+}
+
+void
+rmscopy_fromperl(CV *cv)
+{
+  dXSARGS;
+  char inspec[NAM$C_MAXRSS+1], outspec[NAM$C_MAXRSS+1], *inp, *outp;
+  struct dsc$descriptor indsc  = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
+                        outdsc = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+  unsigned long int sts;
+  SV *mysv;
+  IO *io;
+
+  if (items != 2) croak("Usage: File::Copy::rmscopy(from,to)");
+
+  mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
+  if (SvTYPE(mysv) == SVt_PVGV) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),inspec)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+    inp = inspec;
+  }
+  else {
+    if (mysv != ST(0) || !(inp = SvPV(mysv,na)) || !*inp) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+  }
+  mysv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+  if (SvTYPE(mysv) == SVt_PVGV) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),outspec)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+    outp = outspec;
+  }
+  else {
+    if (mysv != ST(1) || !(outp = SvPV(mysv,na)) || !*outp) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+  }
+
+  ST(0) = rmscopy(inp,outp) ? &sv_yes : &sv_no;
   XSRETURN(1);
 }
 
@@ -3231,13 +3459,14 @@ init_os_extras()
 {
   char* file = __FILE__;
 
-  newXS("VMS::Filespec::vmsify",vmsify_fromperl,file);
-  newXS("VMS::Filespec::unixify",unixify_fromperl,file);
-  newXS("VMS::Filespec::pathify",pathify_fromperl,file);
-  newXS("VMS::Filespec::fileify",fileify_fromperl,file);
-  newXS("VMS::Filespec::vmspath",vmspath_fromperl,file);
-  newXS("VMS::Filespec::unixpath",unixpath_fromperl,file);
-  newXS("VMS::Filespec::candelete",candelete_fromperl,file);
+  newXSproto("VMS::Filespec::vmsify",vmsify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::unixify",unixify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::pathify",pathify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::fileify",fileify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::vmspath",vmspath_fromperl,file,"$");
+  newXSproto("VMS::Filespec::unixpath",unixpath_fromperl,file,"$");
+  newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$");
+  newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
   return;
 }
   
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 55508b9f97..000ba29c2a 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -189,6 +189,9 @@ struct tms {
 #define Stat(name,bufptr) flex_stat(name,bufptr)
 #define Fstat(fd,bufptr) flex_fstat(fd,bufptr)
 
+/* By default, flush data all the way to disk, not just to RMS buffers */
+#define Fflush(fp) ((fflush(fp) || fsync(fileno(fp))) ? EOF : 0)
+
 /* Setup for the dirent routines:
  * opendir(), closedir(), readdir(), seekdir(), telldir(), and
  * vmsreaddirversions(), and preprocessor stuff on which these depend:
@@ -348,6 +351,7 @@ struct passwd *	my_getpwuid _((Uid_t uid));
 struct passwd *	my_getpwent _(());
 void	my_endpwent _(());
 char *	my_getlogin _(());
+int	rmscopy _((char *, char *));
 void	init_os_extras _(());
 typedef char __VMS_SEPYTOTORP__;
 /* prototype section end marker; `typedef' passes through cpp */