000100*>>SOURCE FORMAT IS FIXED
000200*> ***************************************************************
000300*><* =======================
000400*><* ocdoc.cob usage guide
000500*><* =======================
000600*><* .. sidebar:: Table of Contents
000700*><* 
000800*><*     .. contents:: :local:
000900*><*
001000*><* :Author:    Brian Tiffin     
001100*><* :Date:      30-Sep-2008
001200*><* :Rights:    Copyright (c) 2008, Brian Tiffin.
001300*><*             GNU FDL License. 
001400*><* :Purpose:   Extract usage document lines from COBOL sources. 
001500*><*             Using OpenCOBOL 1.1pr.  OpenCOBOL is tasty.
001600*><* :Tectonics: cobc -x ocdoc.cob
001700*> ***************************************************************
001800*><*
001900*><* ------------
002000*><* Command line
002100*><* ------------
002200*><* *ocdoc* runs in two forms.
002300*><* 
002400*><* Without arguments, *ocdoc* will act as a pipe filter.
002500*><* Reading from standard in and writing the extract to standard
002600*><+  out.
002700*><*
002800*><* The *ocdoc* command also takes an input file, an extract
002900*><+  filename, an optional result file (with optional 
003000*><+  stylesheet) and a verbosity option *-v* or a 
003100*><+  special *-fixed* flag (to force skipping sequence numbers).
003200*><* If a result file is given, ocdoc will automatically
003300*><* run an *rst2html* command using the SYSTEM service.
003400*><*
003500*><* Due to an overly simplistic argument handler, you can only
003600*><+  turn on verbosity or -fixed when using all four filenames.
003700*><*
003800*><* Examples::
003900*><*
004000*><*   $ cat ocdoc.cob | ocdoc >ocdoc.rst
004100*><*   $ ./ocdoc ocdoc.cob ocdoc.rst
004200*><*   $ ./ocdoc ocdoc.cob ocdoc.rst
004300*><+  ocdoc.html skin.css -fixed
004400*><*   ...
004500*><*   Input  : ocdoc.cob
004600*><*   Output : ocdoc.rst
004700*><*   Command: rst2html --stylesheet=skin.css
004800*><+  ocdoc.rst ocdoc.html
004900*><*
005000*><* -----------------
005100*><* What is extracted
005200*><* -----------------
005300*><* - Lines that begin with \*><\* *ignoring spaces*, are
005400*><+  extracted.
005500*><*
005600*><* - Lines that begin with \*><+ are appended to the
005700*><+  previous output line.  As lines are trimmed of trailing
005800*><+  spaces, and *ocdoc* removes the space following the
005900*><+  extract triggers, you may need two spaces after an
006000*><+  ocdoc append.
006100*><*
006200*><* - Lines that begin with \*><[ begin a here document
006300*><+  with lines that follow extracted as is.
006400*><*
006500*><* - Lines that begin with \*><] close a here document.
006600*><+  Here document start and end lines are excluded from the
006700*><+  extract.
006800*><*
006900*><* -----------
007000*><* Source code
007100*><* -----------
007200*><* `Download ocdocseq.cob
007300*><+  <http://opencobol.add1tocobol.com/ocdocseq.cob>`_ 
007400*><*
007500*><! .. include:: ocdoc.cob 
007600*><!    :literal:
007700*><*
007800*><* -----------------------
007900*><* identification division
008000*><* -----------------------
008100*><*
008200*><* ::
008300*><*
008400*><[
008500 identification division.
008600 program-id. OCDOC.
008700
008800 environment division.
008900 input-output section.
009000 file-control.
009100     select standard-input assign to KEYBOARD.
009200     select standard-output assign to DISPLAY.
009300
009400     select source-input
009500     assign to source-name
009600     organization is line sequential
009700     .
009800     select doc-output
009900     assign to doc-name
010000     organization is line sequential
010100     .
010200*><]
010300*><*
010400*><* -------------
010500*><* data division
010600*><* -------------
010700*><*
010800*><* ::
010900*><*
011000*><[
011100 data division.
011200 file section.
011300 fd standard-input.
011400    01 stdin-record      pic x(256).
011500 fd standard-output.
011600    01 stdout-record     pic x(256).
011700
011800 fd source-input.
011900    01 source-record     pic x(256).
012000 fd doc-output.
012100    01 doc-record        pic x(256).
012200
012300 working-storage section.
012400 01 arguments            pic x(256).
012500 01 source-name          pic x(256).
012600 01 doc-name             pic x(256).
012700 01 result-name          pic x(256).
012800 01 style-name           pic x(256).
012900 01 verbosity            pic x(9).
013000    88 verbose           values "-v" "--v" "-verbose" "--verbose".
013100    88 skipseqnum        values "-fix" "-fixed" "--fix" "--fixed".
013200 01 usagehelp            pic x(6).
013300    88 helping           values "-h" "--h" "-help" "--help".
013400 01 filter-flag          pic x value low-value.
013500    88 filtering         value high-value.
013600
013700 01 line-count           usage binary-long.
013800 01 line-display         pic z(8)9.
013900
014000*><]
014100*><*
014200*><* Note the conditional test for end of here doc
014300*><*
014400*><* ::
014500*><*
014600*><[
014700 01 trimmed              pic x(256).
014800    88 herestart         value "*><[".
014900    88 hereend           value "*><]".
015000
015100 01 hereflag             pic x value low-value.
015200    88 heredoc           value high-value.
015300    88 herenone          value low-value.
015400
015500*><]
015600*><*
015700*><* Note the here-record adds an ocdoc extract to lines that
015800*><+  follow.
015900*><*
016000*><* ::
016100*><*
016200*><[
016300 01 here-record.
016400    02 filler            pic x(5) value "*><* ".
016500    02 here-data         pic x(251).
016600
016700 01 seq-record.
016800    02 filler            pic x(7) value "       ".
016900    02 seq-data          pic x(249).
017000
017100 01 doc-buffer           pic x(256).
017200 01 buffer-offset        pic 999 usage comp-5 value 1.
017300 01 buffer-flag          pic x value low-value.
017400    88 buffer-empty      value low-value.
017500    88 buffered-output   value high-value.
017600
017700 01 counter              pic 999 usage comp-5.
017800 01 len-of-comment       pic 999 usage comp-5.
017900
018000 01 first-part           pic x(8).
018100    88 special           values "*><*" "*><+".
018200    88 autodoc           value "*><*".
018300    88 autoappend        value "*><+".
018400
018500 01 rst-command          pic x(256).
018600 01 result               usage binary-long.
018700*><]
018800*><*
018900*><* ------------------
019000*><* procedure division
019100*><* ------------------
019200*><*
019300*><* ::
019400*><*
019500*><[
019600*> ***************************************************************
019700 procedure division.
019800
019900*><]
020000*><*
020100*><* Accept command line arguments.  See if help requested.
020200*><*
020300*><* ::
020400*><*
020500*><[
020600 accept arguments from command-line end-accept
020700
020800 move arguments to usagehelp
020900 if helping
021000     display
021100         "$ ./ocdoc source markover [output [skin]] --verbose"
021200     end-display
021300     display "$ ./ocdoc" end-display
021400     display "    without arguments extracts stdin to stdout"
021500     end-display
021600     goback
021700 end-if
021800
021900*><]
022000*><*
022100*><* Either run as filter or open given files.  Two filenames
022200*><+  will generate an extract.  Three will run the extract
022300*><+  through *rst2html* using an optional fourth filename
022400*><+  as a stylesheet.
022500*><*
022600*><* ::
022700*><*
022800*><[
022900*> Determine if this is running as a filter
023000 if arguments not equal spaces
023100     unstring arguments delimited by all spaces
023200         into source-name doc-name
023300              result-name style-name
023400              verbosity
023500     end-unstring
023600
023700     open input source-input
023800     open output doc-output
023900 else
024000     set filtering to true
024100
024200     open input standard-input
024300     open output standard-output
024400 end-if
024500
024600*><]
024700*><*
024800*><* Initialize the output buffer, and line count.
024900*><*
025000*><* ::
025100*><*
025200*><[
025300 set buffer-empty to true
025400 move 1 to buffer-offset
025500 move spaces to doc-record
025600 move 0 to line-count
025700
025800*><]
025900*><*
026000*><* The read is either from file or stdin.  Start with the
026100*><+  first record.
026200*><*
026300*><* ::
026400*><*
026500*><[
026600*> filtering requires different reader loop
026700 if filtering
026800     read standard-input
026900         at end move high-values to stdin-record
027000     end-read
027100     move stdin-record to source-record
027200 else
027300     read source-input
027400         at end move high-values to source-record
027500     end-read
027600 end-if
027700
027800*><]
027900*><*
028000*><* The main loop starts here, having done a pre-read to start
028100*><+  things off.
028200*><*
028300*><* ::
028400*><*
028500*><[
028600 perform until source-record = high-values
028700     add 1 to line-count
028800  
028900*><]
029000*><*
029100*><* Small wrinkle if processing fixed form with sequence numbers,
029200*><+  as the heredoc end marker needs to be recognized
029300*><+  but we still want the sequence numbers in the heredoc.
029400*><*
029500*><* So files processed --fixed play some data shuffling games.
029600*><*
029700*><* ::
029800*><*
029900*><[
030000     if skipseqnum
030100         if heredoc
030200             move source-record(7 : 248) to trimmed
030300             move source-record to seq-data
030400             move seq-record to source-record
030500         else
030600             move source-record(7 : 248) to source-record
030700             move source-record to trimmed
030800         end-if
030900     else
031000         move function trim(source-record leading) to trimmed
031100     end-if
031200             
031300*><]
031400*><*
031500*><* First to check for here doc start and end, setting flag
031600*><+  if trimmed conditional the heredoc start or heredoc end
031700*><+  strings.
031800*><*
031900*><* ::
032000*><*
032100*><[
032200     if herestart
032300         set heredoc to true
032400     end-if
032500
032600     if hereend
032700         set herenone to true
032800     end-if
032900
033000*><]
033100*><*
033200*><* Inside the loop, we skip over heredoc entries.
033300*><+  If it is normal, than check for heredoc and include
033400*><+  source lines that follow, by prepending the extract tag
033500*><*
033600*><* ::
033700*><*
033800*><[
033900     if (not herestart) and (not hereend)
034000         if heredoc
034100             move source-record to here-data
034200             move here-record to trimmed
034300         end-if
034400
034500*><]
034600*><*
034700*><* Unstring the line, looking for special tags in the first
034800*><+  part.
034900*><*
035000*><* ::
035100*><*
035200*><[
035300         unstring trimmed delimited by all spaces
035400             into first-part
035500                 count in counter
035600         end-unstring
035700
035800*><]
035900*><*
036000*><* If special, we either buffer or append to buffer
036100*><*
036200*><* ::
036300*><*
036400*><[
036500         evaluate true when special
036600             if autoappend and buffer-empty
036700                 move spaces to doc-record
036800                 move 1 to buffer-offset
036900             end-if
037000                         
037100             if autodoc and buffered-output
037200                 if filtering
037300                     move doc-record to stdout-record
037400                     write stdout-record end-write
037500                 else
037600                     write doc-record end-write
037700                 end-if
037800                 if verbose
037900                     display
038000                         function trim(doc-record trailing)
038100                     end-display
038200                 end-if
038300                 move spaces to doc-record
038400                 set buffer-empty to true
038500                 move 1 to buffer-offset
038600             end-if
038700
038800*><]
038900*><*
039000*><* Skip over where the tag was found plus an extra space.
039100*><* Adding 2 skips over the assumed space after a special tag
039200*><*
039300*><* ::
039400*><*
039500*><[
039600             add 2 to counter
039700             compute len-of-comment = 
039800                 function length(trimmed) - counter
039900             end-compute
040000
040100             if len-of-comment > 0
040200                 move trimmed(counter : len-of-comment)
040300                     to doc-buffer
040400             else
040500                 move spaces to doc-buffer
040600             end-if
040700
040800*><]
040900*><*
041000*><* Buffer the line, either to position 1 or appending to last.
041100*><*
041200*><* ::
041300*><*
041400*><[
041500             string
041600                 function trim(doc-buffer trailing)
041700                     delimited by size
041800                 into doc-record
041900                 with pointer buffer-offset
042000                 on overflow
042100                     move line-count to line-display
042200                     display
042300                         "*** truncation *** reading line "
042400                         line-display
042500                     end-display
042600             end-string
042700             set buffered-output to true
042800         end-evaluate
042900     end-if
043000     
043100*><]
043200*><*
043300*><* Again, we either read the next record from file or stdin.
043400*><*
043500*><* ::
043600*><*
043700*><[
043800     if filtering
043900         read standard-input
044000             at end move high-values to stdin-record
044100         end-read
044200         move stdin-record to source-record
044300     else
044400         read source-input
044500             at end move high-values to source-record
044600         end-read
044700     end-if
044800 end-perform
044900
045000*><]
045100*><*
045200*><* We may or may not end up with buffered data
045300*><*
045400*><* ::
045500*><*
045600*><[
045700 if buffered-output
045800     set buffer-empty to true
045900     move 1 to buffer-offset
046000     if filtering
046100         move doc-record to stdout-record
046200         write stdout-record end-write
046300     else
046400         write doc-record end-write
046500     end-if
046600     if verbose
046700          display
046800             function trim(doc-record trailing)
046900          end-display
047000     end-if
047100     move spaces to doc-record
047200 end-if
047300
047400*><]
047500*><*
047600*><* Close the OpenCOBOL files
047700*><*
047800*><* ::
047900*><*
048000*><[
048100 if filtering
048200     close standard-output
048300     close standard-input
048400 else
048500     close doc-output
048600     close source-input
048700 end-if
048800
048900 if verbose
049000     display "Input  : " function trim(source-name) end-display
049100     display "Output : " function trim(doc-name) end-display
049200 end-if
049300
049400*><]
049500*><*
049600*><* An if we have a result file, use the SYSTEM service to
049700*><+  generate an HTML file, possibly with stylesheet.
049800*><*
049900*><* ::
050000*><*
050100*><[
050200*> pass the extract through a markover, in this case ReST
050300 move spaces to rst-command
050400 if result-name not equal spaces
050500     if style-name equal spaces
050600         string
050700             "rst2html " delimited by size
050800             doc-name delimited by space
050900             " " delimited by size
051000             result-name delimited by space
051100             into rst-command
051200         end-string
051300     else
051400         string
051500             "rst2html --stylesheet=" delimited by size
051600             style-name delimited by space
051700             " " delimited by size
051800             doc-name delimited by space
051900             " " delimited by size
052000             result-name delimited by space
052100             into rst-command
052200         end-string
052300     end-if
052400
052500     if verbose
052600         display
052700             "Command: " 
052800             function trim(rst-command trailing)
052900         end-display
053000     end-if
053100
053200     call "SYSTEM"
053300         using rst-command
053400         returning result
053500     end-call
053600 
053700     if result not equal zero
053800         display "HTML generate failed: " result end-display
053900     end-if
054000 end-if
054100
054200*><]
054300*><*
054400*><* And before you know it, we are done.
054500*><*
054600*><* ::
054700*><*
054800*><[
054900 goback.
055000
055100 end program OCDOC.
055200*><]
055300*><*
055400*><* Don't forget to visit http://opencobol.org
055500*><*
055600*><* Cheers
055700*><*
055800*><* *Last edit:* 03-Oct-2008