* For more information
-If you're interested in more information on Perl in general, consult the Usenet
-newsgroups comp.lang.perl.announce and comp.lang.perl.misc. The FAQ for these
-groups provides pointers to other online sources of information, as well as
-books describing Perl in depth.
+If you're interested in more information on Perl in general, you may wish to
+consult the Usenet newsgroups comp.lang.perl.announce and comp.lang.perl.misc.
+The FAQ for these groups provides pointers to other online sources of
+information, as well as books describing Perl in depth.
If you're interested in up-to-date information on Perl development and
internals, you might want to subscribe to the perl5-porters mailing list. You
This is a high-volume list at the moment (>50 messages/day).
If you're interested in ongoing information about the VMS port, you can
-subscribe to the VMSperl mailing list by sending a request to
-bailey@genetics.upenn.edu (it's to a human, not a list server - this is a small
-operation at the moment). And, as always, we welcome any help or code you'd
+subscribe to the VMSPerl mailing list by sending a request to
+vmsperl-request@genetics.upenn.edu, containing the single line
+subscribe VMSPerl
+as the body of the message. And, as always, we welcome any help or code you'd
like to offer - you can send mail to bailey@genetics.upenn.edu or directly to
-the VMSperl list at vmsperl@genetics.upenn.edu.
+the VMSPerl list at vmsperl@genetics.upenn.edu.
Finally, if you'd like to try out the latest changes to VMS Perl, you can
retrieve a test distribution kit by anonymous ftp from genetics.upenn.edu, in
for the getredirection() code
Rich Salz <rsalz@bbn.com>
for readdir() and related routines
- Richard Dyson <dyson@blaze.physics.uiowa.edu> and
- Kent Covert <kacovert@miavx1.acs.muohio.edu>
- for additional testing on the AXP.
+ Peter Prymmer <pvhp@lns62.lns.cornell.edu)
+ for extensive testing, as well as development work on
+ configuration and documentation for VMS Perl,
+ the Stanford Synchrotron Radiation Laboratory and the
+ Laboratory of Nuclear Studies at Cornell University for
+ the the opportunity to test and develop for the AXP,
and to the entire VMSperl group for useful advice and suggestions. In addition
the perl5-porters, especially Andy Dougherty <doughera@lafcol.lafayette.edu>
and Tim Bunce <Tim.Bunce@ig.co.uk>, deserve credit for their creativity and
willingness to work with the VMS newcomers. Finally, the greatest debt of
-gratitude is due to Larry Wall <lwall@sems.com>, for having the ideas which
+gratitude is due to Larry Wall <larry@wall.org>, for having the ideas which
have made our sleepless nights possible.
Thanks,
OBJVAL = $@
# Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00301#
+PERL_VERSION = 5_00304#
ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)]
h1 = EXTERN.h, INTERN.h, XSUB.h, av.h, config.h, cop.h, cv.h
h2 = embed.h, form.h, gv.h, handy.h, hv.h, keywords.h, mg.h, op.h
h3 = opcode.h, patchlevel.h, perl.h, perly.h, pp.h, proto.h, regcomp.h
-h4 = regexp.h, scope.h, sv.h, vmsish.h, util.h
+h4 = regexp.h, scope.h, sv.h, vmsish.h, util.h, perlio.h, perlsdio.h
h = $(h1), $(h2), $(h3), $(h4) $(SOCKHLIS)
-c1 = av.c, scope.c, op.c, doop.c, doio.c, dump.c, hv.c, mg.c, universal.c
+c1 = av.c, scope.c, op.c, doop.c, doio.c, dump.c, hv.c, mg.c, universal.c, perlio.c
c2 = perl.c, perly.c, pp.c, pp_hot.c, pp_ctl.c, pp_sys.c, regcomp.c, regexec.c
c3 = gv.c, sv.c, taint.c, toke.c, util.c, deb.c, run.c, globals.c, vms.c $(SOCKCLIS)
c = $(c1), $(c2), $(c3), miniperlmain.c, perlmain.c
-obj1 = perl$(O), gv$(O), toke$(O), perly$(O), op$(O), regcomp$(O), dump$(O), util$(O), mg$(O)
+obj1 = perl$(O), gv$(O), toke$(O), perly$(O), op$(O), regcomp$(O), dump$(O), util$(O), mg$(O), perlio$(O)
obj2 = hv$(O), av$(O), run$(O), pp_hot$(O), sv$(O), pp$(O), scope$(O), pp_ctl$(O), pp_sys$(O)
obj3 = doop$(O), doio$(O), regexec$(O), taint$(O), deb$(O), universal$(O), globals$(O), vms$(O) $(SOCKOBJ)
ac3 = $(ARCHCORE)form.h $(ARCHCORE)gv.h $(ARCHCORE)handy.h $(ARCHCORE)hv.h
ac4 = $(ARCHCORE)keywords.h $(ARCHCORE)mg.h $(ARCHCORE)op.h $(ARCHCORE)opcode.h
ac5 = $(ARCHCORE)patchlevel.h $(ARCHCORE)perl.h $(ARCHCORE)perly.h
-ac6 = $(ARCHCORE)pp.h $(ARCHCORE)proto.h $(ARCHCORE)regcomp.h
+ac6 = $(ARCHCORE)pp.h $(ARCHCORE)proto.h $(ARCHCORE)regcomp.h $(ARCHCORE)perlio.h $(ARCHCORE)perlsdio.h
ac7 = $(ARCHCORE)regexp.h $(ARCHCORE)scope.h $(ARCHCORE)sv.h $(ARCHCORE)util.h
ac8 = $(ARCHCORE)vmsish.h $(ARCHCORE)$(DBG)libperl$(OLB) $(ARCHCORE)perlshr_attr.opt
ac9 = $(ARCHCORE)$(DBG)perlshr_bld.opt
$(ARCHCORE)perl.h : perl.h
@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
Copy/Log perl.h $@
+$(ARCHCORE)perlio.h : perlio.h
+ @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+ Copy/Log perlio.h $@
+$(ARCHCORE)perlsdio.h : perlsdio.h
+ @ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+ Copy/Log perlsdio.h $@
$(ARCHCORE)perly.h : perly.h
@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
Copy/Log perly.h $@
vms$(O) : sv.h
vms$(O) : vmsish.h
vms$(O) : util.h
+perlio$(O) : EXTERN.h
+perlio$(O) : av.h
+perlio$(O) : config.h
+perlio$(O) : cop.h
+perlio$(O) : cv.h
+perlio$(O) : embed.h
+perlio$(O) : form.h
+perlio$(O) : gv.h
+perlio$(O) : handy.h
+perlio$(O) : hv.h
+perlio$(O) : mg.h
+perlio$(O) : op.h
+perlio$(O) : opcode.h
+perlio$(O) : perl.h
+perlio$(O) : perly.h
+perlio$(O) : pp.h
+perlio$(O) : proto.h
+perlio$(O) : regexp.h
+perlio$(O) : perlio.c
+perlio$(O) : scope.h
+perlio$(O) : sv.h
+perlio$(O) : vmsish.h
+perlio$(O) : util.h
miniperlmain$(O) : EXTERN.h
miniperlmain$(O) : av.h
miniperlmain$(O) : config.h
*/
#define OSNAME "VMS" /**/
-/* ARCHLIB_EXP:
+/* ARCHLIB:
* This variable, if defined, holds the name of the directory in
* which the user wants to put architecture-dependent public
* library files for $package. It is most often a local directory
* such as /usr/local/lib. Programs using this variable must be
- * prepared to deal with filename expansion. If ARCHLIB_EXP is the
- * same as PRIVLIB_EXP, it is not defined, since presumably the
- * program already searches PRIVLIB_EXP.
+ * prepared to deal with filename expansion. If ARCHLIB is the
+ * same as PRIVLIB, it is not defined, since presumably the
+ * program already searches PRIVLIB.
+ */
+/* ARCHLIB_EXP:
+ * This symbol contains the ~name expanded version of ARCHLIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
*/
/* ==> NOTE <==
* This value is automatically updated by FndVers.Com
* when Perl is built. Please do not change it by hand; make
* any changes to FndVers.Com instead.
*/
-#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00301" /**/
+#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00304" /**/
+#define ARCHLIB ARCHLIB_EXP /*config-skip*/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
* I/O uses a summy FILE *, and Perl doesn't distinguish between socket
* and non-socket filehandles.
*/
-#undef USE_STDIO_PTR /**/
-#undef USE_STDIO_BASE /**/
+#define USE_STDIO_PTR /**/
+#define USE_STDIO_BASE /**/
/* FILE_ptr:
* This macro is used to access the _ptr field (or equivalent) of the
* This symbol is defined if the FILE_cnt macro can be used as an
* lvalue.
*/
-#undef FILE_ptr
-#undef STDIO_PTR_LVALUE
-#undef FILE_cnt
-#undef STDIO_CNT_LVALUE
+#define FILE_ptr(fp) ((*fp)->_ptr)
+#define STDIO_PTR_LVALUE
+#define FILE_cnt(fp) ((*fp)->_cnt)
+#define STDIO_CNT_LVALUE
+
+/* FILE_filbuf:
+ * This macro is used to access the internal stdio _filbuf function
+ * (or equivalent), if STDIO_CNT_LVALUE and STDIO_PTR_LVALUE
+ * are defined. It is typically either _filbuf or __filbuf.
+ * This macro will only be defined if both STDIO_CNT_LVALUE and
+ * STDIO_PTR_LVALUE are defined.
+ */
+#define FILE_filbuf(fp) do { register int c; if ((c = fgetc(fp)) != EOF) \
+ ungetc(c,(fp)); } while (0);
/* FILE_base:
* This macro is used to access the _base field (or equivalent) of the
* structure pointed to its argument. This macro will always be defined
* if USE_STDIO_BASE is defined.
*/
-#undef FILE_base
-#undef FILE_bufsiz
+#define FILE_base(fp) ((*fp)->_base)
+#define FILE_bufsiz(fp) ((*fp)->_cnt + (*fp)->_ptr - (*fp)->_base)
/* USE_STRUCT_COPY:
* This symbol, if defined, indicates that this C compiler knows how
* include <limits.h> to get definition of symbols like WORD_BIT or
* LONG_MAX, i.e. machine dependant limitations.
*/
-#undef I_LIMITS /**/
+#define I_LIMITS /**/
/* I_MEMORY:
* This symbol, if defined, indicates to the C program that it should
*/
#undef I_SYS_NDIR /**/
+/* I_SYS_RESOURCE:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/resource.h>.
+ */
+#undef I_SYS_RESOURCE /**/
+
/* I_SYS_SELECT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/select.h> in order to get definition of struct timeval.
#undef I_DBM /**/
#undef I_RPCSVC_DBM /**/
+/* I_SFIO:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sfio.h>.
+ */
+#undef I_SFIO /**/
+
/* I_SYS_STAT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/stat.h>.
*/
#undef I_SYS_UN /**/
+/* I_SYS_WAIT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/wait.h>.
+ */
+#undef I_SYS_WAIT /**/
+
/* I_TERMIO:
* This symbol, if defined, indicates that the program should include
* <termio.h> rather than <sgtty.h>. There are also differences in
*/
#define Off_t int /* <offset> type */
+/* I_VALUES:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <values.h> to get definition of symbols like MINFLOAT or
+ * MAXLONG, i.e. machine dependant limitations. Probably, you
+ * should use <limits.h> instead, if it is available.
+ */
+#undef I_VALUES /**/
+
/* Free_t:
* This variable contains the return type of free(). It is usually
* void, but occasionally int.
*/
#undef MYMALLOC /**/
+/* SH_PATH:
+ * This symbol contains the full pathname to the shell used on this
+ * on this system to execute Bourne shell scripts. Usually, this will be
+ * /bin/sh, though it's possible that some systems will have /bin/ksh,
+ * /bin/pdksh, /bin/ash, /bin/bash, or even something such as D:/bin/sh.
+ */
+#define SH_PATH "MCR" /**/
+
/* SIG_NAME:
* This symbol contains a list of signal names in order. This is intended
* to be used as a static array initialization, like this:
#undef RD_NODATA
#undef EOF_NONBLOCK
+/* OLDARCHLIB:
+ * This variable, if defined, holds the name of the directory in
+ * which the user has perl5.000 or perl5.001 architecture-dependent
+ * public library files for $package. For the most part, these
+ * files will work with 5.002 (and later), but that is not
+ * guaranteed.
+ */
/* OLDARCHLIB_EXP:
* This symbol contains the ~name expanded version of OLDARCHLIB, to be
* used in programs that are not prepared to deal with ~ expansion at
* any changes to FndVers.Com instead.
*/
#define OLDARCHLIB_EXP "/perl_root/lib/VMS_VAX" /**/
+#define OLDARCHLIB OLDARCHLIB_EXP /*config-skip*/
-/* PRIVLIB_EXP:
+/* PRIVLIB:
* This symbol contains the name of the private library for this package.
* The library is private in the sense that it needn't be in anyone's
* execution path, but it should be accessible by the world. The program
* should be prepared to do ~ expansion.
*/
+/* PRIVLIB_EXP:
+ * This symbol contains the ~name expanded version of PRIVLIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
#define PRIVLIB_EXP "/perl_root/lib" /**/
+#define PRIVLIB PRIVLIB_EXP /*config-skip*/
+/* SITELIB:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ * The standard distribution will put nothing in this directory.
+ * Individual sites may place their own extensions and modules in
+ * this directory.
+ */
/* SITELIB_EXP:
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define SITELIB_EXP "/perl_root/lib/site_perl" /**/
+#define SITELIB SITELIB_EXP /*config-skip*/
+/* SITEARCH:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ * The standard distribution will put nothing in this directory.
+ * Individual sites may place their own extensions and modules in
+ * this directory.
+ */
/* SITEARCH_EXP:
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
* any changes to FndVers.Com instead.
*/
#define SITEARCH_EXP "/perl_root/lib/site_perl/VMS_VAX" /**/
+#define SITEARCH SITEARCH_EXP /*config-skip*/
/* SCRIPTDIR:
* This symbol holds the name of the directory in which the user wants
*/
#define Gconvert(x,n,t,b) my_gconvert(x,n,t,b)
+/* USE_SFIO:
+ * This symbol, if defined, indicates that sfio should
+ * be used.
+ */
+#undef USE_SFIO /**/
+
/* Sigjmp_buf:
* This is the buffer type to be used with Sigsetjmp and Siglongjmp.
*/
#undef DB_Hash_t /**/
#undef DB_Prefix_t /**/
-/* BIN_SH:
- * This variable contains the path to the shell.
+/* USE_PERLIO:
+ * This symbol, if defined, indicates that the PerlIO abstraction should
+ * be used throughout. If not defined, stdio should be
+ * used in a fully backward compatible manner.
*/
-#define BIN_SH "MCR" /**/
+#undef USE_PERLIO /**/
/* VOIDFLAGS:
* This symbol indicates how much support of the void type is given by this
.endif
# Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_00301#
+PERL_VERSION = 5_00304#
ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)]
h1 = EXTERN.h, INTERN.h, XSUB.h, av.h, config.h, cop.h, cv.h
h2 = embed.h, form.h, gv.h, handy.h, hv.h, keywords.h, mg.h, op.h
h3 = opcode.h, patchlevel.h, perl.h, perly.h, pp.h, proto.h, regcomp.h
-h4 = regexp.h, scope.h, sv.h, vmsish.h, util.h
+h4 = regexp.h, scope.h, sv.h, vmsish.h, util.h, perlio.h, perlsdio.h
h = $(h1), $(h2), $(h3), $(h4) $(SOCKHLIS)
-c1 = av.c, scope.c, op.c, doop.c, doio.c, dump.c, hv.c, mg.c, universal.c
+c1 = av.c, scope.c, op.c, doop.c, doio.c, dump.c, hv.c, mg.c, universal.c, perlio.c
c2 = perl.c, perly.c, pp.c, pp_hot.c, pp_ctl.c, pp_sys.c, regcomp.c, regexec.c
c3 = gv.c, sv.c, taint.c, toke.c, util.c, deb.c, run.c, globals.c, vms.c $(SOCKCLIS)
c = $(c1), $(c2), $(c3), miniperlmain.c, perlmain.c
-obj1 = perl$(O), gv$(O), toke$(O), perly$(O), op$(O), regcomp$(O), dump$(O), util$(O), mg$(O)
+obj1 = perl$(O), gv$(O), toke$(O), perly$(O), op$(O), regcomp$(O), dump$(O), util$(O), mg$(O), perlio$(O)
obj2 = hv$(O), av$(O), run$(O), pp_hot$(O), sv$(O), pp$(O), scope$(O), pp_ctl$(O), pp_sys$(O)
obj3 = doop$(O), doio$(O), regexec$(O), taint$(O), deb$(O), universal$(O), globals$(O), vms$(O) $(SOCKOBJ)
ac3 = $(ARCHCORE)form.h $(ARCHCORE)gv.h $(ARCHCORE)handy.h $(ARCHCORE)hv.h
ac4 = $(ARCHCORE)keywords.h $(ARCHCORE)mg.h $(ARCHCORE)op.h $(ARCHCORE)opcode.h
ac5 = $(ARCHCORE)patchlevel.h $(ARCHCORE)perl.h $(ARCHCORE)perly.h
-ac6 = $(ARCHCORE)pp.h $(ARCHCORE)proto.h $(ARCHCORE)regcomp.h
+ac6 = $(ARCHCORE)pp.h $(ARCHCORE)proto.h $(ARCHCORE)regcomp.h $(ARCHCORE)perlio.h $(ARCHCORE)perlsdio.h
ac7 = $(ARCHCORE)regexp.h $(ARCHCORE)scope.h $(ARCHCORE)sv.h $(ARCHCORE)util.h
ac8 = $(ARCHCORE)vmsish.h $(ARCHCORE)$(DBG)libperl$(OLB) $(ARCHCORE)perlshr_attr.opt
ac9 = $(ARCHCORE)$(DBG)perlshr_bld.opt
$(ARCHCORE)perl.h : perl.h
@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)perlio.h : perlio.h
+ @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)perlsdio.h : perlsdio.h
+ @ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
$(ARCHCORE)perly.h : perly.h
@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
vms$(O) : sv.h
vms$(O) : vmsish.h
vms$(O) : util.h
+perlio$(O) : EXTERN.h
+perlio$(O) : av.h
+perlio$(O) : config.h
+perlio$(O) : cop.h
+perlio$(O) : cv.h
+perlio$(O) : embed.h
+perlio$(O) : form.h
+perlio$(O) : gv.h
+perlio$(O) : handy.h
+perlio$(O) : hv.h
+perlio$(O) : mg.h
+perlio$(O) : op.h
+perlio$(O) : opcode.h
+perlio$(O) : perl.h
+perlio$(O) : perly.h
+perlio$(O) : pp.h
+perlio$(O) : proto.h
+perlio$(O) : regexp.h
+perlio$(O) : perlio.c
+perlio$(O) : scope.h
+perlio$(O) : sv.h
+perlio$(O) : vmsish.h
+perlio$(O) : util.h
miniperlmain$(O) : EXTERN.h
miniperlmain$(O) : av.h
miniperlmain$(O) : config.h
use Exporter ();
$VERSION = '2.0';
-@ISA = qw( Exporter DynaLoader FileHandle );
+@ISA = qw( Exporter DynaLoader IO::File );
@EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY &O_NOWAIT
&O_RDONLY &O_RDWR &O_TRUNC &O_WRONLY );
@EXPORT_OK = qw( &flush &getname &remove &rewind &sync &tmpnam
defined $val or croak("Unknown VMS::Stdio constant $constname");
*$AUTOLOAD = sub { $val };
}
- else { # We don't know about it; hand off to FileHandle
- require FileHandle;
+ else { # We don't know about it; hand off to IO::File
+ require IO::File;
my($obj) = shift(@_);
- $obj->FileHandle::$constname(@_);
+ $obj->IO::File::$constname(@_);
}
goto &$AUTOLOAD;
}
Of course, you can also choose to import specific functions by
name, as usual.
-This package C<ISA> FileHandle, so that you can call FileHandle
+This package C<ISA> IO::File, so that you can call IO::File
methods on the handles returned by C<vmsopen> and C<vmssysopen>.
-The FileHandle package is not initialized, however, until you
+The IO::File package is not initialized, however, until you
actually call a method that VMS::Stdio doesn't provide. This
is doen to save startup time for users who don't wish to use
-the FileHandle methods.
+the IO::File methods.
B<Note:> In order to conform to naming conventions for Perl
extensions and functions, the name of this package has been
=item getname
The C<getname> function returns the file specification associated
-with a Perl FileHandle. If an error occurs, it returns C<undef>.
+with a Perl I/O handle. If an error occurs, it returns C<undef>.
=item remove
to the VMS CRTL when opening a file. It is similar to the built-in
Perl C<open> function (see L<perlfunc> for a complete description),
but will only open normal files; it cannot open pipes or duplicate
-existing FileHandles. Up to 8 optional arguments may follow the
+existing I/O handles. Up to 8 optional arguments may follow the
file name. These arguments should be strings which specify
optional file characteristics as allowed by the CRTL. (See the
CRTL reference manual description of creat() and fopen() for details.)
You can use the file handle returned by C<vmsfopen> just as you
would any other Perl file handle. The class VMS::Stdio ISA
-FileHandle, so you can call FileHandle methods using the handle
+IO::File, so you can call IO::File methods using the handle
returned by C<vmsopen>. However, C<use>ing VMS::Stdio does not
-automatically C<use> FileHandle; you must do so explicitly in
-your program if you want to call FileHandle methods. This is
-done to avoid the overhead of initializing the FileHandle package
+automatically C<use> IO::File; you must do so explicitly in
+your program if you want to call IO::File methods. This is
+done to avoid the overhead of initializing the IO::File package
in programs which intend to use the handle returned by C<vmsopen>
as a normal Perl file handle only. When the scalar containing
a VMS::Stdio file handle is overwritten, C<undef>d, or goes
next if /^\s*$/;
push(@tests,$_);
}
-print '1..',scalar(@tests)+1,"\n";
+print '1..',scalar(@tests)+3,"\n";
foreach $test (@tests) {
($arg,$func,$expect) = split(/\t+/,$test);
}
print +(rmsexpand('[]') eq "\U$ENV{DEFAULT}" ? 'ok ' : 'not ok '),++$idx,"\n";
+print +(rmsexpand('from.here') eq "\L$ENV{DEFAULT}from.here" ?
+ 'ok ' : 'not ok '),++$idx,"\n";
+print +(rmsexpand('from.here','cant:[get.there];2') eq
+ 'cant:[get.there]from.here;2' ? 'ok ' : 'not ok '),++$idx,"\n";
__DATA__
path vmspath [.path]
# Redundant characters in Unix paths
+//some/where//over/../the.rainbow vmsify some:[where]the.rainbow
/some/where//over/./the.rainbow vmsify some:[where.over]the.rainbow
..//../ vmspath [--]
./././ vmspath []
# Kluge to determine whether we need to add EMBED prefix to
-# symbols read from local list. init_os_extras() is a VMS-
+# symbols read from local list. vmsreaddirversions() is a VMS-
# specific function whose Perl_ prefix is added in vmsish.h
# if EMBED is #defined.
-$embed = exists($fcns{'Perl_init_os_extras'}) ? 'Perl_' : '';
+$embed = exists($fcns{'Perl_vmsreaddirversions'}) ? 'Perl_' : '';
while (<DATA>) {
next if /^#/;
s/\s+#.*\n//;
$ Define STORY once,upon,a,time,there,was
$ perl -e "for ($i = 0; $i <= 6; $i++) " -
- _$ -e "{ print $ENV{'foo'.$i},' '}"
+ _$ -e "{ print $ENV{'story;'.$i},' '}"
Perl will print C<ONCE UPON A TIME THERE WAS>.
replace the logical name just deleted. It is not possible
at present to define a search list logical name via %ENV.
+At present, the first time you iterate over %ENV using
+C<keys>, C<values>, or C<each>, you will incur a time
+penalty as all logical names are read, in order to fully
+populate %ENV. Subsequent iterations will not reread
+logical names, so they won't be as slow, but they also
+won't reflect any changes to logical name tables caused
+by other programs.
+
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.
#include <uaidef.h>
#include <uicdef.h>
-#ifndef SS$_NOSUCHOBJECT /* Older versions of ssdef.h don't have this */
+/* Older versions of ssdef.h don't have these */
+#ifndef SS$_INVFILFOROP
+# define SS$_INVFILFOROP 3930
+#endif
+#ifndef SS$_NOSUCHOBJECT
# define SS$_NOSUCHOBJECT 2696
#endif
}
else if (retsts & 1) {
eqv[eqvlen] = '\0';
- return 1;
+ return eqvlen;
}
_ckvmssts(retsts); /* Must be an error */
return 0; /* Not reached, assuming _ckvmssts() bails out */
_ckvmssts(retsts);
}
/* Try for CRTL emulation of a Unix/POSIX name */
- else return getenv(lnm);
+ else return getenv(uplnm);
}
}
return Nullch;
} /* end of my_getenv() */
/*}}}*/
+/*{{{ void prime_env_iter() */
+void
+prime_env_iter(void)
+/* Fill the %ENV associative array with all logical names we can
+ * find, in preparation for iterating over it.
+ */
+{
+ static int primed = 0; /* XXX Not thread-safe!!! */
+ HV *envhv = GvHVn(envgv);
+ FILE *sholog;
+ char eqv[LNM$C_NAMLENGTH+1],*start,*end;
+ STRLEN eqvlen;
+ SV *oldrs, *linesv, *eqvsv;
+
+ if (primed) return;
+ /* Perform a dummy fetch as an lval to insure that the hash table is
+ * set up. Otherwise, the hv_store() will turn into a nullop */
+ (void) hv_fetch(envhv,"DEFAULT",7,TRUE);
+ /* Also, set up the four "special" keys that the CRTL defines,
+ * whether or not underlying logical names exist. */
+ (void) hv_fetch(envhv,"HOME",4,TRUE);
+ (void) hv_fetch(envhv,"TERM",4,TRUE);
+ (void) hv_fetch(envhv,"PATH",4,TRUE);
+ (void) hv_fetch(envhv,"USER",4,TRUE);
+
+ /* Now, go get the logical names */
+ if ((sholog = my_popen("$ Show Logical *","r")) == Nullfp)
+ _ckvmssts(vaxc$errno);
+ /* We use Perl's sv_gets to read from the pipe, since my_popen is
+ * tied to Perl's I/O layer, so it may not return a simple FILE * */
+ oldrs = rs;
+ rs = newSVpv("\n",1);
+ linesv = newSVpv("",0);
+ while (1) {
+ if ((start = sv_gets(linesv,sholog,0)) == Nullch) {
+ my_pclose(sholog);
+ SvREFCNT_dec(linesv); SvREFCNT_dec(rs); rs = oldrs;
+ primed = 1;
+ return;
+ }
+ while (*start != '"' && *start != '=' && *start) start++;
+ if (*start != '"') continue;
+ for (end = ++start; *end && *end != '"'; end++) ;
+ if (*end) *end = '\0';
+ else end = Nullch;
+ if ((eqvlen = my_trnlnm(start,eqv,0)) == 0) _ckvmssts(vaxc$errno);
+ else {
+ eqvsv = newSVpv(eqv,eqvlen);
+ hv_store(envhv,start,(end ? end - start : strlen(start)),eqvsv,0);
+ }
+ }
+} /* end of prime_env_iter */
+/*}}}*/
+
+
/*{{{ void my_setenv(char *lnm, char *eqv)*/
void
my_setenv(char *lnm,char *eqv)
lcklst[2] = {{sizeof newace, ACL$C_WLOCK_ACL, &newace, 0},{0,0,0,0}},
ulklst[2] = {{sizeof newace, ACL$C_UNLOCK_ACL, &newace, 0},{0,0,0,0}};
- if (!remove(name)) return 0; /* Can we just get rid of it? */
+ if (!remove(name)) return 0; /* Can we just get rid of it? */
+ /* If not, can changing protections help? */
+ if (vaxc$errno != RMS$_PRV) return -1;
/* No, so we get our own UIC to use as a rights identifier,
* and the insert an ACE at the head of the ACL which allows us
cxt = 0;
newace.myace$l_ident = oldace.myace$l_ident;
if (!((aclsts = sys$change_acl(0,&type,&fildsc,lcklst,0,0,0)) & 1)) {
- set_errno(EVMSERR);
+ switch (aclsts) {
+ case RMS$_FNF:
+ case RMS$_DNF:
+ case RMS$_DIR:
+ case SS$_NOSUCHOBJECT:
+ set_errno(ENOENT); break;
+ case RMS$_DEV:
+ set_errno(ENODEV); break;
+ case RMS$_SYN:
+ case SS$_INVFILFOROP:
+ set_errno(EINVAL); break;
+ case RMS$_PRV:
+ set_errno(EACCES); break;
+ default:
+ _ckvmssts(aclsts);
+ }
set_vaxc_errno(aclsts);
return -1;
}
struct pipe_details
{
struct pipe_details *next;
- FILE *fp; /* stdio file pointer to pipe mailbox */
+ PerlIO *fp; /* stdio file pointer to pipe mailbox */
int pid; /* PID of subprocess */
int mode; /* == 'r' if pipe open for reading */
int done; /* subprocess has completed */
create_mbx(&chan,&namdsc);
/* open a FILE* onto it */
- info->fp=fopen(mbxname, mode);
+ info->fp = PerlIO_open(mbxname, mode);
/* give up other channel onto it */
_ckvmssts(sys$dassgn(chan));
/* get here => no such pipe open */
croak("No such pipe open");
- fclose(info->fp);
+ PerlIO_close(info->fp);
if (info->done) retsts = info->completion;
else waitpid(info->pid,(int *) &retsts,0);
{
if (j+1 >= argc)
{
- fprintf(Perl_debug_log,"No input file after < on command line");
+ PerlIO_printf(Perl_debug_log,"No input file after < on command line");
exit(LIB$_WRONUMARG);
}
in = argv[++j];
{
if (j+1 >= argc)
{
- fprintf(Perl_debug_log,"No output file after > on command line");
+ PerlIO_printf(Perl_debug_log,"No output file after > on command line");
exit(LIB$_WRONUMARG);
}
out = argv[++j];
out = 1 + ap;
if (j >= argc)
{
- fprintf(Perl_debug_log,"No output file after > or >> on command line");
+ PerlIO_printf(Perl_debug_log,"No output file after > or >> on command line");
exit(LIB$_WRONUMARG);
}
continue;
err = 2 + ap;
if (j >= argc)
{
- fprintf(Perl_debug_log,"No output file after 2> or 2>> on command line");
+ PerlIO_printf(Perl_debug_log,"No output file after 2> or 2>> on command line");
exit(LIB$_WRONUMARG);
}
continue;
{
if (j+1 >= argc)
{
- fprintf(Perl_debug_log,"No command into which to pipe on command line");
+ PerlIO_printf(Perl_debug_log,"No command into which to pipe on command line");
exit(LIB$_WRONUMARG);
}
cmargc = argc-(j+1);
{
if (out != NULL)
{
- fprintf(Perl_debug_log,"'|' and '>' may not both be specified on command line");
+ PerlIO_printf(Perl_debug_log,"'|' and '>' may not both be specified on command line");
exit(LIB$_INVARGORD);
}
pipe_and_fork(cmargv);
/* Input from a pipe, reopen it in binary mode to disable */
/* carriage control processing. */
- fgetname(stdin, mbxname,1);
+ PerlIO_getname(stdin, mbxname);
mbxnam.dsc$a_pointer = mbxname;
mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer);
lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0);
freopen(mbxname, "rb", stdin);
if (errno != 0)
{
- fprintf(Perl_debug_log,"Can't reopen input pipe (name: %s) in binary mode",mbxname);
+ PerlIO_printf(Perl_debug_log,"Can't reopen input pipe (name: %s) in binary mode",mbxname);
exit(vaxc$errno);
}
}
if ((in != NULL) && (NULL == freopen(in, "r", stdin, "mbc=32", "mbf=2")))
{
- fprintf(Perl_debug_log,"Can't open input file %s as stdin",in);
+ PerlIO_printf(Perl_debug_log,"Can't open input file %s as stdin",in);
exit(vaxc$errno);
}
if ((out != NULL) && (NULL == freopen(out, outmode, stdout, "mbc=32", "mbf=2")))
{
- fprintf(Perl_debug_log,"Can't open output file %s as stdout",out);
+ PerlIO_printf(Perl_debug_log,"Can't open output file %s as stdout",out);
exit(vaxc$errno);
}
if (err != NULL) {
FILE *tmperr;
if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2")))
{
- fprintf(Perl_debug_log,"Can't open error file %s as stderr",err);
+ PerlIO_printf(Perl_debug_log,"Can't open error file %s as stderr",err);
exit(vaxc$errno);
}
fclose(tmperr);
}
}
#ifdef ARGPROC_DEBUG
- fprintf(Perl_debug_log, "Arglist:\n");
+ PerlIO_printf(Perl_debug_log, "Arglist:\n");
for (j = 0; j < *ac; ++j)
- fprintf(Perl_debug_log, "argv[%d] = '%s'\n", j, argv[j]);
+ PerlIO_printf(Perl_debug_log, "argv[%d] = '%s'\n", j, argv[j]);
#endif
/* Clear errors we may have hit expanding wildcards, so they don't
show up in Perl's $! later */
if (0 == child_st[0])
{
#ifdef ARGPROC_DEBUG
- fprintf(Perl_debug_log, "Waiting for Child Process to Finish . . .\n");
+ PerlIO_printf(Perl_debug_log, "Waiting for Child Process to Finish . . .\n");
#endif
fflush(stdout); /* Have to flush pipe for binary data to */
/* terminate properly -- <tp@mccall.com> */
static void sig_child(int chan)
{
#ifdef ARGPROC_DEBUG
- fprintf(Perl_debug_log, "Child Completion AST\n");
+ PerlIO_printf(Perl_debug_log, "Child Completion AST\n");
#endif
if (child_st[0] == 0)
child_st[0] = 1;
create_mbx(&child_chan,&mbxdsc);
#ifdef ARGPROC_DEBUG
- fprintf(Perl_debug_log, "Pipe Mailbox Name = '%s'\n", mbxdsc.dsc$a_pointer);
- fprintf(Perl_debug_log, "Sub Process Command = '%s'\n", cmddsc.dsc$a_pointer);
+ PerlIO_printf(Perl_debug_log, "Pipe Mailbox Name = '%s'\n", mbxdsc.dsc$a_pointer);
+ PerlIO_printf(Perl_debug_log, "Sub Process Command = '%s'\n", cmddsc.dsc$a_pointer);
#endif
_ckvmssts_noperl(lib$spawn(&cmddsc, &mbxdsc, 0, &one,
0, &pid, child_st, &zero, sig_child,
&child_chan));
#ifdef ARGPROC_DEBUG
- fprintf(Perl_debug_log, "Subprocess's Pid = %08X\n", pid);
+ PerlIO_printf(Perl_debug_log, "Subprocess's Pid = %08X\n", pid);
#endif
sys$dclexh(&exit_block);
if (NULL == freopen(mbxname, "wb", stdout))
{
- fprintf(Perl_debug_log,"Can't open output pipe (name %s)",mbxname);
+ PerlIO_printf(Perl_debug_log,"Can't open output pipe (name %s)",mbxname);
}
}
_ckvmssts_noperl(retsts);
}
#ifdef ARGPROC_DEBUG
- fprintf(Perl_debug_log, "%s\n", command);
+ PerlIO_printf(Perl_debug_log, "%s\n", command);
#endif
sprintf(pidstring, "%08X", pid);
- fprintf(Perl_debug_log, "%s\n", pidstring);
+ PerlIO_printf(Perl_debug_log, "%s\n", pidstring);
pidstr.dsc$a_pointer = pidstring;
pidstr.dsc$w_length = strlen(pidstr.dsc$a_pointer);
lib$set_symbol(&pidsymbol, &pidstr);
retsts = sys$parse(&myfab,0,0);
if (!(retsts & 1)) {
- if (retsts == RMS$_DNF) {
+ if (retsts == RMS$_DNF || retsts == RMS$_DIR ||
+ retsts == RMS$_DEV || retsts == RMS$_DEV) {
mynam.nam$b_nop |= NAM$M_SYNCHK;
retsts = sys$parse(&myfab,0,0);
if (retsts & 1) goto expanded;
if (islower(*out)) { haslower = 1; break; }
if (mynam.nam$b_rsl) { out = rsa; speclen = mynam.nam$b_rsl; }
else { out = esa; speclen = mynam.nam$b_esl; }
- if (!(mynam.nam$l_fnb & NAM$M_EXP_VER))
- speclen = mynam.nam$l_type - out;
+ if (!(mynam.nam$l_fnb & NAM$M_EXP_VER) &&
+ (items == 1 || !strchr(myfab.fab$l_dna,';')))
+ speclen = mynam.nam$l_ver - out;
+ /* If we just had a directory spec on input, $PARSE "helpfully"
+ * adds an empty name and type for us */
+ if (mynam.nam$l_name == mynam.nam$l_type &&
+ mynam.nam$l_ver == mynam.nam$l_type + 1 &&
+ !(mynam.nam$l_fnb & NAM$M_EXP_NAME))
+ speclen = mynam.nam$l_name - out;
out[speclen] = '\0';
if (haslower) __mystrtolower(out);
ST(0) = sv_2mortal(newSVpv(out, speclen));
+ XSRETURN(1);
}
void
{
char* file = __FILE__;
- newXSproto("VMS::Filespec::rmsexpand",rmsexpand_fromperl,file,"$");
+ newXSproto("VMS::Filespec::rmsexpand",rmsexpand_fromperl,file,"$;$");
newXSproto("VMS::Filespec::vmsify",vmsify_fromperl,file,"$");
newXSproto("VMS::Filespec::unixify",unixify_fromperl,file,"$");
newXSproto("VMS::Filespec::pathify",pathify_fromperl,file,"$");
projects / p5sagit/p5-mst-13.2.git / commitdiff