vms/ext/VMS/stdio/stdio.xs

   1 /* VMS::stdio - VMS extensions to stdio routines
   2  *
   3  * Version:  1.1
   4  * Author:   Charles Bailey  bailey@genetics.upenn.edu
   5  * Revised:  09-Mar-1995
   6  *
   7  *
   8  * Revision History:
   9  *
  10  * 1.0  29-Nov-1994  Charles Bailey  bailey@genetics.upenn.edu
  11  *      original version - vmsfopen
  12  * 1.1  09-Mar-1995  Charles Bailey  bailey@genetics.upenn.edu
  13  *      changed calling sequence to return FH/undef - like POSIX::open
  14  *      added fgetname and tmpnam
  15  */
  16
  17 #include "EXTERN.h"
  18 #include "perl.h"
  19 #include "XSUB.h"
  20
  21 /* Use type for FILE * from Perl's XSUB typemap.  This is a bit
  22  * of a hack, since all Perl filehandles using this type will permit
  23  * both read & write operations, but it saves having to write the PPCODE
  24  * directly for updating the Perl filehandles.
  25  */
  26 typedef FILE * InOutStream;
  27
  28 MODULE = VMS::stdio  PACKAGE = VMS::stdio
  29
  30 void
  31 vmsfopen(name,...)
  32         char *  name
  33         CODE:
  34             char *args[8],mode[5] = {'r','\0','\0','\0','\0'}, c;
  35             register int i, myargc;
  36             FILE *fp;
  37             if (items > 9) {
  38               croak("File::VMSfopen::vmsfopen - too many args");
  39             }
  40             /* First, set up name and mode args from perl's string */
  41             if (*name == '+') {
  42               mode[1] = '+';
  43               name++;
  44             }
  45             if (*name == '>') {
  46               if (*(name+1) == '>') *mode = 'a', name += 2;
  47               else *mode = 'w',  name++;
  48             }
  49             else if (*name == '<') name++;
  50             myargc = items - 1;
  51             for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),na);
  52             /* This hack brought to you by C's opaque arglist management */
  53             switch (myargc) {
  54               case 0:
  55                 fp = fopen(name,mode);
  56                 break;
  57               case 1:
  58                 fp = fopen(name,mode,args[0]);
  59                 break;
  60               case 2:
  61                 fp = fopen(name,mode,args[0],args[1]);
  62                 break;
  63               case 3:
  64                 fp = fopen(name,mode,args[0],args[1],args[2]);
  65                 break;
  66               case 4:
  67                 fp = fopen(name,mode,args[0],args[1],args[2],args[3]);
  68                 break;
  69               case 5:
  70                 fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4]);
  71                 break;
  72               case 6:
  73                 fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5]);
  74                 break;
  75               case 7:
  76                 fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6]);
  77                 break;
  78               case 8:
  79                 fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6],args[7]);
  80                 break;
  81             }
  82             ST(0) = sv_newmortal();
  83             if (fp != NULL) {
  84                GV *gv = newGVgen("VMS::stdio");
  85                c = mode[0]; name = mode;
  86                if (mode[1])  *(name++) = '+';
  87                if (c == 'r') *(name++) = '<';
  88                else {
  89                  *(name++) = '>';
  90                  if (c == 'a') *(name++) = '>';
  91                }
  92                *(name++) = '&';
  93                if (do_open(gv,mode,name - mode,fp))
  94                  sv_setsv(ST(0),newRV((SV*)gv));
  95             }
  96
  97 char *
  98 fgetname(fp)
  99         FILE *  fp
 100         CODE:
 101           char fname[257];
 102           ST(0) = sv_newmortal();
 103           if (fgetname(fp,fname) != NULL) sv_setpv(ST(0),fname);
 104
 105 char *
 106 tmpnam()
 107         CODE:
 108           char fname[L_tmpnam];
 109           ST(0) = sv_newmortal();
 110           if (tmpnam(fname) != NULL) sv_setpv(ST(0),fname);