GeMIS_WEB/dashboard/dashboardImpl.cls

 
/*------------------------------------------------------------------------
   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.
USING OpenEdge.Net.HTTP.HttpHeader FROM PROPATH.

CLASS dashboard.dashboardImpl 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 cUsers            AS CHARACTER        NO-UNDO INIT 'user,admin'.
    
    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 TEMP-TABLE tLevel1
        SERIALIZE-NAME ''
        FIELD menu_id      AS INTEGER 
        FIELD menu_text    AS CHARACTER 
        FIELD menu_link    AS CHARACTER
        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 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 openMode     AS CHARACTER 
        FIELD admin        AS LOGICAL 
        FIELD level3_recid AS RECID     SERIALIZE-HIDDEN 
        .
    DEFINE DATASET menu_structur SERIALIZE-HIDDEN
        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 oJsonResponse   AS JsonObject                   NO-UNDO.
        DEFINE VARIABLE oJsonIdent      AS JsonObject                   NO-UNDO.
        DEFINE VARIABLE oJsonMenu       AS JsonObject                   NO-UNDO.
        DEFINE VARIABLE cDefautlCharSet AS CHARACTER                    NO-UNDO INIT 'UTF-8'.
        DEFINE VARIABLE cContent-Type   AS CHARACTER                    NO-UNDO.
        DEFINE VARIABLE cCorralationID  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 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 cFunction       AS CHARACTER                    NO-UNDO.
        DEFINE VARIABLE lAdmin          AS LOGICAL                      NO-UNDO INIT FALSE.
        DEFINE VARIABLE htwebmenu       AS HANDLE                       NO-UNDO.
        DEFINE VARIABLE oHeader         AS OpenEdge.Net.HTTP.HttpHeader NO-UNDO.
        DEFINE VARIABLE lRetVal         AS LOGICAL                      NO-UNDO.
        DEFINE VARIABLE rtlevel1        AS RECID                        NO-UNDO.
        DEFINE VARIABLE rtlevel2        AS RECID                        NO-UNDO.
        DEFINE VARIABLE cnewuser_name   AS CHARACTER                    NO-UNDO.
        DEFINE VARIABLE cQueryString    AS CHARACTER                    NO-UNDO.
        
        outilitiesHandler = NEW utilitiesHandler().
        
        cQueryString = STRING(poRequest:GetContextValue("QUERY_STRING"))    NO-ERROR.
        outilitiesHandler:getHeaderData(
            INPUT  poRequest    ,
            INPUT  cQueryString ,
            OUTPUT ccompany     ,
            OUTPUT cuser_name   ,
            OUTPUT cAnzeigeName ,
            OUTPUT ilanguage_id ,
            OUTPUT cSessionToken,
            OUTPUT cFunction    ,
            OUTPUT oJsonIdent   
            ).

        oJsonIdent:WriteFile('C:\TEMP\dashboard_GET.json', TRUE).

        cuser_name = oJsonIdent:GetCharacter('H_user_name') NO-ERROR.
        IF NOT ERROR-STATUS:ERROR AND LOOKUP(cuser_name, cUsers, ',') = 0 THEN cUsers = cuser_name + ',' + cUsers.
        cuser_name = oJsonIdent:GetCharacter('user_name') NO-ERROR.
        IF NOT ERROR-STATUS:ERROR AND LOOKUP(cuser_name, cUsers, ',') = 0 THEN cUsers = cuser_name + ',' + cUsers.
        
        lRetVal   = FALSE.
        DO WHILE cFunction = 'init':
            hDSmenu_structur = DATASET menu_structur:HANDLE.
            
            EMPTY TEMP-TABLE tlevel1.
            EMPTY TEMP-TABLE tlevel2.
            EMPTY TEMP-TABLE tlevel3.
            
            DO ii = 1 TO NUM-ENTRIES(cUsers, ','):
                cnewuser_name = ENTRY(ii, cUsers, ',').
                FIND FIRST webmenu NO-LOCK
                    WHERE webmenu.company   = ccompany
                    AND   webmenu.user_name = cnewuser_name NO-ERROR.
                IF AVAILABLE webmenu THEN LEAVE.
                cnewuser_name = ''.
            END.
        
            FIND FIRST users NO-LOCK 
                WHERE users.user_name = oJsonIdent:GetCharacter('H_user_name').
            IF NOT AVAILABLE users THEN LEAVE.
            lAdmin = users.lAdmin.
                     
            FOR EACH webmenu NO-LOCK
                WHERE webmenu.company   = ccompany
                AND   webmenu.user_name = cnewuser_name
                AND   webmenu.level1    > 0 :
                
                IF  NOT lAdmin              AND
                    webmenu.menu_link <> '' AND
                    webmenu.ladmin          THEN NEXT.
                
                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.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.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.openMode     = webmenu.openmode
                    tlevel3.admin        = webmenu.ladmin
                    .
            END.

            cContent-Type   = "application/json".
            cDefautlCharSet = 'utf-8'. 
            oJsonResponse   = NEW JsonObject().
            oJsonMenu       = NEW JsonObject().
            oJsonMenu:READ(hDSmenu_structur).
            oJsonMenu:WRITE(lcJsonInhalt, FALSE).
            ii = INDEX(lcJsonInhalt, '[').
            lcJsonInhalt = SUBSTRING(lcJsonInhalt, ii).
            ii = R-INDEX(lcJsonInhalt, ']').
            lcJsonInhalt = SUBSTRING(lcJsonInhalt,01,ii).
            MESSAGE STRING(lcJsonInhalt).
            
            lRetVal = TRUE.
            LEAVE.
        END.
        
        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 oParser        AS ObjectModelParser            NO-UNDO.           
        DEFINE VARIABLE oJsonResponse  AS JsonObject                   NO-UNDO.
        DEFINE VARIABLE oMessage       AS JsonObject                   NO-UNDO.
        DEFINE VARIABLE oJsonData      AS JsonObject                   NO-UNDO.

        DEFINE VARIABLE lRetVal        AS LOGICAL                      NO-UNDO.
        DEFINE VARIABLE lcJsonString   AS LONGCHAR                     NO-UNDO.
        DEFINE VARIABLE i1             AS INTEGER                      NO-UNDO.

        DEFINE VARIABLE lcMessage      AS LONGCHAR                     NO-UNDO.
        DEFINE VARIABLE lcErrorMessage AS LONGCHAR                     NO-UNDO.
        DEFINE VARIABLE lError         AS LOGICAL                      NO-UNDO.
        DEFINE VARIABLE cString        AS CHARACTER                    NO-UNDO.

        DEFINE VARIABLE oHeader        AS OpenEdge.Net.HTTP.HttpHeader NO-UNDO.
        
        oHeader      = poRequest:GetHeader('X-COMPANY').
        ccompany     = oHeader:VALUE.
        
        oHeader      = poRequest:GetHeader('X-USER-NAME').
        cuser_name    = oHeader:VALUE.
        
        oHeader      = poRequest:GetHeader('X-DISPLAY-NAME').
        cAnzeigeName = oHeader:VALUE.
        
        oHeader = poRequest:GetHeader('X-LANGUAGE-ID').
        ilanguage_id  = INTEGER(oHeader:VALUE).
        
        oHeader = poRequest:GetHeader('X-SESSION-TOKEN').
        cSessionToken = oHeader:VALUE.

        lRetVal = WebHandlerUtilities:getJsonFromRequest(INPUT poRequest, OUTPUT oJsonData) NO-ERROR.
        MESSAGE 'getJsonFromRequest    = ' lRetVal.

        oJsonData:WRITE(lcJsonString, FALSE).
        MESSAGE 'ganzer Eingangsstring = ' STRING(lcJsonString).

        MESSAGE ccompany '-' cuser_name '-' cSessionToken.

        lcErrorMessage    = ''.
        lError            = FALSE.
        outilitiesHandler = NEW utilitiesHandler().
        
        DO WHILE TRUE:
            FIND FIRST users NO-LOCK
                WHERE users.user_name = cuser_name NO-ERROR.
            /*            IF NOT AVAILABLE users THEN              */
            /*            DO:                                      */
            /*                lError = TRUE.                       */
            /*                outilitiesHandler:getErrorMessage (  */
            /*                    INPUT '1990',                    */
            /*                    INPUT 1     , /* Sprcd*/         */
            /*                    INPUT ''    ,    /* Parameter  */*/
            /*                    OUTPUT lcMessage                 */
            /*                    ).                               */
            /*                LEAVE.                               */
            /*            END.                                     */
        
            ilanguage_id = users.language_id.
            
            /*            IF users.password <> cPassword THEN      */
            /*            DO:                                      */
            /*                lError = TRUE.                       */
            /*                outilitiesHandler:getErrorMessage (  */
            /*                    INPUT '1992',                    */
            /*                    INPUT ilanguage_id, /* Sprcd*/   */
            /*                    INPUT ''    ,    /* Parameter  */*/
            /*                    OUTPUT lcMessage                 */
            /*                    ).                               */
            /*                LEAVE.                               */
            /*            END.                                     */
            
            FIND FIRST userauthorization NO-LOCK 
                WHERE userauthorization.company   = ccompany
                AND   userauthorization.user_name = cuser_name NO-ERROR.
            /*            IF NOT AVAILABLE userauthorization THEN        */
            /*            DO:                                            */
            /*                lError = TRUE.                             */
            /*                outilitiesHandler:getErrorMessage (        */
            /*                    INPUT '1991'      ,                    */
            /*                    INPUT ilanguage_id, /* Sprcd*/         */
            /*                    INPUT ''          ,    /* Parameter  */*/
            /*                    OUTPUT lcMessage                       */
            /*                    ).                                     */
            /*                LEAVE.                                     */
            /*            END.                                           */

            /*            REPEAT TRANSACTION ON ERROR UNDO, LEAVE:                */
            /*                FIND FIRST userdata NO-LOCK                         */
            /*                    WHERE userdata.user_name   = cuser_name         */
            /*                    AND   userdata.record_type = 'LOGIN'            */
            /*                    AND   userdata.key_type    = 'company' NO-ERROR.*/
            /*                IF NOT AVAILABLE userdata THEN                      */
            /*                DO:                                                 */
            /*                    CREATE  userdata.                               */
            /*                    ASSIGN                                          */
            /*                        userdata.user_name   = cuser_name           */
            /*                        userdata.record_type = 'LOGIN'              */
            /*                        userdata.key_type    = 'company'.           */
            /*                END.                                                */
            /*                ASSIGN                                              */
            /*                    userdata.cfield_1 = ccompany                    */
            /*                    userdata.cfield_2 = cuser_name.                 */
            /*                RELEASE userdata.                                   */
            /*                LEAVE.                                              */
            /*            END.                                                    */
            
            oResponse             = NEW OpenEdge.Web.WebResponse().
            oResponse:StatusCode  = INTEGER(StatusCodeEnum:OK).
            oResponse:ContentType = "application/json;charset=utf-8".
            oWriter               = NEW WebResponseWriter(oResponse).

            oJsonResponse = NEW JsonObject().
            oJsonResponse:ADD('success'      , TRUE         ).
            oJsonResponse:ADD('session_token', cSessionToken).
            oJsonResponse:ADD('company'      , ccompany     ).
            oJsonResponse:ADD('user_name'    , cuser_name   ).
            oJsonResponse:ADD('language_id'  , ilanguage_id ).
            
            
            oJsonResponse:WRITE(lcJsonString, FALSE).
            MESSAGE 'R�ckmeldung ' STRING(lcJsonString).

            oWriter:Open().
            oWriter:Write(lcJsonString).
            oWriter:Close().
        
            RETURN 0.

        END.
        
        MESSAGE 'Meldung von getErrorMessage ' STRING(lcMessage).
                        
        oResponse             = NEW OpenEdge.Web.WebResponse().
        oResponse:StatusCode  = INTEGER(StatusCodeEnum:OK).
        oResponse:ContentType = "application/json;charset=utf-8".
        oWriter               = NEW WebResponseWriter(oResponse).
        
        oParser       = NEW ObjectModelParser().
        oJsonResponse = NEW JsonObject().
        oJsonResponse:ADD('success', FALSE).
        oJsonResponse:ADD('message', 'ung�ltiger users oder ung�ltiges Passwort!') NO-ERROR.
        oJsonResponse:WRITE(lcJsonString, TRUE).
        
        MESSAGE 'R�ckmeldung ' STRING(lcJsonString).

        oWriter:Open().
        oWriter:Write(lcJsonString).
        oWriter:Close().
        
        RETURN 0.

        CATCH e AS Progress.Lang.Error:

        END CATCH.

        FINALLY:
            DELETE OBJECT oParser NO-ERROR.
        END FINALLY.

    END METHOD.

    /*------------------------------------------------------------------------------
     Purpose:
     Notes:
    ------------------------------------------------------------------------------*/

    METHOD PUBLIC LOGICAL POSTDATAFILLDS( 
        INPUT iphDS AS HANDLE 
        ):
            
        
        RETURN TRUE.

    END METHOD.

END CLASS.