Re: Perl & COBOL

[marinersk]

Updated to add <readmore> tags.
Updated to fix <readmore> tags. (Apparently I'm in noob mode today)
Updated to re-fix <readmore> tags. (Apparently I'm in serious noob mode today)

Okay, I'll take a stab at bridging the gap.

To understand this code you'll need to study up on the following Perl subjects:

• strict (critically useful in disciplined Perl programming)
• split (this is how I break out the translation table)
• Arrays (@ARGV is an array)
• Hashes (%TranslationTable is a hash)
• File I/O (open, close, print, and reading text files via <FILE>)
• Regular Expressions (quotemeta, and the use of the s/// substitution feature)
• Processing the command line (@ARGV contains the command line parameters)

Presuming my assessment of what you want to do is correct, we have some files:

 Directory of C:\Steve\Dev\PerlMonks\P-2013-09-04@0259-Perl-COBOL-Gues
+s

09/04/2013  03:59 AM    <DIR>          .
09/04/2013  03:59 AM    <DIR>          ..
09/04/2013  03:37 AM             1,788 TEST1.COB
09/04/2013  03:53 AM             1,301 varchange.pl
09/04/2013  03:38 AM               144 varchange.txt
               3 File(s)          3,233 bytes
               2 Dir(s)  53,636,513,792 bytes free

The file varchange.txt contains our variable translation data:

I-RECNUM:INPFIL-RECNUM
I-EMPNAM:INPFIL-EMPNAM
I-EMPAGE:INPFIL-EMPAGE
O-RECNUM:OUTFIL-RECNUM
O-EMPNAM:OUTFIL-EMPNAM
O-EMPAGE:OUTFIL-EMPAGE

The TEST1.COB file has our COBOL source code:

000100 IDENTIFICATION DIVISION.
000200     PROGRAM-ID. TEST1.
000300 
000400 ENVIRONMENT DIVISION.
000500     CONFIGURATION SECTION.
000600     SOURCE-COMPUTER. IBM-PC.
000700     OBJECT-COMPUTER. IBM-PC.
000800 
000900 INPUT-OUTPUT SECTION.
001000     FILE-CONTROL.
001100     SELECT INPFIL ASSIGN TO DISK.
001200     SELECT OUTFIL ASSIGN TO DISK.
001300 
001400 DATA DIVISION.
001500     FILE SECTION.
001600     FD INPFIL
001700     LABEL RECORDS ARE STANDARD
001800     VALUE OF FILE-ID IS "EMP.DAT"
001900     DATA RECORD IS INPREC.
002000 
002100 01 INPREC.
002200     02 I-RECNUM PIC 9(5).
002300     02 I-EMPNAM PIC X(15).
002400     02 I-EMPAGE PIC 99.
002500 
002600 FD OUTFIL
002700     LABEL RECORDS ARE STANDARD
002800     VALUE OF FILE-ID IS "EMP.NEW"
002900     DATA RECORD IS OUTREC.
003000 
003100 01 OUTREC.
003200     02 O-RECNUM PIC 9(5).
003300     02 O-EMPNAM PIC X(15).
003400     02 O-EMPAGE PIC 99.
003500 
003600 WORKING-STORAGE SECTION.
003700 
003800 01 OUTBUF.
003900 
004000 SCREEN SECTION.
004100     01 CLRSCR.
004200     02 BLANK SCREEN.
004300 
004400 PROCEDURE DIVISION.
004500 
004600* MAIN *
004700 
004800 0000-MAIN.
004900 
005000 OPEN INPUT  INPFIL
005100      OUTPUT OUTFIL.
005200     MOVE 0 TO EOF
005300     PERFORM 0100-CPYFIL UNTIL EOF = 1.
005400     CLOSE INPFIL
005500           OUTFIL.
005600     GO TO 9999-EOJ.
005700 
005800 0100-CPYFIL.
005900 
006000 READ INPFIL AT END MOVE 1 TO EOF.
006100 IF EOF = 0
006200     MOVE I-RECNUM TO O-RECNUM
006300     MOVE I-EMPNAM TO O-EMPNAM
006400     MOVE I-EMPAGE TO O-EMPAGE
006500     WRITE OUTREC.
006600 
006700**************
006800* END OF JOB *
006900**************
007000 
007100 9999-EOJ.
007200 
007300 STOP RUN.

And the file varchange.pl has our rather wordy and probably inefficient Perl script:

#!/usr/bin/perl -w

use strict;

# For brevity, there is no error checking here.
# In Real Life[TM], you should, of course, check for errors.

my %TranslationTable = ();

# Load Translation Table
{
    open TRANSLATION_FILE, "<varchange.txt";
    while (my $trnbuf = <TRANSLATION_FILE>)
    {
        chomp $trnbuf;
        my ($currentVariableName, $newVariableName, @garbageData) = sp
+lit /\:/, $trnbuf;
        $TranslationTable{$currentVariableName} = $newVariableName;
    }
    close TRANSLATION_FILE;
}

# Non-destructively modify files specified on command line
foreach my $inputFilename (@ARGV)
{
    my $outputFilename = $inputFilename . "-NEW.COB";
    open INPUT_FILE, "<$inputFilename";
    open OUTPUT_FILE, ">$outputFilename";
    while (my $inputBuffer = <INPUT_FILE>)
    {
        my $outputBuffer = $inputBuffer;
        foreach my $currentVariableName (keys %TranslationTable)
        {
            my $newVariableName = $TranslationTable{$currentVariableNa
+me};

            # Your logic will likely be more intense here
            # For example, how to confirm you are only modifying varia
+ble references?
            my $translationRegex = quotemeta $currentVariableName;
            $outputBuffer =~ s/$translationRegex/$newVariableName/ig;
        }
        print OUTPUT_FILE $outputBuffer;
    }
    close INPUT_FILE;
    close OUTPUT_FILE;
}

exit;

__END__

Running the script produces:

C:\Steve\Dev\PerlMonks\P-2013-09-04@0259-Perl-COBOL-Guess>varchange.pl
+ TEST1.COB

C:\Steve\Dev\PerlMonks\P-2013-09-04@0259-Perl-COBOL-Guess>type TEST1.C
+OB-NEW.COB

000100 IDENTIFICATION DIVISION.
000200     PROGRAM-ID. TEST1.
000300 
000400 ENVIRONMENT DIVISION.
000500     CONFIGURATION SECTION.
000600     SOURCE-COMPUTER. IBM-PC.
000700     OBJECT-COMPUTER. IBM-PC.
000800 
000900 INPUT-OUTPUT SECTION.
001000     FILE-CONTROL.
001100     SELECT INPFIL ASSIGN TO DISK.
001200     SELECT OUTFIL ASSIGN TO DISK.
001300 
001400 DATA DIVISION.
001500     FILE SECTION.
001600     FD INPFIL
001700     LABEL RECORDS ARE STANDARD
001800     VALUE OF FILE-ID IS "EMP.DAT"
001900     DATA RECORD IS INPREC.
002000 
002100 01 INPREC.
002200     02 INPFIL-RECNUM PIC 9(5).
002300     02 INPFIL-EMPNAM PIC X(15).
002400     02 INPFIL-EMPAGE PIC 99.
002500 
002600 FD OUTFIL
002700     LABEL RECORDS ARE STANDARD
002800     VALUE OF FILE-ID IS "EMP.NEW"
002900     DATA RECORD IS OUTREC.
003000 
003100 01 OUTREC.
003200     02 OUTFIL-RECNUM PIC 9(5).
003300     02 OUTFIL-EMPNAM PIC X(15).
003400     02 OUTFIL-EMPAGE PIC 99.
003500 
003600 WORKING-STORAGE SECTION.
003700 
003800 01 OUTBUF.
003900 
004000 SCREEN SECTION.
004100     01 CLRSCR.
004200     02 BLANK SCREEN.
004300 
004400 PROCEDURE DIVISION.
004500 
004600* MAIN *
004700 
004800 0000-MAIN.
004900 
005000 OPEN INPUT  INPFIL
005100      OUTPUT OUTFIL.
005200     MOVE 0 TO EOF
005300     PERFORM 0100-CPYFIL UNTIL EOF = 1.
005400     CLOSE INPFIL
005500           OUTFIL.
005600     GO TO 9999-EOJ.
005700 
005800 0100-CPYFIL.
005900 
006000 READ INPFIL AT END MOVE 1 TO EOF.
006100 IF EOF = 0
006200     MOVE INPFIL-RECNUM TO OUTFIL-RECNUM
006300     MOVE INPFIL-EMPNAM TO OUTFIL-EMPNAM
006400     MOVE INPFIL-EMPAGE TO OUTFIL-EMPAGE
006500     WRITE OUTREC.
006600 
006700**************
006800* END OF JOB *
006900**************
007000 
007100 9999-EOJ.
007200 
007300 STOP RUN.

Good luck, and holler if this is nothing like what you were looking for.

Based on certain grammatical constructs in your original post, I am going to guess English is not your native language, so we might have to ask a lot of questions of each other to get past communication problems. I promise I'll do my best if you promise to be patient with me.

:-)