/*******************************************************************************
 Module Interactivity
 Server part
 Version: 1.0
 Authors: Jean-Pierre Dandrieux, Julien Zorko, Gilles Marchal, Julien Ducoin
 Last update: 12/06/2001
 1 to 1 Audio/Video/Text communication system
*******************************************************************************/
struct TSYCUser=
[
  SYCU_Uid    : I          ,/* User Id */
  SYCU_Class  : S          ,/* User class */
  SYCU_State  : S          ,/* User state */
  SYCU_Email  : I          ,/* Can receive email */
  SYCU_Time   : I          ,/* Time when the last change on the state occured */
  SYCU_Fields : [[S r1]r1]  /* Info fields from DB */
] mkSYCUser;;

var FREE_STATE = "FREE";;
var ANONYMOUS_CLASS = "Anonymous";;

typeof UserList = [TSYCUser r1];;
typeof UserClasses = [[S r1] r1];;
typeof AdminLevelItem = S;;
typeof DBsource = SqlDB;;
typeof SQLrequest = S;;
typeof EmailSender = S;;
typeof EmailColumn = S;;
typeof SendEmailColumn = S ;;
typeof TableName = S ;;
typeof LoginColumn = S ;;

var CompteurSalon = 0;;

defcom CaddUser = AddUser I S S I S;; /* user id, login, state, time, fields */
defcom CremoveUser = RemoveUser I S;;
defcom CclearList = ClearList;;
defcom CmodifyState = ModifyState S S S;; /* login newState iniTime */
defcom CerrorMessage = ErrorMessage S S;; /* title content */
defcom CchangeLogin = ChangeLogin S;;     /* Changement de login. */

defcom CSYCnewSalon = SYCnewSalon I;;
defcom CSYCexecScript = SYCexecScript S;;

fun __SYCtransmitScript ( id , comscript ) =
 _DMSsend this _DMSbyId id CSYCexecScript [comscript] ;;

fun __SYCnewSalonID()=
  set CompteurSalon = CompteurSalon +1 ;
  _DMSsend this DMSsender CSYCnewSalon [CompteurSalon] ;;
  

/* Return 1 if str is in the list, 0 otherwise */
fun IsStringInList (str, list) =
  if list == nil then
    0
  else
    let list -> [first next] in
      if !strcmp first str then
        1
      else
        IsStringInList str next
;; 

/* Error test */
fun TestDB (db, user)=
  let SqlCod db ->Result in
  if  Result == SQL_ERROR then
  (
    let SqlDescErr db -> [etat native message lignes] in
    (
      _DMSsend this (UtoC user) CerrorMessage [(_loc this "SERVER_MSG1" nil) message]
    );
      SqlRollback db;
      0
  )
  else
  (
    SqlCommit db;
    1
  )
;;

/*******************************************************************************
  Add an user to the list "UserList"               
  userId    -> I             : User Id
  class     -> S             : user class
  state     -> S             : state (free, busy...)
  timer     -> I             : time in seconds of the state
            <- [TSYCUser r1] : New users list
*******************************************************************************/
fun AddNewUser (user, class, state) =
  let _DMSgetLogin UtoC user -> login in
  /*SELECT champ1 FROM member_description WHERE member_description.login =?*/
  let SqlRequest DBsource SQLrequest (SQL_VARCHAR login)::nil -> fields in
  ( 
    TestDB DBsource user;
    set UserList = (mkSYCUser[(UgetId user) class state 1 _DMStime fields])::UserList
  )
;;


fun RemoveUser2 (uId, userList) =
  if userList == nil then
    nil
  else
    let userList -> [user next] in
      if (user.SYCU_Uid) == uId then
        next
      else
        user::RemoveUser2 uId next
;;

/*******************************************************************************
  Remove a user from the list "UserList"
  uId       -> I             : User Id
            <- [TSYCUser r1] : New users list
*******************************************************************************/
fun RemoveUser (uId) =
  set UserList = RemoveUser2 uId UserList
;;
    
/*******************************************************************************
  Return the user list that a user can see
*******************************************************************************/
fun GetVisibleUserList2 (userList, user, visibleClasses) =
  if userList == nil then
    nil
  else
    let userList -> [first next] in
    if (first.SYCU_Uid != user.SYCU_Uid) && ((first.SYCU_Class==nil) 
    || (IsStringInList first.SYCU_Class visibleClasses)) then
      first::(GetVisibleUserList2 next user visibleClasses)
    else
      GetVisibleUserList2 next user visibleClasses
;;

fun GetVisibleUserList (user) =
  let switchstr UserClasses user.SYCU_Class -> visibleClasses in
    GetVisibleUserList2 UserList user visibleClasses
;;

/*******************************************************************************
  Return the user list that a user can see
*******************************************************************************/
fun GetSeeingUserList2 (userList, user) =
  if userList == nil then
    nil
  else
    let userList -> [first next] in
    if (first.SYCU_Uid != user.SYCU_Uid) && ((user.SYCU_Class==nil) 
    || (IsStringInList user.SYCU_Class (switchstr UserClasses first.SYCU_Class))) then
      first::(GetSeeingUserList2 next user)
    else
      GetSeeingUserList2 next user
;;


fun GetSeeingUserList (user) =
  GetSeeingUserList2 UserList user
;;


fun SearchUserbyId (uId,userList) =
  if userList == nil then
    nil
  else
    let userList -> [user next] in
      if (user.SYCU_Uid) == uId then
        user
      else
        SearchUserbyId uId next
;;


/*******************************************************************************
 broadcat a defcom to all client defined
 listcli -> [TSYCUser r1]:   all client
 com     -> comm        :
*******************************************************************************/
fun broad(listcli, com)=
  if listcli == nil then
    nil
  else
    let listcli -> [cli next] in
    (
      let com -> [com] in
        _DMSsend this (_DMSbyId (cli.SYCU_Uid)) com;
      broad next com;
    );
  0
;;

/*******************************************************************************
 send to a client userId the user connected list
 Id        -> I             :
 usersList -> [TSYCUser r1] :
           <- I             : always 0
*******************************************************************************/
fun SendAllVisibleUsersToClient (userId, usersList)=
  if usersList == nil then
    0
  else
    let usersList -> [user next] in
    (
      _DMSsend this (_DMSbyId userId) CaddUser[ user.SYCU_Uid 
                                                (_DMSgetLogin _DMSbyId (user.SYCU_Uid)) 
                                                user.SYCU_State
                                                user.SYCU_Time 
                                                strbuild user.SYCU_Fields ];
      SendAllVisibleUsersToClient userId next
    )
;;

/* destroy a client */
fun cbDeleteClient (cli) =
  let CtoU cli -> userCli in
  let UgetId userCli -> userId in
  let SearchUserbyId userId UserList -> user in 
  let _DMSgetLogin cli -> login in
  (
    RemoveUser userId;
    broad GetSeeingUserList user [CremoveUser[userId login]];
    _DMSeventTag this userCli "out" nil nil nil
  )
;;

/* Création d'un client */
fun cbStart (from, user, action, param, others, tag, contFileEd ) =
  let UtoC user -> client in
  if _DMScreateClientDMI this client contFileEd then
  (
    _DMSeventTag this user "entering" nil nil nil;
    /* enregistrement du nouveau client. */
    let UgetId user -> userId in
    let _ITEMname UfindItem user AdminLevelItem -> adminLevel in
    let if adminLevel == nil then ANONYMOUS_CLASS else adminLevel -> adminLevel2 in
    let hd AddNewUser user adminLevel2 FREE_STATE -> sysUser in
    (
      broad GetSeeingUserList sysUser [CaddUser[ userId
                                                 (_DMSgetLogin client)
                                                 sysUser.SYCU_State
                                                 sysUser.SYCU_Time 
                                                 strbuild sysUser.SYCU_Fields ]];                                                 
      SendAllVisibleUsersToClient userId (GetVisibleUserList sysUser)
    )
  )
  else
    nil;
  0
;;

/* Modification du login d'un client */
fun cbChgLogin (from, user, action, param, others, tag) =
  let UgetId user -> userId in
  let SearchUserbyId userId UserList -> sysUser in
  let _ITEMname UfindItem user AdminLevelItem -> adminLevel in
  let if adminLevel == nil then ANONYMOUS_CLASS else adminLevel -> adminLevel2 in
  let _DMSgetLogin UtoC user -> login in
  /*SELECT member_description.champ1 FROM member_description WHERE member_description.login =?*/
  let SqlRequest DBsource SQLrequest (SQL_VARCHAR login)::nil -> fields in
  ( 
    TestDB DBsource user;
    /* update list on the other client windows */
    broad GetSeeingUserList sysUser [CremoveUser[userId login]];
    set sysUser.SYCU_Class = adminLevel2;
    set sysUser.SYCU_Fields = fields;
    
    broad GetSeeingUserList sysUser [CaddUser[ userId
                                               login
                                               sysUser.SYCU_State
                                               sysUser.SYCU_Time 
                                               strbuild sysUser.SYCU_Fields ]];  
                                                
    /* update list on the changing login client */
    _DMSsend this UtoC user CclearList[];
    _DMSsend this UtoC user CchangeLogin[login];
    
    SendAllVisibleUsersToClient userId (GetVisibleUserList sysUser)
  );
  0
;;

/* Activation du mail d'avertissement */
fun cbEmailNotification_enable (from, user, action, param, others, tag) =
  let UgetId user -> userId in
  let SearchUserbyId userId UserList -> sysUser in
    set sysUser.SYCU_Email = 1
;;

/* Désactivation du mail d'avertissement */
fun cbEmailNotification_disable (from, user, action, param, others, tag) =
  let UgetId user -> userId in
  let SearchUserbyId userId UserList -> sysUser in
    set sysUser.SYCU_Email = 0
;;

/*******************************************************************************
  Initialisation of the classes list and the rights for each
*******************************************************************************/ 
fun ConvertRights2 (rights) =
  let strfind ";" rights 0 -> pos in
    if pos == nil then
      rights::nil
    else
      (substr rights 0 pos)::( ConvertRights2 substr rights pos+1 (strlen rights)-pos-1 )
;;   

fun ConvertRights (rights) =
  let strfind " (" rights 0 -> pos in
    (substr rights 0 pos)::(ConvertRights2 substr rights pos+2 (strlen rights)-pos-3)
;;

fun IniClassesList2 (rights) =
  if rights == nil then
    nil
  else
    let rights -> [first next] in
      (ConvertRights first)::(IniClassesList2 next)
;;

fun IniClassesList (rights) =
  set UserClasses = IniClassesList2 rights;
  if (getInfo UserClasses ANONYMOUS_CLASS) == nil then
    set UserClasses = (ANONYMOUS_CLASS::ANONYMOUS_CLASS::nil)::UserClasses
  else 
    nil
;;

/*******************************************************************************
 Defcoms for clients
*******************************************************************************/
fun __ModifyState (newState) =
  let if !strcmp newState FREE_STATE then "-" else "00:00:00" -> iniTime in
  let SearchUserbyId UgetId CtoU DMSsender UserList -> user in
  (
    broad GetSeeingUserList user [CmodifyState [(_DMSgetLogin DMSsender) newState iniTime]];
    set user.SYCU_State = newState;
    set user.SYCU_Time = _DMStime
  )
;;

fun NilToEmptyStr (str)=
  if str == nil then
    "" 
  else 
    str
;;

/*******************************************************************************
  Relay the event
*******************************************************************************/
fun __relay(login,param,i) =
  let _DMSbyLoginI login -> cli in
    _DMSeventTag this CtoU cli strcat "relay." i param nil nil
;;

fun GetODBCInfos(odbcAlias,info)=
  hd switchstr strextr _loadressini strcatn "odbc."::odbcAlias::"."::info::nil
;;

fun GetFieldsAlias (fields) =
  if fields == nil then
    nil
  else
    let fields -> [[field [alias _]] next] in
    if alias == nil then
      GetFieldsAlias next
    else
      alias::(GetFieldsAlias next)
;;

fun GetFieldsList (fields) =
  if fields == nil then 
    nil
  else
    let fields -> [[field [alias _]] next] in
      if alias == nil then
        GetFieldsList next
      else
        field::(GetFieldsList next)
;;       

fun StrcatnWithComma (list) =
  let list -> [first next] in
    if next == nil then
      first
    else
      strcatn first::", "::(StrcatnWithComma next)::nil
;;
 
fun __ring(askCallLogin) =
  let SearchUserbyId UgetId CtoU DMSsender UserList -> sysUser in
  let _DMSgetLogin DMSsender -> login in
  let strcatn "SELECT "::(EmailColumn)::", "::(SendEmailColumn)::" FROM "::TableName::" WHERE "::LoginColumn::"=?"::nil -> req in 
  let hd SqlRequest DBsource req (SQL_VARCHAR login)::nil -> [dbEmail[dbSendEmail _]] in
  let ctime time -> s in
  let substr s 0 (strlen s)-1 -> tim in
    if (strcmp dbSendEmail "1") || (dbEmail==nil) || (sysUser.SYCU_Email!=1) then
      nil
    else 
      _DMSevent this nil "sendMail" strbuild
    	 (("snd"::(EmailSender)::nil)::
    		("rcp"::dbEmail::nil)::
    		("sub"::(_locCli this DMSsender "EMAIL_SUBJECT" askCallLogin::DMSname::tim::nil)::nil)::
    		("txt"::(_locCli this DMSsender "EMAIL_CONTENTS" DMSname::nil)::nil)::nil) nil;
  0
;;


fun IniDMI() =
  let _DMSgetDef this "ComData" -> comData in
  let _DMSgetDef this "Data" -> data in
  let switchstr data "rights" -> rights in
  let strextr getInfo data "OtherFields" -> fields in  
  let getInfo data "SQLsource" -> dbName in  
  let GetODBCInfos dbName "login" -> dbLogin in
  let getInfo data "nbEventRelay" -> nbEventRelay in  
  let NilToEmptyStr GetODBCInfos dbName "password" -> dbPassword in
  let strbuild listcat listcat comData ("nbEventRelay"::nbEventRelay::nil)::nil ("fields"::(GetFieldsAlias fields))::nil -> fileEdit in
  (
    set LoginColumn = getInfo data "LoginColumn";
    set EmailSender =  getInfo data "EmailSender";
    set EmailColumn =  getInfo data "EmailColumn";
    set SendEmailColumn =  getInfo data "SendEmailColumn";
    set TableName =  getInfo data "SQLtable";    
    
    set AdminLevelItem = getInfo data "adminLevel";
    set DBsource = SqlCreate _channel dbName dbLogin dbPassword;
    let StrcatnWithComma GetFieldsList fields -> otherFields in
      if otherFields == nil then
        set SQLrequest = nil
      else
        set SQLrequest =  strcatn "SELECT "::otherFields::" FROM "::TableName::" WHERE "::LoginColumn::"=?"::nil;
    IniClassesList rights;
    _DMSregister this nil @cbDeleteClient nil;
    _DMSdefineActions this ["start" (mkfun7 @cbStart fileEdit)]::
                           ["chgLogin" @cbChgLogin]::
                           ["emailNotification.enable" @cbEmailNotification_enable]::
                           ["emailNotification.disable" @cbEmailNotification_disable]::nil;
    0
  )
;;