home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / dongrovs.zip / gettagline.cmd < prev    next >
OS/2 REXX Batch file  |  1996-10-16  |  8KB  |  241 lines
  1. /* ********************************* */
  2. /*   By: Jetnick Enterprise          */
  3. /*       Don E. Groves, Jr.          */
  4. /*   Contact Information:            */
  5. /*     E-mail: jetnick@erols.com     */
  6. /*        CIS: 71310,3702            */
  7. /* Date: 04 Sep 1996                 */
  8. /* ********************************* */
  9. /* public Classes and Routines       */
  10. /* .GetTagLine   a Tagline generator */
  11. /* GetTagLine()  a Tagline generator */
  12. /* ******************************************************** */
  13. /* Works either as an External Function or ::Requires file  */
  14. /* ******************************************************** */
  15. parse source . invhow myName
  16. RtCode = 0
  17. .local~TagsHome = 'H:\HomeOfTagLines\*.tag'
  18. SELECT
  19.  WHEN invhow == 'FUNCTION'
  20.   THEN RtCode = GetTagLine()
  21.  WHEN invhow == 'COMMAND'
  22.   THEN DO
  23.      .OUTPUT~LineOut('----- Sample TagLine -----')
  24.      IF arg(1)~length \= 0
  25.      THEN DO
  26.         tag = .GetTagLine~TagLine
  27.         .OUTPUT~LineOut('-- At:'~' '(tag~fnam))
  28.         rpt = tag~TheTag
  29.         sep = rpt~LEFT(1)
  30.         rpt = rpt~Substr(2)
  31.         do until rpt == ''
  32.            parse value rpt with rec (sep) rpt
  33.            .OutPut~LineOut(('parse   -> ')~''(rec))
  34.         end
  35.  
  36.         .OUTPUT~LineOut('  ----- Sample TagLine MakeArray -----')
  37.         su = .GetTagLine~MakeArray~Supplier
  38.         do while su~Available
  39.            .output~LINEOUT('Mkarray ->'~' '(su~item))
  40.            su~Next
  41.         END
  42.  
  43.         .OUTPUT~LineOut('  ----- Sample TagLine LINEFeed -----')
  44.         rpt = .GetTagLine~LineFeed('LineFeed-> ') /* ~''('0A'x) */
  45.         do until rpt == ''
  46.            parse value rpt with rec '0A'x rpt
  47.            .OutPut~LineOut(rec)
  48.         end
  49.  
  50.         .OUTPUT~LineOut('  ----- Sample TagLine LINEFeed through CharOut -----')
  51.         .OutPut~CharOut(.GetTagLine~LineFeed('LineFeed-> ')~''('0A'x))
  52.  
  53.         .OUTPUT~LineOut('  ----- Sample TagLine MakeString -----')
  54.         .OUTPUT~LineOut(.GetTagLine~MakeString)
  55.  
  56.         .OUTPUT~LineOut('  ----- Sample TagLine MakeString formatted to CharOut -----')
  57.         .OutPut~CharOut(.GetTagLine~MakeString(('0A'x)~''('MakeStr -> '))~SubStr(2)~''('0A'x))
  58.  
  59.         .OUTPUT~LineOut('  ----- Sample TagLine MakeString Parse to LineOut -----')
  60.         rpt = .GetTagLine~MakeString
  61.         sep = rpt~LEFT(1)
  62.         rpt = rpt~Substr(2)
  63.         do until rpt == ''
  64.            parse value rpt with rec (sep) rpt
  65.            .OutPut~LineOut(('MString -> ')~''(rec))
  66.         end
  67.      END
  68.      ELSE .OutPut~CharOut(.GetTagLine~LineFeed(' -> ')~''('0A'x))
  69.      .OUTPUT~LineOut('----- End of Sample -----')
  70.      .OUTPUT~LineOut('Tag file are located by: ['~''(.local~TagsHome)~''(']'))
  71.   END
  72.  WHEN invhow == 'SUBROUTINE'
  73.   THEN nop  /* happens when '::requires GetTagLine' or 'call GetTagLine' is used */
  74.  OTHERWISE
  75.    nop /* I've no idea, but then maybe everything will work out ok anyway. */
  76. END
  77. Return RtCode
  78.  
  79. ::requires RexxUtil_REQ
  80. ::requires TextStream
  81.  
  82. ::class TagLine_Base
  83. ::method init
  84.   expose theTag fnam
  85.   use arg theTag, fnam
  86. return self
  87. ::method fnam
  88.   expose theTag fnam
  89.   forward to (fnam) message 'MakeString'
  90. ::method theTag
  91.   expose theTag fnam
  92.   rpt = TheTag
  93.   if ARG(1,'E')
  94.   THEN rpt = rpt~ChangeStr(rpt~Left(1),ARG(1))
  95.   forward to (rpt) message 'MakeString' Arguments ( .Array~NEW )
  96.  
  97. ::class TagLine subclass TagLine_Base
  98. ::method UNKNOWN
  99.   use arg cMsg, ARGS
  100.   forward to (Self~theTag) message (cMsg) arguments (ARGS)
  101. ::method String
  102.   forward message 'TheTag'
  103. ::method MakeString
  104.   forward message 'String'
  105. ::method TagLine          /* Return a NEW TagLine */
  106.   forward to (.gRanDom)
  107. ::method MakeTagLine      /* copy myself */
  108.   forward to (Self~Class) message 'NEW' Array (self~theTag, self~fnam)
  109. ::method MakeArray
  110.   ar = .Array~NEW
  111.   rpt = Self~TheTag
  112.   sep = rpt~LEFT(1)
  113.   rpt = rpt~Substr(2)
  114.   do until rpt == ''
  115.      parse value rpt with rec (sep) rpt
  116.      ar[ar~size+1] = rec
  117.   end
  118.   return ar
  119. ::method LINEFeed
  120.   forward to (Self~MakeString(('0A'x)~''(ARG(1)))) message 'SubStr' Array (2)
  121.  
  122. ::Class GetTagLine public
  123. ::method init class
  124. return self
  125. ::method init
  126. return self
  127. ::method NEW
  128.   forward to (self~Class)
  129. ::method TagLine CLASS
  130.   forward to (.gRanDom)
  131. ::method TagLine
  132.   forward to (self~Class)
  133. ::method MakeTagLine CLASS
  134.   forward message 'TagLine'
  135. ::method MakeTagLine
  136.   forward to (self~Class)
  137. ::method UNKNOWN CLASS
  138.   use arg cMsg, ARGS
  139.   forward to (self~TagLine) message (cMsg) ARGUMENTS ( ARGS )
  140. ::method UNKNOWN
  141.   forward to (self~Class)
  142. ::method String     CLASS
  143.   forward message 'UNKNOWN' ARRAY ( 'STRING', ARG(1,'A'))
  144. ::method String
  145.   forward to (self~Class)
  146. ::method MakeString CLASS
  147.   forward message 'UNKNOWN' ARRAY ( 'MAKESTRING', ARG(1,'A'))
  148. ::method MakeString
  149.   forward to (self~Class)
  150.  
  151.  
  152. ::Class gRanDom       /* a Random Randomizer */
  153. ::method init class
  154.   expose seed filtertt
  155.   seed = (Time('S') // Date('B') * 199) % 3
  156.   IF seed = 0
  157.   THEN  seed = ((random(50,500) * 1237) // Date('B') * 199) % 3
  158.   /* filter out all but valid ASCII range */
  159.   filtertt = '.'~COPIES(32)~''(XRANGE('20'X, '7E'X))~''('.'~COPIES(128))
  160. return self
  161. ::method RD private class
  162.   expose seed filtertt
  163.   use arg low, high
  164.   q = (((Time('S')+1) * seed) // Date('B') * 199) % 3
  165.   IF q = 0
  166.   THEN  q = ((random(50,500) * 1237) // Date('B') * 199) % 3
  167.   IF seed \= q
  168.   THEN DO
  169.      seed = q
  170.      q = Random(low,high,q)
  171.   END
  172.   ELSE q = Random(low,high)
  173. return q
  174. ::method Filter private class
  175.   expose seed filtertt
  176.   use arg wr
  177. return (wr~TRANSLATE(filtertt) == wr)
  178. ::method TagLine CLASS
  179.   expose seed filtertt
  180.   tag = ''
  181.   fnam = 'NO FILES FOUND'
  182.   call SysFileTree .local~TagsHome, 'files.', 'OF'
  183.   DO While tag~length = 0 & files.0 > 0
  184.      rnd = Self~RD(1, files.0)
  185.      tf = ''
  186.      do i = rnd to files.0 while tf~length = 0
  187.         tf = files.i
  188.         files.i = ''
  189.      END
  190.      IF tf~length = 0
  191.      THEN DO
  192.         files.0 = rnd - 1
  193.         ITERATE
  194.      END
  195.      tf = .TextStream~NEW(tf)
  196.      fnam = tf~Qualify
  197.      tf~OPEN('READ')
  198.      tagA = tf~MAKEARRAY
  199.      tf~CLOSE
  200.      IF tagA~items > 0
  201.      THEN DO
  202.         items = tagA~items
  203.         low = Self~RD(1, items)
  204.         Do TagA~items until tag~length \= 0 & items > 0
  205.            wr = ''
  206.            do i = low to items until wr~length > 0
  207.               wr = tagA~AT(i)
  208.            end
  209.            if wr~length > 0
  210.            THEN DO
  211.               IF self~Filter(wr)
  212.               THEN tag = wr
  213.               ELSE DO
  214.                  TagA[i] = ''
  215.                  low = Self~RD(1, items)
  216.               END
  217.            END
  218.            else items = low - 1
  219.         END
  220.      END
  221.      ELSE DO
  222.         tag = tag~''("** ERROR ** Somebody stoled the Tag file Data. **`")
  223.         tag = tag~''("** ERROR ** That belong in the file: **`")
  224.         tag = tag~''("** ERROR ** [")~''(tf~Qualify)~''("] **`")
  225.         tag = tag~''("** ERROR ** Put it back, NOW. **")
  226.      END
  227.   END
  228.   if files.0 = 0 & tag~length = 0
  229.   THEN DO
  230.      tag = tag~''("** ERROR ** Somebody stoled the Tag files. **`")
  231.      tag = tag~''("** ERROR ** They belong at **`")
  232.      tag = tag~''("** ERROR ** [")~''(.local~TagsHome)~''("] **`")
  233.      tag = tag~''("** ERROR ** Put them back, NOW. **")
  234.   END
  235. forward to (.TagLine) message 'NEW' array ('`'~''(tag),fnam)
  236.  
  237. ::ROUTINE GetTagLine public
  238. return .GetTagLine~TagLine
  239.  
  240. /* ********************************* */
  241.