Production Ready Macros for SAS Application Developers
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
14  @param name= Stored Process name.
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
25  ,name=myNote
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 /* first, check if STP exists */
37 %local tsuri;
38 %let tsuri=stopifempty ;
39 
40 data _null_;
41  format type uri tsuri value $200.;
42  call missing (of _all_);
43  path="&tree/&name(StoredProcess)";
44  /* first, find the STP ID */
45  if metadata_pathobj("",path,"StoredProcess",type,uri)>0 then do;
46  /* get sourcecode */
47  cnt=1;
48  do while (metadata_getnasn(uri,"Notes",cnt,tsuri)>0);
49  rc=metadata_getattr(tsuri,"Name",value);
50  put tsuri= value=;
51  if value="SourceCode" then do;
52  /* found it! */
53  rc=metadata_getattr(tsuri,"Id",value);
54  call symputx('tsuri',value,'l');
55  stop;
56  end;
57  cnt+1;
58  end;
59  end;
60  else put (_all_)(=);
61 run;
62 
63 %if &tsuri=stopifempty %then %do;
64  %put WARNING: &tree/&name.(StoredProcess) not found!;
65  %return;
66 %end;
67 
68 
69 /**
70  * Now we can extract the textstore
71  */
72 filename __getdoc temp lrecl=10000000;
73 proc metadata
74  in="<GetMetadata><Reposid>$METAREPOSITORY</Reposid>
75  <Metadata><TextStore Id='&tsuri'/></Metadata>
76  <Ns>SAS</Ns><Flags>1</Flags><Options/></GetMetadata>"
77  out=__getdoc ;
78 run;
79 
80 /* find the beginning of the text */
81 data _null_;
82  infile __getdoc lrecl=10000;
83  input;
84  start=index(_infile_,'StoredText="');
85  if start then do;
86  call symputx("start",start+11);
87  putlog '"' _infile_ '"';
88  end;
89  stop;
90 
91 %local outeng;
92 %if %length(&outloc)=0 %then %let outeng=TEMP;
93 %else %let outeng="&outloc";
94 /* read the content, byte by byte, resolving escaped chars */
95 filename __outdoc &outeng lrecl=100000;
96 data _null_;
97  length filein 8 fileid 8;
98  filein = fopen("__getdoc","I",1,"B");
99  fileid = fopen("__outdoc","O",1,"B");
100  rec = "20"x;
101  length entity $6;
102  do while(fread(filein)=0);
103  x+1;
104  if x>&start then do;
105  rc = fget(filein,rec,1);
106  if rec='"' then leave;
107  else if rec="&" then do;
108  entity=rec;
109  do until (rec=";");
110  if fread(filein) ne 0 then goto getout;
111  rc = fget(filein,rec,1);
112  entity=cats(entity,rec);
113  end;
114  select (entity);
115  when ('&amp;' ) rec='&' ;
116  when ('&lt;' ) rec='<' ;
117  when ('&gt;' ) rec='>' ;
118  when ('&apos;') rec="'" ;
119  when ('&quot;') rec='"' ;
120  when ('&#x0a;') rec='0A'x;
121  when ('&#x0d;') rec='0D'x;
122  when ('&#36;' ) rec='$' ;
123  otherwise putlog "WARNING: missing value for " entity=;
124  end;
125  rc =fput(fileid, substr(rec,1,1));
126  rc =fwrite(fileid);
127  end;
128  else do;
129  rc =fput(fileid,rec);
130  rc =fwrite(fileid);
131  end;
132  end;
133  end;
134  getout:
135  rc=fclose(filein);
136  rc=fclose(fileid);
137 run;
138 
139 %if &outeng=TEMP %then %do;
140  data _null_;
141  infile __outdoc lrecl=32767;
142  input;
143  putlog _infile_;
144  run;
145 %end;
146 
147 filename __getdoc clear;
148 filename __outdoc clear;
149 
150 %mend;