home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / skeleton.zip / QueDump.cmd < prev    next >
OS/2 REXX Batch file  |  1995-08-03  |  6KB  |  141 lines
  1. /*****************************************************************************\
  2. | Non-destructive dump of REXX data queue contents to file.                   |
  3. |                                                                             |
  4. | $Revision:   1.0  $
  5. |     $Date:   03 Aug 1995 20:10:22  $                                        |
  6. | Libraries:   REXXSAA, REXXUTIL, [REXXLIB]                                   |
  7. |  Category:   Utility                                                        |
  8. |     Class:   Programming                                                    |
  9. |      Type:   Queue                                                          |
  10. |    Author:   Bob Rice - CompuServe: 72421,3016                              |
  11. |                                                                             |
  12. | Copyright (c) 1995 Empirical Heuristics                                     |
  13. \**************************************************************************r4*/
  14. /*  !tr! = value('TRACE',,'OS2ENVIRONMENT'); parse source . . !who!          */
  15. /*  if !tr! \= '' then say '--> Entering' !who!; trace value !tr!; nop       */
  16.   if left(arg(1),1) = '?' then do
  17.     parse source . . !pgm!; call TellHelp arg(1), !pgm!; exit 2; end
  18.  
  19.   parse source . howcalled .
  20.   if howcalled = 'COMMAND' then parse arg dumpfile ',' opts
  21.                            else parse arg dumpfile, opts
  22.   if dumpfile = '' then do
  23.     parse source  . . EH.pgm_filespec
  24.     EH.pgm_fnfe = filespec( 'N', EH.pgm_filespec )
  25.     parse var EH.pgm_fnfe EH.pgm_fn '.'
  26.     dumpfile = EH.pgm_fn'.QUE'
  27.   end
  28.   opts = translate(opts)
  29.   if wordpos('/FLUSH', opts) > 0     then flush = 1
  30.                                      else flush = 0
  31.   if wordpos('/OVERWRITE', opts) > 0 then overwrite = 1
  32.                                      else overwrite = 0
  33.   if Exist(dumpfile) & \ overwrite then do
  34.     ans = AskUser('Oa',dumpfile 'already exists. Overwrite or append?')
  35.     if ans = 'O' then call SysFileDelete dumpfile
  36.   end
  37.  
  38.   newq = RxQueue('CREATE')                      /* Invent a new queue        */
  39.   curq = RxQueue('SET',newq)                    /* Get name of current queue */
  40.   call   RxQueue 'DELETE', newq                 /* Delete invented queue     */
  41.   call   RxQueue 'SET', curq                    /* Switch back to current    */
  42.   qname = curq                                  /* Save current queue name   */
  43.   call ShowQ                                    /* Dump the queue            */
  44.  
  45.   if curq \= 'SESSION' then do                  /* If current was not SESSION*/
  46.     call RxQueue 'SET', 'SESSION'               /* Change to SESSION queue   */
  47.     qname = 'SESSION'                           /* Save the queue name       */
  48.     call ShowQ                                  /* Dump the queue            */
  49.   end
  50.   call RxQueue 'SET', curq                      /* Change back to original   */
  51.   exit q.0                                      /* Exit with number of entries*/
  52.  
  53.   /***************************************************************************\
  54.   |                            PROGRAM SUBROUTINES                            |
  55.   \***************************************************************************/
  56. ShowQ:                                          /* Nondestructive dump of que*/
  57.   n = queued()                                  /* Number of lines queued    */
  58.   if n > 0 then do
  59.     do i = 1 to n
  60.       parse pull s.i                            /* Get a queued line         */
  61.       q.i = '['right('000'i,4)']='s.i           /* Format it                 */
  62.     end
  63.     if \ flush then do i = 1 to n
  64.       queue s.i                                 /* Restore line back on queue*/
  65.     end
  66.   end
  67.   q.0 = n                                       /* Number of lines queued    */
  68.   if dumpfile = '' then do
  69.     call lineout dumpfile, copies('-',79)
  70.     call lineout dumpfile, 'Contents of' qname 'data queue has' q.0 'entries:'
  71.     call lineout dumpfile, ''
  72.   end
  73.   if dumpfile = '' & n > 0 then do i = 1 to n
  74.     say q.i
  75.   end
  76.   else do
  77.     call lineout dumpfile, ''
  78.     call lineout dumpfile, copies('-',79)
  79.     call lineout dumpfile, 'Contents of' qname 'data queue has' q.0 'entries:'
  80.     call lineout dumpfile, ''
  81.     call stream  dumpfile, 'C', 'CLOSE'
  82.     if RXFUNCQUERY('filewrite') = 0 then        /* Use REXXLIB function      */
  83.       if n > 0 then call filewrite dumpfile, 'q.', 'A'; else nop
  84.     else do                                     /* Use slower REXXSAA method */
  85.       do i = 1 to q.0
  86.         call lineout dumpfile, q.i
  87.       end
  88.       call stream dumpfile, 'C', 'CLOSE'
  89.     end
  90.   end
  91.   return
  92. /*--Begin Help-----------------------------------------------------------------
  93. Non-destructive dump of REXX data queue contents to a file.
  94.  
  95. Designed to be called from another REXX program, this program will dump to a
  96. file the contents of the current data queue.  If the current queue is not the
  97. standard SESSION queue, the current queue is dumped first, and then the SESSION
  98. queue is dumped.  This can be very useful when debugging code dealing with
  99. queues.
  100.  
  101. Params: [file-spec] [, [/FLUSH] [/OVERWRITE]]
  102.  
  103. where:
  104.  
  105.   file-spec   is the path and name of the file to which to write the queue
  106.               data.  If not specified, the name defaults to the name of this
  107.               program with a file extent of .QUE and is written to the current
  108.               directory.
  109.  
  110.   /FLUSH      will flush the queue or queues after dumping them.
  111.  
  112.   /OVERWRITE  will cause the program to not ask if it okay to overwrite an
  113.               existing .QUE file; it will just overwrite the file.
  114.  
  115. ________________
  116. Alternate Params: [ ? | ?? | ??? | ???? ]
  117.  
  118. where:
  119.  
  120.   ?     Displays up to the "Syntax:" or "Params:" portion of this help text.
  121.  
  122.   ??    Displays this entire help text except for the technical information.
  123.  
  124.   ???   Displays this entire help text.
  125.  
  126.   ????  Puts this help text into a file whose name is the same as the name of
  127.         this program and whose extent is .ABS.  The file is written to the same
  128.         directory as that in which this program resides.
  129.  
  130. _______________
  131. Technical Notes
  132.  
  133. ___________________
  134. Development History
  135.  
  136. $Log:   Q:/rxdv/skeleton/vcs/quedump.cm!  $
  137.   
  138.      Rev 1.0   03 Aug 1995 20:10:22
  139.   Initial revision.
  140. --End Help-------------------------------------------------------------------*/
  141.