1
0
mirror of https://github.com/sasjs/core.git synced 2025-12-11 06:24:35 +00:00

Compare commits

...

11 Commits

8 changed files with 1170 additions and 28 deletions

597
all.sas
View File

@@ -399,7 +399,7 @@ options noquotelenmax;
@version 9.2
@author Allan Bowe
**/ /** \cond */
**/
%macro mf_getengine(libref
)/*/STORE SOURCE*/;
@@ -419,9 +419,7 @@ options noquotelenmax;
&engine
%mend;
/** \endcond *//**
%mend;/**
@file
@brief Returns the size of a file in bytes.
@details Provide full path/filename.extension to the file, eg:
@@ -1154,6 +1152,38 @@ Usage:
%sysevalf(%superq(param)=,boolean)
%mend;/**
@file
@brief Checks whether a path is a valid directory
@details
Usage:
%let isdir=%mf_isdir(/tmp);
With thanks and full credit to Andrea Defronzo - https://www.linkedin.com/in/andrea-defronzo-b1a47460/
@param path full path of the file/directory to be checked
@return output returns 1 if path is a directory, 0 if it is not
@version 9.2
**/
%macro mf_isdir(path
)/*/STORE SOURCE*/;
%local rc did is_directory fref_t;
%let is_directory = 0;
%let rc = %sysfunc(filename(fref_t, %superq(path)));
%let did = %sysfunc(dopen(&fref_t.));
%if &did. ^= 0 %then %do;
%let is_directory = 1;
%let rc = %sysfunc(dclose(&did.));
%end;
%let rc = %sysfunc(filename(fref_t));
&is_directory
%mend;/**
@file
@brief Returns physical location of various SAS items
@@ -1904,6 +1934,149 @@ Usage:
%mend;
/**
@file mp_csv2ds.sas
@brief Efficient import of arbitrary CSV using a dataset as template
@details Used to import relevant columns from a large CSV using
a dataset to provide the types and lengths. Assumes that a header
row is provided, and datarows start on line 2. Extra columns in
both the CSV and base dataset are ignored.
Usage:
filename mycsv temp;
data _null_;
file mycsv;
put 'name,age,nickname';
put 'John,48,Jonny';
put 'Jennifer,23,Jen';
run;
%mp_csv2ds(inref=mycsv,outds=myds,baseds=sashelp.class)
@param inref= fileref to the CSV
@param outds= output ds (lib.ds format)
@param view= Set to YES or NO to determine whether the output should be
a view or not. Default is NO (not a view).
@param baseds= Template dataset on which to create the input statement.
Is used to determine types, lengths, and any informats.
@version 9.2
@author Allan Bowe
<h4> Dependencies </h4>
@li mp_abort.sas
@li mf_existds.sas
**/
%macro mp_csv2ds(inref=0,outds=0,baseds=0,view=NO);
%mp_abort(iftrue=( &inref=0 )
,mac=&sysmacroname
,msg=%str(the INREF variable must be provided)
)
%mp_abort(iftrue=( %superq(outds)=0 )
,mac=&sysmacroname
,msg=%str(the OUTDS variable must be provided)
)
%mp_abort(iftrue=( &baseds=0 )
,mac=&sysmacroname
,msg=%str(the BASEDS variable must be provided)
)
%mp_abort(iftrue=( &baseds=0 )
,mac=&sysmacroname
,msg=%str(the BASEDS variable must be provided)
)
%mp_abort(iftrue=( %mf_existds(&baseds)=0 )
,mac=&sysmacroname
,msg=%str(the BASEDS dataset (&baseds) needs to be assigned, and to exist)
)
/* count rows */
%local hasheader; %let hasheader=0;
data _null_;
if _N_ > 1 then do;
call symputx('hasheader',1,'l');
stop;
end;
infile &inref;
input;
run;
%mp_abort(iftrue=( &hasheader=0 )
,mac=&sysmacroname
,msg=%str(No header row in &inref)
)
/* get the variables in the CSV */
data _data_;
infile &inref;
input;
length name $32;
do i=1 to countc(_infile_,',')+1;
name=upcase(scan(_infile_,i,','));
output;
end;
stop;
run;
%local csv_vars;%let csv_vars=&syslast;
/* get the variables in the dataset */
proc contents noprint data=&baseds
out=_data_ (keep=name type length format: informat);
run;
%local base_vars; %let base_vars=&syslast;
proc sql undo_policy=none;
create table &csv_vars as
select a.*
,b.type
,b.length
,b.format
,b.formatd
,b.formatl
,b.informat
from &csv_vars a
left join &base_vars b
on a.name=upcase(b.name)
order by i;
/* prepare the input statement */
%local instat dropvars;
data _null_;
set &syslast end=last;
length in dropvars $32767;
retain in dropvars;
if missing(type) then do;
informat='$1.';
dropvars=catx(' ',dropvars,name);
end;
else if missing(informat) then do;
if type=1 then informat='best.';
else informat=cats('$',length,'.');
end;
else informat=cats(informat,'.');
in=catx(' ',in,name,':',informat);
if last then do;
call symputx('instat',in,'l');
call symputx('dropvars',dropvars,'l');
end;
run;
/* import the CSV */
data &outds
%if %upcase(&view)=YES %then %do;
/view=&outds
%end;
;
infile &inref dsd firstobs=2;
input &instat;
%if %length(&dropvars)>0 %then %do;
drop &dropvars;
%end;
run;
%mend;/**
@file mp_deleteconstraints.sas
@brief Delete constraionts
@details Takes the output from mp_getconstraints.sas as input
@@ -2509,6 +2682,326 @@ 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.
<h4> SAS Macros </h4>
@li mf_getquotedstr.sas
@li mp_getconstraints.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
@@ -2642,7 +3135,7 @@ run;
%let curds=%scan(&dsnlist,&x);
data _null_;
file &fref mod;
length nm lab $1024;
length nm lab $1024 typ $20;
set &colinfo (where=(upcase(memname)="&curds")) end=last;
if _n_=1 then do;
@@ -2656,10 +3149,12 @@ run;
end;
else put " ,"@@;
if length(format)>1 then fmt=" format="!!cats(format);
len=" length="!!cats(length);
lab=" label="!!quote(trim(label));
if length(label)>1 then lab=" label="!!quote(trim(label));
if notnull='yes' then notnul=' not null';
put name type len fmt notnul lab;
if type='char' then typ=cats('char(',length,')');
else if length ne 8 then typ='num length='!!left(length);
else typ='num';
put name typ fmt notnul lab;
run;
/* Extra step for data constraints */
@@ -3968,7 +4463,7 @@ proc sql
options &etls_syntaxcheck;
%mend;/**
@file mp_streamfile.sas
@file
@brief Streams a file to _webout according to content type
@details Will set headers using appropriate functions (SAS 9 vs Viya) and send
content as a binary stream.
@@ -3986,6 +4481,7 @@ proc sql
@param contenttype= Either TEXT, ZIP, CSV, EXCEL (default TEXT)
@param inloc= /path/to/file.ext to be sent
@param inref= fileref of file to be sent (if provided, overrides `inloc`)
@param outname= the name of the file, as downloaded by the browser
@author Allan Bowe
@@ -3996,6 +4492,7 @@ proc sql
%macro mp_streamfile(
contenttype=TEXT
,inloc=
,inref=0
,outname=
)/*/STORE SOURCE*/;
@@ -4011,7 +4508,7 @@ proc sql
%end;
%else %if &platform=SASVIYA %then %do;
filename _webout filesrvc parenturi="&SYS_JES_JOB_URI" name='_webout.zip'
contenttype='application/zip'
contenttype='application/zip'
contentdisp="attachment; filename=&outname";
%end;
%end;
@@ -4025,7 +4522,7 @@ proc sql
%end;
%else %if &platform=SASVIYA %then %do;
filename _webout filesrvc parenturi="&SYS_JES_JOB_URI" name='_webout.xls'
contenttype='application/vnd.ms-excel'
contenttype='application/vnd.ms-excel'
contentdisp="attachment; filename=&outname";
%end;
%end;
@@ -4038,7 +4535,7 @@ proc sql
%end;
%else %if &platform=SASVIYA %then %do;
filename _webout filesrvc parenturi="&SYS_JES_JOB_URI" name='_webout.xls'
contenttype='application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'
contenttype='application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'
contentdisp="attachment; filename=&outname";
%end;
%end;
@@ -4071,7 +4568,7 @@ proc sql
%else %if &contentype=HTML %then %do;
%if &platform=SASVIYA %then %do;
filename _webout filesrvc parenturi="&SYS_JES_JOB_URI" name="_webout.json"
contenttype="text/html";
contenttype="text/html";
%end;
%end;
%else %do;
@@ -4079,7 +4576,79 @@ proc sql
%return;
%end;
%mp_binarycopy(inloc="&inloc",outref=_webout)
%if &inref ne 0 %then %do;
%mp_binarycopy(inref=&inref,outref=_webout)
%end;
%else %do;
%mp_binarycopy(inloc="&inloc",outref=_webout)
%end;
%mend;/**
@file
@brief Recursively scans a directory tree to get all subfolders and content
@details
Usage:
%mp_tree(dir=/tmp, outds=work.tree)
Credits:
* Roger Deangelis, https://communities.sas.com/t5/SAS-Programming/listing-all-files-within-a-directory-and-subdirectories/m-p/332616/highlight/true#M74887
* Tom, https://communities.sas.com/t5/SAS-Programming/listing-all-files-of-all-types-from-all-subdirectories/m-p/334113/highlight/true#M75419
@param dir= Directory to be scanned (default=/tmp)
@param outds= Dataset to create (default=work.mp_tree)
@returns outds contains the following variables:
- `dir`: a flag (1/0) to say whether it is a directory or not. This is not
reliable - folders that you do not have permission to open will be flagged
as directories.
- `ext`: file extension
- `filename`: file name
- `dirname`: directory name
- `fullpath`: directory + file name
@version 9.2
**/
%macro mp_tree(dir=/tmp
,outds=work.mp_tree
)/*/STORE SOURCE*/;
data &outds ;
length dir 8 ext filename dirname $256 fullpath $512 ;
call missing(of _all_);
fullpath = "&dir";
run;
%local sep;
%if &sysscp=WIN or &SYSSCP eq DNTHOST %then %let sep=\;
%else %let sep=/;
data &outds ;
modify &outds ;
retain sep "&sep";
rc=filename('tmp',fullpath);
dir_id=dopen('tmp');
dir = (dir_id ne 0) ;
if dir then dirname=fullpath;
else do;
filename=scan(fullpath,-1,sep) ;
dirname =substrn(fullpath,1,length(fullpath)-length(filename));
if index(filename,'.')>1 then ext=scan(filename,-1,'.');
end;
replace;
if dir then do;
do i=1 to dnum(dir_id);
fullpath=cats(dirname,sep,dread(dir_id,i));
output;
end;
rc=dclose(dir_id);
end;
rc=filename('tmp');
run;
%mend;/**
@file mp_unzip.sas

View File

@@ -22,7 +22,7 @@
@version 9.2
@author Allan Bowe
**/ /** \cond */
**/
%macro mf_getengine(libref
)/*/STORE SOURCE*/;
@@ -42,6 +42,4 @@
&engine
%mend;
/** \endcond */
%mend;

33
base/mf_isdir.sas Normal file
View File

@@ -0,0 +1,33 @@
/**
@file
@brief Checks whether a path is a valid directory
@details
Usage:
%let isdir=%mf_isdir(/tmp);
With thanks and full credit to Andrea Defronzo - https://www.linkedin.com/in/andrea-defronzo-b1a47460/
@param path full path of the file/directory to be checked
@return output returns 1 if path is a directory, 0 if it is not
@version 9.2
**/
%macro mf_isdir(path
)/*/STORE SOURCE*/;
%local rc did is_directory fref_t;
%let is_directory = 0;
%let rc = %sysfunc(filename(fref_t, %superq(path)));
%let did = %sysfunc(dopen(&fref_t.));
%if &did. ^= 0 %then %do;
%let is_directory = 1;
%let rc = %sysfunc(dclose(&did.));
%end;
%let rc = %sysfunc(filename(fref_t));
&is_directory
%mend;

144
base/mp_csv2ds.sas Normal file
View File

@@ -0,0 +1,144 @@
/**
@file mp_csv2ds.sas
@brief Efficient import of arbitrary CSV using a dataset as template
@details Used to import relevant columns from a large CSV using
a dataset to provide the types and lengths. Assumes that a header
row is provided, and datarows start on line 2. Extra columns in
both the CSV and base dataset are ignored.
Usage:
filename mycsv temp;
data _null_;
file mycsv;
put 'name,age,nickname';
put 'John,48,Jonny';
put 'Jennifer,23,Jen';
run;
%mp_csv2ds(inref=mycsv,outds=myds,baseds=sashelp.class)
@param inref= fileref to the CSV
@param outds= output ds (lib.ds format)
@param view= Set to YES or NO to determine whether the output should be
a view or not. Default is NO (not a view).
@param baseds= Template dataset on which to create the input statement.
Is used to determine types, lengths, and any informats.
@version 9.2
@author Allan Bowe
<h4> Dependencies </h4>
@li mp_abort.sas
@li mf_existds.sas
**/
%macro mp_csv2ds(inref=0,outds=0,baseds=0,view=NO);
%mp_abort(iftrue=( &inref=0 )
,mac=&sysmacroname
,msg=%str(the INREF variable must be provided)
)
%mp_abort(iftrue=( %superq(outds)=0 )
,mac=&sysmacroname
,msg=%str(the OUTDS variable must be provided)
)
%mp_abort(iftrue=( &baseds=0 )
,mac=&sysmacroname
,msg=%str(the BASEDS variable must be provided)
)
%mp_abort(iftrue=( &baseds=0 )
,mac=&sysmacroname
,msg=%str(the BASEDS variable must be provided)
)
%mp_abort(iftrue=( %mf_existds(&baseds)=0 )
,mac=&sysmacroname
,msg=%str(the BASEDS dataset (&baseds) needs to be assigned, and to exist)
)
/* count rows */
%local hasheader; %let hasheader=0;
data _null_;
if _N_ > 1 then do;
call symputx('hasheader',1,'l');
stop;
end;
infile &inref;
input;
run;
%mp_abort(iftrue=( &hasheader=0 )
,mac=&sysmacroname
,msg=%str(No header row in &inref)
)
/* get the variables in the CSV */
data _data_;
infile &inref;
input;
length name $32;
do i=1 to countc(_infile_,',')+1;
name=upcase(scan(_infile_,i,','));
output;
end;
stop;
run;
%local csv_vars;%let csv_vars=&syslast;
/* get the variables in the dataset */
proc contents noprint data=&baseds
out=_data_ (keep=name type length format: informat);
run;
%local base_vars; %let base_vars=&syslast;
proc sql undo_policy=none;
create table &csv_vars as
select a.*
,b.type
,b.length
,b.format
,b.formatd
,b.formatl
,b.informat
from &csv_vars a
left join &base_vars b
on a.name=upcase(b.name)
order by i;
/* prepare the input statement */
%local instat dropvars;
data _null_;
set &syslast end=last;
length in dropvars $32767;
retain in dropvars;
if missing(type) then do;
informat='$1.';
dropvars=catx(' ',dropvars,name);
end;
else if missing(informat) then do;
if type=1 then informat='best.';
else informat=cats('$',length,'.');
end;
else informat=cats(informat,'.');
in=catx(' ',in,name,':',informat);
if last then do;
call symputx('instat',in,'l');
call symputx('dropvars',dropvars,'l');
end;
run;
/* import the CSV */
data &outds
%if %upcase(&view)=YES %then %do;
/view=&outds
%end;
;
infile &inref dsd firstobs=2;
input &instat;
%if %length(&dropvars)>0 %then %do;
drop &dropvars;
%end;
run;
%mend;

321
base/mp_getdbml.sas Normal file
View File

@@ -0,0 +1,321 @@
/**
@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.
<h4> SAS Macros </h4>
@li mf_getquotedstr.sas
@li mp_getconstraints.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;

View File

@@ -131,7 +131,7 @@ run;
%let curds=%scan(&dsnlist,&x);
data _null_;
file &fref mod;
length nm lab $1024;
length nm lab $1024 typ $20;
set &colinfo (where=(upcase(memname)="&curds")) end=last;
if _n_=1 then do;
@@ -145,10 +145,12 @@ run;
end;
else put " ,"@@;
if length(format)>1 then fmt=" format="!!cats(format);
len=" length="!!cats(length);
lab=" label="!!quote(trim(label));
if length(label)>1 then lab=" label="!!quote(trim(label));
if notnull='yes' then notnul=' not null';
put name type len fmt notnul lab;
if type='char' then typ=cats('char(',length,')');
else if length ne 8 then typ='num length='!!left(length);
else typ='num';
put name typ fmt notnul lab;
run;
/* Extra step for data constraints */

View File

@@ -1,5 +1,5 @@
/**
@file mp_streamfile.sas
@file
@brief Streams a file to _webout according to content type
@details Will set headers using appropriate functions (SAS 9 vs Viya) and send
content as a binary stream.
@@ -17,6 +17,7 @@
@param contenttype= Either TEXT, ZIP, CSV, EXCEL (default TEXT)
@param inloc= /path/to/file.ext to be sent
@param inref= fileref of file to be sent (if provided, overrides `inloc`)
@param outname= the name of the file, as downloaded by the browser
@author Allan Bowe
@@ -27,6 +28,7 @@
%macro mp_streamfile(
contenttype=TEXT
,inloc=
,inref=0
,outname=
)/*/STORE SOURCE*/;
@@ -42,7 +44,7 @@
%end;
%else %if &platform=SASVIYA %then %do;
filename _webout filesrvc parenturi="&SYS_JES_JOB_URI" name='_webout.zip'
contenttype='application/zip'
contenttype='application/zip'
contentdisp="attachment; filename=&outname";
%end;
%end;
@@ -56,7 +58,7 @@
%end;
%else %if &platform=SASVIYA %then %do;
filename _webout filesrvc parenturi="&SYS_JES_JOB_URI" name='_webout.xls'
contenttype='application/vnd.ms-excel'
contenttype='application/vnd.ms-excel'
contentdisp="attachment; filename=&outname";
%end;
%end;
@@ -69,7 +71,7 @@
%end;
%else %if &platform=SASVIYA %then %do;
filename _webout filesrvc parenturi="&SYS_JES_JOB_URI" name='_webout.xls'
contenttype='application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'
contenttype='application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'
contentdisp="attachment; filename=&outname";
%end;
%end;
@@ -102,7 +104,7 @@
%else %if &contentype=HTML %then %do;
%if &platform=SASVIYA %then %do;
filename _webout filesrvc parenturi="&SYS_JES_JOB_URI" name="_webout.json"
contenttype="text/html";
contenttype="text/html";
%end;
%end;
%else %do;
@@ -110,6 +112,11 @@
%return;
%end;
%mp_binarycopy(inloc="&inloc",outref=_webout)
%if &inref ne 0 %then %do;
%mp_binarycopy(inref=&inref,outref=_webout)
%end;
%else %do;
%mp_binarycopy(inloc="&inloc",outref=_webout)
%end;
%mend;

68
base/mp_tree.sas Normal file
View File

@@ -0,0 +1,68 @@
/**
@file
@brief Recursively scans a directory tree to get all subfolders and content
@details
Usage:
%mp_tree(dir=/tmp, outds=work.tree)
Credits:
* Roger Deangelis, https://communities.sas.com/t5/SAS-Programming/listing-all-files-within-a-directory-and-subdirectories/m-p/332616/highlight/true#M74887
* Tom, https://communities.sas.com/t5/SAS-Programming/listing-all-files-of-all-types-from-all-subdirectories/m-p/334113/highlight/true#M75419
@param dir= Directory to be scanned (default=/tmp)
@param outds= Dataset to create (default=work.mp_tree)
@returns outds contains the following variables:
- `dir`: a flag (1/0) to say whether it is a directory or not. This is not
reliable - folders that you do not have permission to open will be flagged
as directories.
- `ext`: file extension
- `filename`: file name
- `dirname`: directory name
- `fullpath`: directory + file name
@version 9.2
**/
%macro mp_tree(dir=/tmp
,outds=work.mp_tree
)/*/STORE SOURCE*/;
data &outds ;
length dir 8 ext filename dirname $256 fullpath $512 ;
call missing(of _all_);
fullpath = "&dir";
run;
%local sep;
%if &sysscp=WIN or &SYSSCP eq DNTHOST %then %let sep=\;
%else %let sep=/;
data &outds ;
modify &outds ;
retain sep "&sep";
rc=filename('tmp',fullpath);
dir_id=dopen('tmp');
dir = (dir_id ne 0) ;
if dir then dirname=fullpath;
else do;
filename=scan(fullpath,-1,sep) ;
dirname =substrn(fullpath,1,length(fullpath)-length(filename));
if index(filename,'.')>1 then ext=scan(filename,-1,'.');
end;
replace;
if dir then do;
do i=1 to dnum(dir_id);
fullpath=cats(dirname,sep,dread(dir_id,i));
output;
end;
rc=dclose(dir_id);
end;
rc=filename('tmp');
run;
%mend;