home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / orx8.zip / class_ref.cmd next >
OS/2 REXX Batch file  |  1997-07-21  |  10KB  |  248 lines
  1. /*
  2. program:   class_ref.cmd
  3. type:      Object REXX, REXXSAA 6.0
  4. purpose:   allows for defining anchor- and reference-objects with the ability to refer to
  5.            objects, even if the anchors are explicitly produced thereafter (i.e. forward-referencing)
  6. version:   1.0
  7. date:      1997-04-15
  8. changed:   ---
  9.  
  10. author:    Rony G. Flatscher
  11.            Rony.Flatscher@wu-wien.ac.at
  12.            (Wirtschaftsuniversitaet Wien, University of Economics and Business
  13.            Administration, Vienna/Austria/Europe)
  14. needs:     ---
  15.  
  16. usage:     call or require & see code
  17.  
  18. comments:  prepared for the "8th International Rexx Symposium 1997", April 1997, Heidelberg/Germany
  19.  
  20.  
  21. All rights reserved and copyrighted 1995-1997 by the author, no guarantee that
  22. it works without errors, etc.  etc.
  23.  
  24. You are granted the right to use this module under the condition that you don't charge money for this module (as you didn't write
  25. it in the first place) or modules directly derived from this module, that you document the original author (to give appropriate
  26. credit) with the original name of the module and that you make the unaltered, original source-code of this module available on
  27. demand.  If that holds, you may even bundle this module (either in source or compiled form) with commercial software.
  28.  
  29. If you find an error, please send me the description (preferably a *very* short example); I'll try to fix it and re-release it to
  30. the net.
  31. */
  32.  
  33.  
  34. :: REQUIRES class_rel.cmd       /* RelTab is needed     */
  35. :: REQUIRES routine_usify.cmd
  36.  
  37. :: ROUTINE pp; RETURN "[" || ARG( 1 ) || "]"
  38.  
  39. :: ROUTINE sayError
  40.    PARSE ARG tmpString
  41.    .error ~ lineout( "==>" tmpString )
  42.    RETURN
  43.  
  44.  
  45. /********************************************************************************/
  46. /* an anchor-object contains various object-variables for storing anchor-objects
  47.    together with the associated (anchored) object with the given prefix; if no
  48.    prefix is given, than the ID-value of the object's class object is used;
  49.  
  50.    there will be one anchor object created *per* prefix; if explicitly an anchor-
  51.    object is created, using a prefix which already exists, then a new, unique
  52.  
  53. bla, bla, bla
  54. */
  55.  
  56.  
  57. /* a class for serving as an anchor name factory */
  58. :: CLASS anchor                 PUBLIC
  59.  
  60. /* ----------------------------------------------- */
  61. :: METHOD init          CLASS
  62.    EXPOSE  AnchorDir
  63.  
  64.    AnchorDir = .directory ~ new         /* contains used AnchorPrefixes */
  65.  
  66. /* ----------------------------------------------- */
  67. :: METHOD AnchorDir     ATTRIBUTE CLASS /* directory of all prefixes and
  68.                                                  their anchor objects   */
  69.  
  70.  
  71.  
  72. /* ----------------------------------------------- */
  73. :: METHOD init
  74.    EXPOSE  AnchorPrefix ObjCounter AnchObjTable
  75.    USE ARG AnchorPrefix
  76.  
  77.    IF ARG( 1, "O" ) THEN                /* generate a system supplied AnchorPrefix */
  78.       AnchorPrefix = "ORX"
  79.    ELSE         /* make sure an AnchorPrefix just contains US-characters and numbers */
  80.       AnchorPrefix = USify( AnchorPrefix )
  81.  
  82.         /* is there already an anchor object defined, if so return it instead   */
  83.    AnchClassDir = self ~ class ~ AnchorDir
  84.    IF AnchClassDir ~ hasentry( AnchorPrefix ) THEN
  85.       RETURN AnchClassDir ~ entry( AnchorPrefix )
  86.  
  87.         /* save the prefix and appropriate anchor-object with the class object  */
  88.    AnchClassDir ~ setentry( AnchorPrefix, self )
  89.  
  90.         /* initialize object variables                          */
  91.    ObjCounter   = 0                     /* reset ObjCounter     */
  92.    AnchObjTable = .relTable  ~ new        /* table like relation, contains objects and
  93.                                            appr. anchor-surrogate string, e.g.
  94.                                            AnchObjTable[ Object ] = surrogate-string      */
  95.  
  96.  
  97.  
  98. /* ----------------------------------------------- */
  99. :: METHOD getAnchorName                 /* generate a new, unique anchor name, i.e.
  100.                                            a USIfied' surrogate-string  */
  101.    EXPOSE AnchorPrefix ObjCounter AnchObjTable
  102.    USE ARG object
  103.  
  104.    IF ARG( 1, "O" ) THEN RETURN .nil    /* sorry, need an object to work on */
  105.  
  106.                 /* try to get the anchor name, if it exists already */
  107.    anchorName = AnchObjTable[ object ]
  108.  
  109.                 /* create a new anchor name for this object */
  110.    IF anchorName = .nil THEN
  111.    DO
  112.       ObjCounter = ObjCounter + 1       /* increase anchor name ObjCounter      */
  113.       anchorName = AnchorPrefix || "_" || ObjCounter    /* produce anchor name  */
  114.  
  115.       AnchObjTable[ object ] = anchorName /* associate object with its surrogate-string   */
  116. /*
  117. call sayerror ".anchor: created -> anchorName ==>" pp( anchorName )
  118. */
  119.    END
  120. /*
  121. else
  122.    call sayerror ".anchor: FOUND ! -> anchorName ==>" pp( anchorName )
  123. */
  124.  
  125.    RETURN anchorName            /* return new anchor Name (surrogate-string)    */
  126.  
  127.  
  128. /* ----------------------------------------------- */
  129. :: METHOD ObjCounter            /* return # of anchor names already produced */
  130.    EXPOSE ObjCounter
  131.    RETURN ObjCounter
  132.  
  133. /* ----------------------------------------------- */
  134. :: METHOD AnchObjTable    ATTRIBUTE /* allow access to table of objects<-->surrogate-strings      */
  135.  
  136. /* -----------------------------------------------------------------------------*/
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145. /* =============================================================================*/
  146. /*
  147.         purpose: allow for generating unique anchor names, using the classId as stem
  148.  
  149.                  work is done in class methods; thereby relieving the user to give a
  150.                  specific instance
  151.  
  152.         this class manages references for Object REXX objects, utilizing automatic
  153.         anchor-name production using the class ID as AnchorPrefix, if no explicit
  154.         prefix is given;
  155.  
  156.         all work is done with class methods !!!
  157. */
  158.  
  159. :: CLASS ref                            PUBLIC  /* an Anchor-manager    */
  160.  
  161. /* ---------------------------------- */
  162. :: METHOD INIT CLASS
  163.    EXPOSE AnchorObjectDir setOfAnchorNames setOfReferences
  164.  
  165.  
  166.    AnchorObjectDir = .directory ~ new   /* relates instance to specific prefix  */
  167.    setOfAnchorNames = .set ~ new        /* set of objects for which surrogate-strings were created */
  168.    setOfReferences = .set ~ new         /* set of objects for which surrogate-strings were asked for */
  169.  
  170. /* ---------------------------------- */
  171. :: METHOD AnchorObjectDir       CLASS   ATTRIBUTE       PRIVATE
  172. :: METHOD setOfAnchorNames      CLASS   ATTRIBUTE /* explicitly created via createReference */
  173. :: METHOD setOfReferences       CLASS   ATTRIBUTE /* explicitly asked for via getReference  */
  174.  
  175.  
  176. /* ---------------------------------- */
  177. /* create a new object for a new class          */
  178. :: METHOD getAnchorObject       CLASS   PRIVATE
  179.    EXPOSE  AnchorObjectDir
  180.    USE ARG anObject, prefix
  181.  
  182.    IF ARG( 2, "O" ) THEN
  183.       prefix = anObject ~ class ~ id            /* prefix omitted               */
  184.  
  185.    tmpAnchObject = AnchorObjectDir ~ entry( prefix )    /* get anchor object    */
  186.  
  187.    IF tmpAnchObject = .nil THEN                 /* no AnchorObject as of yet    */
  188.    DO
  189.       tmpAnchObject = .anchor ~ new( prefix )   /* create new AnchorObject      */
  190.       AnchorObjectDir ~ setentry( prefix, tmpAnchObject ) /* save anchor object */
  191.    END
  192.  
  193.    RETURN tmpAnchObject
  194.  
  195.  
  196. /* ---------------------------------- */
  197. :: METHOD Reference  CLASS           /* retrieve a reference name, else create it */
  198.  
  199.    USE ARG anObject, prefix
  200.  
  201.    IF ARG( 2, "O" )     THEN            /* prefix omitted               */
  202.       AnchorObject = self ~ getAnchorObject( anObject )
  203.    ELSE
  204.       AnchorObject = self ~ getAnchorObject( anObject, prefix )
  205.  
  206.    /* now get appropriate anchor (i.e. surrogate-string)        */
  207.    anchorName = AnchorObject ~ getAnchorName( anObject )   /* get anchor name */
  208.  
  209.    RETURN anchorName
  210.  
  211.  
  212. /* ---------------------------------- */
  213. :: METHOD createReference    CLASS      /* keeps track of explicitly produced references */
  214.    EXPOSE setOfAnchorNames
  215.  
  216.    setOfAnchorNames ~ put( ARG( 1 ) )   /* save object in set   */
  217.    FORWARD MESSAGE "Reference"          /* let method Reference do the work     */
  218.  
  219. /* ---------------------------------- */
  220. :: METHOD getReference       CLASS      /* keeps track of explicitly queried references */
  221.    EXPOSE setOfReferences
  222.  
  223.    setOfReferences ~ put( ARG( 1 ) )    /* save object in set   */
  224.    FORWARD MESSAGE "Reference"          /* let method Reference do the work     */
  225.  
  226. /* ---------------------------------- */
  227. :: METHOD SayStatistics      CLASS      /* tells, if name-set <> reference-set  */
  228.    EXPOSE setOfReferences setOfAnchorNames
  229.  
  230.    tmpString = "class" pp( self ~ id )
  231.    CALL SayError tmpString "references created explicitly:" pp( setOfAnchorNames ~ items ),
  232.                  "references used:" pp( setOfReferences ~ items )
  233.  
  234.    notReferenced  = setOfAnchorNames ~ DIFFERENCE( setOfReferences ) ~ items
  235.    notExplCreated = setOfReferences ~ DIFFERENCE( setOfAnchorNames ) ~ items
  236.  
  237.    IF notReferenced > 0 THEN
  238.       CALL SayError LEFT( "", LENGTH( tmpString ) ) pp( notReferenced ),
  239.            "object-references were created, but never referred to!"
  240.  
  241.    IF notExplCreated > 0 THEN
  242.       CALL SayError LEFT( "", LENGTH( tmpString ) ) pp( notExplCreated ),
  243.            "object-references were created implicitly."
  244.  
  245.  
  246. /* -----------------------------------------------------------------------------*/
  247. /********************************************************************************/
  248.