/* Consult Server - DMS - nov 1998 by Patrice FAVRE */

typeof db=SqlDB;;
typeof NomDB=S;;
typeof LoginDB=S;;
typeof PasswDB=S;;
typeof LTable=S;;
typeof LColName=S;;
typeof LColEmail=S;;
typeof LColWord=S;;
typeof WTable=S;;
typeof WColName=S;;
typeof WColWord=S;;
typeof NbMax=I;;

defcom CAddElem=AddElem S S S;;


/*-----------------------*/
fun _finsrv()=
  _destroyE nil nil;;

/*-----------------------*/
fun _ConnectDB()=
  set db=SqlCreate _channel NomDB LoginDB PasswDB;
  let if db==nil then "impossible"
      else "effectuée" -> s in
  _fooS strcatn "Connexion à la base <"::NomDB::"> login <"::LoginDB::"> passwd <"::PasswDB::"> "::s::nil;
  if db==nil then _finsrv
  else nil;;

/*-----------------------*/
fun _DisconnectDB()=
  SqlDestroy db;
  _fooS strcatn "Déconnexion de la base <"::NomDB::"> effectuée"::nil;;

/*-----------------------*/
fun _FindLogin(login, lst_login)=
  if lst_login==nil then nil
  else
    let lst_login -> [ l nxt ] in
    if !strcmp login hd l then lst_login
    else _FindLogin login tl lst_login;;

/*-----------------------*/
fun _TraitMots(nom,lst_nom)=
  if lst_nom==nil then ""
  else
    let hd lst_nom -> [ l [ m _ ]] in
    if !strcmp nom l then
      let _TraitMots nom tl lst_nom -> s in
      if (strlen s)==0 then m
      else strcatn m::" "::s::nil
    else "";;

/*-----------------------*/
fun _TraitLogin(lst_count,lst_login,nb)=
  if lst_count==nil || nb==0 then
    _DMSsend this DMSsender CAddElem [ "" "" nil ]
  else (
    let hd lst_count -> [ nom _ ] in
    let _FindLogin nom lst_login -> lst_nom in
    _DMSsend this DMSsender CAddElem [ nom _TraitMots nom lst_nom if (_DMSbyLogin nom) != nil then MSG_CNX else "" ];
    _TraitLogin tl lst_count lst_login nb-1
  );;

/*-----------------------*/
fun _SelectList(nom)=
  _TraitLogin SqlRequest db strcatn "SELECT M2."::WColName::",COUNT(M2."::WColName::")"::
                                    " FROM "::WTable::" M1,"::WTable::" M2"::
                                    " WHERE M1."::WColName::"=?"::
                                    "   AND M2."::WColName::"<>?"::
                                    "   AND M1."::WColWord::"=M2."::WColWord::
                                    " GROUP BY M2."::WColName::
                                    " ORDER BY COUNT(M2."::WColName::") DESC;"::nil
                            (SQL_CHAR nom)::(SQL_CHAR nom)::nil
              SqlRequest db strcatn "SELECT M2."::WColName::",M2."::WColWord::
                                    " FROM "::WTable::" M1,"::WTable::" M2"::
                                    " WHERE M1."::WColName::"=?"::
                                    "   AND M2."::WColName::"<>?"::
                                    "   AND M1."::WColWord::"=M2."::WColWord::
                                    " ORDER BY M2."::WColName::";"::nil
                            (SQL_CHAR nom)::(SQL_CHAR nom)::nil
              NbMax;;

/*-----------------------*/
fun clidestroyed(cli)=
 _DMSevent this cli EVT_DESTROYED nil nil;;

/*-----------------------*/
fun action(from,cli,act,param,rep)=
  if !strcmp act ACT_START then (
    _DMScreateClientDMI this cli nil;
    _SelectList _DMSgetLogin cli
  )
  else
  if !strcmp act ACT_DESTROY then (
    _DMSdelClientDMI this cli;
    clidestroyed cli
  )
  else nil;;

/*-----------------------*/
fun beforeclose()=
  _DisconnectDB;
  0;;
  
/*-----------------------*/
fun IniDMI(s)=
  _DMSregisterDMI this @action @clidestroyed @clidestroyed @beforeclose;
  let strextr _getpack _checkpack s -> l in
  ( set NomDB=getInfo l KW_DBNAME;
    set LoginDB=let (getInfo l KW_DBLOGIN) -> val in
              if val==nil then "" else val;
    set PasswDB=let (getInfo l KW_DBPASSW) -> val in
               if val==nil then "" else val;
    set LTable=getInfo l KW_LTABLE;
    set LColName=getInfo l KW_LCOLNAME;
    set LColEmail=getInfo l KW_LCOLEMAIL;
    set LColWord=getInfo l KW_WCOLWORD;
    set WTable=getInfo l KW_WTABLE;
    set WColName=getInfo l KW_WCOLNAME;
    set WColWord=getInfo l KW_WCOLWORD;
    set NbMax=atoi getInfo l KW_NBMAX
  );
  _ConnectDB;;

/*-----------------------*/
fun __SelName(nom)=
  let hd hd SqlRequest db strcatn "SELECT "::LColEmail::" FROM "::LTable::
                                  " WHERE "::LTable::"."::LColName::"=?;"::nil
                          (SQL_CHAR _DMSgetLogin DMSsender)::nil -> snd in
  let hd hd SqlRequest db strcatn "SELECT "::LColEmail::" FROM "::LTable::
                                  " WHERE "::LTable::"."::LColName::"=?;"::nil
                          (SQL_CHAR nom)::nil -> rcp in
  _DMSevent this DMSsender EVT_SELECT strcatn "snd "::snd::"\nrcp "::rcp::nil nil;;