diff options
Diffstat (limited to 'vms/ext/VMS')
-rw-r--r-- | vms/ext/VMS/stdio/Makefile.PL | 3 | ||||
-rw-r--r-- | vms/ext/VMS/stdio/stdio.pm | 78 | ||||
-rw-r--r-- | vms/ext/VMS/stdio/stdio.xs | 109 |
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); |