/*------------------------------------------------------------------------ File : adresse_dict Purpose : Syntax : Description : Author(s) : walter.riechsteiner Created : Thu Jun 26 13:56:20 CEST 2025 Notes : ----------------------------------------------------------------------*/ BLOCK-LEVEL ON ERROR UNDO, THROW. USING OpenEdge.Core.String FROM PROPATH. USING OpenEdge.Net.HTTP.IHttpResponse FROM PROPATH. USING OpenEdge.Net.HTTP.StatusCodeEnum FROM PROPATH. USING OpenEdge.Web.IWebRequest FROM PROPATH. USING OpenEdge.Web.WebHandler FROM PROPATH. USING OpenEdge.Web.WebResponseWriter FROM PROPATH. USING Progress.Json.ObjectModel.JsonObject FROM PROPATH. USING Progress.Json.ObjectModel.JsonArray FROM PROPATH. USING Progress.Json.ObjectModel.ObjectModelParser FROM PROPATH. USING src.ch.adprime.gemis.WebHandlerUtilities FROM PROPATH. USING utilities.utilitiesHandler FROM PROPATH. CLASS admin.menudesignerImpl INHERITS WebHandler: DEFINE VARIABLE ccompany AS CHARACTER NO-UNDO. DEFINE VARIABLE cuser_name AS CHARACTER NO-UNDO. DEFINE VARIABLE cAnzeigeName AS CHARACTER NO-UNDO. DEFINE VARIABLE ilanguage_id AS INTEGER NO-UNDO. DEFINE VARIABLE cSessionToken AS CHARACTER NO-UNDO. DEFINE VARIABLE outilitiesHandler AS utilitiesHandler NO-UNDO. DEFINE TEMP-TABLE tcompanies SERIALIZE-NAME 'companies' FIELD company AS CHARACTER SERIALIZE-NAME 'company' FIELD company_Name AS CHARACTER SERIALIZE-NAME 'company_name' FIELD lselected AS LOGICAL SERIALIZE-NAME 'selected' . DEFINE VARIABLE htcompanies AS HANDLE NO-UNDO. DEFINE TEMP-TABLE tusers FIELD user_name AS CHARACTER FIELD display_name AS CHARACTER . DEFINE VARIABLE htusers AS HANDLE NO-UNDO. DEFINE TEMP-TABLE tlanguages FIELD language_id AS INTEGER FIELD language_name AS CHAR . DEFINE VARIABLE htlanguages AS HANDLE NO-UNDO. DEFINE TEMP-TABLE tLevel1 SERIALIZE-NAME '' FIELD menu_id AS INTEGER FIELD menu_text AS CHARACTER FIELD menu_link AS CHARACTER FIELD level1 AS INTEGER SERIALIZE-NAME 'level1' FIELD level2 AS INTEGER SERIALIZE-NAME 'level2' FIELD level3 AS INTEGER SERIALIZE-NAME 'level3' FIELD openMode AS CHARACTER FIELD admin AS LOGICAL FIELD level1_recid AS RECID SERIALIZE-HIDDEN . DEFINE TEMP-TABLE tLevel2 SERIALIZE-NAME 'children' FIELD level1_recid AS RECID SERIALIZE-HIDDEN FIELD menu_id AS INTEGER FIELD menu_text AS CHARACTER FIELD menu_link AS CHARACTER FIELD level1 AS INTEGER SERIALIZE-NAME 'level1' FIELD level2 AS INTEGER SERIALIZE-NAME 'level2' FIELD level3 AS INTEGER SERIALIZE-NAME 'level3' FIELD openMode AS CHARACTER FIELD admin AS LOGICAL FIELD level2_recid AS RECID SERIALIZE-HIDDEN . DEFINE TEMP-TABLE tLevel3 SERIALIZE-NAME 'children' FIELD level2_recid AS RECID SERIALIZE-HIDDEN FIELD menu_id AS INTEGER FIELD menu_text AS CHARACTER FIELD menu_link AS CHARACTER FIELD level1 AS INTEGER SERIALIZE-NAME 'level1' FIELD level2 AS INTEGER SERIALIZE-NAME 'level2' FIELD level3 AS INTEGER SERIALIZE-NAME 'level3' FIELD openMode AS CHARACTER FIELD admin AS LOGICAL FIELD level3_recid AS RECID SERIALIZE-HIDDEN . DEFINE DATASET menu_structur SERIALIZE-NAME 'menuItem' FOR tLevel1, tLevel2, tLevel3 PARENT-ID-RELATION RELATION1 FOR tLevel1, tLevel2 PARENT-ID-FIELD level1_recid PARENT-ID-RELATION RELATION2 FOR tLevel2, tLevel3 PARENT-ID-FIELD level2_recid . DEFINE VARIABLE hDSmenu_structur AS HANDLE NO-UNDO. /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ METHOD OVERRIDE PROTECTED INTEGER HandleGet (INPUT poRequest AS IWebRequest ): DEFINE VARIABLE oResponse AS IHttpResponse NO-UNDO. DEFINE VARIABLE oWriter AS WebResponseWriter NO-UNDO. DEFINE VARIABLE oBody AS String NO-UNDO. DEFINE VARIABLE cDefautlCharSet AS CHARACTER NO-UNDO INIT 'UTF-8'. DEFINE VARIABLE oParser AS ObjectModelParser NO-UNDO. DEFINE VARIABLE cCorralationID AS CHARACTER NO-UNDO. DEFINE VARIABLE cContent-Type AS CHARACTER NO-UNDO. DEFINE VARIABLE lcJsonInhalt AS LONGCHAR NO-UNDO. DEFINE VARIABLE lOk AS LOGICAL NO-UNDO. DEFINE VARIABLE ii AS INTEGER NO-UNDO. DEFINE VARIABLE dDateTime AS DATETIME NO-UNDO. DEFINE VARIABLE cDateTime AS CHARACTER NO-UNDO. DEFINE VARIABLE oJsonWebmenu AS JsonObject NO-UNDO. DEFINE VARIABLE oJsonResponse AS JsonObject NO-UNDO. DEFINE VARIABLE oJsonCompanies AS JsonArray NO-UNDO. DEFINE VARIABLE oJsonUsers AS JsonArray NO-UNDO. DEFINE VARIABLE oJsonLanguages AS JsonArray NO-UNDO. DEFINE VARIABLE oJsonMenu AS JsonArray NO-UNDO. DEFINE VARIABLE oJsonData AS JsonObject NO-UNDO. DEFINE VARIABLE ccompany AS CHARACTER NO-UNDO. DEFINE VARIABLE cuser_name AS CHARACTER NO-UNDO. DEFINE VARIABLE cnewuser_name AS CHARACTER NO-UNDO. DEFINE VARIABLE rtlevel1 AS RECID NO-UNDO. DEFINE VARIABLE rtlevel2 AS RECID NO-UNDO. DEFINE VARIABLE ilanguage_id AS INTEGER NO-UNDO. DEFINE VARIABLE cFunction AS CHARACTER NO-UNDO. DEFINE VARIABLE lRetVal AS LOGICAL NO-UNDO. DEFINE BUFFER bwebmenu FOR webmenu. outilitiesHandler = NEW utilitiesHandler(). outilitiesHandler:getHeaderData( INPUT poRequest , OUTPUT ccompany , OUTPUT cuser_name , OUTPUT cAnzeigeName , OUTPUT ilanguage_id , OUTPUT cSessionToken ). cFunction = poRequest:URI:GetQueryValue("function") NO-ERROR. ccompany = poRequest:URI:GetQueryValue("company") NO-ERROR. cuser_name = poRequest:URI:GetQueryValue("user_name") NO-ERROR. ilanguage_id = INTEGER(poRequest:URI:GetQueryValue("language_id")) NO-ERROR. MESSAGE 'GET company = ' ccompany 'user_name = ' cuser_name 'Sprache = ' ilanguage_id 'Function = ' cFunction 'Session-Token = ' cSessiontoken. lRetVal = FALSE. DO WHILE cFunction = 'init': EMPTY TEMP-TABLE tcompanies. FOR EACH companies NO-LOCK WHERE companies.active: CREATE tcompanies. BUFFER-COPY companies TO tcompanies. ASSIGN tcompanies.lselected = (IF companies.company = ccompany THEN TRUE ELSE FALSE). END. EMPTY TEMP-TABLE tusers. FOR EACH users NO-LOCK WHERE users.active: CREATE tusers. BUFFER-COPY users TO tusers. END. EMPTY TEMP-TABLE tlanguages. FOR EACH languages NO-LOCK: CREATE tlanguages. BUFFER-COPY languages TO tlanguages. END. oJsonResponse = NEW JsonObject(). oJsonCompanies = NEW JsonArray(). oJsonUsers = NEW JsonArray(). oJsonLanguages = NEW JsonArray(). htcompanies = TEMP-TABLE tcompanies:DEFAULT-BUFFER-HANDLE. htusers = TEMP-TABLE tusers :DEFAULT-BUFFER-HANDLE. htlanguages = TEMP-TABLE tlanguages:DEFAULT-BUFFER-HANDLE. htcompanies:WRITE-JSON('JsonArray', oJsonCompanies ). htusers :WRITE-JSON('JsonArray', oJsonUsers ). htlanguages:WRITE-JSON('JsonArray', oJsonLanguages ). oJsonResponse:ADD('companies', oJsonCompanies). oJsonResponse:ADD('users' , oJsonUsers ). oJsonResponse:ADD('languages', oJsonLanguages). oJsonResponse:WRITE(lcJsonInhalt, FALSE). MESSAGE STRING(lcJsonInhalt). lRetVal = TRUE. LEAVE. END. cnewuser_name = cuser_name. DO WHILE cFunction = 'load': hDSmenu_structur = DATASET menu_structur:HANDLE. EMPTY TEMP-TABLE tlevel1. EMPTY TEMP-TABLE tlevel2. EMPTY TEMP-TABLE tlevel3. DO WHILE TRUE. FIND FIRST webmenu NO-LOCK WHERE webmenu.company = ccompany AND webmenu.user_name = cnewuser_name NO-ERROR. IF AVAILABLE webmenu THEN LEAVE. IF cnewuser_name = 'Admin' THEN LEAVE. cnewuser_name = 'Admin'. END. FOR EACH webmenu NO-LOCK WHERE webmenu.company = ccompany AND webmenu.user_name = cnewuser_name AND webmenu.level1 > 0 : IF webmenu.level2 = 0 THEN DO: CREATE tlevel1. ASSIGN tlevel1.level1_recid = RECID(tLevel1) tlevel1.menu_id = webmenu.level1 tlevel1.menu_text = webmenu.menu_title tlevel1.menu_link = webmenu.menu_link tLevel1.level1 = webmenu.level1 tLevel1.level2 = webmenu.level2 tLevel1.level3 = webmenu.level3 tlevel1.openMode = webmenu.openmode tlevel1.admin = webmenu.ladmin rtlevel1 = RECID(tlevel1). NEXT. END. IF webmenu.level3 = 0 THEN DO: CREATE tlevel2. ASSIGN tlevel2.level1_recid = rtlevel1 tlevel2.level2_recid = RECID(tLevel2) tlevel2.menu_id = webmenu.level2 tlevel2.menu_text = webmenu.menu_title tlevel2.menu_link = webmenu.menu_link tLevel2.level1 = webmenu.level1 tLevel2.level2 = webmenu.level2 tLevel2.level3 = webmenu.level3 tlevel2.openmode = webmenu.openmode tlevel2.admin = webmenu.ladmin rtlevel2 = RECID(tlevel2). NEXT. END. CREATE tlevel3. ASSIGN tlevel3.level2_recid = rtlevel2 tlevel3.level3_recid = RECID(tLevel3) tlevel3.menu_id = webmenu.level3 tlevel3.menu_text = webmenu.menu_title tlevel3.menu_link = webmenu.menu_link tLevel3.level1 = webmenu.level1 tLevel3.level2 = webmenu.level2 tLevel3.level3 = webmenu.level3 tlevel3.openMode = webmenu.openmode tlevel3.admin = webmenu.ladmin . END. oParser = NEW ObjectModelParser(). oJsonResponse = NEW JsonObject(). oJsonMenu = NEW JsonArray (). oJsonData = NEW JsonObject(). oJsonData:READ(hDSmenu_structur). lcJsonInhalt = oJsonData:GetJsonText('menuItem'). ii = INDEX(lcJsonInhalt, '['). lcJsonInhalt = SUBSTRING(lcJsonInhalt, ii). ii = R-INDEX(lcJsonInhalt, ']'). lcJsonInhalt = SUBSTRING(lcJsonInhalt,01,ii). oJsonMenu = CAST(oParser:Parse(lcJsonInhalt), JsonArray) NO-ERROR. oJsonResponse:ADD('menuItems', oJsonMenu). oJsonResponse:WRITE(lcJsonInhalt, FALSE). MESSAGE 'Menustruktur = ' STRING(lcJsonInhalt). lRetVal = TRUE. LEAVE. END. IF NOT lRetVal THEN DO: oJsonResponse = NEW JsonObject(). oJsonResponse:ADD('success', FALSE). oJsonResponse:WRITE(lcJsonInhalt, FALSE). END. cContent-Type = "application/json". cDefautlCharSet = 'utf-8'. oBody = NEW STRING(lcJsonInhalt). WebHandlerUtilities:createHttpResponse(INPUT INTEGER(StatusCodeEnum:OK), INPUT oBody, INPUT cContent-Type, INPUT cDefautlCharSet, INPUT cCorralationID, OUTPUT oResponse). // oResponse:SetHeader(HttpHeaderBuilder:Build(cHeaderCorralationID):Value(cCorralationID):Header). oWriter = NEW WebResponseWriter(oResponse). oWriter:Open(). oWriter:Close(). RETURN 0. CATCH e AS Progress.Lang.Error: END CATCH. FINALLY: END FINALLY. END METHOD. METHOD OVERRIDE PROTECTED INTEGER HandleNotAllowedMethod(INPUT poRequest AS IWebRequest): DEFINE VARIABLE result AS INTEGER NO-UNDO. MESSAGE "HandleNotAllowedMethod called" VIEW-AS ALERT-BOX. RETURN result. END METHOD. METHOD OVERRIDE PROTECTED INTEGER HandleNotImplemented(INPUT poRequest AS IWebRequest): DEFINE VARIABLE result AS INTEGER NO-UNDO. MESSAGE "HandleNotImplemented called" VIEW-AS ALERT-BOX. RETURN result. END METHOD. /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ METHOD OVERRIDE PROTECTED INTEGER HandlePost(INPUT poRequest AS IWebRequest): DEFINE VARIABLE oResponse AS IHttpResponse NO-UNDO. DEFINE VARIABLE oWriter AS WebResponseWriter NO-UNDO. DEFINE VARIABLE oJsonData AS JsonObject NO-UNDO. DEFINE VARIABLE oJsonWebmenu AS JsonArray NO-UNDO. DEFINE VARIABLE oJsonMessage AS JsonObject NO-UNDO. DEFINE VARIABLE oJsonResponse AS JsonObject NO-UNDO. DEFINE VARIABLE oFelder AS JsonArray NO-UNDO. DEFINE VARIABLE oFeld AS JsonObject NO-UNDO. DEFINE VARIABLE oParser AS ObjectModelParser NO-UNDO. DEFINE VARIABLE lRetVal AS LOGICAL NO-UNDO. DEFINE VARIABLE lcJsonString AS LONGCHAR NO-UNDO. DEFINE VARIABLE cJSON AS LONGCHAR NO-UNDO. DEFINE VARIABLE i1 AS INTEGER NO-UNDO. DEFINE VARIABLE cTabellen AS CHARACTER NO-UNDO. DEFINE VARIABLE ccompany AS CHARACTER NO-UNDO. DEFINE VARIABLE cuser_name AS CHARACTER NO-UNDO. DEFINE VARIABLE ilanguage_id AS INTEGER NO-UNDO. DEFINE VARIABLE cMaskenId AS CHARACTER NO-UNDO. lRetVal = WebHandlerUtilities:getJsonFromRequest(INPUT poRequest, OUTPUT oJsonData) NO-ERROR. oJsonData:WRITE(lcJsonString, FALSE). MESSAGE 'ganzer Eingangsstring = ' STRING(lcJsonString). ccompany = oJsonData:GetCharacter('company' ). cuser_name = oJsonData:GetCharacter('user_name' ). ilanguage_id = INTEGER(oJsonData:GetCharacter('language_id')). // Aufbereiten Json-Struktur für READ-JSON in DATASET lcJsonString = oJsonData:GetJsonText('menuItems'). lcJsonString = CHR(123) /* { */ + ' "menuItem": ' + CHR(123) /* { */ + '"": ' + lcJsonString + CHR(125) /* } */ + CHR(125). /* } */ hDSmenu_structur = DATASET menu_structur:HANDLE. hDSmenu_structur:READ-JSON ('LONGCHAR', lcJsonString, 'empty') NO-ERROR. lRetVal = FALSE. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: DEFINE VARIABLE ilevel2 AS INTEGER NO-UNDO. DEFINE VARIABLE ilevel3 AS INTEGER NO-UNDO. // Level2 und level3 neu in 10er-Schritten durchnummerieren FOR EACH tlevel1: ilevel2 = 0. FOR EACH tlevel2 WHERE tLevel2.level1 = tlevel1.level1: ilevel3 = 0. FOR EACH tlevel3 WHERE tLevel3.level1 = tlevel1.level1 AND tLevel3.level2 = tlevel2.level2: ilevel3 = ilevel3 + 10. tlevel3.level3 = ilevel3. END. iLevel2 = ilevel2 + 10. tlevel2.level2 = ilevel2. END. END. FOR EACH webmenu WHERE webmenu.company = ccompany AND webmenu.user_name = cuser_name: DELETE webmenu. END. FOR EACH tlevel1: CREATE webmenu. ASSIGN webmenu.company = ccompany webmenu.user_name = cuser_name webmenu.level1 = tlevel1.level1 webmenu.level2 = 0 webmenu.level3 = 0 webmenu.menu_title = tlevel1.menu_text webmenu.menu_link = tlevel1.menu_link webmenu.ladmin = tlevel1.admin webmenu.openmode = tlevel1.openMode webmenu.created_at = NOW webmenu.updated_at = NOW . END. FOR EACH tlevel2: CREATE webmenu. ASSIGN webmenu.company = ccompany webmenu.user_name = cuser_name webmenu.level1 = tlevel2.level1 webmenu.level2 = tlevel2.level2 webmenu.level3 = 0 webmenu.menu_title = tlevel2.menu_text webmenu.menu_link = tlevel2.menu_link webmenu.ladmin = tlevel2.admin webmenu.openmode = tlevel2.openMode webmenu.created_at = NOW webmenu.updated_at = NOW . END. FOR EACH tlevel3: CREATE webmenu. ASSIGN webmenu.company = ccompany webmenu.user_name = cuser_name webmenu.level1 = tlevel3.level1 webmenu.level2 = tlevel3.level2 webmenu.level3 = tlevel3.level3 webmenu.menu_title = tlevel3.menu_text webmenu.menu_link = tlevel3.menu_link webmenu.ladmin = tlevel3.admin webmenu.openmode = tlevel3.openMode webmenu.created_at = NOW webmenu.updated_at = NOW . END. lRetVal = TRUE. LEAVE. END. oResponse = NEW OpenEdge.Web.WebResponse(). oResponse:StatusCode = INTEGER(StatusCodeEnum:OK). oResponse:ContentType = "application/json;charset=utf-8". oWriter = NEW WebResponseWriter(oResponse). oJsonMessage = NEW JsonObject(). IF lRetVal THEN DO: oJsonMessage:ADD('success', TRUE). oJsonMessage:WRITE(lcJsonString, TRUE). END. ELSE DO: oJsonMessage:ADD('success', TRUE). oJsonMessage:ADD('message', 'Fehler beim erstellen der Menu-Struktur'). oJsonMessage:WRITE(lcJsonString, FALSE). END. MESSAGE 'Rückmeldung ' STRING(lcJsonString). oWriter:Open(). oWriter:Write(lcJsonString). oWriter:Close(). CATCH e AS Progress.Lang.Error: END CATCH. FINALLY: /* DELETE OBJECT oJsonConfig. */ /* DELETE OBJECT oJsonMessage.*/ END FINALLY. END METHOD. END CLASS.