Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re: Perl & COBOL

by marinersk (Chaplain)
on Sep 04, 2013 at 10:14 UTC ( #1052279=note: print w/ replies, xml ) Need Help??


in reply to Perl & COBOL

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.

:-)


Comment on Re: Perl & COBOL
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1052279]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (8)
As of 2014-12-27 12:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (177 votes), past polls