Production Ready Macros for SAS Application Developers
https://github.com/sasjs/core
mm_getstpcode.sas
Go to the documentation of this file.
1 /**
2  @file
3  @brief Writes the code of an to an external file, or the log if none provided
4  @details Get the
5 
6  usage:
7 
8  %mm_getstpcode(tree=/some/meta/path
9  ,name=someSTP
10  ,outloc=/some/unquoted/filename.ext
11  )
12 
13  @param tree= The metadata path of the Stored Process (can also contain name)
14  @param name= Stored Process name. Leave blank if included above.
15  @param outloc= full and unquoted path to the desired text file. This will be
16  overwritten if it already exists. If not provided, the code will be written
17  to the log.
18 
19  @author Allan Bowe
20 
21 **/
22 
23 %macro mm_getstpcode(
24  tree=/User Folders/sasdemo/somestp
25  ,name=
26  ,outloc=
27  ,mDebug=1
28  );
29 
30 %local mD;
31 %if &mDebug=1 %then %let mD=;
32 %else %let mD=%str(*);
33 %&mD.put Executing &sysmacroname..sas;
34 %&mD.put _local_;
35 
36 %if %length(&name)>0 %then %let name=/&name;
37 
38 /* first, check if STP exists */
39 %local tsuri;
40 %let tsuri=stopifempty ;
41 
42 data _null_;
43  format type uri tsuri value $200.;
44  call missing (of _all_);
45  path="&tree&name(StoredProcess)";
46  /* first, find the STP ID */
47  if metadata_pathobj("",path,"StoredProcess",type,uri)>0 then do;
48  /* get sourcecode */
49  cnt=1;
50  do while (metadata_getnasn(uri,"Notes",cnt,tsuri)>0);
51  rc=metadata_getattr(tsuri,"Name",value);
52  put tsuri= value=;
53  if value="SourceCode" then do;
54  /* found it! */
55  rc=metadata_getattr(tsuri,"Id",value);
56  call symputx('tsuri',value,'l');
57  stop;
58  end;
59  cnt+1;
60  end;
61  end;
62  else put (_all_)(=);
63 run;
64 
65 %if &tsuri=stopifempty %then %do;
66  %put %str(WARN)ING: &tree&name.(StoredProcess) not found!;
67  %return;
68 %end;
69 
70 
71 /**
72  * Now we can extract the textstore
73  */
74 filename __getdoc temp lrecl=10000000;
75 proc metadata
76  in="<GetMetadata><Reposid>$METAREPOSITORY</Reposid>
77  <Metadata><TextStore Id='&tsuri'/></Metadata>
78  <Ns>SAS</Ns><Flags>1</Flags><Options/></GetMetadata>"
79  out=__getdoc ;
80 run;
81 
82 /* find the beginning of the text */
83 %local start;
84 data _null_;
85  infile __getdoc lrecl=10000;
86  input;
87  start=index(_infile_,'StoredText="');
88  if start then do;
89  call symputx("start",start+11);
90  *putlog '"' _infile_ '"';
91  end;
92  stop;
93 
94 %local outeng;
95 %if %length(&outloc)=0 %then %let outeng=TEMP;
96 %else %let outeng="&outloc";
97 /* read the content, byte by byte, resolving escaped chars */
98 filename __outdoc &outeng lrecl=100000;
99 data _null_;
100  length filein 8 fileid 8;
101  filein = fopen("__getdoc","I",1,"B");
102  fileid = fopen("__outdoc","O",1,"B");
103  rec = "20"x;
104  length entity $6;
105  do while(fread(filein)=0);
106  x+1;
107  if x>&start then do;
108  rc = fget(filein,rec,1);
109  if rec='"' then leave;
110  else if rec="&" then do;
111  entity=rec;
112  do until (rec=";");
113  if fread(filein) ne 0 then goto getout;
114  rc = fget(filein,rec,1);
115  entity=cats(entity,rec);
116  end;
117  select (entity);
118  when ('&amp;' ) rec='&' ;
119  when ('&lt;' ) rec='<' ;
120  when ('&gt;' ) rec='>' ;
121  when ('&apos;') rec="'" ;
122  when ('&quot;') rec='"' ;
123  when ('&#x0a;') rec='0A'x;
124  when ('&#x0d;') rec='0D'x;
125  when ('&#36;' ) rec='$' ;
126  when ('&#x09;') rec='09'x;
127  otherwise putlog "%str(WARN)ING: missing value for " entity=;
128  end;
129  rc =fput(fileid, substr(rec,1,1));
130  rc =fwrite(fileid);
131  end;
132  else do;
133  rc =fput(fileid,rec);
134  rc =fwrite(fileid);
135  end;
136  end;
137  end;
138  getout:
139  rc=fclose(filein);
140  rc=fclose(fileid);
141 run;
142 
143 %if &outeng=TEMP %then %do;
144  data _null_;
145  infile __outdoc lrecl=32767 end=last;
146  input;
147  if _n_=1 then putlog '>>stpcodeBEGIN<<';
148  putlog _infile_;
149  if last then putlog '>>stpcodeEND<<';
150  run;
151 %end;
152 
153 filename __getdoc clear;
154 filename __outdoc clear;
155 
156 %mend;