/* <Scol Technologies License> */
/* Copyright (c) 2003, organization : Scol Technologies Association, owner : Sylvain Huet */
/* For conditions of distribution and use, see copyright notice in dms/l/license.txt */
/* or on 'www.scol-technologies.org' */

/* cDHDMS - mar 00 - by Sylvain HUET */
/* download part */

struct RSC=
[nameRSC:S,typeRSC:I,filenameRSC:S,endRSC:fun [S] I,
 priorRSC:I,docRSC:S,sizeRSC:I,doneRSC:I,
 inetRSC:INET,retryRSC:I,accesRSC:S,downloadnameRSC:S]
mkRSC;;

var maxcurrentrsc=4;;
var nbretry=5;;


/* compute the download progress bar values : [denom quot] */
fun RSCcount(i,denom,quot)=
 if i>=DMSnbDmi then [denom quot]
 else let _DMSgetByHandle i -> d in
 let d.curDMI->r in
 if r==nil || r.sizeRSC==nil then RSCcount i+1 denom quot
 else RSCcount i+1 denom+r.doneRSC quot+r.sizeRSC;;


fun _RSCcount()=
 let RSCcount 0 0 0 -> [denom quot] in /* call displaybar denom quot */
  _BARupdate denom quot;
 0;;


/* ressources part */


fun RSCbyname(p,name)=!strcmp p.nameRSC name;;

fun RSCkillcur(t)=
 INETStopURL t.curDMI.inetRSC;
 set t.curDMI=nil;
 _RSCcount;;

fun RSCend(d,r)=
 execch if d.chnDMI==nil then DMSserver else d.chnDMI d.curDMI.endRSC [r];;

fun RSCretry(d)=
 _fooS "retry";
 let d.curDMI->t in
 if t.retryRSC then
 (set t.retryRSC=t.retryRSC-1;
  set t.docRSC=nil;
  set t.accesRSC="d"; /* les retry se font toujours vers le serveur principal */
  set d.listDMI=t::d.listDMI;
  nil)
 else RSCend d nil;;
 
fun searchCont(l,s)=
 if l==nil then nil
 else if !strcmp hd hd l s then tl hd l
 else searchCont tl l s;;

fun RSCcheckControl(d,n,s)=
 if n==nil then
  [0 nil nil] /* download de synchro */
 else
 let searchCont d.controlDMI n -> [sign [acces _]] in
  if sign==nil then [0 nil "d"]
 else let _checkpack s -> p in
  if p==nil then [0 sign acces]
  else [(!strcmp sign _fileSign p) sign acces];;

fun RSCcontrolComparaison(d,n,s)=
 let RSCcheckControl d n s ->[comp _ _] in comp;;
 

fun RSCcheckPostControl(d,n,sign)=
 let hd searchCont d.controlDMI n -> k in
 if k==nil then 1
 else !strcmp k sign;;


proto contRSCprocess=fun[DMI] I;;
 
typeof waitingrsc=[DMI r1];;
var currentrsc=0;;

fun debloquebis(a,b)=contRSCprocess a;;

fun debloque()=
 set currentrsc=currentrsc-1;
 let waitingrsc -> l in
 (set waitingrsc=nil;
  apply_on_list l @debloquebis nil);;


fun cbgetRSC(inet,z,s,reason)=
  let z->[t url] in
 (/*_fooS strcatn ">>>get "::(itoa strlen s)::" bytes from "::url::"("::(itoa reason)::")"::nil;*/
  let t.curDMI->q in
  if (reason==0) then
  (if q.docRSC==nil then set q.sizeRSC=htoi substr s 1 8
   else nil;
   set q.docRSC=strcat q.docRSC s;
   set q.doneRSC=q.doneRSC+strlen s;
   _RSCcount;
   0)
  else
  (if q.inetRSC!=nil then debloque else nil;
   set q.inetRSC=nil;
   if (reason==1) then 
   (set q.docRSC=strcat q.docRSC s;
    let nth_char q.docRSC 0 -> code in
    let substr q.docRSC 9 strlen q.docRSC -> data in
    let if code=='z then unzip data
    else data -> doc in
     (if q.filenameRSC!=nil then
       if (RSCcheckPostControl t q.nameRSC _getlongname doc "" "#") then
       (_storepack doc q.filenameRSC;
        RSCend t q.filenameRSC)
       else
       (_fooS "bad signature";
        _fooS substr q.docRSC 0 256;
        RSCretry t)
      else (RSCend t doc);
      RSCkillcur t;
      contRSCprocess t;
      nil);
    0)
   else
   (_fooS "error on download";
    RSCretry t;
    RSCkillcur t;
    contRSCprocess t)
  )
 )
;;


fun contRSCprocess(t)=
 if t.curDMI!=nil then nil
 else if t.listDMI==nil then nil
 else
  (set t.curDMI=hd t.listDMI;
   set t.listDMI=tl t.listDMI;
   if RSCcontrolComparaison t t.curDMI.nameRSC t.curDMI.filenameRSC
   then
   (RSCend t t.curDMI.filenameRSC;
    RSCkillcur t;
    contRSCprocess t)
   else if t.curDMI.nameRSC==nil then 
   (RSCend t nil;
    RSCkillcur t;
    contRSCprocess t)
   else
   (set t.curDMI.docRSC=nil;
    if currentrsc<maxcurrentrsc then
     let _COMurlDownload t t.curDMI.downloadnameRSC t.curDMI.accesRSC -> url in
     if nil==(set t.curDMI.inetRSC=INETGetURL DMSserver url 0 @cbgetRSC [t url])
     then errHTTP "contRSC" else
     (set currentrsc=currentrsc+1;
      nil)
    else
     (set t.listDMI=(t.curDMI)::t.listDMI;
      set t.curDMI=nil;
      if !findList waitingrsc t then set waitingrsc=conc waitingrsc t::nil
      else nil;
      nil))
 );;

fun _RSCabort(d,rs)=
 if d.curDMI==rs && rs!=nil
 then
 (RSCkillcur d;
  debloque)
 else 
 (set d.listDMI=remove_from_list d.listDMI rs;
  _RSCcount);
 contRSCprocess d;
 0;;

fun _RSCabortDMI(d)=
 set waitingrsc=remove_from_list waitingrsc d;
 set d.listDMI=nil;
 if d.curDMI!=nil then debloque else nil; 
 RSCkillcur d;
 0;;

fun RSCappend(l,a)=
 if l==nil then a::nil
 else let l->[b n] in
 if a.priorRSC < b.priorRSC then a::l
 else b::RSCappend n a;;

fun _RSCdownloadP(d,name,filename,loaded,salve,prior)=
 let RSCcheckControl d name filename ->[comparaison sign acces] in
 if comparaison
 then
 (exec loaded with [filename];nil)
 else let mkRSC [name nil filename loaded prior nil nil 0 nil nbretry acces strcat sign name] -> rs in
 (set d.listDMI= RSCappend d.listDMI rs;
  contRSCprocess d;
  if d.curDMI==nil && !findList d.listDMI rs then nil else rs);;

fun _RSCdownload(d,name,filename,loaded,salve)=
 _RSCdownloadP d name filename loaded salve 0;;


fun _RSCinit()=
 set waitingrsc=nil;
 set currentrsc=0;
 0;;

fun _RSCgetPendingSize(d)=
  sizelist d.listDMI
;;