Commit | Line | Data |
---|---|---|
5f05dabc | 1 | /* VMS::DCLsym - manipulate DCL symbols |
2 | * | |
3 | * Version: 1.0 | |
bd3fa61c | 4 | * Author: Charles Bailey bailey@newman.upenn.edu |
5f05dabc | 5 | * Revised: 17-Aug-1995 |
6 | * | |
7 | * | |
8 | * Revision History: | |
9 | * | |
bd3fa61c | 10 | * 1.0 17-Aug-1995 Charles Bailey bailey@newman.upenn.edu |
5f05dabc | 11 | * original production version |
12 | */ | |
13 | ||
14 | #include <descrip.h> | |
15 | #include <lib$routines.h> | |
16 | #include <libclidef.h> | |
17 | #include <libdef.h> | |
18 | #include <ssdef.h> | |
19 | #include "EXTERN.h" | |
20 | #include "perl.h" | |
21 | #include "XSUB.h" | |
22 | ||
23 | MODULE = VMS::DCLsym PACKAGE = VMS::DCLsym | |
24 | ||
25 | void | |
26 | _getsym(name) | |
27 | SV * name | |
28 | PPCODE: | |
29 | { | |
30 | struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}, | |
31 | valdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0}; | |
32 | STRLEN namlen; | |
33 | int tbltype; | |
34 | unsigned long int retsts; | |
35 | SETERRNO(0,SS$_NORMAL); | |
36 | if (!name) { | |
37 | PUSHs(sv_newmortal()); | |
38 | SETERRNO(EINVAL,LIB$_INVARG); | |
39 | return; | |
40 | } | |
41 | namdsc.dsc$a_pointer = SvPV(name,namlen); | |
42 | namdsc.dsc$w_length = (unsigned short int) namlen; | |
43 | retsts = lib$get_symbol(&namdsc,&valdsc,0,&tbltype); | |
44 | if (retsts & 1) { | |
45 | PUSHs(sv_2mortal(newSVpv(valdsc.dsc$w_length ? | |
46 | valdsc.dsc$a_pointer : "",valdsc.dsc$w_length))); | |
7a30efb0 FC |
47 | EXTEND(sp,2); /* just in case we're at the end of the stack */ |
48 | if (tbltype == LIB$K_CLI_LOCAL_SYM) | |
5f05dabc | 49 | PUSHs(sv_2mortal(newSVpv("LOCAL",5))); |
7a30efb0 | 50 | else |
5f05dabc | 51 | PUSHs(sv_2mortal(newSVpv("GLOBAL",6))); |
5f05dabc | 52 | _ckvmssts(lib$sfree1_dd(&valdsc)); |
53 | } | |
54 | else { | |
a89f9420 | 55 | /* error - we'll return an empty list */ |
5f05dabc | 56 | switch (retsts) { |
57 | case LIB$_NOSUCHSYM: | |
58 | break; /* nobody home */; | |
59 | case LIB$_INVSYMNAM: /* user errors; set errno return undef */ | |
60 | case LIB$_INSCLIMEM: | |
61 | case LIB$_NOCLI: | |
62 | set_errno(EVMSERR); | |
63 | set_vaxc_errno(retsts); | |
64 | break; | |
65 | default: /* bail out */ | |
66 | { _ckvmssts(retsts); } | |
67 | } | |
68 | } | |
69 | } | |
70 | ||
71 | ||
72 | void | |
73 | _setsym(name,val,typestr="LOCAL") | |
74 | SV * name | |
75 | SV * val | |
76 | char * typestr | |
77 | CODE: | |
78 | { | |
79 | struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}, | |
80 | valdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}; | |
81 | STRLEN slen; | |
82 | int type; | |
83 | unsigned long int retsts; | |
84 | SETERRNO(0,SS$_NORMAL); | |
85 | if (!name || !val) { | |
86 | SETERRNO(EINVAL,LIB$_INVARG); | |
87 | XSRETURN_UNDEF; | |
88 | } | |
89 | namdsc.dsc$a_pointer = SvPV(name,slen); | |
90 | namdsc.dsc$w_length = (unsigned short int) slen; | |
91 | valdsc.dsc$a_pointer = SvPV(val,slen); | |
92 | valdsc.dsc$w_length = (unsigned short int) slen; | |
93 | type = strNE(typestr,"GLOBAL") ? | |
94 | LIB$K_CLI_LOCAL_SYM : LIB$K_CLI_GLOBAL_SYM; | |
95 | retsts = lib$set_symbol(&namdsc,&valdsc,&type); | |
96 | if (retsts & 1) { XSRETURN_YES; } | |
97 | else { | |
98 | switch (retsts) { | |
99 | case LIB$_AMBSYMDEF: /* user errors; set errno and return */ | |
100 | case LIB$_INSCLIMEM: | |
101 | case LIB$_INVSYMNAM: | |
102 | case LIB$_NOCLI: | |
103 | set_errno(EVMSERR); | |
104 | set_vaxc_errno(retsts); | |
105 | XSRETURN_NO; | |
106 | break; /* NOTREACHED */ | |
107 | default: /* bail out */ | |
108 | { _ckvmssts(retsts); } | |
109 | } | |
110 | } | |
111 | } | |
112 | ||
113 | ||
114 | void | |
115 | _delsym(name,typestr="LOCAL") | |
116 | SV * name | |
117 | char * typestr | |
118 | CODE: | |
119 | { | |
120 | struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0}; | |
121 | STRLEN slen; | |
122 | int type; | |
123 | unsigned long int retsts; | |
124 | SETERRNO(0,SS$_NORMAL); | |
125 | if (!name || !typestr) { | |
126 | SETERRNO(EINVAL,LIB$_INVARG); | |
127 | XSRETURN_UNDEF; | |
128 | } | |
129 | namdsc.dsc$a_pointer = SvPV(name,slen); | |
130 | namdsc.dsc$w_length = (unsigned short int) slen; | |
131 | type = strNE(typestr,"GLOBAL") ? | |
132 | LIB$K_CLI_LOCAL_SYM : LIB$K_CLI_GLOBAL_SYM; | |
133 | retsts = lib$delete_symbol(&namdsc,&type); | |
134 | if (retsts & 1) { XSRETURN_YES; } | |
135 | else { | |
136 | switch (retsts) { | |
137 | case LIB$_INVSYMNAM: /* user errors; set errno and return */ | |
138 | case LIB$_NOCLI: | |
139 | case LIB$_NOSUCHSYM: | |
140 | set_errno(EVMSERR); | |
141 | set_vaxc_errno(retsts); | |
142 | XSRETURN_NO; | |
143 | break; /* NOTREACHED */ | |
144 | default: /* bail out */ | |
145 | { _ckvmssts(retsts); } | |
146 | } | |
147 | } | |
148 | } | |
149 |