The class-based sample application consists of several class definition files and a procedure file. These files define several classes, an interface, and a procedure that drives the class-based application. The following is a description of the relationships among the classes, interface, and procedure, using unqualified names for the application classes and interface for readability:

Abstract Class CommonObj INHERITS Class Progress.Lang.Object
    instantiates and uses Class MsgObj

  Class CustObj INHERITS Abstract Class CommonObj 
            and IMPLEMENTS Interface IBusObj
    instantiates and uses Class CreditObj
    instantiates and uses Class MsgObj

    Class NECustObj INHERITS Class CustObj

Class MsgObj INHERITS Class Progress.Lang.Object

Class CreditObj INHERITS Class Progress.Lang.Object

Class HelperClass INHERITS Class Progress.Lang.Object
  instantiates and uses Class MsgObj
  uses Abstract Class CommonObj
  uses Class CustObj
  uses Interface IBusObj

Class Main INHERITS Class Progress.Lang.Object
  instantiates and uses Class HelperClass
  instantiates and uses Class CustObj
  instantiates and uses Class NECustObj
  uses Abstract Class CommonObj
  uses Interface IBusObj

Procedure Driver.p
  instantiates and uses Class Main

The descriptions and code listings for these files follow.

CommonObj.cls

This is the top-level user-defined abstract super class that provides a common method and variable for storing time-tracking information. It also provides abstract definitions for a class event and event publishing method, and for a message handler method, all to be implemented by classes that inherit from it:

USING acme.myObjs.Common.*.

CLASS acme.myObjs.Common.CommonObj ABSTRACT:

  DEFINE PROTECTED VARIABLE dtTimestamp AS DATETIME NO-UNDO.       /* 5 */

  METHOD PUBLIC DATETIME updateTimestamp ( ):
    dtTimestamp = NOW.
    RETURN dtTimestamp.
  END METHOD.

  DEFINE PUBLIC ABSTRACT EVENT OutputGenerated                     /* 16 */
    SIGNATURE VOID (pcOutputType AS CHARACTER).

  METHOD PROTECTED ABSTRACT VOID PublishOutputGenerated            /* 16 */
    (INPUT pcOutputType AS CHARACTER).

  METHOD PROTECTED ABSTRACT CLASS MsgObj MessageHandler            /* 3 */
    (INPUT piObjType AS CHARACTER).

END CLASS.

IBusObj.cls

This interface is implemented by the following class, acme.myObjs.CustObj:

INTERFACE acme.myObjs.Interfaces.IBusObj:

  METHOD PUBLIC VOID printObj ( ).                                 /* 11 */
  METHOD PUBLIC VOID printObj (INPUT pcCopies AS CHARACTER).
  METHOD PUBLIC VOID logObj (INPUT pcFilename AS CHARACTER).

END INTERFACE.

CustObj.cls

This class extends acme.myObjs.Common.CommonObj to provide general functionality for handling customers and is a super class for the acme.myObjs.NECustObj class, which handles New England customers:

USING acme.myObjs.*.
USING acme.myObjs.Common.*.
USING acme.myObjs.Interfaces.*.

CLASS acme.myObjs.CustObj INHERITS CommonObj                       /* 1 */
                          IMPLEMENTS IBusObj:

  DEFINE PUBLIC VARIABLE iNumCusts AS INTEGER NO-UNDO.

  DEFINE PROTECTED TEMP-TABLE ttCustomer NO-UNDO                   /* 14 */
    FIELD RecNum  AS INTEGER
    FIELD CustNum LIKE Customer.CustNum
    FIELD Name    LIKE Customer.Name
    FIELD State   AS CHARACTER.
  DEFINE PRIVATE VARIABLE rMsg       AS CLASS MsgObj    NO-UNDO.
  DEFINE PRIVATE VARIABLE rCreditObj AS CLASS CreditObj NO-UNDO.

  DEFINE PUBLIC OVERRIDE EVENT OutputGenerated                     /* 16 */
    SIGNATURE VOID (pcOutputType AS CHARACTER).

  METHOD PROTECTED OVERRIDE VOID PublishOutputGenerated            /* 16 */
    (INPUT pcOutputType AS CHARACTER):
    OutputGenerated:Publish(pcOutputType).
  END METHOD.

  CONSTRUCTOR PUBLIC CustObj ( ):                                  /* 2 */
    rCreditObj = NEW CreditObj ( ).
    iNumCusts = 0.
    /* Fill temp table and get row count */
    FOR EACH Customer NO-LOCK WHERE Customer.CreditLimit > 50000:
      CREATE ttCustomer.
      ASSIGN
        iNumCusts          = iNumCusts + 1
        ttCustomer.RecNum  = iNumCusts
        ttCustomer.CustNum = Customer.CustNum
        ttCustomer.Name    = Customer.Name
        ttCustomer.State   = Customer.State.
    END.
    rMsg = MessageHandler ("acme.myObjs.CustObj").                 /* 3 */
  END CONSTRUCTOR.

METHOD PROTECTED OVERRIDE CLASS MsgObj MessageHandler              /* 3 */
    (INPUT iObjType AS CHARACTER):
    RETURN NEW MsgObj (iObjType).
  END METHOD.

  METHOD PUBLIC CHARACTER GetCustomerName (INPUT piRecNum AS INTEGER):
    FIND ttCustomer WHERE ttCustomer.RecNum = piRecNum NO-ERROR.   /* 15 */
    IF AVAILABLE ttCustomer THEN
      RETURN ttCustomer.Name.
    ELSE DO:
      rMsg:Alert ("Customer number" + STRING(ttCustomer.RecNum) 
                  + "does not exist").
      RETURN ?.
    END.
  END METHOD.

  METHOD PUBLIC VOID CheckCredit ( ):
    IF VALID-OBJECT (rCreditObj) THEN DO:
      FOR EACH ttCustomer:
        rCreditObj:SetCurrentCustomer (ttCustomer.CustNum).
        rCreditObj:CheckCustCredit ( ).

        /* Invokes the CustCreditLimit property GET accessor */
        rMsg:InfoMsg (ttCustomer.Name + " is in good standing."
          + "  Credit Limit has been increased to "
          + STRING(rCreditObj:CustCreditLimit)).                   /* 12 */
        CATCH e AS Progress.Lang.AppError:                         /* 13 */
          IF e:ReturnValue = "Over Limit" THEN DO:
            /* Invokes the CustCreditLimit property GET accessor */
            rMsg:Alert (ttCustomer.Name + " is on Credit Hold."
              + "  Balance exceeds Credit Limit of "
              + STRING(rCreditObj:CustCreditLimit)).               /* 12 */
          END.
          ELSE
            rMsg:Alert ("Customer not found").
        END CATCH.
      END. /* FOR EACH */
    END.
    ELSE rMsg:Alert ("Unable to check credit").
  END METHOD.

/* Must implement methods defined in the IBusObj interface. Timestamp is
     a PROTECTED variable inherited from CommonObj */

  /* First version of printObj prints a single copy of a report */
  METHOD PUBLIC VOID printObj ( ):                                 /* 11 */
    OUTPUT TO PRINTER.
    DISPLAY dtTimestamp.                                           /* 5 */
    FOR EACH ttCustomer:
      DISPLAY ttCustomer.
    END.
    OUTPUT CLOSE.
    PublishOutputGenerated("One copy of report sent to printer").  /* 16 */
  END METHOD.

  /* Second version of printObj takes an integer parameter representing the
     number of copies to print. */
  METHOD PUBLIC VOID printObj (INPUT piCopies AS INTEGER):         /* 11 */
    DEFINE VARIABLE iCnt AS INTEGER NO-UNDO.
    OUTPUT TO PRINTER.
    IF piCopies <> 0 THEN 
    DO iCnt = 1 TO ABS(piCopies):
      DISPLAY dtTimestamp.                                         /* 5 */
      FOR EACH ttCustomer:
        DISPLAY ttCustomer.
      END.
    END.
    OUTPUT CLOSE.
    PublishOutputGenerated(STRING(piCopies)                        /* 16 */
                           + " copies of report sent to printer").
  END METHOD.

  /* Method to log customer information */
  METHOD PUBLIC VOID logObj (INPUT pcFilename AS CHARACTER):
    OUTPUT TO VALUE(pcFilename).
    DISPLAY dtTimestamp.                                           /* 5 */
    FOR EACH ttCustomer:
      DISPLAY ttCustomer.
    END.
    OUTPUT CLOSE.
    PublishOutputGenerated("One copy of report sent to "           /* 16 */
                           + pcFilename + " file").
  END METHOD.

  DESTRUCTOR PUBLIC CustObj ( ):                                   /* 6 */
    EMPTY TEMP-TABLE ttCustomer.
  END DESTRUCTOR.

END CLASS.

NECustObj.cls

This class extends acme.myObjs.CustObj to handle New England customers by overriding GetCustomerName( ) to return the customer’s E-mail address along with their name:

USING acme.myObjs.*.

CLASS acme.myObjs.NECustObj INHERITS CustObj:                      /* 7 */

  DEFINE PRIVATE TEMP-TABLE ttEmail NO-UNDO
    FIELD RecNum AS INTEGER
    FIELD Name   AS CHARACTER FORMAT "X(20)"
    FIELD Email  AS CHARACTER FORMAT "X(20)".

  CONSTRUCTOR PUBLIC NECustObj (INPUT EmailFile AS CHARACTER):
    /* Because there are no parameters to the super class's constructor, this
       constructor call is optional */
    SUPER ( ).                                                     /* 8 */

    /* Code to initialize ttEmail. The supplied file lists the email addresses
       in the correct order for the customers being processed. */
    INPUT FROM VALUE (EmailFile).
    FOR EACH ttCustomer 
      WHERE ttCustomer.State = "MA" OR                             /* 14 */
            ttCustomer.State = "VT" OR
            ttCustomer.State = "NH" OR
            ttCustomer.State = "CT" OR
            ttCustomer.State = "RI" OR
            ttCustomer.State = "ME":
      CREATE ttEmail.
      ASSIGN
        ttEmail.RecNum = ttCustomer.RecNum
        ttEmail.Name   = ttCustomer.Name.
      IMPORT ttEmail.Email.
    END.
  END CONSTRUCTOR.

  /* Override method to always get customer name and email */
  METHOD PUBLIC OVERRIDE CHARACTER GetCustomerName 
    (INPUT piCustNum AS INTEGER):                                  /* 9 */
    DEFINE VARIABLE EmailName AS CHARACTER NO-UNDO.

    EmailName = SUPER:GetCustomerName (piCustNum).
    FIND FIRST ttEmail WHERE ttEmail.Name = EmailName NO-ERROR.    /* 15 */
    IF AVAILABLE (ttEmail) THEN
      RETURN EmailName + ";" + ttEmail.Email.
    ELSE
      RETURN EmailName.
  END METHOD.

/* First override version of printObj for a single copy */
  METHOD PUBLIC OVERRIDE VOID printObj ( ):                        /* 11 */
    OUTPUT TO PRINTER.
    DISPLAY dtTimestamp.                                           /* 5 */
    FOR EACH ttEmail:
      DISPLAY ttEmail.
    END.
    OUTPUT CLOSE.
    PublishOutputGenerated("One copy of report sent to printer").  /* 16 */
  END METHOD.

  /* Second override version of printObj for multiple copies */
  METHOD PUBLIC OVERRIDE VOID printObj 
    (INPUT piCopies AS INTEGER):                                   /* 11 */
    DEFINE VARIABLE iCnt AS INTEGER.
    OUTPUT TO PRINTER.
    IF piCopies <> 0 THEN DO iCnt = 1 TO ABS(piCopies):
      DISPLAY dtTimestamp.                                         /* 5 */
      FOR EACH ttEmail:
        DISPLAY ttEmail.
      END.
    END.
    OUTPUT CLOSE.
    PublishOutputGenerated(STRING(piCopies)                        /* 16 */
                           + " copies of report sent to printer").
  END METHOD.

  /* Override method to log customer information with email */
  METHOD PUBLIC OVERRIDE VOID logObj (INPUT pcFilename AS CHARACTER):
    OUTPUT TO VALUE (pcFilename).
    DISPLAY dtTimestamp.                                           /* 5 */
    FOR EACH ttEmail:
      DISPLAY ttEmail.
    END.
    OUTPUT CLOSE.
    PublishOutputGenerated("One copy of report sent to "           /* 16 */
                           + pcFilename + " file").
  END METHOD.

END CLASS.

HelperClass.cls

This class provides various support methods for other classes:

USING acme.myObjs.*.
USING acme.myObjs.Common.*.
USING acme.myObjs.Interfaces.*.

CLASS acme.myObjs.Common.HelperClass:

  DEFINE PRIVATE VARIABLE rCustObj AS CLASS CustObj NO-UNDO.
  DEFINE PRIVATE VARIABLE rMsg     AS CLASS MsgObj  NO-UNDO.

  DEFINE PRIVATE TEMP-TABLE ttNames NO-UNDO
    FIELD CustName AS CHARACTER.

  CONSTRUCTOR PUBLIC HelperClass ( ):
    rMsg = NEW MsgObj ("acme.myObjs.Common.HelperClass").
  END CONSTRUCTOR.

  METHOD PUBLIC VOID InitializeDate (INPUT prObject AS CLASS CommonObj):
    /* Timestamp this object */
    IF VALID-OBJECT(prObject) THEN
      prObject:updateTimestamp ( ).                                 /* 4 */
    ELSE
      rMsg:Alert ("Not a valid object").
  END METHOD.

  METHOD PUBLIC VOID ListNames (INPUT-OUTPUT prCustObj AS CLASS CustObj):
    DEFINE VARIABLE idx AS INTEGER NO-UNDO.
    DO idx = 1 to prCustObj:iNumCusts:
      CREATE ttNames.
      ttNames.CustName = prCustObj:GetCustomerName (idx).
    END.
    rCustObj = prCustObj.
  END METHOD.

  METHOD PUBLIC VOID ReportOutput (OUTPUT prInterface AS CLASS IBusObj):
    /* Send the PRIVATE CustObj instance back to be printed */
    IF VALID-OBJECT(rCustObj) THEN
      prInterface = rCustObj.
    ELSE
      rMsg:Alert ("Not a valid object").
  END METHOD.

END CLASS.

CreditObj.cls

This class provides a method for notification of customers who have exceeded their credit limit:

ROUTINE-LEVEL ON ERROR UNDO, THROW.                                 /* 13 */

CLASS acme.myObjs.CreditObj:

  DEFINE PUBLIC PROPERTY CustCreditLimit AS DECIMAL INITIAL ? NO-UNDO /* 12 */
    /* GET: Returns the credit limit of the current Customer. If there is no
       current Customer, it returns Unknown (?).*/
    GET .
    /* SET: Raises the credit limit for Customers in good standing. Current
       increase is $1,000. */
    PROTECTED SET (INPUT piCL AS DECIMAL):
      IF Customer.Balance > piCL THEN DO:
        CustCreditLimit = Customer.Creditlimit.                    /* 13 */
        UNDO, THROW NEW Progress.Lang.AppError( "Over Limit" ).
      END.
      ELSE
        ASSIGN
          Customer.Creditlimit = piCL + 1000
          CustCreditLimit      = Customer.Creditlimit.
    END SET.

  METHOD PUBLIC VOID SetCurrentCustomer (INPUT piCustNum AS INTEGER):
    /* Verify that this object has the current Customer before the property
       is referenced. */                                           /* 15 */
    FIND FIRST Customer WHERE Customer.CustNum = piCustNum NO-ERROR.
  END METHOD.

  METHOD PUBLIC VOID CheckCustCredit ( ):
    /* invokes the property SET */
    IF AVAILABLE (Customer) THEN
      CustCreditLimit = Customer.Creditlimit.                      /* 12 */
    ELSE
    UNDO, THROW NEW Progress.Lang.AppError( "No Customer" ).       /* 13 */
  END METHOD.

END CLASS.

MsgObj.cls

This class provides a common mechanism together with the MessageHandler( ) method in acme.myObjs.Common.CommonObj for other classes to store and report error information:

CLASS acme.myObjs.Common.MsgObj:

  DEFINE PRIVATE VARIABLE cObjType AS CHARACTER NO-UNDO.

  CONSTRUCTOR PUBLIC MsgObj (INPUT pcObjType AS CHARACTER):
    cObjType = pcObjType.
  END CONSTRUCTOR.

  METHOD PUBLIC VOID Alert (INPUT ErrorString AS CHARACTER):
    MESSAGE "Error in " cObjType "!" SKIP
      ErrorString VIEW-AS ALERT-BOX ERROR.
  END METHOD.

  METHOD PUBLIC VOID InfoMsg (INPUT MsgString AS CHARACTER):
    MESSAGE MsgString VIEW-AS ALERT-BOX.
  END METHOD.

END CLASS.

Main.cls

This is the class that initializes the environment for running all the other sample classes:

USING acme.myObjs.*.
USING acme.myObjs.Common.*.
USING acme.myObjs.Interfaces.*.

CLASS Main:
  DEFINE PRIVATE VARIABLE cOutFile     AS CHARACTER         NO-UNDO.
  DEFINE PRIVATE VARIABLE rCommonObj   AS CLASS CommonObj   NO-UNDO.
  DEFINE PRIVATE VARIABLE rCustObj     AS CLASS CustObj     NO-UNDO.
  DEFINE PRIVATE VARIABLE rCustObj2    AS CLASS CustObj     NO-UNDO.
  DEFINE PRIVATE VARIABLE rHelperClass AS CLASS HelperClass NO-UNDO.
  DEFINE PRIVATE VARIABLE rIBusObj     AS CLASS IBusObj     NO-UNDO.

  /* First constructor instantiates a Customer object */
  CONSTRUCTOR PUBLIC Main ( ):                                     /* 10 */
    ASSIGN
      /* Create an instance of the HelperClass class */
      rHelperClass = NEW HelperClass ( )

      /* Create an instance of the CustObj class */
      rCustObj     = NEW CustObj ( )
      cOutFile      = "Customers.out".
                                                                   /* 16 */
    /* Subscribe OutputGenerated event handler for CustObj */
    rCustObj:OutputGenerated:Subscribe(OutputGenerated_CustObjHandler).
  END CONSTRUCTOR.

  /* Second constructor takes a character parameter representing an input
     file of email addresses to instantiate a New England Customer object */
  CONSTRUCTOR PUBLIC Main (INPUT EmailFile AS CHARACTER):          /* 10 */
    ASSIGN
      /* Create an instance of the HelperClass class */
      rHelperClass = NEW HelperClass( )

      /* Create an instance of the NECustObj class */
      rCustObj     = NEW NECustObj (EmailFile)
      cOutFile      = "NECustomers.out".
                                                                   /* 16 */
    /* Subscribe OutputGenerated event handler for NECustObj */
    rCustObj:OutputGenerated:Subscribe(OutputGenerated_NECustObjHandler).
  END CONSTRUCTOR.

  /* Event handlers for each Customer class instance */
  METHOD PRIVATE VOID OutputGenerated_CustObjHandler               /* 16 */
      (pcOutputType AS CHARACTER):
    MESSAGE pcOutputType "for all customers." VIEW-AS ALERT-BOX.
  END METHOD.

  METHOD PRIVATE VOID OutputGenerated_NECustObjHandler             /* 16 */
      (pcOutputType AS CHARACTER):
    MESSAGE pcOutputType "for New England customers." VIEW-AS ALERT-BOX.
  END METHOD.

/* ObjectInfo processes information about the Customer object */
  METHOD PUBLIC VOID ObjectInfo (piInfoCount AS INTEGER):
    /* Demonstrates passing object references as parameters */

    rCommonObj = rCustObj.
                                                                   /* 10 */
    IF rCustObj:GetClass( ):TypeName = "acme.myObjs.NECustObj" THEN 
      MESSAGE "Initializing reports for New England customers at" 
        STRING(rCommonObj:updateTimestamp( ))                      /* 4 */
        VIEW-AS ALERT-BOX.
    ELSE
      MESSAGE "Initializing reports for all customers at" 
        STRING(rCommonObj:updateTimestamp( ))                      /* 4 */
        VIEW-AS ALERT-BOX.

    /* INPUT: It is valid to pass a subclass to a method defined to take a
       super class */
    rHelperClass:InitializeDate (rCustObj).                        /* 4 */

    /* INPUT-OUTPUT: Must be an exact match, a class to a method defined to
       take that same class type */
    rHelperClass:ListNames (INPUT-OUTPUT rCustObj).
    rCustObj:CheckCredit ( ).
    rCustObj2 = rCustObj.

    /* OUTPUT: An interface is used to receive a class that implements that
       interface */
    rHelperClass:ReportOutput (OUTPUT rIBusObj).
    IF piInfoCount <> ? AND piInfoCount > 1 THEN
      rIBusObj:printObj(piInfoCount).
    ELSE
      rIBusObj:printObj( ).
    rIBusObj:logObj (cOutFile).
    rIBusObj = rCustObj.
  END METHOD.
END CLASS.

Driver.p

This is the procedure that instantiates the sample classes to run with two different sets of sample data, depending on the constructor used to instantiate Main:

/** This procedure drives the class example **/

DEFINE VARIABLE rClassExample AS CLASS Main NO-UNDO.

/* Run the example for all Customers         */
rClassExample = NEW Main ( ).                                    /* 10 */
rClassExample:ObjectInfo (0).

/* Run the example for New England Customers */
rClassExample = NEW Main ("email.txt").                          /* 10 */
rClassExample:ObjectInfo (2).