        identification division.

        author.    Micro Focus, Ltd.        Micro Focus, Inc.
                   Newbury, Berkshire       Palo Alto, California
                   United Kingdom           U.S.A.

                         ALL RIGHTS RESERVED.

      ***
      ***  To Build (Win32):  cobol sampprnx.cbl /dialect"mf" /gnt;
      ***  To Build (Unix):   cob -zg -C'CONSTANT UNIX"1" ' sampprnx.cbl
      ***
      ***--------------------------------------------------------------*
      *** Revision History                                             *
      ***--------------------------------------------------------------*
      ***  $Log: sampprnx.cbl,v $
      ***  Revision 1.4  2007/05/18 12:37:37  dmf
      ***  Make sources more 'unix friendly'
      ***
      ***  Revision 1.3  2007/01/05 21:05:35  dmf
      ***  Fixes to allow OUTPUT statement to function.
      ***  FORM expanded to 8 bytes and moved to end of IDADOUTP.CPY
      ***  structure.
      ***  MFJX402 modified to move 8 bytes of FORM data to ()-form in
      ***  IDADOUTP.CPY
      ***  Sample Printer Exit and Sample JCL enhanced to drive through
      ***  FORM and FORMDEF so we can prove it's working/not working.
      ***  Mods: idadoutp.cpy mfjx402.cbl sampprnx.cbl sampprnx.jcl
      ***
      ***  Revision 1.2  2006/04/10 19:52:22  dmf
      ***  OUTPUT Statement Printer Exit Rough-in
      ***
      ***  Revision 1.1  2006/03/22 21:44:37  dmf
      ***  Add sample printer user exit.
      ***  Sample Printer user exit now works on Unix and Win32 depending on conditional compilation
      ***  Modified EBCDIC table so that it will compile cleanly on Linux - Uses hex constants
      ***
      ***  Revision 1.1  2004/07/26 02:03:53  sc
      ***  jes-13 Code complete for batch printer & printer exit;
      ***         Correct MFE compile errors.
      ***    Mod: casbat.cbl   cascbprn.cpy cascpcat.cpy cascwjes.cpy
      ***         cacwprn.cpy  casprn.cbl   casrdo42.cbl casrdo43.cbl
      ***         casrdo47.cbl casrdo52.cbl casxmast.htm dfhcbdca.cpy
      ***         dfhcprdt.cpy dfheini1.cbl dfhgglbl.cbl messages
      ***         sampprnx.cbl txmake.ctl
      ***
      ***--------------------------------------------------------------*
       environment division.
       working-storage section.
       copy 'cascwprn.cpy'.
       01  ws-work.
           03  ws-y                    pic x(4) comp-5.
       01  ws-font-family.
           03  value 11                pic x(2) comp-5.
           03  value 'Courier New'.
           
       77 msg-dest-both                         pic 9(8) comp value 0.
       77 msg-dest-joblog                       pic 9(8) comp value 1.
       77 msg-dest-syslog                       pic 9(8) comp value 2.

       01 txt-buffer                            pic x(256).
       copy 'cascbsmg.cpy' replacing ==(tag)== by ==ws==.          
           
       78  78-cbl-create-file          value 'CBL_CREATE_FILE'.
       78  78-cbl-delete-file          value 'CBL_DELETE_FILE'.
       78  78-cbl-open-file            value 'CBL_OPEN_FILE'.
       78  78-cbl-read-file            value 'CBL_READ_FILE'.
       78  78-cbl-write-file           value 'CBL_WRITE_FILE'.
       78  78-cbl-close-file           value 'CBL_CLOSE_FILE'.

055750 01  fnf-access-type  pic x                  value 0     comp-x.
055750     88  fnf-access-read-88              value 1.
055750     88  fnf-access-write-88             value 2.
055750     88  fnf-access-rdwrt-88             value 3.
055750
055750 01  fnf-deny-type           pic x           value 0     comp-x.
055750     88  fnf-deny-rdwrt-88               value 0.
055750     88  fnf-deny-write-88               value 1.
055750     88  fnf-deny-read-88                value 2.
055750     88  fnf-deny-none-88                value 3.
055750
055750 01  fnf-device       pic x              value 0     comp-x.
055750
055750 01  fnf-file-handle             pic x(4)    value spaces.
055750
055750 01  fnf-io-offset               pic x(8)    value 0     comp-x.
055750
055750 01  fnf-io-bytes                pic x(4)    value 0     comp-x.
055750
055750 01  fnf-flag-type               pic x       value 0     comp-x.
055750     88  fnf-flag-normal-88             value 0.
055750     88  fnf-flag-getsize-88            value 128.
055750
055750 
055750 01 ws-unix-printer-command-buffer  pic x(100).
055750 01 ws-unix-printer-rc              PIC  9(04) comp.       
055750 01 ws-unix-printer-fs              PIC X(04) COMP-5.
055750 01 ws-unix-printer-ndx             pic x(02) COMP-5.
538159 01 ws-offset-0                     pic x(8) comp-x value 0.     
538159 01 ws-content-length               pic x(4) comp-x.
055750 01 ws-unix-lp-log                  pic x(100) value
055750    '$TXRFDIR/lp.log'.
055750 01 ws-unix-tmp-prnt                pic x(100). 

       linkage section.
       copy 'cascbprn.cpy' replacing ==(ws)== by ==lk==.
       01 lk-catalog-rec. 
       copy 'mvscatlg.cpy' replacing ==(TAG)== by ==lk==. 

       01 LK-OUTPUT.
       copy 'mvsdout.cpy'  replacing ==()== by ==LK-OUTPUT==.

       procedure division using lk-prn-exit-interface.
           evaluate true
            when lk-prn-exit-init-88
               perform print-initialize
            when lk-prn-exit-print-88
               perform print-processor
            when lk-prn-exit-term-88
               perform print-terminate
            when other
               move -1                 to return-code
           end-evaluate
           exit program
           stop run
           .
      ***--------------------------------------------------------------*
       print-initialize section.
       
               move low-values to ws-srv-console-msg
               
               move spaces to txt-buffer
               
               move 1          to ws-srv-cmsg-size
               string   " EXIT - Printer Initializing "
                 into txt-buffer
                 pointer ws-srv-cmsg-size
                              
               set ws-srv-cmsg-ptr to address of txt-buffer
      
               call lk-prn-message-pptr using ws-srv-console-msg
       
           exit section
           .
      ***--------------------------------------------------------------*
       print-processor  section.
              
   
           move low-values to ws-srv-console-msg

           move spaces to txt-buffer

           move 1          to ws-srv-cmsg-size
           string   " EXIT - Printer Printing "
             into txt-buffer
             pointer ws-srv-cmsg-size

           set ws-srv-cmsg-ptr to address of txt-buffer

           call lk-prn-message-pptr using ws-srv-console-msg

                    
           evaluate true
            when lk-prn-char-ascii-88
               move ws-ASCII-table
                               to ws-dump-char-table
            when lk-prn-char-ebcdic-88
               move ws-EBCDIC-table
                               to ws-dump-char-table
            when other
               move ws-default-table
                               to ws-dump-char-table
           end-evaluate
      $IF UNIX NOT DEFINED
           call 'PC_PRINTER_OPEN' using
            by reference lk-prn-printer-handle
            by reference lk-prn-document
            by value     0 size 2
            by value     0 size 4
           end-call
      $ELSE
           set address of lk-catalog-rec
               to lk-prn-catalog-record-ptr 
           move spaces to ws-unix-tmp-prnt
           string
                '$TXRFDIR/'      delimited by size
                lk-dsn          delimited by space                       
           into ws-unix-tmp-prnt
                   
           set fnf-access-write-88      to true
           set fnf-deny-rdwrt-88       to true
           move low-values to fnf-file-handle
           move 0 to ws-offset-0
           call 78-cbl-delete-file using
                ws-unix-tmp-prnt
           end-call
           call 78-cbl-create-file using
                                        ws-unix-tmp-prnt
                                        fnf-access-type
                                        fnf-deny-type
                                        fnf-device
                                        fnf-file-handle
            end-call    
      $END
           if return-code = 0
      $IF UNIX NOT DEFINED 
               call 'PC_PRINTER_SET_FONT' using
                by reference lk-prn-printer-handle
                by reference ws-font-family
                by value     10   *> font-size
                by value      0   *> font-style
               end-call 
      $END
               move lk-prn-document-title
                                       to lk-prn-buffer
               move lk-prn-document-len
                                       to lk-prn-buffer-len
               perform write-printer-output
               
               perform process-output-statements
                              
               move lk-prn-sysout-file-name
                                       to lk-prn-buffer
               move length of lk-prn-sysout-file-name
                                       to lk-prn-buffer-len
               perform write-printer-output
               move 0                  to lk-prn-buffer-len
               perform write-printer-output
               call lk-prn-sysout-open-pptr
               if lk-prn-sysout-status-ok-88
                   perform until exit
                       call lk-prn-sysout-read-next-pptr
                       if lk-prn-sysout-status-ok-88
                           perform display-record
                           if return-code not = 0
                               exit perform
                           end-if
                       else
                           exit perform
                       end-if
                   end-perform
                   call lk-prn-sysout-close-pptr
      $IF UNIX NOT DEFINED 
                   call 'PC_PRINTER_CLOSE' using
                    by reference lk-prn-printer-handle
                   end-call
      $ELSE
                   call 78-cbl-close-file using 
                        fnf-file-handle
                   end-call
      
                   move low-values to ws-unix-printer-command-buffer
                   string
                       'lp -d '                   delimited by size
                       lk-prn-printer-name(1:lk-prn-printer-name-len)
                                                  delimited by space
                       ' '                        delimited by size
                       ws-unix-tmp-prnt           delimited by size
                       ' > '                     delimited by size
                       ws-unix-lp-log             delimited by space
                       X'00'                      delimited by size
                   into ws-unix-printer-command-buffer
                   call 'system' using 
                         by reference ws-unix-printer-command-buffer
                   returning ws-unix-printer-rc   

                   *>  Get rid of tmp file!
                      
                   call 78-cbl-delete-file
                           using ws-unix-tmp-prnt
                   end-call
      $END
               end-if
           end-if
           exit section
           .
      ***--------------------------------------------------------------*
       print-terminate  section.
       
   
           move low-values to ws-srv-console-msg

           move spaces to txt-buffer

           move 1          to ws-srv-cmsg-size
           string   " EXIT - Printer Terminating "
             into txt-buffer
             pointer ws-srv-cmsg-size

           set ws-srv-cmsg-ptr to address of txt-buffer

           call lk-prn-message-pptr using ws-srv-console-msg

       
           exit section
           .
      ***--------------------------------------------------------------*
       display-record        section.
           perform varying ws-y from 1 by 1
            until ws-y > lk-prn-buffer-len
               if lk-prn-buffer-byte(ws-y) = 0
                   move '.'            to lk-prn-buffer-byte (ws-y) (1:)
               else
                   move ws-dump-char(lk-prn-buffer-byte  (ws-y) )
                                       to lk-prn-buffer-byte (ws-y) (1:)
               end-if
           end-perform
           perform write-printer-output
           exit section
           .
      ***--------------------------------------------------------------*
       write-printer-output section.
           if lk-prn-buffer-len > length of lk-prn-buffer
               move length of lk-prn-buffer
                                       to lk-prn-buffer-len
           end-if
           perform varying lk-prn-buffer-len
             from lk-prn-buffer-len by -1
             until lk-prn-buffer-len = 0
               if lk-prn-buffer(lk-prn-buffer-len:1) not = space
                   exit perform
               end-if
           end-perform
           add 1                       to lk-prn-buffer-len
           if lk-prn-buffer-len > length of lk-prn-buffer
               move length of lk-prn-buffer
                                       to lk-prn-buffer-len
           end-if
           move x'0a'                  to lk-prn-buffer
                                          (lk-prn-buffer-len:1)

      $IF UNIX DEFINED 
            move lk-prn-buffer-len to ws-content-length 
            call 78-cbl-write-file using 
                fnf-file-handle
                ws-offset-0
                ws-content-length
                fnf-flag-type
                lk-prn-buffer
            end-call
            add lk-prn-buffer-len to ws-offset-0
      $ELSE      
           call 'PC_PRINTER_WRITE' using
            by reference lk-prn-printer-handle
            by reference lk-prn-buffer
            by value     lk-prn-buffer-len
           end-call
      $END
           exit section
           .
           
      ***--------------------------------------------------------------*
       process-output-statements  section.
       
           if lk-prn-output-record-ptr  <> NULL then

               move spaces to lk-prn-buffer
               move 80 to lk-prn-buffer-len 
               perform write-printer-output               
               
               move '*************** OUTPUT STATEMENTS ***************'
                    to lk-prn-buffer
               move 50 to lk-prn-buffer-len
               perform write-printer-output
               
               perform until lk-prn-output-record-ptr = NULL               
                   set address of lk-output to lk-prn-output-record-ptr

                   move spaces to lk-prn-buffer

                   string
                      'OUTPUT statement - CLASS: '
                      lk-output-class
                      ' DEST NODE: '
                      lk-output-dest-node
                      ' DEST USERID: '
                      lk-output-dest-userid
                   into lk-prn-buffer    

                   move 80 to lk-prn-buffer-len
                   perform write-printer-output

                   move spaces to lk-prn-buffer

                   string
                      '                           '
                      ' FORM: '
                      lk-output-form
                      ' FORMDEF: '
                      lk-output-formdef
                   into lk-prn-buffer    

                   move 80 to lk-prn-buffer-len
                   perform write-printer-output
                   call lk-prn-output-read-next-pptr

               end-perform
               
               move '************* END OUTPUT STATEMENTS *************'
                   to lk-prn-buffer
               move 50 to lk-prn-buffer-len
               perform write-printer-output
               
               move spaces to lk-prn-buffer
               move 80 to lk-prn-buffer-len 
               perform write-printer-output               


           end-if
       
           exit section
           .
           
      ***--------------------------------------------------------------*
      ***  $Workfile:   sampprnx.cbl  $ end
      ***--------------------------------------------------------------*
