mm_createwebservice.sas
Go to the documentation of this file.
1 /**
2  @file mm_createwebservice.sas
3  @brief Create a Web Ready Stored Process
4  @details This macro creates a Type 2 Stored Process with the mm_webout macro
5  (and dependencies) included as pre-code.
6 
7 Usage:
8 
9  %* compile macros ;
10  filename mc url "https://raw.githubusercontent.com/sasjs/core/main/all.sas";
11  %inc mc;
12 
13  %* parmcards lets us write to a text file from open code ;
14  filename ft15f001 temp;
15  parmcards4;
16  %webout(FETCH)
17  %* do some sas, any inputs are now already WORK tables;
18  data example1 example2;
19  set sashelp.class;
20  run;
21  %* send data back;
22  %webout(OPEN)
23  %webout(ARR,example1) * Array format, fast, suitable for large tables ;
24  %webout(OBJ,example2) * Object format, easier to work with ;
25  %webout(CLOSE)
26  ;;;;
27  %mm_createwebservice(path=/Public/app/common,name=appInit,code=ft15f001)
28 
29  For more examples of using these web services with the SASjs Adapter, see:
30  https://github.com/sasjs/adapter#readme
31 
32  @param [in] path= () The full path (in SAS Metadata) where the service
33  will be created
34  @param [in] name= Stored Process name. Avoid spaces - testing has shown that
35  the check to avoid creating multiple STPs in the same folder with the same
36  name does not work when the name contains spaces.
37  @param [in] desc= The description of the service (optional)
38  @param [in] precode= () Space separated list of filerefs, pointing to the
39  code that needs to be attached to the beginning of the service (optional)
40  @param [in] code= (ft15f001) Space seperated fileref(s) of the actual code
41  to be added
42  @param [in] server= (SASApp) The server which will run the STP. Server
43  name or uri is fine.
44  @param [in] mDebug= (0) set to 1 to show debug messages in the log
45  @param [in] replace= (YES) select NO to avoid replacing an existing service
46  in that location
47  @param [in] adapter= (sasjs) the macro uses the sasjs adapter by default.
48  To use another adapter, add a (different) fileref here.
49 
50  <h4> SAS Macros </h4>
51  @li mm_createstp.sas
52  @li mf_getuser.sas
53  @li mm_createfolder.sas
54  @li mm_deletestp.sas
55 
56  @version 9.2
57  @author Allan Bowe
58 
59 **/
60 
61 %macro mm_createwebservice(path=
62  ,name=initService
63  ,precode=
64  ,code=ft15f001
65  ,desc=This stp was created automagically by the mm_createwebservice macro
66  ,mDebug=0
67  ,server=SASApp
68  ,replace=YES
69  ,adapter=sasjs
70 )/*/STORE SOURCE*/;
71 
72 %if &syscc ge 4 %then %do;
73  %put &=syscc - &sysmacroname will not execute in this state;
74  %return;
75 %end;
76 
77 %local mD;
78 %if &mDebug=1 %then %let mD=;
79 %else %let mD=%str(*);
80 %&mD.put Executing mm_createwebservice.sas;
81 %&mD.put _local_;
82 
83 * remove any trailing slash ;
84 %if "%substr(&path,%length(&path),1)" = "/" %then
85  %let path=%substr(&path,1,%length(&path)-1);
86 
87 /**
88  * Add webout macro
89  * These put statements are auto generated - to change the macro, change the
90  * source (mm_webout) and run `build.py`
91  */
92 filename sasjs temp;
93 data _null_;
94  file sasjs lrecl=3000 ;
95  put "/* Created on %sysfunc(datetime(),datetime19.) by %mf_getuser() */";
96 /* WEBOUT BEGIN */
97  put '%macro mp_jsonout(action,ds,jref=_webout,dslabel=,fmt=Y ';
98  put ' ,engine=DATASTEP ';
99  put ' ,missing=NULL ';
100  put ' ,showmeta=N ';
101  put ' ,maxobs=MAX ';
102  put ')/*/STORE SOURCE*/; ';
103  put '%local tempds colinfo fmtds i numcols numobs stmt_obs lastobs optval ';
104  put ' tmpds1 tmpds2 tmpds3 tmpds4; ';
105  put '%let numcols=0; ';
106  put '%if &maxobs ne MAX %then %let stmt_obs=%str(if _n_>&maxobs then stop;); ';
107  put ' ';
108  put '%if &action=OPEN %then %do; ';
109  put ' options nobomfile; ';
110  put ' data _null_;file &jref encoding=''utf-8'' lrecl=200; ';
111  put ' put ''{"PROCESSED_DTTM" : "'' "%sysfunc(datetime(),E8601DT26.6)" ''"''; ';
112  put ' run; ';
113  put '%end; ';
114  put '%else %if (&action=ARR or &action=OBJ) %then %do; ';
115  put ' /* force variable names to always be uppercase in the JSON */ ';
116  put ' options validvarname=upcase; ';
117  put ' /* To avoid issues with _webout on EBI - such as encoding diffs and truncation ';
118  put ' (https://support.sas.com/kb/49/325.html) we use temporary files */ ';
119  put ' filename _sjs1 temp lrecl=200 ; ';
120  put ' data _null_; file _sjs1 encoding=''utf-8''; ';
121  put ' put ", ""%lowcase(%sysfunc(coalescec(&dslabel,&ds)))"":"; ';
122  put ' run; ';
123  put ' /* now write to _webout 1 char at a time */ ';
124  put ' data _null_; ';
125  put ' infile _sjs1 lrecl=1 recfm=n; ';
126  put ' file &jref mod lrecl=1 recfm=n; ';
127  put ' input sourcechar $char1. @@; ';
128  put ' format sourcechar hex2.; ';
129  put ' put sourcechar char1. @@; ';
130  put ' run; ';
131  put ' filename _sjs1 clear; ';
132  put ' ';
133  put ' /* grab col defs */ ';
134  put ' proc contents noprint data=&ds ';
135  put ' out=_data_(keep=name type length format formatl formatd varnum label); ';
136  put ' run; ';
137  put ' %let colinfo=%scan(&syslast,2,.); ';
138  put ' proc sort data=&colinfo; ';
139  put ' by varnum; ';
140  put ' run; ';
141  put ' /* move meta to mac vars */ ';
142  put ' data &colinfo; ';
143  put ' if _n_=1 then call symputx(''numcols'',nobs,''l''); ';
144  put ' set &colinfo end=last nobs=nobs; ';
145  put ' name=upcase(name); ';
146  put ' /* fix formats */ ';
147  put ' if type=2 or type=6 then do; ';
148  put ' typelong=''char''; ';
149  put ' length fmt $49.; ';
150  put ' if format='''' then fmt=cats(''$'',length,''.''); ';
151  put ' else if formatl=0 then fmt=cats(format,''.''); ';
152  put ' else fmt=cats(format,formatl,''.''); ';
153  put ' end; ';
154  put ' else do; ';
155  put ' typelong=''num''; ';
156  put ' if format='''' then fmt=''best.''; ';
157  put ' else if formatl=0 then fmt=cats(format,''.''); ';
158  put ' else if formatd=0 then fmt=cats(format,formatl,''.''); ';
159  put ' else fmt=cats(format,formatl,''.'',formatd); ';
160  put ' end; ';
161  put ' /* 32 char unique name */ ';
162  put ' newname=''sasjs''!!substr(cats(put(md5(name),$hex32.)),1,27); ';
163  put ' ';
164  put ' call symputx(cats(''name'',_n_),name,''l''); ';
165  put ' call symputx(cats(''newname'',_n_),newname,''l''); ';
166  put ' call symputx(cats(''length'',_n_),length,''l''); ';
167  put ' call symputx(cats(''fmt'',_n_),fmt,''l''); ';
168  put ' call symputx(cats(''type'',_n_),type,''l''); ';
169  put ' call symputx(cats(''typelong'',_n_),typelong,''l''); ';
170  put ' call symputx(cats(''label'',_n_),coalescec(label,name),''l''); ';
171  put ' /* overwritten when fmt=Y and a custom format exists in catalog */ ';
172  put ' if typelong=''num'' then call symputx(cats(''fmtlen'',_n_),200,''l''); ';
173  put ' else call symputx(cats(''fmtlen'',_n_),min(32767,ceil((length+10)*1.5)),''l''); ';
174  put ' run; ';
175  put ' ';
176  put ' %let tempds=%substr(_%sysfunc(compress(%sysfunc(uuidgen()),-)),1,32); ';
177  put ' proc sql; ';
178  put ' select count(*) into: lastobs from &ds; ';
179  put ' %if &maxobs ne MAX %then %let lastobs=%sysfunc(min(&lastobs,&maxobs)); ';
180  put ' ';
181  put ' %if &engine=PROCJSON %then %do; ';
182  put ' %if &missing=STRING %then %do; ';
183  put ' %put &sysmacroname: Special Missings not supported in proc json.; ';
184  put ' %put &sysmacroname: Switching to DATASTEP engine; ';
185  put ' %goto datastep; ';
186  put ' %end; ';
187  put ' data &tempds; ';
188  put ' set &ds; ';
189  put ' &stmt_obs; ';
190  put ' %if &fmt=N %then format _numeric_ best32.;; ';
191  put ' /* PRETTY is necessary to avoid line truncation in large files */ ';
192  put ' filename _sjs2 temp lrecl=131068 encoding=''utf-8''; ';
193  put ' proc json out=_sjs2 pretty ';
194  put ' %if &action=ARR %then nokeys ; ';
195  put ' ;export &tempds / nosastags fmtnumeric; ';
196  put ' run; ';
197  put ' /* send back to webout */ ';
198  put ' data _null_; ';
199  put ' infile _sjs2 lrecl=1 recfm=n; ';
200  put ' file &jref mod lrecl=1 recfm=n; ';
201  put ' input sourcechar $char1. @@; ';
202  put ' format sourcechar hex2.; ';
203  put ' put sourcechar char1. @@; ';
204  put ' run; ';
205  put ' filename _sjs2 clear; ';
206  put ' %end; ';
207  put ' %else %if &engine=DATASTEP %then %do; ';
208  put ' %datastep: ';
209  put ' %if %sysfunc(exist(&ds)) ne 1 & %sysfunc(exist(&ds,VIEW)) ne 1 ';
210  put ' %then %do; ';
211  put ' %put &sysmacroname: &ds NOT FOUND!!!; ';
212  put ' %return; ';
213  put ' %end; ';
214  put ' ';
215  put ' %if &fmt=Y %then %do; ';
216  put ' /** ';
217  put ' * Extract format definitions ';
218  put ' * First, by getting library locations from dictionary.formats ';
219  put ' * Then, by exporting the width using proc format ';
220  put ' * Cannot use maxw from sashelp.vformat as not always populated ';
221  put ' * Cannot use fmtinfo() as not supported in all flavours ';
222  put ' */ ';
223  put ' %let tmpds1=%substr(fmtsum%sysfunc(compress(%sysfunc(uuidgen()),-)),1,32); ';
224  put ' %let tmpds2=%substr(cntl%sysfunc(compress(%sysfunc(uuidgen()),-)),1,32); ';
225  put ' %let tmpds3=%substr(cntl%sysfunc(compress(%sysfunc(uuidgen()),-)),1,32); ';
226  put ' %let tmpds4=%substr(col%sysfunc(compress(%sysfunc(uuidgen()),-)),1,32); ';
227  put ' proc sql noprint; ';
228  put ' create table &tmpds1 as ';
229  put ' select cats(libname,''.'',memname) as FMTCAT, ';
230  put ' FMTNAME ';
231  put ' from dictionary.formats ';
232  put ' where fmttype=''F'' and libname is not null ';
233  put ' and fmtname in (select format from &colinfo where format is not null) ';
234  put ' order by 1; ';
235  put ' create table &tmpds2( ';
236  put ' FMTNAME char(32), ';
237  put ' LENGTH num ';
238  put ' ); ';
239  put ' %local catlist cat fmtlist i; ';
240  put ' select distinct fmtcat into: catlist separated by '' '' from &tmpds1; ';
241  put ' %do i=1 %to %sysfunc(countw(&catlist,%str( ))); ';
242  put ' %let cat=%scan(&catlist,&i,%str( )); ';
243  put ' proc sql; ';
244  put ' select distinct fmtname into: fmtlist separated by '' '' ';
245  put ' from &tmpds1 where fmtcat="&cat"; ';
246  put ' proc format lib=&cat cntlout=&tmpds3(keep=fmtname length); ';
247  put ' select &fmtlist; ';
248  put ' run; ';
249  put ' proc sql; ';
250  put ' insert into &tmpds2 select distinct fmtname,length from &tmpds3; ';
251  put ' %end; ';
252  put ' ';
253  put ' proc sql; ';
254  put ' create table &tmpds4 as ';
255  put ' select a.*, b.length as MAXW ';
256  put ' from &colinfo a ';
257  put ' left join &tmpds2 b ';
258  put ' on cats(a.format)=cats(upcase(b.fmtname)) ';
259  put ' order by a.varnum; ';
260  put ' data _null_; ';
261  put ' set &tmpds4; ';
262  put ' if not missing(maxw); ';
263  put ' call symputx( ';
264  put ' cats(''fmtlen'',_n_), ';
265  put ' /* vars need extra padding due to JSON escaping of special chars */ ';
266  put ' min(32767,ceil((max(length,maxw)+10)*1.5)) ';
267  put ' ,''l'' ';
268  put ' ); ';
269  put ' run; ';
270  put ' ';
271  put ' /* configure varlenchk - as we are explicitly shortening the variables */ ';
272  put ' %let optval=%sysfunc(getoption(varlenchk)); ';
273  put ' options varlenchk=NOWARN; ';
274  put ' data _data_(compress=char); ';
275  put ' /* shorten the new vars */ ';
276  put ' length ';
277  put ' %do i=1 %to &numcols; ';
278  put ' &&name&i $&&fmtlen&i ';
279  put ' %end; ';
280  put ' ; ';
281  put ' /* rename on entry */ ';
282  put ' set &ds(rename=( ';
283  put ' %do i=1 %to &numcols; ';
284  put ' &&name&i=&&newname&i ';
285  put ' %end; ';
286  put ' )); ';
287  put ' &stmt_obs; ';
288  put ' ';
289  put ' drop ';
290  put ' %do i=1 %to &numcols; ';
291  put ' &&newname&i ';
292  put ' %end; ';
293  put ' ; ';
294  put ' %do i=1 %to &numcols; ';
295  put ' %if &&typelong&i=num %then %do; ';
296  put ' &&name&i=cats(put(&&newname&i,&&fmt&i)); ';
297  put ' %end; ';
298  put ' %else %do; ';
299  put ' &&name&i=put(&&newname&i,&&fmt&i); ';
300  put ' %end; ';
301  put ' %end; ';
302  put ' if _error_ then do; ';
303  put ' call symputx(''syscc'',1012); ';
304  put ' stop; ';
305  put ' end; ';
306  put ' run; ';
307  put ' %let fmtds=&syslast; ';
308  put ' options varlenchk=&optval; ';
309  put ' %end; ';
310  put ' ';
311  put ' proc format; /* credit yabwon for special null removal */ ';
312  put ' value bart (default=40) ';
313  put ' %if &missing=NULL %then %do; ';
314  put ' ._ - .z = null ';
315  put ' %end; ';
316  put ' %else %do; ';
317  put ' ._ = [quote()] ';
318  put ' . = null ';
319  put ' .a - .z = [quote()] ';
320  put ' %end; ';
321  put ' other = [best.]; ';
322  put ' ';
323  put ' data &tempds; ';
324  put ' attrib _all_ label=''''; ';
325  put ' %do i=1 %to &numcols; ';
326  put ' %if &&typelong&i=char or &fmt=Y %then %do; ';
327  put ' length &&name&i $&&fmtlen&i...; ';
328  put ' format &&name&i $&&fmtlen&i...; ';
329  put ' %end; ';
330  put ' %end; ';
331  put ' %if &fmt=Y %then %do; ';
332  put ' set &fmtds; ';
333  put ' %end; ';
334  put ' %else %do; ';
335  put ' set &ds; ';
336  put ' %end; ';
337  put ' &stmt_obs; ';
338  put ' format _numeric_ bart.; ';
339  put ' %do i=1 %to &numcols; ';
340  put ' %if &&typelong&i=char or &fmt=Y %then %do; ';
341  put ' if findc(&&name&i,''"\''!!''0A0D09000E0F010210111A''x) then do; ';
342  put ' &&name&i=''"''!!trim( ';
343  put ' prxchange(''s/"/\\"/'',-1, /* double quote */ ';
344  put ' prxchange(''s/\x0A/\n/'',-1, /* new line */ ';
345  put ' prxchange(''s/\x0D/\r/'',-1, /* carriage return */ ';
346  put ' prxchange(''s/\x09/\\t/'',-1, /* tab */ ';
347  put ' prxchange(''s/\x00/\\u0000/'',-1, /* NUL */ ';
348  put ' prxchange(''s/\x0E/\\u000E/'',-1, /* SS */ ';
349  put ' prxchange(''s/\x0F/\\u000F/'',-1, /* SF */ ';
350  put ' prxchange(''s/\x01/\\u0001/'',-1, /* SOH */ ';
351  put ' prxchange(''s/\x02/\\u0002/'',-1, /* STX */ ';
352  put ' prxchange(''s/\x10/\\u0010/'',-1, /* DLE */ ';
353  put ' prxchange(''s/\x11/\\u0011/'',-1, /* DC1 */ ';
354  put ' prxchange(''s/\x1A/\\u001A/'',-1, /* SUB */ ';
355  put ' prxchange(''s/\\/\\\\/'',-1,&&name&i) ';
356  put ' )))))))))))))!!''"''; ';
357  put ' end; ';
358  put ' else &&name&i=quote(cats(&&name&i)); ';
359  put ' %end; ';
360  put ' %end; ';
361  put ' run; ';
362  put ' ';
363  put ' filename _sjs3 temp lrecl=131068 ; ';
364  put ' data _null_; ';
365  put ' file _sjs3 encoding=''utf-8''; ';
366  put ' if _n_=1 then put "["; ';
367  put ' set &tempds; ';
368  put ' if _n_>1 then put "," @; put ';
369  put ' %if &action=ARR %then "[" ; %else "{" ; ';
370  put ' %do i=1 %to &numcols; ';
371  put ' %if &i>1 %then "," ; ';
372  put ' %if &action=OBJ %then """&&name&i"":" ; ';
373  put ' "&&name&i"n /* name literal for reserved variable names */ ';
374  put ' %end; ';
375  put ' %if &action=ARR %then "]" ; %else "}" ; ; ';
376  put ' ';
377  put ' /* close out the table */ ';
378  put ' data _null_; ';
379  put ' file _sjs3 mod encoding=''utf-8''; ';
380  put ' put '']''; ';
381  put ' run; ';
382  put ' data _null_; ';
383  put ' infile _sjs3 lrecl=1 recfm=n; ';
384  put ' file &jref mod lrecl=1 recfm=n; ';
385  put ' input sourcechar $char1. @@; ';
386  put ' format sourcechar hex2.; ';
387  put ' put sourcechar char1. @@; ';
388  put ' run; ';
389  put ' filename _sjs3 clear; ';
390  put ' %end; ';
391  put ' ';
392  put ' proc sql; ';
393  put ' drop table &colinfo, &tempds; ';
394  put ' ';
395  put ' %if %substr(&showmeta,1,1)=Y %then %do; ';
396  put ' filename _sjs4 temp lrecl=131068 encoding=''utf-8''; ';
397  put ' data _null_; ';
398  put ' file _sjs4; ';
399  put ' length label $350; ';
400  put ' put ", ""$%lowcase(%sysfunc(coalescec(&dslabel,&ds)))"":{""vars"":{"; ';
401  put ' do i=1 to &numcols; ';
402  put ' name=quote(trim(symget(cats(''name'',i)))); ';
403  put ' format=quote(trim(symget(cats(''fmt'',i)))); ';
404  put ' label=quote(prxchange(''s/\\/\\\\/'',-1,trim(symget(cats(''label'',i))))); ';
405  put ' length=quote(trim(symget(cats(''length'',i)))); ';
406  put ' type=quote(trim(symget(cats(''typelong'',i)))); ';
407  put ' if i>1 then put "," @@; ';
408  put ' put name '':{"format":'' format '',"label":'' label ';
409  put ' '',"length":'' length '',"type":'' type ''}''; ';
410  put ' end; ';
411  put ' put ''}}''; ';
412  put ' run; ';
413  put ' /* send back to webout */ ';
414  put ' data _null_; ';
415  put ' infile _sjs4 lrecl=1 recfm=n; ';
416  put ' file &jref mod lrecl=1 recfm=n; ';
417  put ' input sourcechar $char1. @@; ';
418  put ' format sourcechar hex2.; ';
419  put ' put sourcechar char1. @@; ';
420  put ' run; ';
421  put ' filename _sjs4 clear; ';
422  put ' %end; ';
423  put '%end; ';
424  put ' ';
425  put '%else %if &action=CLOSE %then %do; ';
426  put ' data _null_; file &jref encoding=''utf-8'' mod ; ';
427  put ' put "}"; ';
428  put ' run; ';
429  put '%end; ';
430  put '%mend mp_jsonout; ';
431  put ' ';
432  put '%macro mf_getuser( ';
433  put ')/*/STORE SOURCE*/; ';
434  put ' %local user; ';
435  put ' ';
436  put ' %if %symexist(_sasjs_username) %then %let user=&_sasjs_username; ';
437  put ' %else %if %symexist(SYS_COMPUTE_SESSION_OWNER) %then %do; ';
438  put ' %let user=&SYS_COMPUTE_SESSION_OWNER; ';
439  put ' %end; ';
440  put ' %else %if %symexist(_metaperson) %then %do; ';
441  put ' %if %length(&_metaperson)=0 %then %let user=&sysuserid; ';
442  put ' /* sometimes SAS will add @domain extension - remove for consistency */ ';
443  put ' /* but be sure to quote in case of usernames with commas */ ';
444  put ' %else %let user=%unquote(%scan(%quote(&_metaperson),1,@)); ';
445  put ' %end; ';
446  put ' %else %let user=&sysuserid; ';
447  put ' ';
448  put ' %quote(&user) ';
449  put ' ';
450  put '%mend mf_getuser; ';
451  put '%macro mm_webout(action,ds,dslabel=,fref=_webout,fmt=N,missing=NULL ';
452  put ' ,showmeta=N,maxobs=MAX,workobs=0 ';
453  put '); ';
454  put '%global _webin_file_count _webin_fileref1 _webin_name1 _program _debug ';
455  put ' sasjs_tables; ';
456  put '%local i tempds jsonengine; ';
457  put ' ';
458  put '/* see https://github.com/sasjs/core/issues/41 */ ';
459  put '%if "%upcase(&SYSENCODING)" ne "UTF-8" %then %let jsonengine=PROCJSON; ';
460  put '%else %let jsonengine=DATASTEP; ';
461  put ' ';
462  put ' ';
463  put '%if &action=FETCH %then %do; ';
464  put ' %if %str(&_debug) ge 131 %then %do; ';
465  put ' options mprint notes mprintnest; ';
466  put ' %end; ';
467  put ' %let _webin_file_count=%eval(&_webin_file_count+0); ';
468  put ' /* now read in the data */ ';
469  put ' %do i=1 %to &_webin_file_count; ';
470  put ' %if &_webin_file_count=1 %then %do; ';
471  put ' %let _webin_fileref1=&_webin_fileref; ';
472  put ' %let _webin_name1=&_webin_name; ';
473  put ' %end; ';
474  put ' data _null_; ';
475  put ' infile &&_webin_fileref&i termstr=crlf; ';
476  put ' input; ';
477  put ' call symputx(''input_statement'',_infile_); ';
478  put ' putlog "&&_webin_name&i input statement: " _infile_; ';
479  put ' stop; ';
480  put ' data &&_webin_name&i; ';
481  put ' infile &&_webin_fileref&i firstobs=2 dsd termstr=crlf encoding=''utf-8''; ';
482  put ' input &input_statement; ';
483  put ' %if %str(&_debug) ge 131 %then %do; ';
484  put ' if _n_<20 then putlog _infile_; ';
485  put ' %end; ';
486  put ' run; ';
487  put ' %let sasjs_tables=&sasjs_tables &&_webin_name&i; ';
488  put ' %end; ';
489  put '%end; ';
490  put ' ';
491  put '%else %if &action=OPEN %then %do; ';
492  put ' /* fix encoding */ ';
493  put ' OPTIONS NOBOMFILE; ';
494  put ' ';
495  put ' /** ';
496  put ' * check xengine type to avoid the below err message: ';
497  put ' * > Function is only valid for filerefs using the CACHE access method. ';
498  put ' */ ';
499  put ' data _null_; ';
500  put ' set sashelp.vextfl(where=(fileref="_WEBOUT")); ';
501  put ' if xengine=''STREAM'' then do; ';
502  put ' rc=stpsrv_header(''Content-type'',"text/html; encoding=utf-8"); ';
503  put ' end; ';
504  put ' run; ';
505  put ' ';
506  put ' /* setup json */ ';
507  put ' data _null_;file &fref encoding=''utf-8''; ';
508  put ' %if %str(&_debug) ge 131 %then %do; ';
509  put ' put ''>>weboutBEGIN<<''; ';
510  put ' %end; ';
511  put ' put ''{"SYSDATE" : "'' "&SYSDATE" ''"''; ';
512  put ' put '',"SYSTIME" : "'' "&SYSTIME" ''"''; ';
513  put ' run; ';
514  put ' ';
515  put '%end; ';
516  put ' ';
517  put '%else %if &action=ARR or &action=OBJ %then %do; ';
518  put ' %mp_jsonout(&action,&ds,dslabel=&dslabel,fmt=&fmt,jref=&fref ';
519  put ' ,engine=&jsonengine,missing=&missing,showmeta=&showmeta,maxobs=&maxobs ';
520  put ' ) ';
521  put '%end; ';
522  put '%else %if &action=CLOSE %then %do; ';
523  put ' /* To avoid issues with _webout on EBI we use a temporary file */ ';
524  put ' filename _sjsref temp lrecl=131068; ';
525  put ' %if %str(&workobs) > 0 %then %do; ';
526  put ' /* if debug mode, send back first XX records of each work table also */ ';
527  put ' data;run;%let tempds=%scan(&syslast,2,.); ';
528  put ' ods output Members=&tempds; ';
529  put ' proc datasets library=WORK memtype=data; ';
530  put ' %local wtcnt;%let wtcnt=0; ';
531  put ' data _null_; ';
532  put ' set &tempds; ';
533  put ' if not (upcase(name) =:"DATA"); /* ignore temp datasets */ ';
534  put ' i+1; ';
535  put ' call symputx(cats(''wt'',i),name,''l''); ';
536  put ' call symputx(''wtcnt'',i,''l''); ';
537  put ' data _null_; file _sjsref mod encoding=''utf-8''; ';
538  put ' put ",""WORK"":{"; ';
539  put ' %do i=1 %to &wtcnt; ';
540  put ' %let wt=&&wt&i; ';
541  put ' data _null_; file _sjsref mod encoding=''utf-8''; ';
542  put ' dsid=open("WORK.&wt",''is''); ';
543  put ' nlobs=attrn(dsid,''NLOBS''); ';
544  put ' nvars=attrn(dsid,''NVARS''); ';
545  put ' rc=close(dsid); ';
546  put ' if &i>1 then put '',''@; ';
547  put ' put " ""&wt"" : {"; ';
548  put ' put ''"nlobs":'' nlobs; ';
549  put ' put '',"nvars":'' nvars; ';
550  put ' %mp_jsonout(OBJ,&wt,jref=_sjsref,dslabel=first10rows,showmeta=Y ';
551  put ' ,maxobs=&workobs ';
552  put ' ) ';
553  put ' data _null_; file _sjsref mod encoding=''utf-8''; ';
554  put ' put "}"; ';
555  put ' %end; ';
556  put ' data _null_; file _sjsref mod encoding=''utf-8''; ';
557  put ' put "}"; ';
558  put ' run; ';
559  put ' %end; ';
560  put ' /* close off json */ ';
561  put ' data _null_;file _sjsref mod encoding=''utf-8''; ';
562  put ' length SYSPROCESSNAME syserrortext syswarningtext autoexec $512; ';
563  put ' put ",""_DEBUG"" : ""&_debug"" "; ';
564  put ' _METAUSER=quote(trim(symget(''_METAUSER''))); ';
565  put ' put ",""_METAUSER"": " _METAUSER; ';
566  put ' _METAPERSON=quote(trim(symget(''_METAPERSON''))); ';
567  put ' put '',"_METAPERSON": '' _METAPERSON; ';
568  put ' _PROGRAM=quote(trim(resolve(symget(''_PROGRAM'')))); ';
569  put ' put '',"_PROGRAM" : '' _PROGRAM ; ';
570  put ' autoexec=quote(urlencode(trim(getoption(''autoexec'')))); ';
571  put ' put '',"AUTOEXEC" : '' autoexec; ';
572  put ' put ",""MF_GETUSER"" : ""%mf_getuser()"" "; ';
573  put ' put ",""SYSCC"" : ""&syscc"" "; ';
574  put ' put ",""SYSENCODING"" : ""&sysencoding"" "; ';
575  put ' syserrortext=cats(symget(''syserrortext'')); ';
576  put ' if findc(syserrortext,''"\''!!''0A0D09000E0F010210111A''x) then do; ';
577  put ' syserrortext=''"''!!trim( ';
578  put ' prxchange(''s/"/\\"/'',-1, /* double quote */ ';
579  put ' prxchange(''s/\x0A/\n/'',-1, /* new line */ ';
580  put ' prxchange(''s/\x0D/\r/'',-1, /* carriage return */ ';
581  put ' prxchange(''s/\x09/\\t/'',-1, /* tab */ ';
582  put ' prxchange(''s/\x00/\\u0000/'',-1, /* NUL */ ';
583  put ' prxchange(''s/\x0E/\\u000E/'',-1, /* SS */ ';
584  put ' prxchange(''s/\x0F/\\u000F/'',-1, /* SF */ ';
585  put ' prxchange(''s/\x01/\\u0001/'',-1, /* SOH */ ';
586  put ' prxchange(''s/\x02/\\u0002/'',-1, /* STX */ ';
587  put ' prxchange(''s/\x10/\\u0010/'',-1, /* DLE */ ';
588  put ' prxchange(''s/\x11/\\u0011/'',-1, /* DC1 */ ';
589  put ' prxchange(''s/\x1A/\\u001A/'',-1, /* SUB */ ';
590  put ' prxchange(''s/\\/\\\\/'',-1,syserrortext) ';
591  put ' )))))))))))))!!''"''; ';
592  put ' end; ';
593  put ' else syserrortext=cats(''"'',syserrortext,''"''); ';
594  put ' put '',"SYSERRORTEXT" : '' syserrortext; ';
595  put ' put ",""SYSHOSTNAME"" : ""&syshostname"" "; ';
596  put ' put ",""SYSPROCESSID"" : ""&SYSPROCESSID"" "; ';
597  put ' put ",""SYSPROCESSMODE"" : ""&SYSPROCESSMODE"" "; ';
598  put ' SYSPROCESSNAME=quote(urlencode(cats(SYSPROCESSNAME))); ';
599  put ' put ",""SYSPROCESSNAME"" : " SYSPROCESSNAME; ';
600  put ' put ",""SYSJOBID"" : ""&sysjobid"" "; ';
601  put ' put ",""SYSSCPL"" : ""&sysscpl"" "; ';
602  put ' put ",""SYSSITE"" : ""&syssite"" "; ';
603  put ' put ",""SYSUSERID"" : ""&sysuserid"" "; ';
604  put ' sysvlong=quote(trim(symget(''sysvlong''))); ';
605  put ' put '',"SYSVLONG" : '' sysvlong; ';
606  put ' syswarningtext=cats(symget(''syswarningtext'')); ';
607  put ' if findc(syswarningtext,''"\''!!''0A0D09000E0F010210111A''x) then do; ';
608  put ' syswarningtext=''"''!!trim( ';
609  put ' prxchange(''s/"/\\"/'',-1, /* double quote */ ';
610  put ' prxchange(''s/\x0A/\n/'',-1, /* new line */ ';
611  put ' prxchange(''s/\x0D/\r/'',-1, /* carriage return */ ';
612  put ' prxchange(''s/\x09/\\t/'',-1, /* tab */ ';
613  put ' prxchange(''s/\x00/\\u0000/'',-1, /* NUL */ ';
614  put ' prxchange(''s/\x0E/\\u000E/'',-1, /* SS */ ';
615  put ' prxchange(''s/\x0F/\\u000F/'',-1, /* SF */ ';
616  put ' prxchange(''s/\x01/\\u0001/'',-1, /* SOH */ ';
617  put ' prxchange(''s/\x02/\\u0002/'',-1, /* STX */ ';
618  put ' prxchange(''s/\x10/\\u0010/'',-1, /* DLE */ ';
619  put ' prxchange(''s/\x11/\\u0011/'',-1, /* DC1 */ ';
620  put ' prxchange(''s/\x1A/\\u001A/'',-1, /* SUB */ ';
621  put ' prxchange(''s/\\/\\\\/'',-1,syswarningtext) ';
622  put ' )))))))))))))!!''"''; ';
623  put ' end; ';
624  put ' else syswarningtext=cats(''"'',syswarningtext,''"''); ';
625  put ' put '',"SYSWARNINGTEXT" : '' syswarningtext; ';
626  put ' put '',"END_DTTM" : "'' "%sysfunc(datetime(),E8601DT26.6)" ''" ''; ';
627  put ' length memsize $32; ';
628  put ' memsize="%sysfunc(INPUTN(%sysfunc(getoption(memsize)), best.),sizekmg.)"; ';
629  put ' memsize=quote(cats(memsize)); ';
630  put ' put '',"MEMSIZE" : '' memsize; ';
631  put ' put "}" @; ';
632  put ' %if %str(&_debug) ge 131 %then %do; ';
633  put ' put ''>>weboutEND<<''; ';
634  put ' %end; ';
635  put ' run; ';
636  put ' /* now write to _webout 1 char at a time */ ';
637  put ' data _null_; ';
638  put ' infile _sjsref lrecl=1 recfm=n; ';
639  put ' file &fref mod lrecl=1 recfm=n; ';
640  put ' input sourcechar $char1. @@; ';
641  put ' format sourcechar hex2.; ';
642  put ' put sourcechar char1. @@; ';
643  put ' run; ';
644  put ' filename _sjsref clear; ';
645  put ' ';
646  put '%end; ';
647  put ' ';
648  put '%mend mm_webout; ';
649 /* WEBOUT END */
650  put '%macro webout(action,ds,dslabel=,fmt=,missing=NULL,showmeta=NO';
651  put ' ,maxobs=MAX';
652  put ');';
653  put ' %mm_webout(&action,ds=&ds,dslabel=&dslabel,fmt=&fmt,missing=&missing';
654  put ' ,showmeta=&showmeta,maxobs=&maxobs';
655  put ' )';
656  put '%mend;';
657 run;
658 
659 /* add precode and code */
660 %local work tmpfile;
661 %let work=%sysfunc(pathname(work));
662 %let tmpfile=__mm_createwebservice.temp;
663 %local x fref freflist mod;
664 %let freflist= &adapter &precode &code ;
665 %do x=1 %to %sysfunc(countw(&freflist));
666  %if &x>1 %then %let mod=mod;
667 
668  %let fref=%scan(&freflist,&x);
669  %&mD.put &sysmacroname: adding &fref;
670  data _null_;
671  file "&work/&tmpfile" lrecl=3000 &mod;
672  infile &fref;
673  input;
674  put _infile_;
675  run;
676 %end;
677 
678 /* create the metadata folder if not already there */
679 %mm_createfolder(path=&path)
680 %if &syscc ge 4 %then %return;
681 
682 %if %upcase(&replace)=YES %then %do;
683  %mm_deletestp(target=&path/&name)
684 %end;
685 
686 /* create the web service */
687 %mm_createstp(stpname=&name
688  ,filename=&tmpfile
689  ,directory=&work
690  ,tree=&path
691  ,stpdesc=&desc
692  ,mDebug=&mdebug
693  ,server=&server
694  ,stptype=2)
695 
696 /* find the web app url */
697 %local url;
698 %let url=localhost/SASStoredProcess;
699 data _null_;
700  length url $128;
701  rc=METADATA_GETURI("Stored Process Web App",url);
702  if rc=0 then call symputx('url',url,'l');
703 run;
704 
705 %put &sysmacroname: STP &name successfully created in &path;
706 %put Check it out here:;
707 %put ;%put ;%put ;
708 %put &url?_PROGRAM=&path/&name;
709 %put ;%put ;%put ;
710 
711 %mend mm_createwebservice;