/* Trafic Server - DMS - March 98 - by Sylvain HUET */
defcom Cstart=start S;;
defcom Csend=send S;;
defcom Ctoday=today S;;

typeof text=ObjText;;

typeof file=S;;
typeof ll=[[CLIENT I] r1];;

struct Tmp=
 [month:S,day:S,hour:I,
  dayhits:tab I,dayaff:tab I,dayaffmax:tab I,
  daytime:I,dayuser:I,daytimemax:I,
  totalhits:I,totalaffmax:I,totaltime:I,lastafftime:I]mkTmp;;

typeof tmp=Tmp;;

fun bycli(a,c)=let a->[x _] in x==c;;

fun conc(p,q)=
 if p==nil then q
 else (hd p)::conc (tl p) q;;

fun getTime()=
 let hd strextr ctime time -> l in
 [nth_list l 1 strcat nth_list l 2 nth_list l 0 atoi substr nth_list l 3 0 2];;

fun iniTmp()=
 let getTime->[m d h] in
 mkTmp[m d h mktab 24 0 mktab 24 0 mktab 24 0 0 0 0 0 0 0 time];;

fun getTab(t,i,j)=
 if i>=j then nil else (itoa t.i)::getTab t i+1 j;;

fun TmpToA(t)=
 strbuild 
 (conc t.month::t.day::nil
  conc getTab t.dayhits 0 24
  conc getTab t.dayaff 0 24
  conc getTab t.dayaffmax 0 24
  conc (itoa t.daytime)::(itoa t.dayuser)::(itoa t.daytimemax)::nil
   (itoa t.totalhits)::(itoa t.totalaffmax)::(itoa t.totaltime)::nil)::nil;;

fun sublist(l,n)=
 if n then (atoi hd l)::sublist tl l n-1
 else nil;;

fun AToTmp(ll,t)=
 let hd ll->l in
 (set t.month=nth_list l 0;
  set t.day=nth_list l 1;
  set t.dayhits=listtotab sublist endlist l 2 24;
  set t.dayaff=listtotab sublist endlist l 26 24;
  set t.dayaffmax=listtotab sublist endlist l 50 24;
  set t.daytime=atoi nth_list l 74;
  set t.dayuser=atoi nth_list l 75;
  set t.daytimemax=atoi nth_list l 76;
  set t.totalhits=atoi nth_list l 77;
  set t.totalaffmax=atoi nth_list l 78;
  set t.totaltime=atoi nth_list l 79);;

fun storeMonth(t)=
 _appendpack TmpToA t _getmodifypack strcatn file::"."::t.month::".log"::nil;;

fun updateTmp()=
 _SETtext text strcatn (_loc this "TR_HITS" nil)::" : "::(itoa tmp.totalhits)::" - "::(_loc this "TR_TIME" nil)::" : "::
 (itoa tmp.totaltime)::" - "::(_loc this "TR_SIMULT" nil)::" : "::(itoa tmp.totalaffmax)::nil;
 _storepack TmpToA tmp file;;

fun updateaff()=
 set tmp.dayaff.(tmp.hour)=((time-tmp.lastafftime)*sizelist ll)+
  tmp.dayaff.(tmp.hour);
 set tmp.lastafftime=time;;

fun _clockE(a,b)=
 let getTime->[m d h] in
 if tmp.hour==h && (!strcmp tmp.month m) && (!strcmp tmp.day d) then nil
 else
 (updateaff;
  set tmp.hour=h;
  if (!strcmp tmp.month m) && (!strcmp tmp.day d) then nil
  else
  (storeMonth tmp;
   set tmp=mkTmp[m d h mktab 24 0 mktab 24 0 mktab 24 0 0 0 0
    tmp.totalhits tmp.totalaffmax tmp.totaltime time]);
  updateTmp);;

fun logout(cli)=
 let search_in_list ll @bycli cli -> a in
 if a==nil then nil
 else let a->[_ t0] in let time-t0->t in
 (updateaff;
  set ll=remove_from_list ll a;
  set tmp.daytime=tmp.daytime+t;
  set tmp.dayuser=tmp.dayuser+1;
  if tmp.daytimemax<t then set tmp.daytimemax=t else nil;
  set tmp.totaltime=tmp.totaltime+t;
  updateTmp;
  0);;

fun login(cli)=
 if nil!=search_in_list ll @bycli cli then nil
 else
 (updateaff;
  set ll=[cli time]::ll;
  set tmp.dayhits.(tmp.hour)=1+tmp.dayhits.(tmp.hour);
  set tmp.totalhits=1+tmp.totalhits;
  let sizelist ll -> n in
  (if (tmp.dayaffmax.(tmp.hour))<n then set tmp.dayaffmax.(tmp.hour)=n else nil;
   if tmp.totalaffmax<n then set tmp.totalaffmax=n else nil);
  updateTmp;
  0);;

fun activate(from,cli,action,param,rep)=
 _clockE nil nil;
 if !strcmp action "register" then
  if !_DMSclientAlive cli then nil
  else login cli
 else if !strcmp action "unregister" then
  logout cli
 else if !strcmp action "show" then
  _DMScreateClientDMI this cli nil
 else if !strcmp action "hide" then
  _DMSdelClientDMI this cli
 else nil;;

fun startStat()=
 set tmp=iniTmp;
 let strextr _getpack _checkpack file->l in
  if (sizelist hd l)!=80 then nil
  else AToTmp l tmp;
 _rfltimer _starttimer _channel 60000 @_clockE 0;
 _clockE nil nil;
 updateTmp;
 0;;

fun _resizeI(x,s)=
 let x->[win x y w h] in _SIZEtext text w h x y;
 0;;

fun IniDMI(param)=
 _DMSregisterDMI this @activate @logout nil nil;
 let strextr _getpack _checkpack param ->l in
  (set file=getInfo l "file");
 let _DMSgetZone this "Trafic" nil @_resizeI nil ->[win x y w h] in
 if win==nil then nil
  else set text=_CRtext _channel win x y w h ET_DOWN+ET_AHSCROLL "";
 startStat;;

fun __getmonth(m)=
 let strcatn file::"."::m::".log"::nil -> f in
 (_DMSsend this DMSsender Cstart [f];
  let _getpack _checkpack f -> s in
  if s==nil then nil
  else let strlen s -> sz in
   let 0->i in while i<sz do
   (_DMSsend this DMSsender Csend [substr s i 256];
    set i=i+256);
  _DMSsend this DMSsender Csend [nil]);;

fun __gettoday()=
 _DMSsend this DMSsender Ctoday [TmpToA tmp];;