/**
  @file
  @brief Post Edit Hook script for the MPE_DERIVED table
  @details Post edit hooks provide additional backend validation for user
  provided data.  The incoming dataset is named `work.staging_ds` and is
  provided in mpe_loader.sas.

  Available macro variables:
    @li DC_LIBREF - The DC control library
    @li LIBREF - The library of the dataset being edited (is assigned)
    @li DS - The dataset being edited

  This hook normalises the incoming rows and applies the configuration rules
  at submit time, so a bad derived variable is rejected while the submitter is
  still watching - rather than breaking the EDIT screen later, when the view
  is built.

  VAR_DEPS must list every input the expression uses, physical columns
  and derived variables alike.  The hook checks the part that does not need
  the target library: a derived variable referenced by an expression must be
  declared, a variable may not depend on itself, and the resulting graph must
  be acyclic - across the incoming rows and the current rows they do not
  replace.

  The target table is not assigned in this context, so the collision between
  VAR_NM and a physical column, and the resolution of a physical dependency,
  are left to %mpe_derived, which runs with the target library assigned.
  Uniqueness on the business key (LIBREF DSN VAR_NM) is checked by mpe_loader
  before this hook runs, but on the raw submitted values, so it is case
  sensitive: 'Region' and 'REGION' for the same table both pass the loader and
  collide only at approve time.  The post-normalisation check below rejects
  the second one at submit time, naming the variable.

  <h4> SAS Macros </h4>
  @li mf_nobs.sas
  @li mp_abort.sas

  <h4> Related Macros </h4>
  @li mpe_derived.sas
  @li mpe_loader.sas

  @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.

**/

%let errflag=0;
%let errmsg=;

/* a hook is included at execution time, so this is open code - the macro
  language has to be inside a macro definition for %local to be valid */
%macro _mpe_derived_postedit();
  %global errflag errmsg;
  %local left nready cyc_start cyc_cur cyc_next cyc_path cyc_seen cyc_i
    cyc_n cyc_found;

/* normalise the incoming values */
data work.staging_ds;
  set work.staging_ds;
  if upcase(_____DELETE__THIS__RECORD_____) ne 'YES' then do;
    libref=upcase(strip(libref));
    dsn=upcase(strip(dsn));
    var_nm=upcase(strip(var_nm));
    var_type=upcase(strip(var_type));
    var_fmt=upcase(strip(var_fmt));
    var_label=strip(var_label);
    var_deps=upcase(strip(var_deps));
    var_logic=strip(var_logic);
  end;
run;

/**
  * Duplicate names after normalisation - mpe_loader compares the raw values,
  * so a case variant reaches us here
  */
proc sql;
create table work.derived_dup as
  select libref, dsn, var_nm, count(*) as n
  from work.staging_ds
  where upcase(_____DELETE__THIS__RECORD_____) ne 'YES'
  group by libref, dsn, var_nm
  having count(*)>1;
quit;

data _null_;
  set work.derived_dup(obs=1);
  call symputx('errmsg'
    ,cats('MPE_DERIVED: ',var_nm,' is declared more than once for '
      ,libref,'.',dsn));
run;

%mp_abort(iftrue= (0 < %mf_nobs(work.derived_dup))
  ,mac=mpe_derived_postedit
  ,msg=%superq(errmsg)
)

/**
  * Field level checks - the same rules %mpe_derived applies at read time
  */
data work.derived_check;
  set work.staging_ds;
  length reason $200;
  if upcase(_____DELETE__THIS__RECORD_____)='YES' then delete;
  call missing(reason);

  if missing(libref) or missing(dsn) then reason='LIBREF and DSN are required';
  else if var_nm='' then reason='VAR_NM is required';
  else if verify(strip(var_nm),'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_')>0
    then reason='VAR_NM must be a valid SAS name';
  else if verify(substr(var_nm,1,1),'0123456789')=0
    then reason='VAR_NM must not start with a digit';
  else if var_nm='_____DELETE__THIS__RECORD_____'
    then reason='VAR_NM is reserved';
  else if var_type not in ('C','N')
    then reason='VAR_TYPE must be C or N';
  else if missing(var_len) or var_len ne int(var_len) or var_len<1
    then reason='VAR_LEN must be a positive integer';
  else if var_type='C' and var_len>32767
    then reason='VAR_LEN exceeds 32767 for a character variable';
  else if var_type='N' and var_len>8
    then reason='VAR_LEN exceeds 8 for a numeric variable';
  else if index(var_fmt,';')>0 or indexc(var_fmt,'&%')>0
    or index(var_fmt,'/*')>0 or index(var_fmt,'*/')>0
    then reason='VAR_FMT must be a format name, without ; & % or //*';
  else if verify(strip(var_fmt),'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$.')>0
    then reason='VAR_FMT must be a format name';
  else if missing(var_logic)
    then reason='VAR_LOGIC is required';
  else if index(var_logic,';')>0
    then reason='VAR_LOGIC must be a single expression - remove the ;';
  else if indexc(var_logic,'&%')>0
    then reason='VAR_LOGIC must not contain macro triggers';
  else if index(var_logic,'/*')>0 or index(var_logic,'*/')>0
    then reason='VAR_LOGIC must not contain comments';

  if not missing(reason) then output;
run;

%if %mf_nobs(work.derived_check)>0 %then %do;
  data _null_;
    set work.derived_check(obs=1);
    call symputx('errmsg',cats('MPE_DERIVED: ',var_nm,': ',reason));
    call symputx('errflag',1);
  run;
%end;

%mp_abort(iftrue= (&errflag=1)
  ,mac=mpe_derived_postedit
  ,msg=%superq(errmsg)
)

/**
  * The graph has to hold for the resulting configuration: the incoming rows
  * plus the current rows of the same tables that this submission does not
  * replace.
  */
proc sql;
create table work.derived_rows as
  select libref, dsn, upcase(strip(var_nm)) as name
    ,upcase(strip(var_deps)) as deps
    ,strip(var_logic) as logic
  from work.staging_ds
  where upcase(_____DELETE__THIS__RECORD_____) ne 'YES'
  union all
  select libref, dsn, upcase(strip(var_nm)) as name
    ,upcase(strip(var_deps)) as deps
    ,strip(var_logic) as logic
  from &DC_LIBREF..mpe_derived
  where &dc_dttmtfmt. lt tx_to
    and catx('.',libref,dsn,var_nm) not in
      (select catx('.',libref,dsn,var_nm) from work.staging_ds)
    and catx('.',libref,dsn) in
      (select catx('.',libref,dsn) from work.staging_ds);
quit;

data work.derived_dep;
  set work.derived_rows;
  length dep_nm $32;
  do i=1 to countw(deps,' ');
    dep_nm=scan(deps,i,' ');
    if not missing(dep_nm) then output;
  end;
  keep libref dsn name dep_nm;
run;

data work.derived_ref;
  set work.derived_rows;
  length l $4000 tok $32;
  l=prxchange("s/'([^']|'')*'//",-1,logic);
  l=prxchange('s/"([^"]|"")*"//',-1,l);
  l=prxchange('s/[^A-Za-z0-9_]/ /',-1,upcase(l));
  do i=1 to countw(l,' ');
    tok=scan(l,i,' ');
    if not missing(tok) then output;
  end;
  keep libref dsn name tok;
run;

proc sql;
create table work.derived_self as
  select libref, dsn, name, dep_nm
  from work.derived_dep
  where name=dep_nm;

create table work.derived_undeclared as
  select r.libref, r.dsn, r.name, r.tok as dep_nm
  from work.derived_ref r
  where exists (
      select 1 from work.derived_rows n
      where n.libref=r.libref and n.dsn=r.dsn and n.name=r.tok
    )
    and r.tok ne r.name
    and not exists (
      select 1 from work.derived_dep d
      where d.libref=r.libref and d.dsn=r.dsn and d.name=r.name
        and d.dep_nm=r.tok
    );
quit;

/* the message is always prepared, the abort is driven by the count - an
  iftrue=1 inside a wrapping %if leaves the step alive on some engines */
data _null_;
  set work.derived_self(obs=1);
  call symputx('errmsg'
    ,cats('MPE_DERIVED: ',name,': VAR_DEPS may not list itself'));
run;

%mp_abort(iftrue= (0 < %mf_nobs(work.derived_self))
  ,mac=mpe_derived_postedit
  ,msg=%superq(errmsg)
)

data _null_;
  set work.derived_undeclared(obs=1);
  call symputx('errmsg'
    ,cats('MPE_DERIVED: ',name,': VAR_LOGIC references ',dep_nm
      ,', which is not in VAR_DEPS'));
run;

%mp_abort(iftrue= (0 < %mf_nobs(work.derived_undeclared))
  ,mac=mpe_derived_postedit
  ,msg=%superq(errmsg)
)

/* the inverse of the check above: a declared name the expression never uses
  is stale, and the read-time engine rejects it too */
proc sql;
create table work.derived_stale as
  select d.libref, d.dsn, d.name, d.dep_nm
  from work.derived_dep d
  where not exists (
    select 1 from work.derived_ref r
    where r.libref=d.libref and r.dsn=d.dsn and r.name=d.name
      and r.tok=d.dep_nm
  );
quit;

data _null_;
  set work.derived_stale(obs=1);
  call symputx('errmsg'
    ,cats('MPE_DERIVED: ',name,': VAR_DEPS lists ',dep_nm
      ,', which VAR_LOGIC does not reference'));
run;

%mp_abort(iftrue= (0 < %mf_nobs(work.derived_stale))
  ,mac=mpe_derived_postedit
  ,msg=%superq(errmsg)
)

/**
  * Cycle check - repeatedly take the variables whose derived inputs have all
  * been placed; a round that places nothing leaves a cycle
  */
proc sql;
create table work.derived_edge as
  select d.libref, d.dsn, d.name as child, d.dep_nm as parent
  from work.derived_dep d
  where d.dep_nm in (select name from work.derived_rows);
quit;

data work.derived_todo;
  set work.derived_rows(keep=libref dsn name);
run;

%let left=%mf_nobs(work.derived_todo);
%let cyc_found=0;

%do %while (&left>0);
  proc sql;
  create table work.derived_ready as
    select t.libref, t.dsn, t.name
    from work.derived_todo t
    where not exists (
      select 1 from work.derived_edge e
      inner join work.derived_todo t2
        on e.libref=t2.libref and e.dsn=t2.dsn and e.parent=t2.name
      where e.libref=t.libref and e.dsn=t.dsn and e.child=t.name
    );
  quit;

  %let nready=%mf_nobs(work.derived_ready);
  %if &nready=0 %then %do;
    /* walk the edges, so the message names the cycle rather than just the
      names that could not be placed */
    %let cyc_n=%mf_nobs(work.derived_todo);
    data _null_;
      set work.derived_todo(obs=1);
      call symputx('cyc_start',name);
    run;
    %let cyc_path=&cyc_start;
    %let cyc_cur=&cyc_start;
    %let cyc_seen=%str(.&cyc_start..);
    %do cyc_i=1 %to &cyc_n;
      %let cyc_next=;
      proc sql noprint;
        select e.parent into: cyc_next
        from work.derived_edge e
        where e.child="&cyc_cur"
          and catx('.',e.libref,e.dsn,e.parent) in
            (select catx('.',libref,dsn,name) from work.derived_todo);
      quit;
      %if %length(&cyc_next)=0 %then %let cyc_i=&cyc_n;
      %else %do;
        %let cyc_path=&cyc_path. -> &cyc_next;
        %if %index(&cyc_seen,%str(.&cyc_next..))>0 %then %let cyc_i=&cyc_n;
        %else %do;
          %let cyc_seen=&cyc_seen.&cyc_next..;
          %let cyc_cur=&cyc_next;
        %end;
      %end;
    %end;
    /* leave the loop before aborting - an abort that only cancels the step
      would re-enter it with the ready count still zero */
    %let cyc_found=1;
    %let left=0;
  %end;

  %if &cyc_found=0 %then %do;
    proc sql;
    delete from work.derived_todo
      where catx('.',libref,dsn,name) in
        (select catx('.',libref,dsn,name) from work.derived_ready);
    quit;

    %let left=%mf_nobs(work.derived_todo);
  %end;
%end;

%mp_abort(iftrue= (&cyc_found=1)
  ,mac=mpe_derived_postedit
  ,msg=%str(VAR_DEPS contains a cycle: &cyc_path)
)

%mend _mpe_derived_postedit;

%_mpe_derived_postedit()