All Downloads are FREE. Search and download functionalities are using the official Maven repository.

progress.Consultingwerk.Studio.ClassDocumentation.ClassDocumentationParser.cls Maven / Gradle / Ivy

There is a newer version: 229
Show newest version
/**********************************************************************
 * Copyright 2013 Consultingwerk Ltd.                                 *
 *                                                                    *
 * Licensed under the Apache License, Version 2.0 (the "License");    *
 * you may not use this file except in compliance with the License.   *
 * You may obtain a copy of the License at                            *
 *                                                                    *
 *     http://www.apache.org/licenses/LICENSE-2.0                     *
 *                                                                    *
 * Unless required by applicable law or agreed to in writing,         *
 * software distributed under the License is distributed on an        *
 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND,       *
 * either express or implied. See the License for the specific        *
 * language governing permissions and limitations under the License.  *
 *                                                                    *
 **********************************************************************/
/*------------------------------------------------------------------------
    File        : ClassDocumentationParser
    Purpose     :
    Syntax      :
    Description :
    Author(s)   : Mike Fechner / Consultingwerk Ltd.
    Created     : Mon Sep 10 17:53:07 CEST 2012
    Notes       :
  ----------------------------------------------------------------------*/

ROUTINE-LEVEL ON ERROR UNDO, THROW.

USING Consultingwerk.Studio.* FROM PROPATH .
USING Consultingwerk.Util.*   FROM PROPATH .
USING Progress.Lang.*         FROM PROPATH .

CLASS Consultingwerk.Studio.ClassDocumentation.ClassDocumentationParser
    IMPLEMENTS Consultingwerk.ISaxReader:

    DEFINE VARIABLE hSaxHandler          AS HANDLE    NO-UNDO .
    DEFINE VARIABLE lcCharacterData      AS LONGCHAR  NO-UNDO .
    DEFINE VARIABLE iInterfaceSequence   AS INTEGER   NO-UNDO .
    DEFINE VARIABLE iParameterSequence   AS INTEGER   NO-UNDO .
    DEFINE VARIABLE iUsingSequence       AS INTEGER   NO-UNDO .
    DEFINE VARIABLE iMemberSequence      AS INTEGER   NO-UNDO .
    DEFINE VARIABLE cParameterParentGUID AS CHARACTER NO-UNDO .
    DEFINE VARIABLE lExpectingCharacter  AS LOGICAL   NO-UNDO INITIAL FALSE .
    DEFINE VARIABLE cCommentFor          AS CHARACTER NO-UNDO INITIAL ? .
    DEFINE VARIABLE cTextFor             AS CHARACTER NO-UNDO INITIAL ? .

    { Consultingwerk/Studio/ClassDocumentation/dsClassDocumentation.i &REFERENCE-ONLY=REFERENCE-ONLY }

    /*------------------------------------------------------------------------------
        Purpose: Constructor for the ClassDocumentionParser class
        Notes:
    ------------------------------------------------------------------------------*/
    CONSTRUCTOR PUBLIC ClassDocumentationParser ():
        SUPER ().

        FIX-CODEPAGE (lcCharacterData) = "utf-8":U .

        RUN Consultingwerk/sax-reader-handler.p
            PERSISTENT SET hSaxHandler (THIS-OBJECT) .

    END CONSTRUCTOR.

    /*------------------------------------------------------------------------------
        Purpose: Parses a class doc XML document generated by PCT
        Notes:
        @param pcFileName The filename of the XML document generated by the ClassDocumentation task
        @param dsClassDocumentation OUTPUT The dataset with the raw class documentation (pass in BY-REFERENCE)
    ------------------------------------------------------------------------------*/
    METHOD PUBLIC VOID ParseClassDocumentation (pcFileName AS CHARACTER,
                                                INPUT-OUTPUT DATASET dsClassDocumentation):

        DEFINE VARIABLE hSaxReader AS HANDLE NO-UNDO.

        DATASET dsClassDocumentation:EMPTY-DATASET () .

        FILE-INFORMATION:FILE-NAME = pcFileName .
        IF FILE-INFORMATION:FULL-PATHNAME = ? THEN
            UNDO, THROW NEW AppError (SUBSTITUTE ("Invalid file for parsing: &1":U,
                                                  pcFileName),
                                      0) .

        CREATE SAX-READER hSaxReader .
        hSaxReader:HANDLER = hSaxHandler .

        hSaxReader:SET-INPUT-SOURCE ("FILE":U, pcFileName).

        hSaxReader:SAX-PARSE () .

        FINALLY:
            IF VALID-HANDLE (hSaxReader) THEN
                DELETE OBJECT hSaxReader .
        END FINALLY.

    END METHOD .

    /*------------------------------------------------------------------------------
        Purpose: Invoked when the XML parser detects character data.
        Notes:   The parser calls this method to report each chunk of character data.
                 It might report contiguous character data in one chunk, or split it
                 into several chunks. If validation is enabled, whitespace is reported
                 by the IgnorableWhitespace callback
        @param plcCharData A LONGCHAR that contains a chunk of character data.
        @param piNumChars The number of characters contained in the MEMPTR.
    ------------------------------------------------------------------------------*/
    METHOD PUBLIC VOID SaxCharacters (plcCharData AS LONGCHAR,
                                      piNumChars  AS INTEGER):

        IF lExpectingCharacter THEN
            ASSIGN lcCharacterData = lcCharacterData + plcCharData .

    END METHOD .

    /*------------------------------------------------------------------------------
        Purpose: Invoked when the XML parser detects the end of an XML document.
        Notes:
        @param pcNamespaceURI A character string indicating the namespace URI of the element. If namespace processing is not enabled or the element is not part of a namespace, the string is of length zero.
        @param pcLocalName A character string indicating the non-prefixed element name. If namespace processing is not enabled, the string is of length zero.
        @param pcName A character string indicating the actual name of the element in the XML source. If the name has a prefix, qName includes it, whether or not namespace processing is enabled.
    ------------------------------------------------------------------------------*/
    METHOD PUBLIC VOID SaxEndElement (pcNamespaceURI AS CHARACTER,
                                      pcLocalName    AS CHARACTER,
                                      pcName         AS CHARACTER):

        CASE pcName:
            WHEN "interfaces":U THEN
                ASSIGN eInterfaces.InterfaceName = lcCharacterData
                       lcCharacterData           = "":U
                       lExpectingCharacter       = FALSE .
            WHEN "classComment":U THEN
                ASSIGN eUnit.ClassComment  = lcCharacterData
                       lcCharacterData     = lcCharacterData + "~n":U
                       lExpectingCharacter = FALSE.
            WHEN "constrComment":U THEN
                ASSIGN eConstructor.ConstructorComment = lcCharacterData
                       lExpectingCharacter             = FALSE.
            WHEN "destructorComment":U THEN
                ASSIGN eDestructor.DestructorComment   = lcCharacterData
                       lExpectingCharacter             = FALSE.
            WHEN "comment":U OR WHEN "methodComment":U THEN DO:
                CASE cCommentFor:
                    WHEN "M":U THEN DO:
                        ASSIGN eMethod.MethodComment = lcCharacterData
                               lcCharacterData       = "":U
                               lExpectingCharacter   = FALSE.
                    END.
                    WHEN "P":U THEN DO:
                        ASSIGN eProperty.PropertyComment = lcCharacterData
                               lcCharacterData           = "":U
                               lExpectingCharacter       = FALSE.
                    END.
                END CASE .
            END.
            WHEN "eventComment":U THEN
                ASSIGN eEvent.EventComment = lcCharacterData
                       lExpectingCharacter = FALSE.
            WHEN "enumComment":U THEN
                ASSIGN eMember.EnumComment = lcCharacterData
                       lExpectingCharacter = FALSE.
            WHEN "text":U THEN DO:
                IF cTextFor = "temp-table":U THEN
                    ASSIGN eTempTable.SourceCode = lcCharacterData .
                ELSE
                    ASSIGN eDataset.SourceCode = lcCharacterData .

                ASSIGN cTextFor = ? .
            END.
            WHEN "buffer":U THEN DO:
                ASSIGN eDataset.memberBuffers = ListHelper:AddEntry (eDataset.memberBuffers,
                                                                     lcCharacterData) .
            END.

        END CASE .

    END METHOD .

    /*------------------------------------------------------------------------------
        Purpose: Invoked when the XML parser detects the beginning of an element.
        Notes:
        @param pcNamespaceURI A character string indicating the namespace URI of the element. If namespace processing is not enabled or the element is not part of a namespace, the string is of length zero.
        @param pcLocalName A character string indicating the non-prefixed element name. If namespace processing is not enabled, the string is of length zero.
        @param pcName A character string indicating the actual name of the element in the XML source. If the name has a prefix, qName includes it, whether or not namespace processing is enabled.
        @param phAttributes A handle to a SAX-attributes object, which provides access to all attributes specified for the element. If the element has no attributes, attributes is still a valid handle, and the NUM-ITEMS attribute is zero.
    ------------------------------------------------------------------------------*/
    METHOD PUBLIC VOID SaxStartElement (pcNamespaceURI AS CHARACTER,
                                        pcLocalName    AS CHARACTER,
                                        pcName         AS CHARACTER,
                                        phAttributes   AS HANDLE):

        IF pcName <> "unit":U AND NOT AVAILABLE eUnit THEN
            UNDO, THROW NEW AppError (SUBSTITUTE ("Unable to parse element ~"&1~" as there is no ~"unit~" element.":U, pcName), 0) .

        CASE pcName:
            WHEN "unit":U THEN DO:
                CREATE eUnit.
                ASSIGN eUnit.GUID         = GUID
                       iInterfaceSequence = 0
                       lcCharacterData      = "":U .

                BufferHelper:ParseSaxAttributesToBuffer (BUFFER eUnit:HANDLE, phAttributes, FALSE) .
            END.
            WHEN "interfaces":U THEN DO:
                CREATE eInterfaces .
                ASSIGN iInterfaceSequence   = iInterfaceSequence + 1
                       eInterfaces.UnitGUID = eUnit.GUID
                       eInterfaces.Sequence = iInterfaceSequence
                       eInterfaces.GUID     = GUID
                       lcCharacterData      = "":U
                       lExpectingCharacter  = TRUE .
            END.
            WHEN "classComment":U THEN
                ASSIGN lExpectingCharacter = TRUE .
            WHEN "constrComment":U OR WHEN "destructorComment":U OR WHEN "comment":U OR WHEN "propertyComment":U OR
            WHEN "eventComment":U OR WHEN "methodComment":U OR WHEN "text":U THEN DO:
                ASSIGN lExpectingCharacter = TRUE
                       lcCharacterData     = "":U .
            END.
            WHEN "constructor":U THEN DO:
                CREATE eConstructor .
                ASSIGN eConstructor.GUID    = GUID
                       iParameterSequence   = 0
                       cParameterParentGUID = eConstructor.GUID
                       lcCharacterData      = "":U .

                BufferHelper:ParseSaxAttributesToBuffer (BUFFER eConstructor:HANDLE, phAttributes, FALSE) .
            END.
            WHEN "destructor":U THEN DO:
                CREATE eDestructor.
                ASSIGN eDestructor.GUID    = GUID
                       iParameterSequence   = 0
                       lcCharacterData      = "":U .
            END.
            WHEN "method":U THEN DO:
                CREATE eMethod .
                ASSIGN eMethod.GUID         = GUID
                       iParameterSequence   = 0
                       cParameterParentGUID = eMethod.GUID
                       lcCharacterData      = "":U
                       cCommentFor          = "M":U .

                BufferHelper:ParseSaxAttributesToBuffer (BUFFER eMethod:HANDLE, phAttributes, FALSE) .
            END.
            WHEN "parameter":U THEN DO:
               CREATE eParameter .
               ASSIGN iParameterSequence    = iParameterSequence + 1
                      eParameter.GUID       = GUID
                      eParameter.ParentGUID = cParameterParentGUID
                      eParameter.Sequence   = iParameterSequence .

                BufferHelper:ParseSaxAttributesToBuffer (BUFFER eParameter:HANDLE, phAttributes, FALSE) .
            END.
            WHEN "property":U THEN DO:
                CREATE eProperty .
                ASSIGN eProperty.GUID       = GUID
                       lcCharacterData      = "":U
                       cCommentFor          = "P":U .

                BufferHelper:ParseSaxAttributesToBuffer (BUFFER eProperty:HANDLE, phAttributes, FALSE) .
            END.
            WHEN "event":U THEN DO:
                CREATE eEvent .
                ASSIGN eEvent.GUID         = GUID
                       iParameterSequence   = 0
                       cParameterParentGUID = eEvent.GUID
                       lcCharacterData      = "":U .

                BufferHelper:ParseSaxAttributesToBuffer (BUFFER eEvent:HANDLE, phAttributes, FALSE) .
            END.
            WHEN "using":U THEN DO:
                CREATE eUsing.
                ASSIGN iUsingSequence  = iUsingSequence + 1
                       eUsing.GUID     = GUID
                       eUsing.UnitGUID = eUnit.GUID
                       eUsing.Sequence = iUsingSequence .

                BufferHelper:ParseSaxAttributesToBuffer (BUFFER eUsing:HANDLE, phAttributes, FALSE) .
            END.
            WHEN "member":U THEN DO:
                CREATE eMember.
                ASSIGN iMemberSequence = iUsingSequence + 1
                       eMember.GUID     = GUID
                       eMember.UnitGUID = eUnit.GUID
                       eMember.Sequence = iMemberSequence
                       cCommentFor      = "EM":U .

                BufferHelper:ParseSaxAttributesToBuffer (BUFFER eMember:HANDLE, phAttributes, FALSE) .
            END.
            WHEN "enumComment":U THEN DO:
                ASSIGN lExpectingCharacter = TRUE
                       lcCharacterData     = "":U .
            END.
            WHEN "temp-table":U THEN DO:
                CREATE eTempTable .
                ASSIGN eTempTable.GUID      = GUID
                       eTempTable.UnitGUID  = eUnit.GUID
                       lcCharacterData      = "":U
                       cTextFor             = "temp-table":U .

                BufferHelper:ParseSaxAttributesToBuffer (BUFFER eTempTable:HANDLE, phAttributes, FALSE) .
            END.
            WHEN "dataset":U THEN DO:
                CREATE eDataset .
                ASSIGN eDataset.GUID      = GUID
                       eDataset.UnitGUID  = eUnit.GUID
                       lcCharacterData    = "":U
                       cTextFor           = "dataset":U .

                BufferHelper:ParseSaxAttributesToBuffer (BUFFER eDataset:HANDLE, phAttributes, FALSE) .
            END.
            WHEN "field":U OR WHEN "index":U OR WHEN "ttComment":U or WHEN "dsComment":U OR WHEN "definition" THEN DO:
                /* Ignore */
            END.
            WHEN "buffer":U THEN DO:
                ASSIGN lExpectingCharacter = TRUE
                       lcCharacterData     = "":U .
            END.

            OTHERWISE
                UNDO, THROW NEW AppError (SUBSTITUTE ("Unrecognized element ~"&1~".":U, pcName), 0) .
        END CASE .

    END METHOD .

    /*------------------------------------------------------------------------------
        Purpose: Destructor for the ClassDocumentationParser class
        Notes:
    ------------------------------------------------------------------------------*/
    DESTRUCTOR PUBLIC ClassDocumentationParser ():

        IF VALID-HANDLE (hSaxHandler) THEN
            DELETE OBJECT hSaxHandler .

    END DESTRUCTOR.

END CLASS.




© 2015 - 2024 Weber Informatics LLC | Privacy Policy