/* <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' */

/* sDHDMS - mar 00 - by Sylvain HUET */
/* module part */

var preDMI="_load \"dms/l/dhdms/spredmi.pkg\"";;

var DMIok=0;;
var DMIwait=1;;
var DMIoff=2;;

/* ulist management */
fun getUlist(l)=
 if l==nil then nil else let l->[u nxt] in
 ((itoa u.idU)::(itoa u.flagU)::nil)::getUlist nxt;;
 
fun getUliststring(l)=
 if l==nil then nil
 else strbuild getUlist l;;

fun buildulist(l)=
 if l==nil then nil
 else let UgetGlobalUser atoi hd l -> x in
 if x==nil then buildulist tl l
 else x::buildulist tl l;;

/* tag management */

struct InitialTag=[cbITag:fun [S [User r1]] I,modITag:DMI,timeoutITag:I]mkInitialTag;;
struct ClientTagCore=[clientCTag:CLIENT,idCTag:I,countCTag:I,listCTag:[I r1],timeoutCTag:I]mkClientTagCore;;
struct ClientTag=[coreCTag:ClientTagCore,valCTag:I]mkClientTag;;
struct ServerTag=[modSTag:DMI,serverSTag:SERVER,idSTag:I,flagSTag:I]mkServerTag;;

typedef Tag=
  localTag InitialTag
 |clientTag ClientTag;;

struct TagToClient=[baseTTC:Tag,clientTTC:CLIENT,modTTC:DMI,idTTC:I,timeoutTTC:I]mkTagToClient;;
struct TagToServer=[baseTTS:Tag,serverTTS:SERVER,idTTS:I,timeoutTTS:I]mkTagToServer;;

fun ttcbyid(t,id)=t.idTTC==id;;

var tagnumber=0;;
fun newtagnumber()=set tagnumber=tagnumber+1;;

fun makeLocalTag(d,tag)=
 if tag==nil then nil
 else let tag->[cb timeout _] in localTag mkInitialTag [cb d time+timeout];;
 
fun makeClientTag(d,cli,idtag,timeout)=
 if idtag==nil then nil
 else clientTag mkClientTag [mkClientTagCore [cli idtag 0 0::nil timeout] 0];;

fun _DMStagKeepAlive(t)=
 match t with
  (clientTag x -> let x.coreCTag -> y in if findList y.listCTag x.valCTag then nil
    else set y.listCTag=x.valCTag::y.listCTag);
 0;;

/* copy tag */
fun copyTag(t)=
 match t with
 (clientTag x -> let x.coreCTag -> y in
   let set y.countCTag=y.countCTag+1->newid in clientTag mkClientTag [y newid])
 |(_-> t);;

/* tag management */
fun sendClientTag(d,cli,t)=
 if t==nil then nil else
 let match t with
  (localTag x -> x.timeoutITag)
 |(clientTag x -> (_DMStagKeepAlive t; x.coreCTag.timeoutCTag)) -> timeout in
 let newtagnumber -> id in
 (set cli.tagsCLI=(mkTagToClient [t cli d id timeout])::cli.tagsCLI;
  id);;

fun testaliveTag(t)=
 match t with
 (clientTag x -> let x.coreCTag -> y in if y.listCTag!=nil then nil
   else _on_ y.clientCTag Cdeltag [y.idCTag]);
 0;;

fun tagclear(t)=
 match t with
 (clientTag x -> set x.coreCTag.listCTag=remove_from_list x.coreCTag.listCTag x.valCTag);
 0;;

fun _DMStagForget(t)=
 tagclear t;
 testaliveTag t;;
 
fun _DMSreplyTag(t,param,ulist,holdon)=
 match t with
  (localTag x -> execch x.modITag.chnDMI x.cbITag [param ulist])
 |(clientTag x -> let x.coreCTag -> y in _on_ y.clientCTag
    Cfiretag [y.idCTag param getUliststring ulist]);
 if holdon!=1 then _DMStagForget t else _DMStagKeepAlive t;; 

fun _clideltaglist(cli,l)=
 if l==nil then 0
 else let l->[ttc nxt] in
 (set cli.tagsCLI=remove_from_list cli.tagsCLI ttc;
  _DMStagForget ttc.baseTTC;
  _clideltaglist cli nxt);;
  
fun _clideltag(cli,i)=
 let search_in_list cli.tagsCLI @ttcbyid i -> ttc in
 if ttc==nil then nil
 else _clideltaglist cli ttc::nil;;

fun MODdelallclitag(cli)=_clideltaglist cli cli.tagsCLI;;

fun filtertagbymod(l,d)=
 if l==nil then nil
 else let l->[x nxt] in 
 if x.modTTC==d then x::filtertagbymod nxt d
 else filtertagbymod nxt d;;
 
fun MODdelclitag(d,cli)=_clideltaglist cli filtertagbymod cli.tagsCLI d;;

fun filtertagbytimeout(l,t)=
 if l==nil then nil
 else let l->[x nxt] in 
 if (x.timeoutTTC-t)<0 then x::filtertagbytimeout nxt t
 else filtertagbytimeout nxt t;;

fun MODdelclitagtimeout(cli)=_clideltaglist cli filtertagbytimeout cli.tagsCLI time;;
 
fun _clifiretag(cli,i,param,ulist)=let search_in_list cli.tagsCLI @ttcbyid i -> ttc in
 _DMSreplyTag ttc.baseTTC param buildulist hd strextr ulist 1;;

/* condition manager */
fun testcond1(l,u)=
 if l==nil then 1
 else let hd l -> s in let u.cliU-> cli in
 if !strcmp s "!" then
  1-testcond1 tl l u
 else if !strcmp s "login" then
  if !strcmp cli.loginCLI nth_list l 1 then
   testcond1 tl tl l u
  else 0
 else if !strcmp s "notlogin" then
  if strcmp cli.loginCLI nth_list l 1 then
   testcond1 tl tl l u
  else 0
 else if !strcmp s "ip" then
  if !strcmp cli.ipCLI nth_list l 1 then
   testcond1 tl tl l u
  else 0
 else if !strcmp s "local" then
  if (!strcmp cli.ipCLI _hostIP)||(!strcmp cli.ipCLI "127.0.0.1") then
   testcond1 tl l u
  else 0
 else if !strcmp s "notip" then
  if strcmp cli.ipCLI nth_list l 1 then
   testcond1 tl tl l u
  else 0
 else if !strcmp s "activeX" then
  if cli.activeXCLI then
   testcond1 tl l u
  else 0
 else if !strcmp s "item" then  /*test if ref is present*/
  let UfindItem u nth_list l 1 -> i in
   if i!=nil then
    testcond1 tl tl l u
   else 0
 else if !strcmp s "item2" then /*test if ref/name is present*/
  let UfindItem u nth_list l 1 -> i in
   if i!=nil then
    if !strcmp i.nameItem nth_list l 2 then
     testcond1 tl tl tl l u
    else 0
   else 0
 else if !strcmp s "noitem" then /*test if ref is not present*/
  let UfindItem u nth_list l 1 -> i in
   if i==nil then testcond1 tl tl l u
   else 0
 else if !strcmp s "noitem2" then /*test if ref/name is not present*/
  let UfindItem u nth_list l 1 -> i in
   if i==nil then
    testcond1 tl tl tl l u
   else
    if strcmp i.nameItem nth_list l 2 then
     testcond1 tl tl tl l u
    else 0
 else if !strcmp s "items" then /*test if ref is present and quantity enough*/
  let UfindItem u nth_list l 1 -> i in
   if i!=nil && i.countItem>=atoi nth_list l 2 then testcond1 tl tl tl l u
   else 0
 else if !strcmp s "items2" then /*test if ref/name is present and quantity enough*/
  let UfindItem u nth_list l 1 -> i in
   if i!=nil then
    if !strcmp i.nameItem nth_list l 2 then
     if i.countItem>=atoi nth_list l 3 then testcond1 tl tl tl tl l u
    else 0
   else 0
  else 0
 else if !strcmp s "noitems" then
  let UfindItem u nth_list l 1 -> i in
   if i==nil || i.countItem<atoi nth_list l 2 then testcond1 tl tl tl l u
   else 0
 else if !strcmp s "noitems2" then /*test if ref/name is not present or quantity too large*/
  let UfindItem u nth_list l 1 -> i in
   if i!=nil then
    if strcmp i.nameItem nth_list l 2 then testcond1 tl tl tl tl l u
    else
     if i.countItem<atoi nth_list l 3 then testcond1 tl tl tl tl l u
     else 0
   else 0
 else if !strcmp s "language" then
  if !strcmpi cli.langCLI nth_list l 1 then
   testcond1 tl tl l u
  else 0
 else if !strcmp s "nolanguage" then
  if strcmpi cli.langCLI nth_list l 1 then
   testcond1 tl tl l u
  else 0
 else 0;;

fun testcond(cond,user)=
 if cond==nil then 0
 else if (hd cond)!=nil && testcond1 hd cond user then 1
 else testcond tl cond user;;


/* fire events */
fun fireEvent(g,args,k)=
 let g.modGRAPH->d in
 if d==nil || (k && g.fifoGRAPH!=nil) then
 (set g.fifoGRAPH=addFifo args g.fifoGRAPH;
  let args->[x _] in
   match x with (actionPending [_ _ _ _ _ _ tag] -> _DMStagKeepAlive tag);
  0)
 else /*tester si le module est sur ce serveur, sinon, transmettre le message au bon serveur */
 let args->[x where] in
  match x with
  (actionPending [from u act para repl ulist oldtag] ->
    let copyTag oldtag -> tag in
    if where && u.cliU!=nil then /* client action for client user */
     let u.cliU -> cli in
     let Caction [_DMSgetHandle from g.idGRAPH act para repl (getUliststring ulist) (sendClientTag d cli tag)] -> msg in
     if findList cli.activCLI d then _on_ cli msg
     else
     (execch d.chnDMI switchstr d.hookactionsDMI act [cli act];
      if findList cli.activCLI d then _on_ cli msg
      else nil)
    else if d.actionDMI==nil then execch d.chnDMI switchstr d.actionsDMI act [from u act para ulist tag]
     else execch d.chnDMI d.actionDMI [from u.cliU act para repl]);;

/* purge events */
fun purgeEvents(g)=
 if g.fifoGRAPH==nil then 0
 else let getFifo g.fifoGRAPH ->[args newf] in
 (set g.fifoGRAPH=newf;
  let args->[x _] in
  match x with
  (actionPending [_ _ _ _ _ _ tag] ->
   (tagclear tag;
    fireEvent g args 0;
    testaliveTag tag))
 |(_->(fireEvent g args 0;nil));
  purgeEvents g);;

/* receiving messages */
fun _MODreceive(cli,i,c)=
 let _DMSgetByHandle i-> d in
 if d.stateDMI!=DMIok then nil
 else if findList cli.activCLI d then
 let DMSsender -> old in
 (set DMSsender=cli;
  _scriptc d.chnDMI strcat "__" c;
  set DMSsender=old;
  0)
 else nil;;

/* event system */
fun DMSevent3(from,user,param,reply,ulist,tag,l)=
 if l==nil then 0
 else let l->[[dd action param2 reply2 cond where] nxt] in
 (if dd==nil then nil
  else if cond!=nil && !testcond cond user then nil
   else fireEvent dd [(actionPending [from user action niltest param param2 niltest reply reply2 ulist tag]) where] 1;
  DMSevent3 from user param reply ulist tag nxt);;
  
fun DMSevent2(d,user,ev,para,repl,ulist,tag)=
 DMSevent3 d user para repl ulist tag _GRAPHgetLinks d.graphDMI ev;;

/* receiving events */
 
fun _MODreceiveEvent(cli,i,ev,para,rep,ulist,idtag)=
 let _DMSgetByHandle i-> d in
 if d.stateDMI!=DMIok then nil
 else if (findList cli.activCLI d)&&(strFindList d.graphDMI.hookcliGRAPH ev) then
  let makeClientTag d cli idtag DMStimeout -> tag in
  (DMSevent2 d cli.userCLI ev para rep (buildulist hd strextr ulist) tag;
   _DMStagForget tag)
 else nil;;

/* receiving hooks from inactive clients */
fun _MODhook(cli,from,i,act,n)=
 let _DMSgetByHandle i ->d in
 let _DMSgetByHandle from ->dfrom in
 if d==nil || dfrom==nil || (!findList cli.activCLI dfrom) || (!GRAPHfindLinkCli dfrom.graphDMI i act)
  then _on_ cli CpurgeHook [i n]
 else if findList cli.activCLI d then nil
 else
 (execch d.chnDMI switchstr d.hookactionsDMI act [cli act];
  if findList cli.activCLI d then nil
  else _on_ cli CpurgeHook [i n])
 ;;

/* starting modules */
fun DMCloader(name)=
 if fixdirectory && strcmpi substr name 0 4 "dms/" then (_adderror strcat "##dmc is not in dms/ directory : " name;nil)
 else strextr _getpack _checkpack name;;

fun DMCtest(class,l)=
 if l==nil then 0
 else
 (if (_checkpack hd l)==nil then _adderror strcatn "##dmc "::class::" requires "::(hd l)::nil
  else nil;
  DMCtest class tl l);;


fun DMCmkload(l)=
 if l==nil then nil
 else (mkscript Sload [hd l])::DMCmkload tl l;;

fun DMCgetScript(path,dmc)=
 let getConcInfos dmc "serverLoad" -> l in
 if l==nil then getInfo dmc "serverScript"
 else strcatn DMCmkload _DMSrelativpath path l;;

fun _DMSreinitLoc(d)=
 set d.extralangDMI=getConcInfos (_DMSgetDef d "dmi") "extralang";
 iniDMIloc d;
 apply_on_list d.cliDMI @broad CreinitLoc [_DMSgetHandle d];;

/* theme management */
fun getThmFileFromClass(d)=
 let d.classDMI-> file in
 strextr _getpack _checkpack strcat substr file 0 (strlen file)-4 ".thm";;

var filterthm=[".png" 1]::[".bmp" 1]::[".jpg" 1]::["jpeg" 1]::nil;;

fun filterline(l)=
 if l==nil then nil
 else if 1==switchstr filterthm substr hd l (strlen hd l)-4 4 then (hd l)::filterline tl l
 else filterline tl l;;

fun retrieveFilesFromThm(l)=
 if l==nil then [nil "./"]
 else let retrieveFilesFromThm tl l->[lres path] in
  let hd l->[label args] in
  if !strcmp substr label 0 6 "$theme" then [lres hd tl tl hd l]
  else [conc (filterline args) lres path];;

fun concstring(l,path)=
 if l==nil then nil else (strcat path hd l)::concstring tl l path;;

fun mystrcmp(a,b)=strcmp a b;;

fun registerthm(d,thm)=
 _RSunregister d d.thmDMI;
 let strbuild thm -> sthm in
 let _getlongname sthm "thm/.thm" "#" -> name in
 (_RSregister d name RScontrol sthm;
  set d.thmDMI=name);;

fun _DMSaddThm(d,thmsrc)=
 let conc thmsrc d.thmsDMI -> thm in
 (set d.thmsDMI=thm;
  let retrieveFilesFromThm thmsrc ->[lfiles path_thm] in
  let concstring lfiles path_thm -> lf1 in
  let hd strextr d.clientneededDMI -> lf2 in
  let quicksort (conc lf2 lf1) @mystrcmp -> lf in
   (_RSregisterfiles d (_DMSrelativpath _DMSgetpath d.classDMI lf1) RSfile|RScontrol;
    registerthm d thm;
    set d.clientneededDMI=strbuild lf::nil));;

fun starfilter(l)=
 if l==nil then nil
 else let l->[a n] in
 if !strcmp a "*" then starfilter n
 else a::starfilter n;;

/* start module */
fun startDmi(d,dmi)=
 _RSregisterfiles d getConcInfos dmi "register" RScontrol;
 _RSregisterfiles d getConcInfos dmi "registerF" RSfile|RScontrol;
 _DMSreinitLoc d;
 let DMCloader d.classDMI -> dmc in
 let _DMSgetpath d.classDMI -> path in
 (_RSregisterfiles d d.classDMI::nil RScontrol;
  _RSregisterfiles d (_DMSrelativpath path (getConcInfos dmc "register")) RScontrol;
  _RSregisterfiles d (_DMSrelativpath path (getConcInfos dmc "registerF")) RSfile|RScontrol;
  _RSregisterfiles d (_DMSrelativpath path (getConcInfos dmc "clientNeeded")) RScontrol;
  _RSregisterfiles d (_DMSrelativpath path (getConcInfos dmc "clientNeededF")) RSfile|RScontrol; /*seb ajout clientNeededF*/
  _RSregisterfiles d (_DMSrelativpath path (starfilter getConcInfos dmc "clientLoad")) RScontrol;
  let conc _DMSgetDef d "thm" getThmFileFromClass d -> thm in
  if thm==nil then
   set d.clientneededDMI=strbuild (getConcInfos dmi "clientNeeded")::(getConcInfos dmi "clientNeededF")::nil /*seb ajout clientNeededF*/
  else
  (set d.thmsDMI=thm;
   let retrieveFilesFromThm thm ->[lfiles path_thm] in
   let quicksort concstring lfiles path_thm @mystrcmp -> lf in
   (_RSregisterfiles d (_DMSrelativpath path lf) RSfile|RScontrol;
    registerthm d thm;
    set d.clientneededDMI=strbuild (conc lf getConcInfos dmi "clientNeeded")::(conc lf getConcInfos dmi "clientNeededF")::nil)); /*seb ajout clientNeededF*/
  _fooS strcatn ".loading module "::d.graphDMI.defGRAPH.nameDEF::" from class "::d.classDMI::nil;
  set d.chnDMI=_openchannel nil preDMI DMSenv;
  _scriptc d.chnDMI mkscript Sreg [d.graphDMI.idGRAPH];
  _scriptc d.chnDMI DMCgetScript path dmc;
  set d.stateDMI=DMIok;
  _scriptc d.chnDMI mkscript SIniDMI [".dmi"];
  purgeEvents d.graphDMI;
  0);;

fun IniDMI(param)=0;;

/* deconnection */
fun DMSdelete(dl,cli)=
 if dl==nil then 0
 else let dl->[d nxt] in
 (set d.cliDMI=remove_from_list d.cliDMI cli;
  MODdelclitag d cli;
  execch d.chnDMI d.deleteDMI [cli];
  DMSdelete nxt cli);;

fun DMSlogout2(dl,cli)=
 if dl==nil then 0
 else let dl->[d nxt] in
 (DMSlogout2 d.subGRAPH cli;
  UdelClient d.modGRAPH cli;
  execch d.modGRAPH.chnDMI d.modGRAPH.logoutDMI [cli];
  DMSlogout2 nxt cli);;

fun DMSlogout(d,cli)=
 DMSlogout2 d.graphDMI::nil cli;;

/* client module destruction */
fun MODclientDel(d,cli)=
 if d==nil || !findList cli.activCLI d then 0
 else
 (set cli.activCLI=remove_from_list cli.activCLI d;
  set d.cliDMI=remove_from_list d.cliDMI cli;
  MODdelclitag d cli;
  UdelClient d cli;
  1);;

/* API */
fun _DMSrootModule()=DMSdmi.0;;

fun _DMSgetByHandle(h)=
 if h<0 || h>=DMSnbDmi then nil else DMSdmi.h;;

fun _DMSgetName(d)=d.graphDMI.defGRAPH.nameDEF;;

fun _DMSgetHandle(d)=d.graphDMI.idGRAPH;;

fun _DMSgetZones(d)=d.graphDMI.zonesrvGRAPH;;

fun _DMSgetDef(d,s)= _DEFgetDef d.graphDMI.defGRAPH s;;

fun _DMSupdateDef(d,s,val)= _DEFupdate d.graphDMI.defGRAPH s val;0;;

fun _DMSgetDMIclients(d)=d.cliDMI;;

fun _DMSregister(d,flogout,fdelete,fbeforeclose)=
 set d.logoutDMI=flogout;
 set d.deleteDMI=fdelete;
 set d.beforecloseDMI=fbeforeclose;
 0;;

fun _DMIstartModule(g)=
 let _DEFgetDef g.defGRAPH "dmi" -> dmi in
 let getInfo dmi "class" -> class in
 if class==nil && g!=siteGRAPH then nil
 else let mkDMI [g g.idGRAPH class DMIwait nil  nil nil nil nil nil nil nil  nil nil nil nil mkTree [nil mktab SIZE_GRID_MODULO+1 nil nil nil nil]  nil nil nil nil ".dmi" nil nil nil] -> d in
 (set g.modGRAPH=set DMSdmi.(g.idGRAPH)=d;
  if class==nil then
  (set DMSfileCli=strcat DMSpathname ".scc";
   _RSregister d DMSfileCli RScontrol strbuild _DEFgetDef g.defGRAPH "docclient";
   iniDMIloc d;
   nil)
  else startDmi d dmi;
  g);;

fun sendCli(c,cl)=_on_ cl c;;

fun _DMScreateClientDMI(d,cli,s)=
 if d==nil || (findList cli.activCLI d) || cli.chnCLI==nil then 0
 else let _getlocfile d cli ->[_ sign] in
 let d.graphDMI.masterGRAPH.modGRAPH-> father in
 let d.graphDMI.idGRAPH -> id in
 (_DMScreateClientDMI father cli nil;
  _on_ cli Ccreate [father.graphDMI.idGRAPH _DMSgetName d id
    d.classDMI s strbuild d.graphDMI.zonecliGRAPH if sign==nil then nil else d.pathlocDMI];
  let strbuild if sign==nil then d.controlDMI else (d.pathlocDMI::sign::nil)::d.controlDMI -> lf in
   if lf==nil then nil
   else
   (let 0-> i in while i<strlen lf do
    (_on_ cli Caddlf [id substr lf i 512];
     set i=i+512);
    _on_ cli Caddlf [id nil]);
  let strcat (if d.thmDMI==nil then nil else strcat d.thmDMI " ") d.clientneededDMI -> lf in /* HACK !!*/
   if lf==nil then nil
   else
   (let 0-> i in while i<strlen lf do
    (_on_ cli Caddlfneeded [id substr lf i 512];
     set i=i+512);
    _on_ cli Caddlfneeded [id nil]);
  apply_on_list (_GRAPHclientLinks d.graphDMI) @sendCli cli;
  set cli.activCLI=d::cli.activCLI;
  set d.cliDMI=cli::d.cliDMI;
  1);;

fun _MODclientDel(cli,i)=
 let _DMSgetByHandle i -> d in
 if MODclientDel d cli then execch d.chnDMI d.deleteDMI [cli]
 else nil;;

fun _DMSdelClientDMI(d,cli)=
 if MODclientDel d cli then
 (_on_ cli Cdelete [_DMSgetHandle d];
  1)
 else 0;;

fun _DMSsend(d,cli,c)=
 _on_ cli Csend [d.graphDMI.idGRAPH mkscript c];;

fun _DMSdefineActions(d,l)=
 set d.actionsDMI=conc l d.actionsDMI;;

fun _DMSremoveActions(d,l)=
 if l==nil then 0
 else let getSwitchStr d.actionsDMI hd l -> x in
 (if x==nil then nil else set d.actionsDMI=remove_from_list d.actionsDMI x;
  _DMSremoveActions d tl l);;

fun _DMShookInactiveClientActions(d,l)=
 _GRAPHsetHookInactive _DMSgetHandle d l;
 set d.hookactionsDMI=conc l d.hookactionsDMI;;

 
fun _DMSeventTag(d,user,ev,param,ulist,tag)=
 DMSevent2 d user ev param nil ulist makeLocalTag d tag;;

fun _DMSgetClass(d)=d.classDMI;;

fun _DMScbUpload(d,f)=
 set d.cbuploadDMI=f;;

fun _DMSdelete(d)=
 _fooS "####DMSdelete";_fooI d.numDMI;
 if d==nil then nil
 else GRAPHdelete d.graphDMI::nil;;

/* ascendant compatibility */
fun _DMSregisterDMI(d,faction,flogout,fdelete,fbeforeclose)=
 set d.actionDMI=faction;
 _DMSregister d flogout fdelete fbeforeclose;;
fun _DMSgetFullName(d)=GRAPHfullName d.graphDMI;;


fun _DMSreply(d,cli,dest,act,para,repl)=
 fireEvent dest.graphDMI [(actionPending [d cli.userCLI act para repl nil nil]) 0] 1;;

fun _DMSevent(d,cli,ev,para,repl)= DMSevent2 d cli.userCLI ev para repl nil nil;;

/* hack */
fun DMIcheckpack(d,s)=
 if s==nil then nil
 else if !strcmp s ".dmi" then
   let strbuild _DMSgetDef d "dmi" -> Sdmi in
   let _getlongname Sdmi "" "#" -> sign in
   let strcat strcat "tmp/" substr sign 1 strlen sign ".dmi" -> name in
     (_storepack Sdmi name;
      _checkpack name)
 else if (!strcmpi substr s (strlen s)-4 4 ".dat")
  && !strcmp s getInfo _DMSgetDef d "dmi" "data" then
   let strbuild _DMSgetDef d "dat" -> Sdat in
   let _getlongname Sdat "" "#" -> sign in
   let strcat strcat "tmp/" substr sign 1 strlen sign ".dat" -> name in
     (_storepack Sdat name;
      _checkpack name)
 else _checkpack s;;

fun DMIstorepack(d,val,s)=
 if !strcmp s ".dmi" then
 (_DMSupdateDef d "dmi" strextr val;
  _DEFsave;
  0)
 else _storepack val s;;