perl 5.002beta2 patch: toke.c
[perl.git] / 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);