/**
  @file
  @brief fetch Table Lineage for SAS 9

  Some nice ideas for formatting are available here:
    https://renenyffenegger.ch/notes/tools/Graphviz/examples/index

  <h4> SAS Macros </h4>
  @li mpeinit.sas

  @version 9.3
  @author 4GL Apps Ltd
  @copyright 4GL Apps Ltd.  This code may only be used within Data Controller
    and may not be re-distributed or re-sold without the express permission of
    4GL Apps Ltd.
**/

%mpeinit()

%global table_id direction graphOrientation;

/* enable table id and direction to be passed as url params */
%let exist=%sysfunc(exist(work.SASControlTable));
%let inds=%sysfunc(ifc(&exist=1,SASControlTable,_null_));
%put &=inds;
%let max_depth=50;
data _null_;
  length max_depth $ 8;
  set &inds;
  call symputx('table_id',table_id);
  call symputx('direction',direction);
  call symputx('graphOrientation','LR');
  if max_depth>'0' then call symputx('max_depth',max_depth);
  putlog (_all_)(=);
run;
%put &=max_depth;

%mp_abort(iftrue= (&table_id=undefined)
  ,mac=&_program
  ,msg=%str(Table_id UNDEFINED provided from frontend)
)

data work.info;
  length tableid tablename liburi $64 libref $8;
  drop rc;
  tableid="&table_id";
  call missing(liburi);
  rc=metadata_getattr(tableid,"Name",tablename);
  if metadata_getnasn(tableid,"TablePackage",1,liburi)>0 then do;
    rc=metadata_getattr(liburi,"Libref",libref);
    libref=upcase(libref);
  end;
  tablename=upcase(tablename);
  if missing(libref) then libref='nolib';
  call symputx('libds',cats(libref,'.',tablename));
run;

%mp_abort(iftrue= (&syscc ne 0)
  ,mac=&_program..sas
  ,msg=%str(syscc=&syscc)
)

%let src=%sysfunc(ifc(&direction=REVERSE,src,tgt));
%let tgt=%sysfunc(ifc(&direction=REVERSE,tgt,src));

data work.sourcetable/view=work.sourcetable;
  set &mpelib..MPE_LINEAGE_TABS;
  where &dc_dttmtfmt. lt tx_to ;
  drop tx_from tx_to;
run;

%macro recursivejoin(iter=0
    ,maxiter=&max_depth /* avoid infinite loop */
);
%if &iter=0 %then %do;
  data work.baseds ;
    retain level 0;
    set work.sourcetable;
    where &tgt.tableid="&table_id";
  run;
  %let iter=1;
  proc sql;
%end;
%else %if &iter>&maxiter %then %return;

create table work.appendds as
  select distinct &iter as level
    ,b.*
  from work.baseds a
  left join work.sourcetable b
  on a.&src.tableid=b.&tgt.tableid
  where a.level=%eval(&iter.-1)
  and b.&src.tableid is not null
  and a.&src.tableid is not null
  and a.&src.tableid ne 'N/A';

%let obs=&sqlobs;
insert into work.baseds select * from work.appendds;

%if &obs %then %do;
  %recursivejoin(iter=%eval(&iter.+1) )
%end;

%mend recursivejoin;

%recursivejoin()

proc sql;
create table work.final as
  select distinct *
  from work.baseds(drop=level)
  where jobid is not null;


/* generate graphviz */
filename tmp "%sysfunc(pathname(work))\GraphViz%sysfunc(datetime()).txt"
          lrecl=10000 encoding='utf-8';

/* prepare label with metadata */
proc sql;
create table work.jobs as
  select distinct jobid
    , jobname
    ,quote(cats(jobid))||' [label='||quote(cats(jobname))||'];' as line
  from work.final;
create table work.tables as
  select distinct &src.tableid as tableid
    ,&src.tablename as tablename
    ,&src.libref as libref
    from work.final
    where &src.tableid ne 'N/A'
  union select
    &tgt.tableid as tableid
    ,&tgt.tablename as tablename
    ,&tgt.libref as libref
  from work.final
  where &tgt.tableid ne 'N/A'
  order by libref, tablename;

create table idlookup as
  select tableid as metaid
    ,'TABLE' as metatype
    ,cats(libref,'.',tablename) as metaname
  from work.tables
union
  select jobid as metaid
    ,'JOB' as metatype
    ,jobname as metaname
  from work.jobs
  order by metaid;


data CRAYONS;
length attribute value $8;
infile datalines4 dsd;
input attribute value;
call symput(cats('col',_n_),quote(trim(value)));
datalines;
red,#e6194b
green,#3cb44b
blue,#4363d8
orange,#f58231
purple,#911eb4
cyan,#46f0f0
magenta,#f032e6
lime,#bcf60c
pink,#fabebe
teal,#008080
lavender,#e6beff
brown,#9a6324
beige,#fffac8
maroon,#800000
mint,#aaffc3
olive,#808000
apricot,#ffd8b1
navy,#000075
gray,#808080
black,#00000
yellow,#ffe119
white,#ffffff
bazaar,#98777b
beaver,#9f8170
bisque,#ffe4c4
blond,#faf0be
blush,#de5d83
bole,#79443b
bone,#e3dac9
brass,#b5a642
bronze,#cd7f32
bubbles,#e7feff
buff,#f0dc82
camel,#c19a6b
canary,#ffff99
capri,#00bfff
cardinal,#c41e3a
carmine,#ff0040
celadon,#ace1af
celeste,#b2ffff
cerise,#de3163
cerulean,#007ba7
cherry,#de3163
chestnut,#cd5c5c
cinnabar,#e34234
cinnamon,#d2691e
citrine,#e4d00a
cobalt,#0047ab
coffee,#6f4e37
copper,#b87333
coral,#ff7f50
corn,#fbec5d
cornsilk,#fff8dc
cream,#fffdd0
crimson,#dc143c
daffodil,#ffff31
denim,#1560bd
desert,#c19a6b
drab,#967117
ecru,#c2b280
eggplant,#614051
eggshell,#f0ead6
emerald,#50c878
fallow,#c19a6b
fawn,#e5aa70
fern,#71bc78
flame,#e25822
flax,#eedc82
folly,#ff004f
fuchsia,#ff00ff
fulvous,#e48400
gamboge,#e49b0f
ginger,#b06500
glaucous,#6082b6
glitter,#e6e8fa
gold,#ffd700
grullo,#a99a86
icterine,#fcf75e
indigo,#4b0082
iris,#5a4fcf
ivory,#fffff0
jade,#00a86b
;;;;
run;

proc sort data=work.tables out=work.libs nodupkey;
by libref;
run;
data work.alllibs;
  set work.libs end=last;
  length line $1000. ;
  crayon=symget(cats('col',_n_));
  call symputx(libref,crayon);
  if _n_=1 then do;
    line='subgraph cluster_libs { label="Libraries";';output;
  end;
  line=cats(libref)!!' [label='||quote(cats(libref))||'; style="filled"; color='
    ||cats(crayon)||', shape = Mrecord, fontcolor=white]';output;
  if last then do;
    line='}';output;
  end;
run;

data alltables;
  length line $1000. ;
  set work.tables;
  crayon=symget(libref);
  line=quote(cats(tableid))||' [label="'||cats(tablename)
    !!'", color='!!cats(crayon)
    !!', shape=cylinder,style=filled,fontcolor=white];';
  output;
run;

proc sort
    data=final(keep=&src.tableid jobid &src.libref) out=&src.relations nodupkey;
  by &src.tableid jobid;
proc sort
    data=final(keep=&tgt.tableid jobid &tgt.libref) out=&tgt.relations nodupkey;
  by jobid &tgt.tableid;
run;


data srcrelations;
  set srcrelations;
  length line $1000;
  where srctableid ne 'N/A';
  line=cats(
      '"',cats(srctableid),'" -> "',jobid,'" [color=',symget(srclibref),'];'
    );
data tgtrelations;
  set tgtrelations;
  where tgttableid ne 'N/A';
  length line $1000;
  line=cats(
    '"',cats(jobid),'" -> "',tgttableid,'" [color=',symget(tgtlibref),'];'
  );
run;

data finalfinal;
set work.alllibs(keep=line) work.alltables (keep=line) work.jobs(keep=line)
  work.&src.relations(keep=line) work.&tgt.relations(keep=line) end=last;
if _N_ = 1 then do;
  firstline=line;
  line='strict digraph "'!!"&libds"!!'" {'; output;
  line="rankdir=&graphOrientation; nodesep=0.5; node [shape = octagon];";output;
  line=firstline;
end;
output;
if last then do;
  line='}';
  output;
end;
drop firstline;
run;


%webout(OPEN)
%webout(OBJ,finalfinal)
%webout(OBJ,info)
%webout(OBJ,final,dslabel=flatdata)
%webout(OBJ,idlookup)
%webout(CLOSE)
%mpeterm()
