Production Ready Macros for SAS Application Developers
https://github.com/sasjs/core
mp_getdbml.sas
Go to the documentation of this file.
1 /**
2  @file
3  @brief Extract DBML from SAS Libraries
4  @details DBML is an open source markup format to represent databases.
5  More details: https://www.dbml.org/home/
6 
7  Usage:
8 
9 
10  %mp_getdbml(liblist=SASHELP WORK,outref=mydbml,showlog=YES)
11 
12  Take the log output and paste it into the renderer at https://dbdiagram.io
13  to view your data model diagram. The code takes a "best guess" at
14  the one to one and one to many relationships (based on constraints
15  and indexes, and assuming that the column names would match).
16 
17  You may need to adjust the rendered DBML to suit your needs.
18 
19  ![dbml for sas](https://i.imgur.com/8T1tIZp.gif)
20 
21 
22  <h4> SAS Macros </h4>
23  @li mf_getquotedstr.sas
24  @li mp_getconstraints.sas
25 
26  @param liblist= Space seperated list of librefs to take as
27  input (Default=SASHELP)
28  @param outref= Fileref to contain the DBML (Default=getdbml)
29  @param showlog= set to YES to show the DBML in the log (Default is NO)
30 
31  @version 9.3
32  @author Allan Bowe
33 **/
34 
35 %macro mp_getdbml(liblist=SASHELP,outref=getdbml,showlog=NO
36 )/*/STORE SOURCE*/;
37 
38 /* check fileref is assigned */
39 %if %sysfunc(fileref(&outref)) > 0 %then %do;
40  filename &outref temp;
41 %end;
42 
43 %let liblist=%upcase(&liblist);
44 
45 proc sql noprint;
46 create table _data_ as
47  select * from dictionary.tables
48  where upcase(libname) in (%mf_getquotedstr(&liblist))
49  order by libname,memname;
50 %local tabinfo; %let tabinfo=&syslast;
51 
52 create table _data_ as
53  select * from dictionary.columns
54  where upcase(libname) in (%mf_getquotedstr(&liblist))
55  order by libname,memname,varnum;
56 %local colinfo; %let colinfo=&syslast;
57 
58 %local dsnlist;
59  select distinct upcase(cats(libname,'.',memname)) into: dsnlist
60  separated by ' '
61  from &syslast
62 ;
63 
64 create table _data_ as
65  select * from dictionary.indexes
66  where upcase(libname) in (%mf_getquotedstr(&liblist))
67  order by idxusage, indxname, indxpos;
68 %local idxinfo; %let idxinfo=&syslast;
69 
70 /* Extract all Primary Key and Unique data constraints */
71 %mp_getconstraints(lib=%scan(&liblist,1),outds=_data_)
72 %local colconst; %let colconst=&syslast;
73 
74 %do x=2 %to %sysfunc(countw(&liblist));
75  %mp_getconstraints(lib=%scan(&liblist,&x),outds=_data_)
76  proc append base=&colconst data=&syslast;
77  run;
78 %end;
79 
80 
81 
82 
83 /* header info */
84 data _null_;
85  file &outref;
86  put "// DBML generated by &sysuserid on %sysfunc(datetime(),datetime19.) ";
87  put "Project sasdbml {";
88  put " database_type: 'SAS'";
89  put " Note: 'Generated by the mp_getdbml() macro'";
90  put "}";
91 run;
92 
93 /* create table groups */
94 data _null_;
95  file &outref mod;
96  set &tabinfo;
97  by libname;
98  if first.libname then put "TableGroup " libname "{";
99  ds=quote(cats(libname,'.',memname));
100  put ' ' ds;
101  if last.libname then put "}";
102 run;
103 
104 /* table for pks */
105 data _data_;
106  length curds const col $39;
107  call missing (of _all_);
108  stop;
109 run;
110 %let pkds=&syslast;
111 
112 %local x curds constraints_used constcheck;
113 %do x=1 %to %sysfunc(countw(&dsnlist,%str( )));
114  %let curds=%scan(&dsnlist,&x,%str( ));
115  %let constraints_used=;
116  %let constcheck=0;
117  data _null_;
118  file &outref mod;
119  length lab $1024 typ $20;
120  set &colinfo (where=(
121  libname="%scan(&curds,1,.)" and upcase(memname)="%scan(&curds,2,.)"
122  )) end=last;
123 
124  if _n_=1 then do;
125  table='Table "'!!"&curds"!!'"{';
126  put table;
127  end;
128  name=upcase(name);
129  lab=" note:"!!quote(trim(tranwrd(label,'"',"'")));
130  if upcase(format)=:'DATETIME' then typ='datetime';
131  else if type='char' then typ=cats('char(',length,')');
132  else typ='num';
133 
134  if notnull='yes' then notnul=' not null';
135  if notnull='no' and missing(label) then put ' ' name typ;
136  else if notnull='yes' and missing(label) then put ' ' name typ '[' notnul ']';
137  else if notnull='no' then put ' ' name typ '[' lab ']';
138  else put ' ' name typ '[' notnul ',' lab ']';
139 
140  run;
141 
142  data _data_(keep=curds const col);
143  length ctype $11 cols constraints_used $5000;
144  set &colconst (where=(
145  upcase(libref)="%scan(&curds,1,.)"
146  and upcase(table_name)="%scan(&curds,2,.)"
147  and constraint_type in ('PRIMARY','UNIQUE')
148  )) end=last;
149  file &outref mod;
150  by constraint_type constraint_name;
151  retain cols;
152  column_name=upcase(column_name);
153 
154  if _n_=1 then put / ' indexes {';
155 
156  if upcase(strip(constraint_type)) = 'PRIMARY' then ctype='[pk]';
157  else ctype='[unique]';
158 
159  if first.constraint_name then cols = cats('(',column_name);
160  else cols=cats(cols,',',column_name);
161 
162  if last.constraint_name then do;
163  cols=cats(cols,')',ctype)!!' //'!!constraint_name;
164  put ' ' cols;
165  constraints_used=catx(' ',constraints_used, constraint_name);
166  call symputx('constcheck',1);
167  end;
168 
169  if last then call symputx('constraints_used',cats(upcase(constraints_used)));
170 
171  length curds const col $39;
172  curds="&curds";
173  const=constraint_name;
174  col=column_name;
175  run;
176 
177  proc append base=&pkds data=&syslast;run;
178 
179  /* Create Unique Indexes, but only if they were not already defined within the Constraints section. */
180  data _data_(keep=curds const col);
181  set &idxinfo (where=(
182  libname="%scan(&curds,1,.)"
183  and upcase(memname)="%scan(&curds,2,.)"
184  and unique='yes'
185  and upcase(indxname) not in (%mf_getquotedstr(&constraints_used))
186  ));
187  file &outref mod;
188  by idxusage indxname;
189  name=upcase(name);
190  if &constcheck=1 then stop; /* in fact we only care about PKs so stop if we have */
191  if _n_=1 and &constcheck=0 then put / ' indexes {';
192 
193  length cols $5000;
194  retain cols;
195  if first.indxname then cols = cats('(',name);
196  else cols=cats(cols,',',name);
197 
198  if last.indxname then do;
199  cols=cats(cols,')[unique]')!!' //'!!indxname;
200  put ' ' cols;
201  call symputx('constcheck',1);
202  end;
203 
204  length curds const col $39;
205  curds="&curds";
206  const=indxname;
207  col=name;
208  run;
209  proc append base=&pkds data=&syslast;run;
210 
211  data _null_;
212  file &outref mod;
213  if &constcheck =1 then put ' }';
214  put '}';
215  run;
216 
217 %end;
218 
219 /**
220  * now we need to figure out the relationships
221  */
222 
223 /* sort alphabetically so we can have one set of unique cols per table */
224 proc sort data=&pkds nodupkey;
225  by curds const col;
226 run;
227 
228 data &pkds.1 (keep=curds col)
229  &pkds.2 (keep=curds cols);
230  set &pkds;
231  by curds const;
232  length retconst $39 cols $5000;
233  retain retconst cols;
234  if first.curds then do;
235  retconst=const;
236  cols=upcase(col);
237  end;
238  else cols=catx(' ',cols,upcase(col));
239  if retconst=const then do;
240  output &pkds.1;
241  if last.const then output &pkds.2;
242  end;
243 run;
244 
245 %let curdslist="0";
246 %do x=1 %to %sysfunc(countw(&dsnlist,%str( )));
247  %let curds=%scan(&dsnlist,&x,%str( ));
248 
249  %let pkcols=0;
250  data _null_;
251  set &pkds.2(where=(curds="&curds"));
252  call symputx('pkcols',cols);
253  run;
254  %if &pkcols ne 0 %then %do;
255  %let curdslist=&curdslist,"&curds";
256 
257  /* start with one2one */
258  data &pkds.4;
259  file &outref mod;
260  set &pkds.2(where=(cols="&pkcols" and curds not in (&curdslist)));
261  line='Ref: "'!!"&curds"
262  !!cats('".(',"%mf_getquotedstr(&pkcols,dlm=%str(,),quote=%str( ))",')')
263  !!' - '
264  !!cats(quote(trim(curds)),'.(',"%mf_getquotedstr(&pkcols,dlm=%str(,),quote=%str( ))",')');
265  put line;
266  run;
267 
268  /* now many2one */
269  /* get table with one row per col */
270  data &pkds.5;
271  set &pkds.1(where=(curds="&curds"));
272  run;
273  /* get tables which contain the PK columns */
274  proc sql;
275  create table &pkds.5a as
276  select upcase(cats(b.libname,'.',b.memname)) as curds
277  ,b.name
278  from &pkds.5 a
279  inner join &colinfo b
280  on a.col=upcase(b.name);
281  /* count to make sure those tables contain ALL the columns */
282  create table &pkds.5b as
283  select curds,count(*) as cnt
284  from &pkds.5a
285  where curds not in (select curds from &pkds.2 where cols="&pkcols") /* not a one to one match */
286  and curds ne "&curds" /* exclude self */
287  group by 1;
288  create table &pkds.6 as
289  select a.*
290  ,b.cols
291  from &pkds.5b a
292  left join &pkds.4 b
293  on a.curds=b.curds;
294 
295  data _null_;
296  set &pkds.6;
297  file &outref mod;
298  colcnt=%sysfunc(countw(&pkcols));
299  if cnt=colcnt then do;
300  /* table contains all the PK cols, and was not a direct / 121 match */
301  line='Ref: "'!!"&curds"
302  !!'".('
303  !!"%mf_getquotedstr(&pkcols,dlm=%str(,),quote=%str( ))"
304  !!') > '
305  !!cats(quote(trim(curds))
306  ,'.('
307  ,"%mf_getquotedstr(&pkcols,dlm=%str(,),quote=%str( ))"
308  ,')'
309  );
310  put line;
311  end;
312  run;
313  %end;
314 %end;
315 
316 
317 %if %upcase(&showlog)=YES %then %do;
318  options ps=max;
319  data _null_;
320  infile &outref;
321  input;
322  putlog _infile_;
323  run;
324 %end;
325 
326 %mend;