COBFD a command line cobol record analyzer


COBFD is a gnuCOBOL opensource cobol command line record analyzer to check your file description file and put the result into an output flat file.

To run the tools open a console prompt and use the c:\>cobfd yourfd.cbl yourreport.txt where: yourfd.cbl is the file description that you want to analyze

yourreport.txt the name of the file that will contains the report (if none is declared it will use cobfd.txt as default name)

Take the result from the output file

GNUCOBOL SYNTAX VERSION

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. COBFD.
000030
000040*---------------------------------------------------------------
000050* COSTRUISCE IL DIZIONARIO PER LA FD SPECIFICATA
000060*---------------------------------------------------------------
000070*
000080* Copyright (C) Federico Priolo TP ONE SRL federico.priolo@tp-one.it
000090*
000100* This program is free software; you can redistribute it and/or
000110* it under the terms of the GNU General Public License as publis
000120* the Free Software Foundation; either version 2, or (at your op
000130* any later version.
000140*
000150* This program is distributed in the hope that it will be useful
000160* but WITHOUT ANY WARRANTY; without even the implied warranty of
000170* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
000180* GNU General Public License for more details.
000190*
000200* You should have received a copy of the GNU General Public Lice
000210* along with this software; see the file COPYING.  If not, write
000220* the Free Software Foundation, 51 Franklin Street, Fifth Floor
000230* Boston, MA 02110-1301 USA
000240*
000250*
000260*---------------------------------------------------------------
000270  ENVIRONMENT DIVISION.
000280  CONFIGURATION SECTION.
000290  SOURCE-COMPUTER.        PC-IBM.
000300  OBJECT-COMPUTER.        PC-IBM.
000310  SPECIAL-NAMES.
000320
000330          DECIMAL-POINT   IS COMMA.
000340
000350  INPUT-OUTPUT SECTION.
000360  FILE-CONTROL.
000370
000380*
000390** your copy fd to examine
000400*
000410
000420          SELECT ARK-IN ASSIGN TO FILE-IN
000430           ORGANIZATION IS LINE SEQUENTIAL
000440           FILE STATUS  IS STATUS-IN.
000450*
000460** isam to figure out size and offset...
000470*
000480          SELECT ARKDATA ASSIGN ".\WORKAREA.DAT"
000490
000500           ORGANIZATION IS INDEXED
000510           ACCESS MODE  IS DYNAMIC
000520           RECORD KEY   IS KEY-DATA
000530           ALTERNATE RECORD KEY IS KEY-NAME-DATA
000540           DUPLICATES
000550           FILE STATUS  IS STATUS-DATA.
000560
000570
000580*
000590** The output result
000600*
000610
000620          SELECT ARK-OUT ASSIGN TO FILE-OUT
000630           ORGANIZATION IS LINE SEQUENTIAL
000640           FILE STATUS  IS STATUS-OUT.
000650
000660
000670  DATA DIVISION.
000680  FILE SECTION.
000690
000700  FD ARK-IN  LABEL RECORD IS STANDARD.
000710
000720  01 REC-IN.
000730    02 FILLER                    PIC X(80).
000740
000750  FD ARK-OUT  LABEL RECORD IS STANDARD.
000760
000770  01 REC-OUT.
000780    02 FILLER-OUT                PIC X(80).
000790
000800  01 REC-OUTX.
000810    02 LEVEL-OUT                 PIC 99.
000820    02 FILLER-OUT                PIC X.
000830    02 NAME-OUT                  PIC X(31).
000840    02 FILLER-OUT                PIC X.
000850    02 PICTURE-OUT               PIC X(15).
000860    02 FILLER-OUT                PIC X.
000870    02 TYPE-OUT                  PIC X(4).
000880    02 FILLER-OUT                PIC X.
000890    02 OCCURS-OUT                PIC ZZZZZZ.
000900    02 FILLER-OUT                PIC X.
000910    02 SIZE-OUT                  PIC ZZZZZZ.
000920    02 FILLER-OUT                PIC X.
000930    02 OFFSET-OUT                PIC ZZZZZ9.
000940
000950*
000960  FD ARKDATA  LABEL RECORD IS STANDARD GLOBAL.
000970*
000980  01 REC-DATA.
000990
001000   02 KEY-DATA                   PIC 9(9).
001010   02 KEY-NAME-DATA.
001020       05 LEV-DATA               PIC 99.
001030       05 FIELD-DATA             PIC X(30).
001040   02 FIELDS-DATA.
001050       05 LEVEL-DATA             PIC 99.
001060       05 NAME-DATA              PIC X(30).
001070       05 FILLER-DATA            PIC X.
001080       05 PICTURE-DATA           PIC X(30).
001090       05 FILLER-DATA            PIC X.
001100       05 TYPE-DATA              PIC X(08).
001110       05 OCCURS-DATA            PIC 9(2).
001120       05 FILLER-DATA            PIC X.
001130       05 SIZE-DATA              PIC 9(7).
001140       05 FILLER-DATA            PIC X.
001150       05 OFFSET-DATA            PIC 9(7).
001160       05 REDEFINES-DATA         PIC X(30).
001170       05 ARRAY-SIZE-DATA        PIC 9(7).
001180       05 FLAG-REDEFINES-DATA    PIC X.
001190
001200  WORKING-STORAGE SECTION.
001210
001220  77 FILE-DATA         PIC X(20) VALUE "ARKDATA".
001230  77 STATUS-DATA       PIC XX VALUE "00".
001240  77 FINE-FILE         PIC X.
001250  77 STATUS-IN         PIC XX VALUE "00".
001260  77 STATUS-OUT        PIC XX VALUE "00".
001270
001280  77 IND               PIC 999.
001290  77 IND1              PIC 999.
001300  77 IND2              PIC 999.
001310  77 IND3              PIC 999.
001320  77 IND4              PIC 999.
001330
001340  01 FILE-IN           PIC X(150).
001350  01 FILE-OUT          PIC X(150).
001360  77 WPARAM            PIC X(512).
001370  77 WSIZE             PIC 9(9).
001380  77 WOFFSET           PIC 9(9).
001390  77 WLEVEL            PIC 99.
001400  77 WPICTURE          PIC X(30).
001410  77 WKEY              PIC 9(9).
001420  77 WREDEFINES        PIC X(30).
001430  77 COUNT-ITEM        PIC 9(9) VALUE ZEROS.
001440  01 STRINGA           PIC X(18).
001450  01 NUMERO            PIC 9(18).
001460
001470  01 TAB-BUFFER.
001480    02 IND-BUFFER      PIC 99.
001490    02 IND1-BUFFER     PIC 99.
001500    02 BUFFER          PIC X(30) OCCURS 50 TIMES.
001510
001520  01 TAB-STRINGA       PIC X(1504) VALUE SPACE.
001530
001540
001550  PROCEDURE DIVISION.
001560
001570  MAIN SECTION.
001580  INIZIO.
001590
001600
001610
001620      PERFORM OPEN-FILES THRU EX-OPEN-FILES.
001630
001640      MOVE SPACES TO FINE-FILE.
001650      MOVE ZEROS  TO COUNT-ITEM
001660
001670      DISPLAY
001680      "COBFD Version 1.00 "
001690       "Copyright (C) 2022 Federico Priolo TP ONE SRL".
001700
001710      DISPLAY
001720      "Analyzing " FUNCTION TRIM(FILE-IN).
001730
001740
001750
001760      PERFORM PROCESS-IN     THRU EX-PROCESS-IN
001770         UNTIL FINE-FILE = "S".
001780
001790      PERFORM BUILD          THRU EX-BUILD.
001800
001810      PERFORM CALCULATE      THRU EX-CALCULATE.
001820
001830      PERFORM OFFSET         THRU EX-OFFSET.
001840
001850      PERFORM EXPORT         THRU EX-EXPORT.
001860
001870  FINE.
001880
001890      DISPLAY "COBFD: end of job ".
001900
001910      CLOSE ARK-IN ARKDATA ARK-OUT.
001920      GOBACK.
001930
001940
001950  OPERATE.
001960
001970      IF FINE-FILE = "S" GO TO EX-OPERATE.
001980
001990      INITIALIZE TAB-BUFFER.
002000
002010
002020      UNSTRING REC-IN DELIMITED BY ALL SPACES
002030       INTO BUFFER(1)
002040            BUFFER(2)
002050            BUFFER(3)
002060            BUFFER(4)
002070            BUFFER(5)
002080            BUFFER(6)
002090            BUFFER(7)
002100            BUFFER(8)
002110            BUFFER(9)
002120            BUFFER(10)
002130            BUFFER(11)
002140            BUFFER(12)
002150            BUFFER(13)
002160            BUFFER(14)
002170            BUFFER(15)
002180              TALLYING IND-BUFFER
002190
002200      PERFORM VARYING IND FROM  LENGTH OF REC-IN BY -1 UNTIL
002210        REC-IN(IND:1) NOT = SPACES
002220       CONTINUE
002230      END-PERFORM
002240
002250      IF REC-IN(IND:1) = "." GO TO END-OPERATE.
002260
002270      PERFORM READ-IN       THRU EX-READ-IN
002280
002290      UNSTRING REC-IN DELIMITED BY ALL SPACES
002300       INTO BUFFER(16)
002310            BUFFER(17)
002320            BUFFER(18)
002330            BUFFER(19)
002340            BUFFER(20)
002350            BUFFER(21)
002360            BUFFER(22)
002370            BUFFER(23)
002380            BUFFER(24)
002390            BUFFER(25)
002400            BUFFER(26)
002410            BUFFER(27)
002420            BUFFER(28)
002430            BUFFER(29)
002440            BUFFER(30).
002450
002460       IF IND-BUFFER NOT = 15
002470        ADD  1  TO IND-BUFFER
002480        MOVE 16 TO IND1-BUFFER
002490        PERFORM 15 TIMES
002500        MOVE BUFFER(IND1-BUFFER)  TO BUFFER(IND-BUFFER)
002510        MOVE SPACES               TO BUFFER(IND1-BUFFER)
002520        ADD 1                     TO IND-BUFFER IND1-BUFFER
002530        END-PERFORM.
002540
002550
002560  END-OPERATE.
002570
002580       ADD 1 TO COUNT-ITEM.
002590
002600       MOVE FUNCTION UPPER-CASE(TAB-BUFFER)    TO TAB-STRINGA
002610
002620       MOVE TAB-STRINGA  TO TAB-BUFFER
002630       INITIALIZE REC-DATA
002640
002650*** FIRST ITEM CONTAINS THE RECORD LEVEL
002660
002670       PERFORM VARYING IND FROM 1 BY 1 UNTIL IND > 30
002680
002690
002700**** HERE A COBOL LEVEL...
002710
002720       IF BUFFER(IND) > SPACES
002730        AND NAME-DATA = SPACES
002740        AND BUFFER(IND) (1:1) NUMERIC
002750
002760
002770       MOVE BUFFER(IND)       TO STRINGA
002780       PERFORM ALFA-TO-NUM    THRU EX-ALFA-TO-NUM
002790       MOVE NUMERO            TO LEVEL-DATA
002800
002810****      ...AND AFTER THE NAME OF COBOL FIELD
002820
002830       ADD 1                  TO IND
002840       MOVE BUFFER(IND)       TO FIELD-DATA NAME-DATA
002850
002860       ADD 1                          TO IND
002870
002880**** here a field WITHOUT PICTURE... E.G. 01 NAME.
002890
002900       IF BUFFER(IND) = SPACES
002910       MOVE "Group" TO PICTURE-DATA
002920       END-IF
002930
002940       END-IF
002950
002960
002970       IF BUFFER(IND) = "REDEFINES"
002980       ADD 1                           TO IND
002990       MOVE BUFFER(IND)                TO REDEFINES-DATA
003000       END-IF
003010
003020
003030       IF BUFFER(IND)(1:3) = "PIC"
003040       ADD 1                     TO IND
003050       MOVE BUFFER(IND)          TO PICTURE-DATA
003060
003070        EVALUATE PICTURE-DATA(1:1)
003080
003090         WHEN "X"       MOVE "AN" TO TYPE-DATA
003100         WHEN "S"       MOVE "N"  TO TYPE-DATA
003110               PERFORM DO-NUMBER-TYPE THRU EX-DO-NUMBER-TYPE
003120
003130         WHEN "9"       MOVE "N"  TO TYPE-DATA
003140               PERFORM DO-NUMBER-TYPE THRU EX-DO-NUMBER-TYPE
003150
003160         WHEN "A"       MOVE "A"  TO TYPE-DATA
003170
003171			 WHEN "-"   MOVE "NE" TO TYPE-DATA
003172
003173			 WHEN "+"   MOVE "NE" TO TYPE-DATA
003174
003175			 WHEN "Z"   MOVE "NE" TO TYPE-DATA
003176	
003177			 WHEN OTHER DISPLAY "TYPE" PICTURE-DATA " NOT MANAGED"
003178
003179
003180        END-EVALUATE
003181
003190
003200        END-IF
003210
003220        IF BUFFER(IND) = "OCCURS"
003230
003240**** here a field WITHOUT PICTURE... E.G. 02 NAME OCCURS 5 TIMES...
003250
003260             MOVE ZEROS             TO IND1
003270             INSPECT TAB-BUFFER TALLYING IND1 FOR ALL "PIC"
003280             IF IND1 = ZEROS
003290             MOVE "Group"           TO PICTURE-DATA
003300             END-IF
003310
003320            ADD 1                   TO IND
003330            MOVE BUFFER(IND)        TO STRINGA
003340            PERFORM ALFA-TO-NUM     THRU EX-ALFA-TO-NUM
003350            MOVE NUMERO             TO OCCURS-DATA
003360            END-IF
003370
003380
003390            END-PERFORM.
003400
003410            PERFORM CALCULATE-SIZE THRU EX-CALCULATE-SIZE.
003420
003430            MOVE COUNT-ITEM         TO KEY-DATA.
003440
003450            IF PICTURE-DATA = SPACES
003460             MOVE "Group"           TO  PICTURE-DATA.
003470
003480            INSPECT KEY-NAME-DATA REPLACING ALL "." BY " "
003490
003500            MOVE LEVEL-DATA         TO LEV-DATA
003510
003520            WRITE REC-DATA
003530             INVALID KEY CONTINUE.
003540
003550             IF STATUS-DATA = "02"
003560              IF NAME-DATA(1:6) NOT = "FILLER"
003570            DISPLAY
003580            "Warning:found duplicates name with the same level:"
003590            FUNCTION TRIM(NAME-DATA)
003600             END-IF.
003610
003620
003630 EX-OPERATE.
003640          EXIT.
003650
003660 DO-NUMBER-TYPE.
003670
003680          MOVE ZEROS               TO IND1
003690          INSPECT TAB-BUFFER TALLYING IND1
003700           FOR ALL "LEADING"
003710          INSPECT TAB-BUFFER TALLYING IND1
003720           FOR ALL "SEPARATE"
003730          IF IND1 = 2    MOVE "SL" TO TYPE-DATA.
003740
003750          MOVE ZEROS               TO IND1
003760          INSPECT TAB-BUFFER TALLYING IND1
003770           FOR ALL "TRAIDING"
003780          INSPECT TAB-BUFFER TALLYING IND1
003790           FOR ALL "SEPARATE"
003800          IF IND1 = 2   MOVE "ST" TO TYPE-DATA.
003810
003820          MOVE ZEROS               TO IND1
003830          INSPECT TAB-BUFFER TALLYING IND1
003840           FOR ALL " COMP-5"
003850          IF IND1 = 1    MOVE "C5" TO TYPE-DATA.
003860
003870          MOVE ZEROS               TO IND1
003880          INSPECT TAB-BUFFER TALLYING IND1
003890           FOR ALL " COMP-3"
003900          IF IND1 = 1    MOVE "C3" TO TYPE-DATA.
003910
003920          MOVE ZEROS               TO IND1
003930          INSPECT TAB-BUFFER TALLYING IND1
003940           FOR ALL " COMP-1"
003950          IF IND1 = 1    MOVE "C1" TO TYPE-DATA.
003960
003970          MOVE ZEROS               TO IND1
003980          INSPECT TAB-BUFFER TALLYING IND1
003990           FOR ALL " BINARY"
004000          IF IND1 = 1    MOVE "C"  TO TYPE-DATA.
004010
004020
004030 EX-DO-NUMBER-TYPE.
004040          EXIT.
004050
004060
004070 PROCESS-IN.
004080
004090         IF FINE-FILE = "S" GO TO EX-PROCESS-IN.
004100
004110          PERFORM READ-IN         THRU EX-READ-IN.
004120
004130**** ANY SYNTAX NOT ALLOWED HERE MUST BE SKIPPED (E.G: CLAUSOLE FD...)
004140
004150          PERFORM VARYING IND FROM 7 BY 1
004160            UNTIL IND > LENGTH OF REC-IN
004170
004180            OR REC-IN(IND:1) NOT = SPACES
004190            CONTINUE
004200          END-PERFORM
004210
004220          IF REC-IN(IND:1) NOT NUMERIC GO TO PROCESS-IN.
004230
004240          PERFORM OPERATE         THRU EX-OPERATE.
004250
004260 EX-PROCESS-IN.
004270          EXIT.
004280
004290
004300
004310 READ-IN.
004320
004330          IF FINE-FILE = "S" GO TO EX-READ-IN.
004340
004350          MOVE SPACES  TO REC-IN.
004360
004370          READ ARK-IN NEXT RECORD AT END MOVE "S" TO FINE-FILE
004380           GO TO EX-READ-IN.
004390
004400* SKIP ANY COMMENT LINES IF FOUND (E.G.  DECLARED IN A FREE SYTLE )
004410
004420          PERFORM VARYING IND FROM 7 BY 1
004430           UNTIL IND > LENGTH OF REC-IN
004440           OR REC-IN(IND:1) NOT = SPACES
004450           CONTINUE
004460          END-PERFORM
004470
004480          IF REC-IN(IND:1) = "*" GO TO READ-IN.
004490
004500          IF REC-IN(IND:) = SPACES GO TO READ-IN.
004510
004520          IF REC-IN(IND:2) = "88" GO TO READ-IN.
004530
004540          IF REC-IN(IND:2) = "66" GO TO READ-IN.
004550
004560* REMOVE ANY UNCONSISTENTLY FIELDS ITEMS INSIDE THE REFCORD
004570
004580          IF REC-IN(1:6) NUMERIC
004590             MOVE SPACES TO REC-IN(1:6).
004600
004610  EX-READ-IN.
004620          EXIT.
004630
004640
004650
004660  ALFA-TO-NUM.
004670
004680         MOVE ALL ZEROS          TO NUMERO.
004690         MOVE 18                 TO IND3
004700         PERFORM VARYING IND2 FROM 18 BY -1 UNTIL IND2 = ZERO
004710         IF STRINGA(IND2:1) NUMERIC
004720          MOVE  STRINGA(IND2:1)   TO NUMERO(IND3:1)
004730          SUBTRACT 1 FROM IND3
004740          END-IF
004750
004760         END-PERFORM.
004770
004780  EX-ALFA-TO-NUM.
004790         EXIT.
004800
004810
004820  OPEN-FILES.
004830
004840          ACCEPT WPARAM  FROM COMMAND-LINE.
004850
004860          IF  WPARAM  = SPACES
004870          PERFORM HELP    THRU EX-HELP
004880           STOP RUN.
004890
004900          UNSTRING WPARAM DELIMITED BY ALL SPACES
004910           INTO FILE-IN FILE-OUT
004920
004930          IF FILE-OUT = SPACES MOVE "COBFD.TXT" TO FILE-OUT.
004940
004950          OPEN OUTPUT ARKDATA.
004960          CLOSE ARKDATA.
004970          OPEN I-O ARKDATA.
004980
004990
005000          OPEN INPUT ARK-IN.
005010
005020          IF STATUS-IN = "35"
005030             DISPLAY "File not found:" FILE-IN
005040              CLOSE ARKDATA
005050               STOP RUN.
005060
005070          OPEN OUTPUT ARK-OUT.
005080
005090
005100  EX-OPEN-FILES.
005110          EXIT.
005120
005130
005140  CALCULATE-SIZE.
005150
005160
005170          MOVE ZEROS TO WSIZE
005180
005190          IF PICTURE-DATA = "Group"
005200            GO TO END-CALCULATE-SIZE.
005210
005220          MOVE PICTURE-DATA         TO WPICTURE.
005230
005240          MOVE ZERO TO IND1
005250
005260          PERFORM VARYING IND1 FROM LENGTH OF WPICTURE
005270            BY -1 UNTIL IND1 = ZEROS
005280            OR WPICTURE(IND1:1) > SPACES
005290            CONTINUE
005300          END-PERFORM
005310
005320*** REMOVE "." from THE END OF THE PICTURE E.G. PIC X.  allowed ONLY FOR 999.999....
005330
005340          IF WPICTURE(IND1:1) = "."
005350          MOVE SPACES               TO WPICTURE(IND1:1).
005360
005370          MOVE ZEROS                TO IND1.
005380          INSPECT WPICTURE TALLYING IND1 FOR ALL "("
005390
005400          IF IND1 = ZEROS GO TO CALCULATE-SINGLE.
005410
005420          PERFORM VARYING IND1 FROM 1 BY 1
005430          UNTIL IND1  > LENGTH OF WPICTURE
005440
005450           if WPICTURE(IND1:1) = "("
005460             COMPUTE IND2 = IND1 -  1
005470             MOVE SPACES              TO WPICTURE(IND2:1)
005480             MOVE SPACES              TO WPICTURE(IND1:1)
005490             ADD 1 TO IND1
005500             MOVE 1 TO IND2
005510             MOVE SPACES TO STRINGA
005520             PERFORM VARYING IND1 FROM IND1 BY 1 UNTIL
005530             WPICTURE(IND1:1) = ")"
005540              MOVE WPICTURE(IND1:1)   TO STRINGA(IND2:1)
005550              MOVE SPACES             TO WPICTURE(IND1:1)
005560              ADD 1                   TO IND2
005570              END-PERFORM
005580
005590              IF WPICTURE(IND1:1) = ")"
005600              MOVE SPACES         TO WPICTURE(IND1:1)
005610              END-IF
005620
005630              PERFORM ALFA-TO-NUM THRU EX-ALFA-TO-NUM
005640              ADD  NUMERO         TO WSIZE
005650           END-IF
005660
005670          END-PERFORM.
005680
005690 CALCULATE-SINGLE.
005700
005710
005720
005730           PERFORM VARYING IND1 FROM 1 BY 1
005740             UNTIL IND1 > LENGTH OF WPICTURE
005750
005760             IF WPICTURE(IND1:1) = "9" ADD 1 TO WSIZE END-IF
005770             IF WPICTURE(IND1:1) = "X" ADD 1 TO WSIZE END-IF
005780             IF WPICTURE(IND1:1) = "A" ADD 1 TO WSIZE END-IF
005790             IF WPICTURE(IND1:1) = "," ADD 1 TO WSIZE END-IF
005800             IF WPICTURE(IND1:1) = "." ADD 1 TO WSIZE END-IF
005810             IF WPICTURE(IND1:1) = "B" ADD 1 TO WSIZE END-IF
005820             IF WPICTURE(IND1:1) = "Z" ADD 1 TO WSIZE END-IF
005821   	   IF WPICTURE(IND1:1) = "-" ADD 1 TO WSIZE END-IF
005822		   IF WPICTURE(IND1:1) = "+" ADD 1 TO WSIZE END-IF
005830
005840           END-PERFORM.
005850
005860  END-CALCULATE-SIZE.
005870
005880           MOVE WSIZE   TO SIZE-DATA.
005890
005900           IF TYPE-DATA  = "SL" ADD 1 TO SIZE-DATA.
005910           IF TYPE-DATA  = "ST" ADD 1 TO SIZE-DATA.
005920
005930           EVALUATE TYPE-DATA
005940
005950            WHEN "C5"
005960
005970            EVALUATE SIZE-DATA
005980              WHEN 1             MOVE 1 TO SIZE-DATA
005990              WHEN 2             MOVE 1 TO SIZE-DATA
006000              WHEN 3             MOVE 2 TO SIZE-DATA
006010              WHEN 4             MOVE 2 TO SIZE-DATA
006020              WHEN 5             MOVE 3 TO SIZE-DATA
006030              WHEN 6             MOVE 3 TO SIZE-DATA
006040              WHEN 7             MOVE 3 TO SIZE-DATA
006050              WHEN 8             MOVE 4 TO SIZE-DATA
006060              WHEN 9             MOVE 4 TO SIZE-DATA
006070              WHEN 10            MOVE 5 TO SIZE-DATA
006080              WHEN 11            MOVE 5 TO SIZE-DATA
006090              WHEN 12            MOVE 5 TO SIZE-DATA
006100              WHEN 13            MOVE 6 TO SIZE-DATA
006110              WHEN 14            MOVE 6 TO SIZE-DATA
006120              WHEN 15            MOVE 7 TO SIZE-DATA
006130              WHEN 16            MOVE 7 TO SIZE-DATA
006140              WHEN 17            MOVE 8 TO SIZE-DATA
006150              WHEN 18            MOVE 8 TO SIZE-DATA
006160            END-EVALUATE
006170
006180            WHEN "C3"
006190
006200             EVALUATE SIZE-DATA
006210               WHEN 1            MOVE 1 TO SIZE-DATA
006220               WHEN 2            MOVE 2 TO SIZE-DATA
006230               WHEN 3            MOVE 2 TO SIZE-DATA
006240               WHEN 4            MOVE 3 TO SIZE-DATA
006250               WHEN 5            MOVE 3 TO SIZE-DATA
006260               WHEN 6            MOVE 4 TO SIZE-DATA
006270               WHEN 7            MOVE 4 TO SIZE-DATA
006280               WHEN 8            MOVE 5 TO SIZE-DATA
006290               WHEN 9            MOVE 5 TO SIZE-DATA
006300               WHEN 10           MOVE 6 TO SIZE-DATA
006310               WHEN 11           MOVE 6 TO SIZE-DATA
006320               WHEN 12           MOVE 7 TO SIZE-DATA
006330               WHEN 13           MOVE 7 TO SIZE-DATA
006340               WHEN 14           MOVE 8 TO SIZE-DATA
006350               WHEN 15           MOVE 8 TO SIZE-DATA
006360               WHEN 16           MOVE 9 TO SIZE-DATA
006370               WHEN 17           MOVE 9 TO SIZE-DATA
006380               WHEN 18           MOVE 10 TO SIZE-DATA
006390             END-EVALUATE
006400
006410            WHEN "C1"
006420
006430             EVALUATE SIZE-DATA
006440               WHEN 1                MOVE 4 TO SIZE-DATA
006450               WHEN 2                MOVE 4 TO SIZE-DATA
006460               WHEN 3                MOVE 4 TO SIZE-DATA
006470               WHEN 4                MOVE 4 TO SIZE-DATA
006480               WHEN 5                MOVE 4 TO SIZE-DATA
006490               WHEN 6                MOVE 4 TO SIZE-DATA
006500               WHEN 7                MOVE 4 TO SIZE-DATA
006510               WHEN 8                MOVE 4 TO SIZE-DATA
006520               WHEN 9                MOVE 4 TO SIZE-DATA
006530               WHEN 10               MOVE 4 TO SIZE-DATA
006540               WHEN 11               MOVE 4 TO SIZE-DATA
006550               WHEN 12               MOVE 4 TO SIZE-DATA
006560               WHEN 13               MOVE 4 TO SIZE-DATA
006570               WHEN 14               MOVE 4 TO SIZE-DATA
006580               WHEN 15               MOVE 4 TO SIZE-DATA
006590               WHEN 16               MOVE 4 TO SIZE-DATA
006600               WHEN 17               MOVE 4 TO SIZE-DATA
006610               WHEN 18               MOVE 4 TO SIZE-DATA
006620             END-EVALUATE
006630
006640           WHEN OTHER CONTINUE.
006650
006660           IF OCCURS-DATA NOT = ZEROS
006670           COMPUTE ARRAY-SIZE-DATA = SIZE-DATA * OCCURS-DATA
006680           ELSE
006690           MOVE SIZE-DATA             TO ARRAY-SIZE-DATA.
006700
006710  EX-CALCULATE-SIZE.
006720           EXIT.
006730
006740  BUILD.
006750
006760           MOVE ZEROS TO KEY-DATA.
006770           START ARKDATA KEY IS NOT < KEY-DATA
006780            INVALID KEY GO TO EX-BUILD.
006790
006800  LOOP-BUILD.
006810
006820           READ ARKDATA NEXT RECORD AT END GO TO END-BUILD.
006830
006840           IF PICTURE-DATA NOT = "Group" GO TO LOOP-BUILD.
006850
006860           IF SIZE-DATA NOT = ZEROS GO TO LOOP-BUILD.
006870
006880           IF LEVEL-DATA = 01 GO TO LOOP-BUILD.
006890
006900
006910  REINDEX-BUILD.
006920
006930           MOVE ZEROS              TO WSIZE.
006940           MOVE LEVEL-DATA         TO WLEVEL.
006950           MOVE KEY-DATA           TO WKEY.
006960           MOVE REDEFINES-DATA     TO WREDEFINES.
006970
006980  LOOP-INTERNAL-LEVEL.
006990
007000           READ ARKDATA NEXT RECORD AT END GO TO LOOP-BUILD1.
007010
007020           IF LEVEL-DATA NOT > WLEVEL GO TO LOOP-BUILD1.
007030
007040** HERE: found a group inside another group.. this take the priority end loop inside it before.. NAME-DATA
007050
007060           IF PICTURE-DATA  = "Group"
007070** HERE: found a group inside another group with size zeros OK process it
007080
007090              IF SIZE-DATA = ZEROS
007100                 GO TO REINDEX-BUILD
007110              ELSE
007120*** HERE: found a group inside another group already processed skip it...
007130
007140              GO TO LOOP-INTERNAL-LEVEL.
007150
007160           IF WREDEFINES > SPACES
007170            MOVE "S"      TO FLAG-REDEFINES-DATA
007180             REWRITE REC-DATA.
007190
007200            ADD ARRAY-SIZE-DATA             TO WSIZE.
007210
007220            GO TO LOOP-INTERNAL-LEVEL.
007230
007240  LOOP-BUILD1.
007250
007260          MOVE WKEY                       TO KEY-DATA.
007270          READ ARKDATA KEY IS KEY-DATA.
007280          MOVE WSIZE                      TO SIZE-DATA.
007290
007300          REWRITE REC-DATA.
007310
007320          GO TO BUILD.
007330
007340  END-BUILD.
007350
007360  EX-BUILD.
007370          EXIT.
007380
007390  CALCULATE.
007400
007410         MOVE ZEROS TO KEY-DATA.
007420         START ARKDATA KEY IS NOT < KEY-DATA
007430          INVALID KEY GO TO EX-CALCULATE.
007440
007450         MOVE ZEROS              TO WLEVEL.
007460         MOVE ZEROS              TO WSIZE.
007470
007480  LOOP-CALCULATE.
007490
007500         READ ARKDATA NEXT RECORD AT END GO TO END-CALCULATE.
007510
007520         IF REDEFINES-DATA > SPACES
007530           MOVE LEVEL-DATA        TO WLEVEL
007540             GO TO LOOP-EXCLUDE.
007550
007560         IF PICTURE-DATA  = "Group" GO TO LOOP-CALCULATE.
007570
007580  LOOP-ADD.
007590
007600         IF FLAG-REDEFINES-DATA = "S" GO TO LOOP-CALCULATE.
007610
007620         ADD ARRAY-SIZE-DATA TO WSIZE.
007630
007640         GO TO LOOP-CALCULATE.
007650
007660
007670  LOOP-EXCLUDE.
007680
007690         READ ARKDATA NEXT RECORD AT END GO TO END-CALCULATE.
007700
007710         IF LEVEL-DATA > WLEVEL GO TO LOOP-EXCLUDE.
007720
007730         MOVE ZEROS       TO WLEVEL.
007740
007750         GO TO LOOP-ADD.
007760
007770  END-CALCULATE.
007780
007790         MOVE 1 TO KEY-DATA
007800
007810         READ ARKDATA KEY IS KEY-DATA.
007820
007830         MOVE WSIZE      TO SIZE-DATA ARRAY-SIZE-DATA.
007840
007850         REWRITE REC-DATA.
007860
007870  EX-CALCULATE.
007880         EXIT.
007890
007900
007910  EXPORT.
007920
007930         MOVE ZEROS TO KEY-DATA.
007940         START ARKDATA KEY IS NOT < KEY-DATA
007950          INVALID KEY GO TO EX-EXPORT.
007960
007970         MOVE SPACES TO REC-OUT
007980         STRING "COBOL Source FILE " FILE-IN(1:30)
007990                 " (c) 2022 Priolo Federico TP ONE Srl "
008000         DELIMITED BY SIZE INTO REC-OUT.
008010
008020         WRITE REC-OUT.
008030
008040         MOVE SPACES TO REC-OUT
008050
008060         WRITE REC-OUT.
008070
008080         STRING
008090          "Level and Dataname                         "
008100          "Picture Type  Occurs Size    Offset"
008110          DELIMITED BY SIZE INTO REC-OUT.
008120          WRITE REC-OUT.
008130
008140          MOVE SPACES TO REC-OUT.
008150          STRING
008160          "--------------------------                 "
008170          "------------  ------ ----    ------"
008180          DELIMITED BY SIZE INTO REC-OUT.
008190           WRITE REC-OUT.
008200
008210
008220  LOOP-EXPORT.
008230
008240          READ ARKDATA NEXT RECORD AT END GO TO EX-EXPORT.
008250
008260          INITIALIZE REC-OUT.
008270          MOVE LEVEL-DATA                 TO LEVEL-OUT
008280          MOVE NAME-DATA                  TO NAME-OUT.
008290          MOVE PICTURE-DATA               TO PICTURE-OUT.
008300          MOVE TYPE-DATA                  TO TYPE-OUT.
008310          MOVE SIZE-DATA                  TO SIZE-OUT.
008320          MOVE OCCURS-DATA                TO OCCURS-OUT.
008330
008340          MOVE OFFSET-DATA                TO OFFSET-OUT.
008350
008360          WRITE REC-OUT.
008370
008380          GO TO LOOP-EXPORT.
008390
008400  EX-EXPORT.
008410          EXIT.
008420
008430
008440  OFFSET.
008450
008460          MOVE 2           TO KEY-DATA 
008470          move zeros       TO WOFFSET.
008480
008490          START ARKDATA KEY IS NOT < KEY-DATA
008500                   INVALID KEY GO TO EX-OFFSET.
008510
008520  LOOP-OFFSET.
008530
008540          READ ARKDATA NEXT RECORD AT END GO TO EX-OFFSET.
008550
008560          MOVE WOFFSET            TO OFFSET-DATA
008570
008580          REWRITE REC-DATA.
008590
008600          IF REDEFINES-DATA = SPACES GO TO AHEAD-OFFSET.
008610
008620          MOVE KEY-DATA           TO WKEY
008630          MOVE REDEFINES-DATA     TO FIELD-DATA
008640          MOVE LEVEL-DATA         TO LEV-DATA
008650          INSPECT KEY-NAME-DATA REPLACING ALL "." BY " "
008660
008670          READ ARKDATA KEY IS KEY-NAME-DATA
008680           INVALID KEY
008690                  DISPLAY "Internal error: ERROR READING "
008700           " check: " function trim (KEY-NAME-DATA)
008710*                          STOP RUN
008720           END-READ
008730
008740          MOVE OFFSET-DATA        TO WOFFSET.
008750          MOVE WKEY                       TO KEY-DATA
008760          READ ARKDATA KEY IS KEY-DATA.
008770
008780          REWRITE REC-DATA.
008790
008800  AHEAD-OFFSET.
008810
008820
008830          ADD ARRAY-SIZE-DATA     TO WOFFSET.
008840
008850          GO TO LOOP-OFFSET.
008860
008870  EX-OFFSET.
008880          EXIT.
008890
008900  HELP.
008910
008920          DISPLAY "Usage: COBFD fdfile.cbl [cobfd.txt]".
008930          DISPLAY "                              ".
008940
008950  EX-HELP.
008960          EXIT.
008970
008980
008990  end program COBFD.
009000


FUJITSU COBOL SYNTAX

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. COBFD.
000030
000040*---------------------------------------------------------------
000050* COSTRUISCE IL DIZIONARIO PER LA FD SPECIFICATA
000060*---------------------------------------------------------------
000070*
000080* Copyright (C) Federico Priolo TP ONE SRL federico.priolo@tp-one.it
000090*
000100* This program is free software; you can redistribute it and/or
000110* it under the terms of the GNU General Public License as publis
000120* the Free Software Foundation; either version 2, or (at your op
000130* any later version.
000140*
000150* This program is distributed in the hope that it will be useful
000160* but WITHOUT ANY WARRANTY; without even the implied warranty of
000170* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
000180* GNU General Public License for more details.
000190*
000200* You should have received a copy of the GNU General Public Lice
000210* along with this software; see the file COPYING.  If not, write
000220* the Free Software Foundation, 51 Franklin Street, Fifth Floor
000230* Boston, MA 02110-1301 USA
000240*
000250*
000260*---------------------------------------------------------------
000270  ENVIRONMENT DIVISION.
000280  CONFIGURATION SECTION.
000290  SOURCE-COMPUTER.        PC-IBM.
000300  OBJECT-COMPUTER.        PC-IBM.
000310  SPECIAL-NAMES.
000320          ARGUMENT-NUMBER IS ARG-NUM
000330          ARGUMENT-VALUE  IS ARG-VAL
000340          DECIMAL-POINT   IS COMMA.
000350 
000360
000370  INPUT-OUTPUT SECTION.
000380  FILE-CONTROL.
000390
000400*
000410** your copy fd to examine
000420*
000430
000440          SELECT ARK-IN ASSIGN TO FILE-IN
000450           ORGANIZATION IS LINE SEQUENTIAL
000460           FILE STATUS  IS STATUS-IN.
000470*
000480** isam to figure out size and offset...
000490*
000500          SELECT ARKDATA ASSIGN ".\WORKAREA.DAT"
000510
000520           ORGANIZATION IS INDEXED
000530           ACCESS MODE  IS DYNAMIC
000540           RECORD KEY   IS KEY-DATA
000550           ALTERNATE RECORD KEY IS KEY-NAME-DATA
000560           DUPLICATES
000570           FILE STATUS  IS STATUS-DATA.
000580
000590
000600*
000610** The output result
000620*
000630
000640          SELECT ARK-OUT ASSIGN TO FILE-OUT
000650           ORGANIZATION IS LINE SEQUENTIAL
000660           FILE STATUS  IS STATUS-OUT.
000670
000680
000690  DATA DIVISION.
000700  FILE SECTION.
000710
000720  FD ARK-IN  LABEL RECORD IS STANDARD.
000730
000740  01 REC-IN.
000750    02 FILLER                    PIC X(80).
000760
000770  FD ARK-OUT  LABEL RECORD IS STANDARD.
000780
000790  01 REC-OUT.
000800    02 FILLER-OUT                PIC X(80).
000810
000820  01 REC-OUTX.
000830    02 LEVEL-OUT                 PIC 99.
000840    02 FILLER-OUT                PIC X.
000850    02 NAME-OUT                  PIC X(31).
000860    02 FILLER-OUT                PIC X.
000870    02 PICTURE-OUT               PIC X(15).
000880    02 FILLER-OUT                PIC X.
000890    02 TYPE-OUT                  PIC X(4).
000900    02 FILLER-OUT                PIC X.
000910    02 OCCURS-OUT                PIC ZZZZZZ.
000920    02 FILLER-OUT                PIC X.
000930    02 SIZE-OUT                  PIC ZZZZZZ.
000940    02 FILLER-OUT                PIC X.
000950    02 OFFSET-OUT                PIC ZZZZZ9.
000960
000970*
000980  FD ARKDATA  LABEL RECORD IS STANDARD GLOBAL.
000990*
001000  01 REC-DATA.
001010
001020   02 KEY-DATA                   PIC 9(9).
001030   02 KEY-NAME-DATA.
001040       05 LEV-DATA               PIC 99.
001050       05 FIELD-DATA             PIC X(30).
001060   02 FIELDS-DATA.
001070       05 LEVEL-DATA             PIC 99.
001080       05 NAME-DATA              PIC X(30).
001090       05 FILLER-DATA            PIC X.
001100       05 PICTURE-DATA           PIC X(30).
001110       05 FILLER-DATA            PIC X.
001120       05 TYPE-DATA              PIC X(08).
001130       05 OCCURS-DATA            PIC 9(2).
001140       05 FILLER-DATA            PIC X.
001150       05 SIZE-DATA              PIC 9(7).
001160       05 FILLER-DATA            PIC X.
001170       05 OFFSET-DATA            PIC 9(7).
001180       05 REDEFINES-DATA         PIC X(30).
001190       05 ARRAY-SIZE-DATA        PIC 9(7).
001200       05 FLAG-REDEFINES-DATA    PIC X.
001210
001220  WORKING-STORAGE SECTION.
001230
001240  77 FILE-DATA         PIC X(20) VALUE "ARKDATA".
001250  77 STATUS-DATA       PIC XX VALUE "00".
001260  77 FINE-FILE         PIC X.
001270  77 STATUS-IN         PIC XX VALUE "00".
001280  77 STATUS-OUT        PIC XX VALUE "00".
001290
001300  77 IND               PIC 999.
001310  77 IND1              PIC 999.
001320  77 IND2              PIC 999.
001330  77 IND3              PIC 999.
001340  77 IND4              PIC 999.
001350  77 NUM               PIC 9(4).
001360
001370  01 FILE-IN           PIC X(150).
001380  01 FILE-OUT          PIC X(150).
001390  77 WPARAM            PIC X(512).
001400  77 WSIZE             PIC 9(9).
001410  77 WOFFSET           PIC 9(9).
001420  77 WLEVEL            PIC 99.
001430  77 WPICTURE          PIC X(30).
001440  77 WKEY              PIC 9(9).
001450  77 WREDEFINES        PIC X(30).
001460  77 COUNT-ITEM        PIC 9(9) VALUE ZEROS.
001470  01 STRINGA           PIC X(18).
001480  01 NUMERO            PIC 9(18).
001490
001500  01 TAB-BUFFER.
001510    02 IND-BUFFER      PIC 99.
001520    02 IND1-BUFFER     PIC 99.
001530    02 BUFFER          PIC X(30) OCCURS 50 TIMES.
001540
001550  01 TAB-STRINGA       PIC X(1504) VALUE SPACE.
001560
001570
001580  PROCEDURE DIVISION.
001590
001600  MAIN SECTION.
001610  INIZIO.
001620
001630
001640
001650      PERFORM OPEN-FILES THRU EX-OPEN-FILES.
001660
001670      MOVE SPACES TO FINE-FILE.
001680      MOVE ZEROS  TO COUNT-ITEM
001690
001700      DISPLAY
001710      "COBFD Version 1.00 "
001720       "Copyright (C) 2022 Federico Priolo TP ONE SRL".
001730
001740      DISPLAY
001750      "Analyzing " FILE-IN . 
001760
001770
001780
001790      PERFORM PROCESS-IN     THRU EX-PROCESS-IN
001800         UNTIL FINE-FILE = "S".
001810
001820      PERFORM BUILD          THRU EX-BUILD.
001830
001840      PERFORM CALCULATE      THRU EX-CALCULATE.
001850
001860      PERFORM OFFSET         THRU EX-OFFSET.
001870
001880      PERFORM EXPORT         THRU EX-EXPORT.
001890
001900  FINE.
001910
001920      DISPLAY "COBFD: end of job ".
001930
001940      CLOSE ARK-IN ARKDATA ARK-OUT.
001950      GOBACK.
001960
001970
001980  OPERATE.
001990
002000      IF FINE-FILE = "S" GO TO EX-OPERATE.
002010
002020      INITIALIZE TAB-BUFFER.
002030
002040
002050      UNSTRING REC-IN DELIMITED BY ALL SPACES
002060       INTO BUFFER(1)
002070            BUFFER(2)
002080            BUFFER(3)
002090            BUFFER(4)
002100            BUFFER(5)
002110            BUFFER(6)
002120            BUFFER(7)
002130            BUFFER(8)
002140            BUFFER(9)
002150            BUFFER(10)
002160            BUFFER(11)
002170            BUFFER(12)
002180            BUFFER(13)
002190            BUFFER(14)
002200            BUFFER(15)
002210              TALLYING IND-BUFFER
002220
002230      PERFORM VARYING IND FROM  LENGTH OF REC-IN BY -1 UNTIL
002240        REC-IN(IND:1) NOT = SPACES
002250       CONTINUE
002260      END-PERFORM
002270
002280      IF REC-IN(IND:1) = "." GO TO END-OPERATE.
002290
002300      PERFORM READ-IN       THRU EX-READ-IN
002310
002320      UNSTRING REC-IN DELIMITED BY ALL SPACES
002330       INTO BUFFER(16)
002340            BUFFER(17)
002350            BUFFER(18)
002360            BUFFER(19)
002370            BUFFER(20)
002380            BUFFER(21)
002390            BUFFER(22)
002400            BUFFER(23)
002410            BUFFER(24)
002420            BUFFER(25)
002430            BUFFER(26)
002440            BUFFER(27)
002450            BUFFER(28)
002460            BUFFER(29)
002470            BUFFER(30).
002480
002490       IF IND-BUFFER NOT = 15
002500        ADD  1  TO IND-BUFFER
002510        MOVE 16 TO IND1-BUFFER
002520        PERFORM 15 TIMES
002530        MOVE BUFFER(IND1-BUFFER)  TO BUFFER(IND-BUFFER)
002540        MOVE SPACES               TO BUFFER(IND1-BUFFER)
002550        ADD 1                     TO IND-BUFFER IND1-BUFFER
002560        END-PERFORM.
002570
002580
002590  END-OPERATE.
002600
002610       ADD 1 TO COUNT-ITEM.
002620
002630       MOVE FUNCTION UPPER-CASE(TAB-BUFFER)    TO TAB-STRINGA
002640
002650       MOVE TAB-STRINGA  TO TAB-BUFFER
002660       INITIALIZE REC-DATA
002670
002680*** FIRST ITEM CONTAINS THE RECORD LEVEL
002690
002700       PERFORM VARYING IND FROM 1 BY 1 UNTIL IND > 30
002710
002720
002730**** HERE A COBOL LEVEL...
002740
002750       IF BUFFER(IND) > SPACES
002760        AND NAME-DATA = SPACES
002770        AND BUFFER(IND) (1:1) NUMERIC
002780
002790
002800       MOVE BUFFER(IND)       TO STRINGA
002810       PERFORM ALFA-TO-NUM    THRU EX-ALFA-TO-NUM
002820       MOVE NUMERO            TO LEVEL-DATA
002830
002840****      ...AND AFTER THE NAME OF COBOL FIELD
002850
002860       ADD 1                  TO IND
002870       MOVE BUFFER(IND)       TO FIELD-DATA NAME-DATA
002880
002890       ADD 1                          TO IND
002900
002910**** here a field WITHOUT PICTURE... E.G. 01 NAME.
002920
002930       IF BUFFER(IND) = SPACES
002940       MOVE "Group" TO PICTURE-DATA
002950       END-IF
002960
002970       END-IF
002980
002990
003000       IF BUFFER(IND) = "REDEFINES"
003010       ADD 1                           TO IND
003020       MOVE BUFFER(IND)                TO REDEFINES-DATA
003030       END-IF
003040
003050
003060       IF BUFFER(IND)(1:3) = "PIC"
003070       ADD 1                     TO IND
003080       MOVE BUFFER(IND)          TO PICTURE-DATA
003090
003100        EVALUATE PICTURE-DATA(1:1)
003110
003120         WHEN "X"       MOVE "AN" TO TYPE-DATA
003130         WHEN "S"       MOVE "N"  TO TYPE-DATA
003140               PERFORM DO-NUMBER-TYPE THRU EX-DO-NUMBER-TYPE
003150
003160         WHEN "9"       MOVE "N"  TO TYPE-DATA
003170               PERFORM DO-NUMBER-TYPE THRU EX-DO-NUMBER-TYPE
003180
003190         WHEN "A"       MOVE "A"  TO TYPE-DATA
003191
003192			 WHEN "-"   MOVE "NE" TO TYPE-DATA
003193
003194			 WHEN "+"   MOVE "NE" TO TYPE-DATA
003195
003196			 WHEN "Z"   MOVE "NE" TO TYPE-DATA
003197	
003198			 WHEN OTHER DISPLAY "TYPE" PICTURE-DATA " NOT MANAGED"
003199
003200        END-EVALUATE
003210
003220
003230        END-IF
003240
003250        IF BUFFER(IND) = "OCCURS"
003260
003270**** here a field WITHOUT PICTURE... E.G. 02 NAME OCCURS 5 TIMES...
003280
003290             MOVE ZEROS             TO IND1
003300             INSPECT TAB-BUFFER TALLYING IND1 FOR ALL "PIC"
003310             IF IND1 = ZEROS
003320             MOVE "Group"           TO PICTURE-DATA
003330             END-IF
003340
003350            ADD 1                   TO IND
003360            MOVE BUFFER(IND)        TO STRINGA
003370            PERFORM ALFA-TO-NUM     THRU EX-ALFA-TO-NUM
003380            MOVE NUMERO             TO OCCURS-DATA
003390            END-IF
003400
003410
003420            END-PERFORM.
003430
003440            PERFORM CALCULATE-SIZE THRU EX-CALCULATE-SIZE.
003450
003460            MOVE COUNT-ITEM         TO KEY-DATA.
003470
003480            IF PICTURE-DATA = SPACES
003490             MOVE "Group"           TO  PICTURE-DATA.
003500
003510            INSPECT KEY-NAME-DATA REPLACING ALL "." BY " "
003520
003530            MOVE LEVEL-DATA         TO LEV-DATA
003540
003550            WRITE REC-DATA
003560             INVALID KEY CONTINUE.
003570
003580             IF STATUS-DATA = "02"
003590              IF NAME-DATA(1:6) NOT = "FILLER"
003600            DISPLAY
003610            "Warning:found duplicates name with the same level:"
003620            NAME-DATA
003630             END-IF.
003640
003650
003660 EX-OPERATE.
003670          EXIT.
003680
003690 DO-NUMBER-TYPE.
003700
003710          MOVE ZEROS               TO IND1
003720          INSPECT TAB-BUFFER TALLYING IND1
003730           FOR ALL "LEADING"
003740          INSPECT TAB-BUFFER TALLYING IND1
003750           FOR ALL "SEPARATE"
003760          IF IND1 = 2    MOVE "SL" TO TYPE-DATA.
003770
003780          MOVE ZEROS               TO IND1
003790          INSPECT TAB-BUFFER TALLYING IND1
003800           FOR ALL "TRAIDING"
003810          INSPECT TAB-BUFFER TALLYING IND1
003820           FOR ALL "SEPARATE"
003830          IF IND1 = 2   MOVE "ST" TO TYPE-DATA.
003840
003850          MOVE ZEROS               TO IND1
003860          INSPECT TAB-BUFFER TALLYING IND1
003870           FOR ALL " COMP-5"
003880          IF IND1 = 1    MOVE "C5" TO TYPE-DATA.
003890
003900          MOVE ZEROS               TO IND1
003910          INSPECT TAB-BUFFER TALLYING IND1
003920           FOR ALL " COMP-3"
003930          IF IND1 = 1    MOVE "C3" TO TYPE-DATA.
003940
003950          MOVE ZEROS               TO IND1
003960          INSPECT TAB-BUFFER TALLYING IND1
003970           FOR ALL " COMP-1"
003980          IF IND1 = 1    MOVE "C1" TO TYPE-DATA.
003990
004000          MOVE ZEROS               TO IND1
004010          INSPECT TAB-BUFFER TALLYING IND1
004020           FOR ALL " BINARY"
004030          IF IND1 = 1    MOVE "C"  TO TYPE-DATA.
004040
004050
004060 EX-DO-NUMBER-TYPE.
004070          EXIT.
004080
004090
004100 PROCESS-IN.
004110
004120         IF FINE-FILE = "S" GO TO EX-PROCESS-IN.
004130
004140          PERFORM READ-IN         THRU EX-READ-IN.
004150
004160**** ANY SYNTAX NOT ALLOWED HERE MUST BE SKIPPED (E.G: CLAUSOLE FD...)
004170
004180          PERFORM VARYING IND FROM 7 BY 1
004190            UNTIL IND > LENGTH OF REC-IN
004200
004210            OR REC-IN(IND:1) NOT = SPACES
004220            CONTINUE
004230          END-PERFORM
004240
004250          IF REC-IN(IND:1) NOT NUMERIC GO TO PROCESS-IN.
004260
004270          PERFORM OPERATE         THRU EX-OPERATE.
004280
004290 EX-PROCESS-IN.
004300          EXIT.
004310
004320
004330
004340 READ-IN.
004350
004360          IF FINE-FILE = "S" GO TO EX-READ-IN.
004370
004380          MOVE SPACES  TO REC-IN.
004390
004400          READ ARK-IN NEXT RECORD AT END MOVE "S" TO FINE-FILE
004410           GO TO EX-READ-IN.
004420
004430* SKIP ANY COMMENT LINES IF FOUND (E.G.  DECLARED IN A FREE SYTLE )
004440
004450          PERFORM VARYING IND FROM 7 BY 1
004460           UNTIL IND > LENGTH OF REC-IN
004470           OR REC-IN(IND:1) NOT = SPACES
004480           CONTINUE
004490          END-PERFORM
004500
004510          IF REC-IN(IND:1) = "*" GO TO READ-IN.
004520
004530          IF REC-IN(IND:) = SPACES GO TO READ-IN.
004540
004550          IF REC-IN(IND:2) = "88" GO TO READ-IN.
004560
004570          IF REC-IN(IND:2) = "66" GO TO READ-IN.
004580
004590* REMOVE ANY UNCONSISTENTLY FIELDS ITEMS INSIDE THE REFCORD
004600
004610          IF REC-IN(1:6) NUMERIC
004620             MOVE SPACES TO REC-IN(1:6).
004630
004640  EX-READ-IN.
004650          EXIT.
004660
004670
004680
004690  ALFA-TO-NUM.
004700
004710         MOVE ALL ZEROS          TO NUMERO.
004720         MOVE 18                 TO IND3
004730         PERFORM VARYING IND2 FROM 18 BY -1 UNTIL IND2 = ZERO
004740         IF STRINGA(IND2:1) NUMERIC
004750          MOVE  STRINGA(IND2:1)   TO NUMERO(IND3:1)
004760          SUBTRACT 1 FROM IND3
004770          END-IF
004780
004790         END-PERFORM.
004800
004810  EX-ALFA-TO-NUM.
004820         EXIT.
004830
004840
004850  OPEN-FILES.
004860
004870			ACCEPT NUM FROM ARG-NUM
004880 
004890 			EVALUATE NUM
004900 		 	WHEN 2 
004910 	            ACCEPT FILE-IN FROM ARG-VAL
004920      		    ACCEPT FILE-OUT FROM ARG-VAL
004930 		 	WHEN 1 
004940 	            ACCEPT FILE-IN FROM ARG-VAL
004950 				MOVE SPACES	TO FILE-OUT
004960    	 	WHEN OTHER 
004970 		 	DISPLAY "Missing command line parameter for COBFD usage: COBFD fdefile.cbl [your-report.txt]"
004980 		 	stop run
004990 
005000 			END-EVALUATE.			
005010
005020
005030			IF FILE-OUT = SPACES MOVE "COBFD.TXT" TO FILE-OUT.
005040
005050          OPEN OUTPUT ARKDATA.
005060          CLOSE ARKDATA.
005070          OPEN I-O ARKDATA.
005080
005090
005100          OPEN INPUT ARK-IN.
005110
005120          IF STATUS-IN = "35"
005130             DISPLAY "File not found:" FILE-IN
005140              CLOSE ARKDATA
005150               STOP RUN.
005160
005170          OPEN OUTPUT ARK-OUT.
005180
005190
005200  EX-OPEN-FILES.
005210          EXIT.
005220
005230
005240  CALCULATE-SIZE.
005250
005260
005270          MOVE ZEROS TO WSIZE
005280
005290          IF PICTURE-DATA = "Group"
005300            GO TO END-CALCULATE-SIZE.
005310
005320          MOVE PICTURE-DATA         TO WPICTURE.
005330
005340          MOVE ZERO TO IND1
005350
005360          PERFORM VARYING IND1 FROM LENGTH OF WPICTURE
005370            BY -1 UNTIL IND1 = ZEROS
005380            OR WPICTURE(IND1:1) > SPACES
005390            CONTINUE
005400          END-PERFORM
005410
005420*** REMOVE "." from THE END OF THE PICTURE E.G. PIC X.  allowed ONLY FOR 999.999....
005430
005440          IF WPICTURE(IND1:1) = "."
005450          MOVE SPACES               TO WPICTURE(IND1:1).
005460
005470          MOVE ZEROS                TO IND1.
005480          INSPECT WPICTURE TALLYING IND1 FOR ALL "("
005490
005500          IF IND1 = ZEROS GO TO CALCULATE-SINGLE.
005510
005520          PERFORM VARYING IND1 FROM 1 BY 1
005530          UNTIL IND1  > LENGTH OF WPICTURE
005540
005550           if WPICTURE(IND1:1) = "("
005560             COMPUTE IND2 = IND1 -  1
005570             MOVE SPACES              TO WPICTURE(IND2:1)
005580             MOVE SPACES              TO WPICTURE(IND1:1)
005590             ADD 1 TO IND1
005600             MOVE 1 TO IND2
005610             MOVE SPACES TO STRINGA
005620             PERFORM VARYING IND1 FROM IND1 BY 1 UNTIL
005630             WPICTURE(IND1:1) = ")"
005640              MOVE WPICTURE(IND1:1)   TO STRINGA(IND2:1)
005650              MOVE SPACES             TO WPICTURE(IND1:1)
005660              ADD 1                   TO IND2
005670              END-PERFORM
005680
005690              IF WPICTURE(IND1:1) = ")"
005700              MOVE SPACES         TO WPICTURE(IND1:1)
005710              END-IF
005720
005730              PERFORM ALFA-TO-NUM THRU EX-ALFA-TO-NUM
005740              ADD  NUMERO         TO WSIZE
005750           END-IF
005760
005770          END-PERFORM.
005780
005790 CALCULATE-SINGLE.
005800
005810
005820
005830           PERFORM VARYING IND1 FROM 1 BY 1
005840             UNTIL IND1 > LENGTH OF WPICTURE
005850
005860             IF WPICTURE(IND1:1) = "9" ADD 1 TO WSIZE END-IF
005870             IF WPICTURE(IND1:1) = "X" ADD 1 TO WSIZE END-IF
005880             IF WPICTURE(IND1:1) = "A" ADD 1 TO WSIZE END-IF
005890             IF WPICTURE(IND1:1) = "," ADD 1 TO WSIZE END-IF
005900             IF WPICTURE(IND1:1) = "." ADD 1 TO WSIZE END-IF
005910             IF WPICTURE(IND1:1) = "B" ADD 1 TO WSIZE END-IF
005920             IF WPICTURE(IND1:1) = "Z" ADD 1 TO WSIZE END-IF
005930			   IF WPICTURE(IND1:1) = "-" ADD 1 TO WSIZE END-IF
005931			   IF WPICTURE(IND1:1) = "+" ADD 1 TO WSIZE END-IF
005932
005940           END-PERFORM.
005950
005960  END-CALCULATE-SIZE.
005970
005980           MOVE WSIZE   TO SIZE-DATA.
005990
006000           IF TYPE-DATA  = "SL" ADD 1 TO SIZE-DATA.
006010           IF TYPE-DATA  = "ST" ADD 1 TO SIZE-DATA.
006020
006030           EVALUATE TYPE-DATA
006040
006050            WHEN "C5"
006060
006070            EVALUATE SIZE-DATA
006080              WHEN 1             MOVE 1 TO SIZE-DATA
006090              WHEN 2             MOVE 1 TO SIZE-DATA
006100              WHEN 3             MOVE 2 TO SIZE-DATA
006110              WHEN 4             MOVE 2 TO SIZE-DATA
006120              WHEN 5             MOVE 3 TO SIZE-DATA
006130              WHEN 6             MOVE 3 TO SIZE-DATA
006140              WHEN 7             MOVE 3 TO SIZE-DATA
006150              WHEN 8             MOVE 4 TO SIZE-DATA
006160              WHEN 9             MOVE 4 TO SIZE-DATA
006170              WHEN 10            MOVE 5 TO SIZE-DATA
006180              WHEN 11            MOVE 5 TO SIZE-DATA
006190              WHEN 12            MOVE 5 TO SIZE-DATA
006200              WHEN 13            MOVE 6 TO SIZE-DATA
006210              WHEN 14            MOVE 6 TO SIZE-DATA
006220              WHEN 15            MOVE 7 TO SIZE-DATA
006230              WHEN 16            MOVE 7 TO SIZE-DATA
006240              WHEN 17            MOVE 8 TO SIZE-DATA
006250              WHEN 18            MOVE 8 TO SIZE-DATA
006260            END-EVALUATE
006270
006280            WHEN "C3"
006290
006300             EVALUATE SIZE-DATA
006310               WHEN 1            MOVE 1 TO SIZE-DATA
006320               WHEN 2            MOVE 2 TO SIZE-DATA
006330               WHEN 3            MOVE 2 TO SIZE-DATA
006340               WHEN 4            MOVE 3 TO SIZE-DATA
006350               WHEN 5            MOVE 3 TO SIZE-DATA
006360               WHEN 6            MOVE 4 TO SIZE-DATA
006370               WHEN 7            MOVE 4 TO SIZE-DATA
006380               WHEN 8            MOVE 5 TO SIZE-DATA
006390               WHEN 9            MOVE 5 TO SIZE-DATA
006400               WHEN 10           MOVE 6 TO SIZE-DATA
006410               WHEN 11           MOVE 6 TO SIZE-DATA
006420               WHEN 12           MOVE 7 TO SIZE-DATA
006430               WHEN 13           MOVE 7 TO SIZE-DATA
006440               WHEN 14           MOVE 8 TO SIZE-DATA
006450               WHEN 15           MOVE 8 TO SIZE-DATA
006460               WHEN 16           MOVE 9 TO SIZE-DATA
006470               WHEN 17           MOVE 9 TO SIZE-DATA
006480               WHEN 18           MOVE 10 TO SIZE-DATA
006490             END-EVALUATE
006500
006510            WHEN "C1"
006520
006530             EVALUATE SIZE-DATA
006540               WHEN 1                MOVE 4 TO SIZE-DATA
006550               WHEN 2                MOVE 4 TO SIZE-DATA
006560               WHEN 3                MOVE 4 TO SIZE-DATA
006570               WHEN 4                MOVE 4 TO SIZE-DATA
006580               WHEN 5                MOVE 4 TO SIZE-DATA
006590               WHEN 6                MOVE 4 TO SIZE-DATA
006600               WHEN 7                MOVE 4 TO SIZE-DATA
006610               WHEN 8                MOVE 4 TO SIZE-DATA
006620               WHEN 9                MOVE 4 TO SIZE-DATA
006630               WHEN 10               MOVE 4 TO SIZE-DATA
006640               WHEN 11               MOVE 4 TO SIZE-DATA
006650               WHEN 12               MOVE 4 TO SIZE-DATA
006660               WHEN 13               MOVE 4 TO SIZE-DATA
006670               WHEN 14               MOVE 4 TO SIZE-DATA
006680               WHEN 15               MOVE 4 TO SIZE-DATA
006690               WHEN 16               MOVE 4 TO SIZE-DATA
006700               WHEN 17               MOVE 4 TO SIZE-DATA
006710               WHEN 18               MOVE 4 TO SIZE-DATA
006720             END-EVALUATE
006730
006740           WHEN OTHER CONTINUE.
006750
006760           IF OCCURS-DATA NOT = ZEROS
006770           COMPUTE ARRAY-SIZE-DATA = SIZE-DATA * OCCURS-DATA
006780           ELSE
006790           MOVE SIZE-DATA             TO ARRAY-SIZE-DATA.
006800
006810  EX-CALCULATE-SIZE.
006820           EXIT.
006830
006840  BUILD.
006850
006860           MOVE ZEROS TO KEY-DATA.
006870           START ARKDATA KEY IS NOT < KEY-DATA
006880            INVALID KEY GO TO EX-BUILD.
006890
006900  LOOP-BUILD.
006910
006920           READ ARKDATA NEXT RECORD AT END GO TO END-BUILD.
006930
006940           IF PICTURE-DATA NOT = "Group" GO TO LOOP-BUILD.
006950
006960           IF SIZE-DATA NOT = ZEROS GO TO LOOP-BUILD.
006970
006980           IF LEVEL-DATA = 01 GO TO LOOP-BUILD.
006990
007000
007010  REINDEX-BUILD.
007020
007030           MOVE ZEROS              TO WSIZE.
007040           MOVE LEVEL-DATA         TO WLEVEL.
007050           MOVE KEY-DATA           TO WKEY.
007060           MOVE REDEFINES-DATA     TO WREDEFINES.
007070
007080  LOOP-INTERNAL-LEVEL.
007090
007100           READ ARKDATA NEXT RECORD AT END GO TO LOOP-BUILD1.
007110
007120           IF LEVEL-DATA NOT > WLEVEL GO TO LOOP-BUILD1.
007130
007140** HERE: found a group inside another group.. this take the priority end loop inside it before.. NAME-DATA
007150
007160           IF PICTURE-DATA  = "Group"
007170** HERE: found a group inside another group with size zeros OK process it
007180
007190              IF SIZE-DATA = ZEROS
007200                 GO TO REINDEX-BUILD
007210              ELSE
007220*** HERE: found a group inside another group already processed skip it...
007230
007240              GO TO LOOP-INTERNAL-LEVEL.
007250
007260           IF WREDEFINES > SPACES
007270            MOVE "S"      TO FLAG-REDEFINES-DATA
007280             REWRITE REC-DATA.
007290
007300            ADD ARRAY-SIZE-DATA             TO WSIZE.
007310
007320            GO TO LOOP-INTERNAL-LEVEL.
007330
007340  LOOP-BUILD1.
007350
007360          MOVE WKEY                       TO KEY-DATA.
007370          READ ARKDATA KEY IS KEY-DATA.
007380          MOVE WSIZE                      TO SIZE-DATA.
007390
007400          REWRITE REC-DATA.
007410
007420          GO TO BUILD.
007430
007440  END-BUILD.
007450
007460  EX-BUILD.
007470          EXIT.
007480
007490  CALCULATE.
007500
007510         MOVE ZEROS TO KEY-DATA.
007520         START ARKDATA KEY IS NOT < KEY-DATA
007530          INVALID KEY GO TO EX-CALCULATE.
007540
007550         MOVE ZEROS              TO WLEVEL.
007560         MOVE ZEROS              TO WSIZE.
007570
007580  LOOP-CALCULATE.
007590
007600         READ ARKDATA NEXT RECORD AT END GO TO END-CALCULATE.
007610
007620         IF REDEFINES-DATA > SPACES
007630           MOVE LEVEL-DATA        TO WLEVEL
007640             GO TO LOOP-EXCLUDE.
007650
007660         IF PICTURE-DATA  = "Group" GO TO LOOP-CALCULATE.
007670
007680  LOOP-ADD.
007690
007700         IF FLAG-REDEFINES-DATA = "S" GO TO LOOP-CALCULATE.
007710
007720         ADD ARRAY-SIZE-DATA TO WSIZE.
007730
007740         GO TO LOOP-CALCULATE.
007750
007760
007770  LOOP-EXCLUDE.
007780
007790         READ ARKDATA NEXT RECORD AT END GO TO END-CALCULATE.
007800
007810         IF LEVEL-DATA > WLEVEL GO TO LOOP-EXCLUDE.
007820
007830         MOVE ZEROS       TO WLEVEL.
007840
007850         GO TO LOOP-ADD.
007860
007870  END-CALCULATE.
007880
007890         MOVE 1 TO KEY-DATA
007900
007910         READ ARKDATA KEY IS KEY-DATA.
007920
007930         MOVE WSIZE      TO SIZE-DATA ARRAY-SIZE-DATA.
007940
007950         REWRITE REC-DATA.
007960
007970  EX-CALCULATE.
007980         EXIT.
007990
008000
008010  EXPORT.
008020
008030         MOVE ZEROS TO KEY-DATA.
008040         START ARKDATA KEY IS NOT < KEY-DATA
008050          INVALID KEY GO TO EX-EXPORT.
008060
008070         MOVE SPACES TO REC-OUT
008080         STRING "COBOL Source FILE " FILE-IN(1:30)
008090                 " (c) 2022 Priolo Federico TP ONE Srl "
008100         DELIMITED BY SIZE INTO REC-OUT.
008110
008120         WRITE REC-OUT.
008130
008140         MOVE SPACES TO REC-OUT
008150
008160         WRITE REC-OUT.
008170
008180         STRING
008190          "Level and Dataname                         "
008200          "Picture Type  Occurs Size    Offset"
008210          DELIMITED BY SIZE INTO REC-OUT.
008220          WRITE REC-OUT.
008230
008240          MOVE SPACES TO REC-OUT.
008250          STRING
008260          "--------------------------                 "
008270          "------------  ------ ----    ------"
008280          DELIMITED BY SIZE INTO REC-OUT.
008290           WRITE REC-OUT.
008300
008310
008320  LOOP-EXPORT.
008330
008340          READ ARKDATA NEXT RECORD AT END GO TO EX-EXPORT.
008350
008360          INITIALIZE REC-OUT.
008370          MOVE LEVEL-DATA                 TO LEVEL-OUT
008380          MOVE NAME-DATA                  TO NAME-OUT.
008390          MOVE PICTURE-DATA               TO PICTURE-OUT.
008400          MOVE TYPE-DATA                  TO TYPE-OUT.
008410          MOVE SIZE-DATA                  TO SIZE-OUT.
008420          MOVE OCCURS-DATA                TO OCCURS-OUT.
008430
008440          MOVE OFFSET-DATA                TO OFFSET-OUT.
008450
008460          WRITE REC-OUT.
008470
008480          GO TO LOOP-EXPORT.
008490
008500  EX-EXPORT.
008510          EXIT.
008520
008530
008540  OFFSET.
008550
008560          MOVE 2           TO KEY-DATA 
008570          move zeros       TO WOFFSET.
008580
008590          START ARKDATA KEY IS NOT < KEY-DATA
008600                   INVALID KEY GO TO EX-OFFSET.
008610
008620  LOOP-OFFSET.
008630
008640          READ ARKDATA NEXT RECORD AT END GO TO EX-OFFSET.
008650
008660          MOVE WOFFSET            TO OFFSET-DATA
008670
008680          REWRITE REC-DATA.
008690
008700          IF REDEFINES-DATA = SPACES GO TO AHEAD-OFFSET.
008710
008720          MOVE KEY-DATA           TO WKEY
008730          MOVE REDEFINES-DATA     TO FIELD-DATA
008740          MOVE LEVEL-DATA         TO LEV-DATA
008750          INSPECT KEY-NAME-DATA REPLACING ALL "." BY " "
008760
008770          READ ARKDATA KEY IS KEY-NAME-DATA
008780           INVALID KEY
008790                  DISPLAY "Internal error: ERROR READING "
008800           " check: " KEY-NAME-DATA
008810*                          STOP RUN
008820           END-READ
008830
008840          MOVE OFFSET-DATA        TO WOFFSET.
008850          MOVE WKEY                       TO KEY-DATA
008860          READ ARKDATA KEY IS KEY-DATA.
008870
008880          REWRITE REC-DATA.
008890
008900  AHEAD-OFFSET.
008910
008920
008930          ADD ARRAY-SIZE-DATA     TO WOFFSET.
008940
008950          GO TO LOOP-OFFSET.
008960
008970  EX-OFFSET.
008980          EXIT.
008990
009000  HELP.
009010
009020          DISPLAY "Usage: COBFD fdfile.cbl [cobfd.txt]".
009030          DISPLAY "                              ".
009040
009050  EX-HELP.
009060          EXIT.
009070
009080
009090  end program COBFD.
009100