summaryrefslogtreecommitdiff
path: root/vms/ext/VMS
diff options
context:
space:
mode:
Diffstat (limited to 'vms/ext/VMS')
-rw-r--r--vms/ext/VMS/stdio/Makefile.PL3
-rw-r--r--vms/ext/VMS/stdio/stdio.pm78
-rw-r--r--vms/ext/VMS/stdio/stdio.xs109
3 files changed, 190 insertions, 0 deletions
diff --git a/vms/ext/VMS/stdio/Makefile.PL b/vms/ext/VMS/stdio/Makefile.PL
new file mode 100644
index 0000000000..d6683b4af6
--- /dev/null
+++ b/vms/ext/VMS/stdio/Makefile.PL
@@ -0,0 +1,3 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile( 'VERSION' => '1.0' );
diff --git a/vms/ext/VMS/stdio/stdio.pm b/vms/ext/VMS/stdio/stdio.pm
new file mode 100644
index 0000000000..d8b4ec21ec
--- /dev/null
+++ b/vms/ext/VMS/stdio/stdio.pm
@@ -0,0 +1,78 @@
+# VMS::stdio - VMS extensions to Perl's stdio calls
+#
+# Author: Charles Bailey bailey@genetics.upenn.edu
+# Version: 1.0
+# Revised: 29-Nov-1994
+#
+# Revision History:
+# 1.0 29-Nov-1994 Charles Bailey bailey@genetics.upenn.edu
+# original version
+# 1.1 09-Mar-1995 Charles Bailey bailey@genetics.upenn.edu
+# changed calling sequence to return FH/undef - like POSIX::open
+# added fgetname and tmpnam
+
+=head1 NAME
+
+VMS::stdio
+
+=head1 SYNOPSIS
+
+use VMS::stdio;
+$name = fgetname(FH);
+$uniquename = &tmpnam;
+$fh = vmsfopen("my.file","rfm=var","alq=100",...) or die $!;
+
+=head1 DESCRIPTION
+
+This package gives Perl scripts access to VMS extensions to the
+C stdio routines, such as optional arguments to C<fopen()>.
+The specific routines are described below.
+
+=head2 fgetname
+
+The C<fgetname> function returns the file specification associated
+with a Perl FileHandle. If an error occurs, it returns C<undef>.
+
+=head2 tmpnam
+
+The C<tmpnam> function returns a unique string which can be used
+as a filename when creating temporary files. If, for some
+reason, it is unable to generate a name, it returns C<undef>.
+
+=head2 vmsfopen
+
+The C<vmsfopen> function provides access to the VMS CRTL
+C<fopen()> function. 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
+file name. These arguments should be strings which specify
+optional file characteristics as allowed by the CRTL C<fopen()>
+routine. (See the CRTL reference manual for details.)
+
+You can use the FileHandle returned by C<vmsfopen> just as you
+would any other Perl FileHandle.
+
+C<vmsfopen> is a temporary solution to problems which arise in
+handling VMS-specific file formats; in the long term, we hope to
+provide more transparent access to VMS file I/O through routines
+which replace standard Perl C<open> function, or through tied
+FileHandles. When this becomes possible, C<vmsfopen> may be
+replaced.
+
+=head1 REVISION
+
+This document was last revised on 09-Mar-1995, for Perl 5.001.
+
+=cut
+
+package VMS::stdio;
+
+require DynaLoader;
+require Exporter;
+
+@ISA = qw( Exporter DynaLoader);
+@EXPORT = qw( &fgetname &tmpfile &tmpnam &vmsfopen );
+
+bootstrap VMS::stdio;
+1;
diff --git a/vms/ext/VMS/stdio/stdio.xs b/vms/ext/VMS/stdio/stdio.xs
new file mode 100644
index 0000000000..367f489bf5
--- /dev/null
+++ b/vms/ext/VMS/stdio/stdio.xs
@@ -0,0 +1,109 @@
+/* VMS::stdio - VMS extensions to stdio routines
+ *
+ * Version: 1.1
+ * Author: Charles Bailey bailey@genetics.upenn.edu
+ * Revised: 09-Mar-1995
+ *
+ *
+ * Revision History:
+ *
+ * 1.0 29-Nov-1994 Charles Bailey bailey@genetics.upenn.edu
+ * original version - vmsfopen
+ * 1.1 09-Mar-1995 Charles Bailey bailey@genetics.upenn.edu
+ * changed calling sequence to return FH/undef - like POSIX::open
+ * added fgetname and tmpnam
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* Use type for FILE * from Perl's XSUB typemap. This is a bit
+ * of a hack, since all Perl filehandles using this type will permit
+ * both read & write operations, but it saves to write the PPCODE
+ * directly for updating the Perl filehandles.
+ */
+typedef FILE * InOutStream;
+
+MODULE = VMS::stdio PACKAGE = VMS::stdio
+
+void
+vmsfopen(name,...)
+ char * name
+ CODE:
+ char *args[8],mode[5] = {'r','\0','\0','\0','\0'}, c;
+ register int i, myargc;
+ FILE *fp;
+ if (items > 9) {
+ croak("File::VMSfopen::vmsfopen - too many args");
+ }
+ /* First, set up name and mode args from perl's string */
+ if (*name == '+') {
+ mode[1] = '+';
+ name++;
+ }
+ if (*name == '>') {
+ if (*(name+1) == '>') *mode = 'a', name += 2;
+ else *mode = 'w', name++;
+ }
+ myargc = items - 1;
+ for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),na);
+ /* This hack brought to you by C's opaque arglist management */
+ switch (myargc) {
+ case 0:
+ fp = fopen(name,mode);
+ break;
+ case 1:
+ fp = fopen(name,mode,args[0]);
+ break;
+ case 2:
+ fp = fopen(name,mode,args[0],args[1]);
+ break;
+ case 3:
+ fp = fopen(name,mode,args[0],args[1],args[2]);
+ break;
+ case 4:
+ fp = fopen(name,mode,args[0],args[1],args[2],args[3]);
+ break;
+ case 5:
+ fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4]);
+ break;
+ case 6:
+ fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5]);
+ break;
+ case 7:
+ fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6]);
+ break;
+ case 8:
+ fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6],args[7]);
+ break;
+ }
+ ST(0) = sv_newmortal();
+ if (fp != NULL) {
+ GV *gv = newGVgen("VMS::stdio");
+ c = mode[0]; name = mode;
+ if (mode[1]) *(name++) = '+';
+ if (c == 'r') *(name++) = '<';
+ else {
+ *(name++) = '>';
+ if (c == 'a') *(name++) = '>';
+ }
+ *(name++) = '&';
+ if (do_open(gv,mode,name - mode,fp))
+ sv_setsv(ST(0),newRV((SV*)gv));
+ }
+
+char *
+fgetname(fp)
+ FILE * fp
+ CODE:
+ char fname[257];
+ ST(0) = sv_newmortal();
+ if (fgetname(fp,fname) != NULL) sv_setpv(ST(0),fname);
+
+char *
+tmpnam()
+ CODE:
+ char fname[L_tmpnam];
+ ST(0) = sv_newmortal();
+ if (tmpnam(fname) != NULL) sv_setpv(ST(0),fname);