/* */ /* 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' */ /* KitLocalisation Server - August 99 - by Sebastien DENEUX */ /* last update : 09/11/00 */ var defaultLanguage="english";; /*--------------*/ /*div functions*/ /*--------------*/ fun listcat (p, q)= if p==nil then q else let p -> [h nxt] in h::listcat nxt q;; fun reverse_aux(list,res)= if list == nil then res else reverse_aux (tl list) ((hd list)::res);; fun mirror (list)= reverse_aux list nil;; fun getPathFile (longfile, file)= if (longfile==nil) || (strlen longfile)==0 || (nth_char longfile ((strlen longfile)-1)) == '/ then [longfile file] else getPathFile substr longfile 0 (strlen longfile)-1 strcat substr longfile ((strlen longfile)-1) 1 file;; fun _getNameExt (l, f)= if l==nil then [listtostr mirror f ""] else if (hd l) == '. then [listtostr mirror tl l listtostr mirror f] else _getNameExt tl l listcat f (hd l)::nil;; fun getNameExt (filename)= _getNameExt mirror strtolist filename nil;; fun posInList(liste,e)= if liste == nil then nil else let liste -> [tete queue] in if !strcmp tete e then 0 else 1 + posInList queue e;; fun removef_from_list(l, f, x)= if l==nil then nil else let l -> [a next] in if exec f with [a x] then next else a::removef_from_list next f x;; /*-----------------*/ /*end div functions*/ /*-----------------*/ /*--------------*/ /*fonction de hachage*/ fun hachage(ref)= let ((nth_char ref 0)+(nth_char ref 1))&255 -> x in if x==nil then 0 else x;; /*--------------*/ /*returns the parameter of the list param in function of the number no*/ /*returns !!ERR_PARAM!! if not found*/ fun getParam(param, no)= let nth_list param no -> p in if p==nil then "!!ERR_PARAM!!" else p;; /*------------*/ /*first param = list of all words of the text*/ /*2nd param = list of all parameters*/ /*returns msg as a string with all parameters inserted*/ fun parcoursMessage(messageParamNonInseres,param,NewListe)= let messageParamNonInseres -> [premier suite] in if (premier)!=nil then let "" -> resultat in ( let (strfind "<#" premier 0) -> resOpen in ( while resOpen!=nil do /*loop on all parameters*/ ( if resOpen!=0 then ( set resultat = strcat resultat substr premier 0 (resOpen); /*add char before param*/ set premier = substr premier resOpen ((strlen premier)); /*delete char before param*/ ) else nil; /*premier begins with <#*/ let strfind ">" premier 0 -> resClose in let strfind ":" premier 0 -> resFinNo in ( let substr premier 2 (resFinNo - 2) -> no in /*extract parameter number*/ set resultat = strcat resultat (getParam param atoi no); /*add parameter*/ set premier = substr premier (resClose + 1) ((strlen premier) - resClose + 1); /*delete parameter*/ set resOpen = strfind "<#" premier 0; /*search for next parameter*/ ); ) /*while*/ ); /*let strfind*/ if premier !=nil then set resultat = strcat resultat premier else nil; /*add char after last parameter*/ if NewListe==nil then parcoursMessage suite param (resultat) else if (nth_char NewListe ((strlen NewListe)-1)) == 10 then parcoursMessage suite param strcatn NewListe::resultat::nil else parcoursMessage suite param strcatn NewListe::" "::resultat::nil ) /*let resultat*/ else NewListe;; /*------------*/ fun rebuild(l)= if l==nil then nil else let l->[a b] in if b==nil then a::nil else a::" "::rebuild b;; /*------------*/ /*add all texts of the list res in the hashtable*/ fun parcoursListe(res,tableLangue)= if res==nil then tableLangue else let res->[[ref suite] queue] in let strcatn rebuild suite -> txt in (if (ref==nil)||(txt==nil)||((nth_char ref 0)=='#) then nil else let hachage ref -> i in set tableLangue.(i) = [ref txt]::tableLangue.(i); /*we add the reference*/ parcoursListe queue tableLangue);; /*--------------*/ /*search for the reference ref in the list l [[S S] r1]*/ /*returns the value of the reference*/ /*returns !!ERR_REF!! if reference not found*/ fun chercheRef(ref,l)= if l==nil then "!!ERR_REF!!" else let l->[[refCourante texte] queue] in (if !strcmp refCourante ref then texte else chercheRef ref queue);; /*------------*/ /*returns a hashtable (tab [[S S] r1]) created with s (format strbuild)*/ fun createHashtable(l)= let mktab 256 nil -> tableLangue in parcoursListe l tableLangue;; /*------------*/ /*returns the path of the class*/ fun getClassPath(DMCpathName)= let getPathFile DMCpathName "" -> [a b] in a;; /*------------*/ /*returns the name of the class*/ fun getClassName(DMCpathName)= let getPathFile DMCpathName "" -> [_ b] in let getNameExt b -> [c _] in c;; /*------------*/ /*returns a list containing only the .lang files of the list l*/ fun getLangFiles(l)= if l==nil then nil else let l-> [tete queue] in let getNameExt tete -> [a b] in if !strcmpi b "lang" then tete::(getLangFiles queue) else getLangFiles queue;; /*------------*/ /*returns a string with the contents of the ExtralangDMI files of list l that have the language langue*/ fun addExtralangDMI(l,langue,res)= if l==nil then res else let l-> [tete queue] in let getNameExt tete -> [a currentExt] in /*second extension*/ let getNameExt a -> [_ currentLangue] in /*first extension*/ if !strcmpi currentLangue langue then let _getpack _checkpack tete -> sAdd in addExtralangDMI queue langue (strcat strcat res sAdd "\n") /*modif SD 06-10-00*/ else addExtralangDMI queue langue res;; /*------------*/ /*returns the list of lang files in the directories of list l*/ fun getExtraLangFiles(l)= if l==nil then nil else let _listoffiles hd l -> lfiles in listcat lfiles (getExtraLangFiles tl l);; /*------------*/ /*returns a list without references that begins with a star (hidden)*/ fun getNonHiddenReferences(l)= if l==nil then nil else let l -> [t q] in if (nth_char hd t 0)=='* then getNonHiddenReferences q else t::(getNonHiddenReferences q);; /*------------*/ /*returns a list with all references, substr the star at the beginning of each reference if exists*/ fun getAllReferences(l)= if l==nil then nil else let l -> [t q] in let hd t -> ref in if (nth_char ref 0)=='* then ((substr ref 1 strlen ref)::(tl t))::(getAllReferences q) else t::(getAllReferences q);; /*------------*/ /*initialize the DMI structure with the .lang files contained in the list l*/ fun iniDmiStructure(myDmi,l,serverLanguage,className)= if l==nil then nil else let l-> [tete queue] in let getNameExt tete -> [a currentExt] in /*second extension*/ let getNameExt a -> [currentPath currentLangue] in /*first extension*/ ( if !strcmpi currentExt "lang" then /*check for .lang files*/ let getPathFile currentPath "" -> [_ currentName] in if strcmpi currentName className then nil /*the file name must be the same as the the module class (no case control)*/ else let _getpack _checkpack tete -> s in ( set s = strcat strcat s "\n" addExtralangDMI (getExtraLangFiles myDmi.extralangDMI) currentLangue ""; /*check for extralangDMI if there is a language file to add*/ let strextr s -> lref in let getNonHiddenReferences lref -> lnonHiddenRef in /*keep only references without any * for server only localisation*/ let getAllReferences lref -> lallRef in /*keep all references, substr the star at the beginning of each reference if exist*/ let createHashtable lallRef -> hTable in /*htable with all references*/ let createHashtable lnonHiddenRef -> hTableNonHiddenRef in /*htable with only non hidden references*/ let strbuild lnonHiddenRef -> sNonHidden in let _getlongname sNonHidden "" "#" -> sign in /*calculate a signature*/ let zip sNonHidden -> doc in let strcat (strcat http_header (strcat "z" itoh8 strlen doc)) doc -> cont in (set myDmi.loclistDMI=[currentLangue hTableNonHiddenRef cont sign]::myDmi.loclistDMI; /*update DMI structure*/ if !strcmpi currentLangue serverLanguage then /*load server hashtable*/ set myDmi.locDMI=hTable else nil; 0); ) else nil; iniDmiStructure myDmi queue serverLanguage className; 0 );; /*------------*/ /*returns the server language*/ /*English if ressource not found*/ fun getServerLanguage()= let strlowercase _getress "DefaultLanguage" -> defLang in if (!strcmp defLang "")||(defLang==nil) then defaultLanguage else defLang;; /*returns the hashtable in the language lang contained in the loclistDMI field in the DMI structure*/ /*if cli language not found, returns server htable*/ fun getHtable2(serverLocDMI,l,lang)= if l==nil then serverLocDMI else let l -> [[currentLang currentHtab _ _] queue] in if !strcmpi currentLang lang then currentHtab else getHtable2 serverLocDMI queue lang;; /*------------*/ /*returns the hashtable in the default language contained in the loclistDMI field in the DMI structure*/ fun getHtable(l)= if l==nil then nil else let l -> [[currentLang currentHtab _ _] queue] in if !strcmpi currentLang defaultLanguage then currentHtab else getHtable queue;; /*------------*/ /*returns 1 if serverLanguage exist in l, else nil*/ fun existServerLanguageLocFile(l,suffixServerLanguageLocFile)= if l==nil then nil else if (strfindi suffixServerLanguageLocFile hd l 0)!=nil then 1 else existServerLanguageLocFile tl l suffixServerLanguageLocFile;; /*------------*/ /*called to initialize DMI*/ fun iniDMIloc(myDmi)= set myDmi.loclistDMI=nil; /*reinit dmi loc*/ set myDmi.locDMI=nil; let if myDmi.classDMI == nil then ["dms/l/dhdms/" "dms"] else [strlowercase getClassPath myDmi.classDMI getClassName myDmi.classDMI] -> [DMCpath className] in let strcat DMCpath "lang" -> path in /*language files path on server*/ let strcat strcat DMCpath className ".lang" -> langFileOnClient in let _listoffiles path -> l in let getServerLanguage -> serverLanguage in let if (existServerLanguageLocFile l strcatn "/lang/"::className::"."::serverLanguage::".lang"::nil)!=nil then serverLanguage else defaultLanguage -> serverLocLanguage in /*if server language file does not exist, try to load default language*/ (iniDmiStructure myDmi l serverLocLanguage className; set myDmi.pathlocDMI=langFileOnClient;0);; /*------------*/ fun rebuild2(l)= if l==nil then nil else let l->[a b] in let mirror a -> ltemp in if b==nil then (mirror (hd ltemp)::(tl ltemp)) else listcat (mirror (strcat hd ltemp "\n")::(tl ltemp)) (rebuild2 b);; /*------------*/ /*returns the translation of the reference ref with its parameters param using the hashtable htable*/ /*returns !!ERR_REF!! if reference not found*/ fun _locEx(htable,ref,param)= let hachage ref -> i in let htable.(i)-> l in if l==nil then "!!ERR_REF!!" /*l=[[S S] r1]*/ else if param==nil then chercheRef ref l else let chercheRef ref l -> s in let rebuild2 strextr s -> l2 in if (nth_char s ((strlen s)-1))==10 then strcat parcoursMessage l2 param nil "\n" else parcoursMessage l2 param nil;; /*------------*/ /*returns the translation of the reference in the language of the client cli*/ fun _locCli(myDmi,cli,ref,param)= let cli.langCLI -> cliLanguage in _locEx (getHtable2 myDmi.locDMI myDmi.loclistDMI cliLanguage) ref param;; /*------------*/ /*idem _locCli but we specify a language directly instead of a client*/ fun _locCliEx(myDmi,cliLanguage,ref,param)= _locEx (getHtable2 myDmi.locDMI myDmi.loclistDMI cliLanguage) ref param;; /*------------*/ /*returns the translation of the reference ref with its parameters param in the language of the server*/ fun _loc(myDmi,ref,param)= _locEx myDmi.locDMI ref param;; /*------------*/ fun dmiByLangue(elt,langue)= let elt -> [currentLangue _ _ _] in !strcmpi currentLangue langue;; /*------------*/ /*returns [contents sign]*/ /*if the .lang file in the client language does not exist, we try to load the .lang file in the server language*/ /*if does not exist in the server language, try english language*/ /*else returns nil*/ fun _getlocfile(myDmi,cli)= let search_in_list myDmi.loclistDMI @dmiByLangue cli.langCLI -> e in if e==nil then let search_in_list myDmi.loclistDMI @dmiByLangue getServerLanguage -> e2 in if e2==nil then let search_in_list myDmi.loclistDMI @dmiByLangue defaultLanguage -> e3 in if e3==nil then nil else let e3 -> [_ _ s3 sign3] in [s3 sign3] else let e2 -> [_ _ s2 sign2] in [s2 sign2] else let e -> [_ _ s sign] in [s sign];; /*------------*/ /*add reference to loc table*/ fun _locAddRef(myDmi,language,ref,txt)= let hachage ref -> i in let search_in_list myDmi.loclistDMI @dmiByLangue language -> e in if e==nil then 0 else let e -> [_ tableLangue _ _] in (set tableLangue.(i) = [ref txt]::tableLangue.(i); mutate e <- [_ tableLangue _ _];1);; /*------------*/ fun eltByRef(e,ref)= let e -> [currentRef _] in !strcmp currentRef ref;; /*------------*/ /*delete reference from loc table*/ fun _locDelRef(myDmi,language,ref)= let hachage ref -> i in let search_in_list myDmi.loclistDMI @dmiByLangue language -> e in if e==nil then 0 else let e -> [_ tableLangue _ _] in (set tableLangue.(i) = removef_from_list tableLangue.(i) @eltByRef ref; mutate e <- [_ tableLangue _ _];1);; /*------------*/ fun getLanguages(l)= if l==nil then nil else let l -> [[lang _ _ _] nl] in lang::(getLanguages nl);; /*------------*/ /*returns the list of the languages supported by the module*/ fun _locGetLanguages(d)=getLanguages d.loclistDMI;;