diff --git a/all.sas b/all.sas
index 064ab1f..61ea9c7 100644
--- a/all.sas
+++ b/all.sas
@@ -2650,6 +2650,325 @@ create table &outds as
%end;
;
+%mend;/**
+ @file
+ @brief Extract DBML from SAS Libraries
+ @details DBML is an open source markup format to represent databases.
+ More details: https://www.dbml.org/home/
+
+ Usage:
+
+
+ %mp_getdbml(liblist=SASHELP WORK,outref=mydbml,showlog=YES)
+
+ Take the log output and paste it into the renderer at https://dbdiagram.io
+ to view your data model diagram. The code takes a "best guess" at
+ the one to one and one to many relationships (based on constraints
+ and indexes, and assuming that the column names would match).
+
+ You may need to adjust the rendered DBML to suit your needs.
+
+
+
SAS Macros
+ @li mf_getquotedstr.sas
+
+ @param liblist= Space seperated list of librefs to take as
+ input (Default=SASHELP)
+ @param outref= Fileref to contain the DBML (Default=getdbml)
+ @param showlog= set to YES to show the DBML in the log (Default is NO)
+
+ @version 9.3
+ @author Allan Bowe
+**/
+
+%macro mp_getdbml(liblist=SASHELP,outref=getdbml,showlog=NO
+)/*/STORE SOURCE*/;
+
+/* check fileref is assigned */
+%if %sysfunc(fileref(&outref)) > 0 %then %do;
+ filename &outref temp;
+%end;
+
+%let liblist=%upcase(&liblist);
+
+proc sql noprint;
+create table _data_ as
+ select * from dictionary.tables
+ where upcase(libname) in (%mf_getquotedstr(&liblist))
+ order by libname,memname;
+%local tabinfo; %let tabinfo=&syslast;
+
+create table _data_ as
+ select * from dictionary.columns
+ where upcase(libname) in (%mf_getquotedstr(&liblist))
+ order by libname,memname,varnum;
+%local colinfo; %let colinfo=&syslast;
+
+%local dsnlist;
+ select distinct upcase(cats(libname,'.',memname)) into: dsnlist
+ separated by ' '
+ from &syslast
+;
+
+create table _data_ as
+ select * from dictionary.indexes
+ where upcase(libname) in (%mf_getquotedstr(&liblist))
+ order by idxusage, indxname, indxpos;
+%local idxinfo; %let idxinfo=&syslast;
+
+/* Extract all Primary Key and Unique data constraints */
+%mp_getconstraints(lib=%scan(&liblist,1),outds=_data_)
+%local colconst; %let colconst=&syslast;
+
+%do x=2 %to %sysfunc(countw(&liblist));
+ %mp_getconstraints(lib=%scan(&liblist,&x),outds=_data_)
+ proc append base=&colconst data=&syslast;
+ run;
+%end;
+
+
+
+
+/* header info */
+data _null_;
+ file &outref;
+ put "// DBML generated by &sysuserid on %sysfunc(datetime(),datetime19.) ";
+ put "Project sasdbml {";
+ put " database_type: 'SAS'";
+ put " Note: 'Generated by the mp_getdbml() macro'";
+ put "}";
+run;
+
+/* create table groups */
+data _null_;
+ file &outref mod;
+ set &tabinfo;
+ by libname;
+ if first.libname then put "TableGroup " libname "{";
+ ds=quote(cats(libname,'.',memname));
+ put ' ' ds;
+ if last.libname then put "}";
+run;
+
+/* table for pks */
+data _data_;
+ length curds const col $39;
+ call missing (of _all_);
+ stop;
+run;
+%let pkds=&syslast;
+
+%local x curds constraints_used constcheck;
+%do x=1 %to %sysfunc(countw(&dsnlist,%str( )));
+ %let curds=%scan(&dsnlist,&x,%str( ));
+ %let constraints_used=;
+ %let constcheck=0;
+ data _null_;
+ file &outref mod;
+ length lab $1024 typ $20;
+ set &colinfo (where=(
+ libname="%scan(&curds,1,.)" and upcase(memname)="%scan(&curds,2,.)"
+ )) end=last;
+
+ if _n_=1 then do;
+ table='Table "'!!"&curds"!!'"{';
+ put table;
+ end;
+ name=upcase(name);
+ lab=" note:"!!quote(trim(tranwrd(label,'"',"'")));
+ if upcase(format)=:'DATETIME' then typ='datetime';
+ else if type='char' then typ=cats('char(',length,')');
+ else typ='num';
+
+ if notnull='yes' then notnul=' not null';
+ if notnull='no' and missing(label) then put ' ' name typ;
+ else if notnull='yes' and missing(label) then put ' ' name typ '[' notnul ']';
+ else if notnull='no' then put ' ' name typ '[' lab ']';
+ else put ' ' name typ '[' notnul ',' lab ']';
+
+ run;
+
+ data _data_(keep=curds const col);
+ length ctype $11 cols constraints_used $5000;
+ set &colconst (where=(
+ upcase(libref)="%scan(&curds,1,.)"
+ and upcase(table_name)="%scan(&curds,2,.)"
+ and constraint_type in ('PRIMARY','UNIQUE')
+ )) end=last;
+ file &outref mod;
+ by constraint_type constraint_name;
+ retain cols;
+ column_name=upcase(column_name);
+
+ if _n_=1 then put / ' indexes {';
+
+ if upcase(strip(constraint_type)) = 'PRIMARY' then ctype='[pk]';
+ else ctype='[unique]';
+
+ if first.constraint_name then cols = cats('(',column_name);
+ else cols=cats(cols,',',column_name);
+
+ if last.constraint_name then do;
+ cols=cats(cols,')',ctype)!!' //'!!constraint_name;
+ put ' ' cols;
+ constraints_used=catx(' ',constraints_used, constraint_name);
+ call symputx('constcheck',1);
+ end;
+
+ if last then call symputx('constraints_used',cats(upcase(constraints_used)));
+
+ length curds const col $39;
+ curds="&curds";
+ const=constraint_name;
+ col=column_name;
+ run;
+
+ proc append base=&pkds data=&syslast;run;
+
+ /* Create Unique Indexes, but only if they were not already defined within the Constraints section. */
+ data _data_(keep=curds const col);
+ set &idxinfo (where=(
+ libname="%scan(&curds,1,.)"
+ and upcase(memname)="%scan(&curds,2,.)"
+ and unique='yes'
+ and upcase(indxname) not in (%mf_getquotedstr(&constraints_used))
+ ));
+ file &outref mod;
+ by idxusage indxname;
+ name=upcase(name);
+ if &constcheck=1 then stop; /* in fact we only care about PKs so stop if we have */
+ if _n_=1 and &constcheck=0 then put / ' indexes {';
+
+ length cols $5000;
+ retain cols;
+ if first.indxname then cols = cats('(',name);
+ else cols=cats(cols,',',name);
+
+ if last.indxname then do;
+ cols=cats(cols,')[unique]')!!' //'!!indxname;
+ put ' ' cols;
+ call symputx('constcheck',1);
+ end;
+
+ length curds const col $39;
+ curds="&curds";
+ const=indxname;
+ col=name;
+ run;
+ proc append base=&pkds data=&syslast;run;
+
+ data _null_;
+ file &outref mod;
+ if &constcheck =1 then put ' }';
+ put '}';
+ run;
+
+%end;
+
+/**
+ * now we need to figure out the relationships
+ */
+
+/* sort alphabetically so we can have one set of unique cols per table */
+proc sort data=&pkds nodupkey;
+ by curds const col;
+run;
+
+data &pkds.1 (keep=curds col)
+ &pkds.2 (keep=curds cols);
+ set &pkds;
+ by curds const;
+ length retconst $39 cols $5000;
+ retain retconst cols;
+ if first.curds then do;
+ retconst=const;
+ cols=upcase(col);
+ end;
+ else cols=catx(' ',cols,upcase(col));
+ if retconst=const then do;
+ output &pkds.1;
+ if last.const then output &pkds.2;
+ end;
+run;
+
+%let curdslist="0";
+%do x=1 %to %sysfunc(countw(&dsnlist,%str( )));
+ %let curds=%scan(&dsnlist,&x,%str( ));
+
+ %let pkcols=0;
+ data _null_;
+ set &pkds.2(where=(curds="&curds"));
+ call symputx('pkcols',cols);
+ run;
+ %if &pkcols ne 0 %then %do;
+ %let curdslist=&curdslist,"&curds";
+
+ /* start with one2one */
+ data &pkds.4;
+ file &outref mod;
+ set &pkds.2(where=(cols="&pkcols" and curds not in (&curdslist)));
+ line='Ref: "'!!"&curds"!!cats('".(',cols,')')!!' - '!!cats(quote(trim(curds)),'.(',cols,')');
+ put line;
+ run;
+
+ /* now many2one */
+ /* get table with one row per col */
+ data &pkds.5;
+ set &pkds.1(where=(curds="&curds"));
+ run;
+ /* get tables which contain the PK columns */
+ proc sql;
+ create table &pkds.5a as
+ select upcase(cats(b.libname,'.',b.memname)) as curds
+ ,b.name
+ from &pkds.5 a
+ inner join &colinfo b
+ on a.col=upcase(b.name);
+ /* count to make sure those tables contain ALL the columns */
+ create table &pkds.5b as
+ select curds,count(*) as cnt
+ from &pkds.5a
+ where curds not in (select curds from &pkds.2 where cols="&pkcols") /* not a one to one match */
+ and curds ne "&curds" /* exclude self */
+ group by 1;
+ create table &pkds.6 as
+ select a.*
+ ,b.cols
+ from &pkds.5b a
+ left join &pkds.4 b
+ on a.curds=b.curds;
+
+ data _null_;
+ set &pkds.6;
+ file &outref mod;
+ colcnt=%sysfunc(countw(&pkcols));
+ if cnt=colcnt then do;
+ /* table contains all the PK cols, and was not a direct / 121 match */
+ line='Ref: "'!!"&curds"
+ !!'".('
+ !!"%mf_getquotedstr(&pkcols,dlm=%str(,),quote=%str( ))"
+ !!') > '
+ !!cats(quote(trim(curds))
+ ,'.('
+ ,"%mf_getquotedstr(&pkcols,dlm=%str(,),quote=%str( ))"
+ ,')'
+ );
+ put line;
+ end;
+ run;
+ %end;
+%end;
+
+
+%if %upcase(&showlog)=YES %then %do;
+ options ps=max;
+ data _null_;
+ infile &outref;
+ input;
+ putlog _infile_;
+ run;
+%end;
+
%mend;/**
@file mp_getddl.sas
@brief Extract DDL in various formats, by table or library
diff --git a/base/mp_getdbml.sas b/base/mp_getdbml.sas
new file mode 100644
index 0000000..a529dc5
--- /dev/null
+++ b/base/mp_getdbml.sas
@@ -0,0 +1,320 @@
+/**
+ @file
+ @brief Extract DBML from SAS Libraries
+ @details DBML is an open source markup format to represent databases.
+ More details: https://www.dbml.org/home/
+
+ Usage:
+
+
+ %mp_getdbml(liblist=SASHELP WORK,outref=mydbml,showlog=YES)
+
+ Take the log output and paste it into the renderer at https://dbdiagram.io
+ to view your data model diagram. The code takes a "best guess" at
+ the one to one and one to many relationships (based on constraints
+ and indexes, and assuming that the column names would match).
+
+ You may need to adjust the rendered DBML to suit your needs.
+
+
+ SAS Macros
+ @li mf_getquotedstr.sas
+
+ @param liblist= Space seperated list of librefs to take as
+ input (Default=SASHELP)
+ @param outref= Fileref to contain the DBML (Default=getdbml)
+ @param showlog= set to YES to show the DBML in the log (Default is NO)
+
+ @version 9.3
+ @author Allan Bowe
+**/
+
+%macro mp_getdbml(liblist=SASHELP,outref=getdbml,showlog=NO
+)/*/STORE SOURCE*/;
+
+/* check fileref is assigned */
+%if %sysfunc(fileref(&outref)) > 0 %then %do;
+ filename &outref temp;
+%end;
+
+%let liblist=%upcase(&liblist);
+
+proc sql noprint;
+create table _data_ as
+ select * from dictionary.tables
+ where upcase(libname) in (%mf_getquotedstr(&liblist))
+ order by libname,memname;
+%local tabinfo; %let tabinfo=&syslast;
+
+create table _data_ as
+ select * from dictionary.columns
+ where upcase(libname) in (%mf_getquotedstr(&liblist))
+ order by libname,memname,varnum;
+%local colinfo; %let colinfo=&syslast;
+
+%local dsnlist;
+ select distinct upcase(cats(libname,'.',memname)) into: dsnlist
+ separated by ' '
+ from &syslast
+;
+
+create table _data_ as
+ select * from dictionary.indexes
+ where upcase(libname) in (%mf_getquotedstr(&liblist))
+ order by idxusage, indxname, indxpos;
+%local idxinfo; %let idxinfo=&syslast;
+
+/* Extract all Primary Key and Unique data constraints */
+%mp_getconstraints(lib=%scan(&liblist,1),outds=_data_)
+%local colconst; %let colconst=&syslast;
+
+%do x=2 %to %sysfunc(countw(&liblist));
+ %mp_getconstraints(lib=%scan(&liblist,&x),outds=_data_)
+ proc append base=&colconst data=&syslast;
+ run;
+%end;
+
+
+
+
+/* header info */
+data _null_;
+ file &outref;
+ put "// DBML generated by &sysuserid on %sysfunc(datetime(),datetime19.) ";
+ put "Project sasdbml {";
+ put " database_type: 'SAS'";
+ put " Note: 'Generated by the mp_getdbml() macro'";
+ put "}";
+run;
+
+/* create table groups */
+data _null_;
+ file &outref mod;
+ set &tabinfo;
+ by libname;
+ if first.libname then put "TableGroup " libname "{";
+ ds=quote(cats(libname,'.',memname));
+ put ' ' ds;
+ if last.libname then put "}";
+run;
+
+/* table for pks */
+data _data_;
+ length curds const col $39;
+ call missing (of _all_);
+ stop;
+run;
+%let pkds=&syslast;
+
+%local x curds constraints_used constcheck;
+%do x=1 %to %sysfunc(countw(&dsnlist,%str( )));
+ %let curds=%scan(&dsnlist,&x,%str( ));
+ %let constraints_used=;
+ %let constcheck=0;
+ data _null_;
+ file &outref mod;
+ length lab $1024 typ $20;
+ set &colinfo (where=(
+ libname="%scan(&curds,1,.)" and upcase(memname)="%scan(&curds,2,.)"
+ )) end=last;
+
+ if _n_=1 then do;
+ table='Table "'!!"&curds"!!'"{';
+ put table;
+ end;
+ name=upcase(name);
+ lab=" note:"!!quote(trim(tranwrd(label,'"',"'")));
+ if upcase(format)=:'DATETIME' then typ='datetime';
+ else if type='char' then typ=cats('char(',length,')');
+ else typ='num';
+
+ if notnull='yes' then notnul=' not null';
+ if notnull='no' and missing(label) then put ' ' name typ;
+ else if notnull='yes' and missing(label) then put ' ' name typ '[' notnul ']';
+ else if notnull='no' then put ' ' name typ '[' lab ']';
+ else put ' ' name typ '[' notnul ',' lab ']';
+
+ run;
+
+ data _data_(keep=curds const col);
+ length ctype $11 cols constraints_used $5000;
+ set &colconst (where=(
+ upcase(libref)="%scan(&curds,1,.)"
+ and upcase(table_name)="%scan(&curds,2,.)"
+ and constraint_type in ('PRIMARY','UNIQUE')
+ )) end=last;
+ file &outref mod;
+ by constraint_type constraint_name;
+ retain cols;
+ column_name=upcase(column_name);
+
+ if _n_=1 then put / ' indexes {';
+
+ if upcase(strip(constraint_type)) = 'PRIMARY' then ctype='[pk]';
+ else ctype='[unique]';
+
+ if first.constraint_name then cols = cats('(',column_name);
+ else cols=cats(cols,',',column_name);
+
+ if last.constraint_name then do;
+ cols=cats(cols,')',ctype)!!' //'!!constraint_name;
+ put ' ' cols;
+ constraints_used=catx(' ',constraints_used, constraint_name);
+ call symputx('constcheck',1);
+ end;
+
+ if last then call symputx('constraints_used',cats(upcase(constraints_used)));
+
+ length curds const col $39;
+ curds="&curds";
+ const=constraint_name;
+ col=column_name;
+ run;
+
+ proc append base=&pkds data=&syslast;run;
+
+ /* Create Unique Indexes, but only if they were not already defined within the Constraints section. */
+ data _data_(keep=curds const col);
+ set &idxinfo (where=(
+ libname="%scan(&curds,1,.)"
+ and upcase(memname)="%scan(&curds,2,.)"
+ and unique='yes'
+ and upcase(indxname) not in (%mf_getquotedstr(&constraints_used))
+ ));
+ file &outref mod;
+ by idxusage indxname;
+ name=upcase(name);
+ if &constcheck=1 then stop; /* in fact we only care about PKs so stop if we have */
+ if _n_=1 and &constcheck=0 then put / ' indexes {';
+
+ length cols $5000;
+ retain cols;
+ if first.indxname then cols = cats('(',name);
+ else cols=cats(cols,',',name);
+
+ if last.indxname then do;
+ cols=cats(cols,')[unique]')!!' //'!!indxname;
+ put ' ' cols;
+ call symputx('constcheck',1);
+ end;
+
+ length curds const col $39;
+ curds="&curds";
+ const=indxname;
+ col=name;
+ run;
+ proc append base=&pkds data=&syslast;run;
+
+ data _null_;
+ file &outref mod;
+ if &constcheck =1 then put ' }';
+ put '}';
+ run;
+
+%end;
+
+/**
+ * now we need to figure out the relationships
+ */
+
+/* sort alphabetically so we can have one set of unique cols per table */
+proc sort data=&pkds nodupkey;
+ by curds const col;
+run;
+
+data &pkds.1 (keep=curds col)
+ &pkds.2 (keep=curds cols);
+ set &pkds;
+ by curds const;
+ length retconst $39 cols $5000;
+ retain retconst cols;
+ if first.curds then do;
+ retconst=const;
+ cols=upcase(col);
+ end;
+ else cols=catx(' ',cols,upcase(col));
+ if retconst=const then do;
+ output &pkds.1;
+ if last.const then output &pkds.2;
+ end;
+run;
+
+%let curdslist="0";
+%do x=1 %to %sysfunc(countw(&dsnlist,%str( )));
+ %let curds=%scan(&dsnlist,&x,%str( ));
+
+ %let pkcols=0;
+ data _null_;
+ set &pkds.2(where=(curds="&curds"));
+ call symputx('pkcols',cols);
+ run;
+ %if &pkcols ne 0 %then %do;
+ %let curdslist=&curdslist,"&curds";
+
+ /* start with one2one */
+ data &pkds.4;
+ file &outref mod;
+ set &pkds.2(where=(cols="&pkcols" and curds not in (&curdslist)));
+ line='Ref: "'!!"&curds"!!cats('".(',cols,')')!!' - '!!cats(quote(trim(curds)),'.(',cols,')');
+ put line;
+ run;
+
+ /* now many2one */
+ /* get table with one row per col */
+ data &pkds.5;
+ set &pkds.1(where=(curds="&curds"));
+ run;
+ /* get tables which contain the PK columns */
+ proc sql;
+ create table &pkds.5a as
+ select upcase(cats(b.libname,'.',b.memname)) as curds
+ ,b.name
+ from &pkds.5 a
+ inner join &colinfo b
+ on a.col=upcase(b.name);
+ /* count to make sure those tables contain ALL the columns */
+ create table &pkds.5b as
+ select curds,count(*) as cnt
+ from &pkds.5a
+ where curds not in (select curds from &pkds.2 where cols="&pkcols") /* not a one to one match */
+ and curds ne "&curds" /* exclude self */
+ group by 1;
+ create table &pkds.6 as
+ select a.*
+ ,b.cols
+ from &pkds.5b a
+ left join &pkds.4 b
+ on a.curds=b.curds;
+
+ data _null_;
+ set &pkds.6;
+ file &outref mod;
+ colcnt=%sysfunc(countw(&pkcols));
+ if cnt=colcnt then do;
+ /* table contains all the PK cols, and was not a direct / 121 match */
+ line='Ref: "'!!"&curds"
+ !!'".('
+ !!"%mf_getquotedstr(&pkcols,dlm=%str(,),quote=%str( ))"
+ !!') > '
+ !!cats(quote(trim(curds))
+ ,'.('
+ ,"%mf_getquotedstr(&pkcols,dlm=%str(,),quote=%str( ))"
+ ,')'
+ );
+ put line;
+ end;
+ run;
+ %end;
+%end;
+
+
+%if %upcase(&showlog)=YES %then %do;
+ options ps=max;
+ data _null_;
+ infile &outref;
+ input;
+ putlog _infile_;
+ run;
+%end;
+
+%mend;
\ No newline at end of file