1 /* VMS::stdio - VMS extensions to stdio routines
4 * Author: Charles Bailey bailey@genetics.upenn.edu
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
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.
26 typedef FILE * InOutStream;
28 MODULE = VMS::stdio PACKAGE = VMS::stdio
34 char *args[8],mode[5] = {'r','\0','\0','\0','\0'}, c;
35 register int i, myargc;
38 croak("File::VMSfopen::vmsfopen - too many args");
40 /* First, set up name and mode args from perl's string */
46 if (*(name+1) == '>') *mode = 'a', name += 2;
47 else *mode = 'w', name++;
49 else if (*name == '<') name++;
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 */
55 fp = fopen(name,mode);
58 fp = fopen(name,mode,args[0]);
61 fp = fopen(name,mode,args[0],args[1]);
64 fp = fopen(name,mode,args[0],args[1],args[2]);
67 fp = fopen(name,mode,args[0],args[1],args[2],args[3]);
70 fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4]);
73 fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5]);
76 fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6]);
79 fp = fopen(name,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6],args[7]);
82 ST(0) = sv_newmortal();
84 GV *gv = newGVgen("VMS::stdio");
85 c = mode[0]; name = mode;
86 if (mode[1]) *(name++) = '+';
87 if (c == 'r') *(name++) = '<';
90 if (c == 'a') *(name++) = '>';
93 if (do_open(gv,mode,name - mode,fp))
94 sv_setsv(ST(0),newRV((SV*)gv));
102 ST(0) = sv_newmortal();
103 if (fgetname(fp,fname) != NULL) sv_setpv(ST(0),fname);
108 char fname[L_tmpnam];
109 ST(0) = sv_newmortal();
110 if (tmpnam(fname) != NULL) sv_setpv(ST(0),fname);