460 lines
14 KiB
Perl
460 lines
14 KiB
Perl
#!/usr/local/bin/perl -w
|
|
#
|
|
# Copyright (C) 2001 David Essex
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2, or (at your option)
|
|
# any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this software; see the file COPYING. If not, write to
|
|
# the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
|
# Boston, MA 02111-1307 USA
|
|
#
|
|
|
|
###########################################################################
|
|
# #
|
|
# Perl script to extract EXEC85 COBOL program from NIST test file #
|
|
# and change SELECT clause file names #
|
|
# #
|
|
###########################################################################
|
|
|
|
|
|
############### Globals ################
|
|
|
|
my $SW_start;
|
|
# Set to true to output program files
|
|
my $SW_output = "true";
|
|
#my $SW_output = "";
|
|
#
|
|
my $SW_nistfile = "true";
|
|
my $InString;
|
|
my $OutString;
|
|
my @InStringArray;
|
|
my @InStringArray1;
|
|
my $FileNameOut;
|
|
#my $FileNameLog = "logfile.txt";
|
|
#my $FileNameLog = $ARGV[1];
|
|
my $FileNameLog;
|
|
my @FileNameLogArray;
|
|
my $FileNameNIST = $ARGV[0];
|
|
my @SubPrmArray;
|
|
my $SubPrmItem;
|
|
my $PrgmInCntr = 0;
|
|
my $SubDirDel = "/";
|
|
my $SubDir = "e85/";
|
|
# program name extention
|
|
my $PrgmNameExtention = ".cob";
|
|
#
|
|
my $PrgmSubIn = "SELECT OPTIONAL POPULATION-FILE";
|
|
my $PrgmSubOut = "SELECT POPULATION-FILE ";
|
|
#
|
|
#------------------ File names begin ------------------#
|
|
#
|
|
#\* "XXXXX001." "../newcob.val"
|
|
my $PrgmFileIn01 = "XXXXX001. ";
|
|
my $PrgmFileOut01 = "\"newcob.val\"";
|
|
#
|
|
# "XXXXX002".
|
|
my $PrgmFileIn02 = "XXXXX002 ";
|
|
my $PrgmFileOut02 = "\"XXXXX002\"";
|
|
#
|
|
# "XXXXX003".
|
|
my $PrgmFileIn03 = "XXXXX003";
|
|
my $PrgmFileOut03 = "\"XXXXX003\"";
|
|
#
|
|
# "XXXXX055".
|
|
my $PrgmFileIn55 = "XXXXX055";
|
|
my $PrgmFileOut55 = "\"XXXXX055\"";
|
|
#
|
|
# "XXXXX058" "make_pop_linux.txt"
|
|
my $PrgmFileIn58 = "XXXXX058";
|
|
my $PrgmFileOut58 = "\"make_pop_linux.txt\"";
|
|
#
|
|
#------------------ End globals ------------------#
|
|
|
|
sub initialize_rtn ()
|
|
{
|
|
|
|
@FileNameLogArray = <logfile*txt>;
|
|
$FileNameLog = "logfile." . ($#FileNameLogArray + 2) . ".txt";
|
|
|
|
if (-f $FileNameLog) {
|
|
print "ERROR: file FileNameLog \"$FileNameLog\" exists\n";
|
|
die;
|
|
}
|
|
# print "FileNameLog = $FileNameLog;\n";
|
|
|
|
open (NISTFILE, "< $FileNameNIST")
|
|
or die "unable to open file \"$FileNameNIST\"";
|
|
|
|
open (LOGFILE, "> $FileNameLog ")
|
|
or die "unable to run \"$FileNameLog\"";
|
|
|
|
}
|
|
|
|
sub process_header ()
|
|
{
|
|
|
|
print LOGFILE "* ---------------------------------------- *\n";
|
|
print LOGFILE "head :" . $_ . ":\n";
|
|
$SW_start = 'True';
|
|
$InString = $_;
|
|
$InString =~ s/^\*HEADER,//g;
|
|
$InString =~ s/ /:/;
|
|
$InString =~ s/ //g;
|
|
print LOGFILE "InString :" . $InString . ":\n";
|
|
@InStringArray1 = split(/:/, $InString);
|
|
@InStringArray = split(/,/, $InStringArray1[0]);
|
|
for ($i=0; $i<=$#InStringArray; $i++) {
|
|
print LOGFILE "InStringArray[$i] :" . "$InStringArray[$i]" . ":\n";
|
|
}
|
|
}
|
|
|
|
sub determine_FileNameOut ()
|
|
{
|
|
# $FileNameOut = $SubDir .
|
|
$FileNameOut = $InStringArray[$#InStringArray] .
|
|
$PrgmNameExtention;
|
|
|
|
print LOGFILE "FileNameOut :" . "$FileNameOut" . ":\n";
|
|
}
|
|
|
|
sub output_PgmFile ()
|
|
{
|
|
print PGMFILE $InString . "\n";
|
|
}
|
|
|
|
#
|
|
#000600*INSTALLATION
|
|
sub process_line_06 ()
|
|
{
|
|
$SubtStringIn1 = "000600 INSTALLATION";
|
|
$SubtStringOut1 = "000600*INSTALLATION";
|
|
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn1/$SubtStringOut1/;
|
|
output_PgmFile;
|
|
}
|
|
|
|
#000700* "ON-SITE VALIDATION,
|
|
sub process_line_07 ()
|
|
{
|
|
$SubtStringIn1 = "000700 \"ON-SITE VALIDATION,";
|
|
$SubtStringOut1 = "000700* \"ON-SITE VALIDATION,";
|
|
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn1/$SubtStringOut1/;
|
|
output_PgmFile;
|
|
}
|
|
|
|
#000800* "COBOL 85 VERSION
|
|
sub process_line_08 ()
|
|
{
|
|
$SubtStringIn1 = "000800 \"COBOL 85 VERSION";
|
|
$SubtStringOut1 = "000800* \"COBOL 85 VERSION";
|
|
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn1/$SubtStringOut1/;
|
|
output_PgmFile;
|
|
}
|
|
|
|
#my $PrgmFile55 = "\"XXXXX055\"";
|
|
#my $PrgmFile58 = "\"make_pop_linux.txt\"";
|
|
|
|
#002500 SELECT OPTIONAL POPULATION-FILE EXEC84.2
|
|
#002600 ASSIGN TO EXEC84.2
|
|
#002700 XXXXX001. EXEC84.2
|
|
#
|
|
#\* SELECT OPTIONAL POPULATION-FILE
|
|
# SELECT POPULATION-FILE
|
|
# ASSIGN TO
|
|
#* "XXXXX001"
|
|
# "newcob.val"
|
|
# ORGANIZATION LINE SEQUENTIAL
|
|
# ACCESS SEQUENTIAL.
|
|
#
|
|
sub process_file01_24 ()
|
|
{
|
|
$SubtStringIn1 = "002500 SELECT";
|
|
$SubtStringOut1 = "002500* SELECT";
|
|
$SubtStringIn2 = "SELECT OPTIONAL POPULATION-FILE";
|
|
$SubtStringOut2 = "SELECT POPULATION-FILE ";
|
|
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn1/$SubtStringOut1/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn2/$SubtStringOut2/;
|
|
output_PgmFile;
|
|
}
|
|
|
|
sub process_file01_26 ()
|
|
{
|
|
$SubtStringIn1 = "002700 XXXXX001. ";
|
|
$SubtStringOut1 = "002700* XXXXX001. ";
|
|
$SubtStringOut2 = "002701 ORGANIZATION LINE SEQUENTIAL";
|
|
$SubtStringOut3 = "002702 ACCESS SEQUENTIAL. ";
|
|
# $SubtStringIn2 = "XXXXX001. ";
|
|
# $PrgmFile01 = "newcob.val";
|
|
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn1/$SubtStringOut1/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$PrgmFileIn01/$PrgmFileOut01/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn1/$SubtStringOut2/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn1/$SubtStringOut3/;
|
|
output_PgmFile;
|
|
}
|
|
|
|
#002800 SELECT SOURCE-COBOL-PROGRAMS EXEC84.2
|
|
#002900 ASSIGN TO EXEC84.2
|
|
#003000 XXXXX002 EXEC84.2
|
|
#003100 ORGANIZATION SEQUENTIAL. EXEC84.2
|
|
#
|
|
# SELECT SOURCE-COBOL-PROGRAMS
|
|
# ASSIGN TO
|
|
# "XXXXX002"
|
|
# ORGANIZATION LINE SEQUENTIAL
|
|
#* ORGANIZATION SEQUENTIAL
|
|
# ACCESS SEQUENTIAL.
|
|
#* ORGANIZATION SEQUENTIAL.
|
|
#
|
|
sub process_file02_29 ()
|
|
{
|
|
$SubtStringIn1 = "003000 XXXXX002";
|
|
$SubtStringOut1 = "003000* XXXXX002";
|
|
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn1/$SubtStringOut1/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$PrgmFileIn02/$PrgmFileOut02/;
|
|
output_PgmFile;
|
|
}
|
|
|
|
sub process_file02_30 ()
|
|
{
|
|
$SubtStringIn = "003100 ORGANIZATION SEQUENTIAL. ";
|
|
$SubtStringOut1 = "003100* ORGANIZATION SEQUENTIAL. ";
|
|
$SubtStringOut2 = "003100 ORGANIZATION LINE SEQUENTIAL";
|
|
$SubtStringOut3 = "003101 ACCESS SEQUENTIAL. ";
|
|
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn/$SubtStringOut1/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn/$SubtStringOut2/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn/$SubtStringOut3/;
|
|
output_PgmFile;
|
|
}
|
|
|
|
#003200 SELECT UPDATED-POPULATION-FILE EXEC84.2
|
|
#003300 ASSIGN TO EXEC84.2
|
|
#003400 XXXXX003. EXEC84.2
|
|
#
|
|
# SELECT UPDATED-POPULATION-FILE
|
|
# ASSIGN TO
|
|
# "XXXXX003".
|
|
#
|
|
sub process_file03_33 ()
|
|
{
|
|
$SubtStringIn1 = "003400 XXXXX003.";
|
|
$SubtStringOut1 = "003400* XXXXX003.";
|
|
# "XXXXX003".
|
|
# $PrgmFileIn03 = "XXXXX003";
|
|
# $PrgmFileOut03 = ""XXXXX003"";
|
|
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn1/$SubtStringOut1/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$PrgmFileIn03. /$PrgmFileOut03./;
|
|
output_PgmFile;
|
|
}
|
|
|
|
#
|
|
#003500 SELECT PRINT-FILE EXEC84.2
|
|
#003600 ASSIGN TO EXEC84.2
|
|
#003700 XXXXX055. EXEC84.2
|
|
#
|
|
# SELECT PRINT-FILE
|
|
# ASSIGN TO
|
|
# "XXXXX055".
|
|
sub process_file55_36 ()
|
|
{
|
|
$SubtStringIn1 = "003700 XXXXX055.";
|
|
$SubtStringOut1 = "003700* XXXXX055.";
|
|
# "XXXXX055".
|
|
# $PrgmFileIn55 = "XXXXX055";
|
|
# $PrgmFileOut55 = ""XXXXX055"";
|
|
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn1/$SubtStringOut1/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$PrgmFileIn55. /$PrgmFileOut55./;
|
|
output_PgmFile;
|
|
}
|
|
|
|
#
|
|
#003800 SELECT CONTROL-CARD-FILE EXEC84.2
|
|
#003900 ASSIGN TO EXEC84.2
|
|
#004000 XXXXX058. EXEC84.2
|
|
#
|
|
# SELECT CONTROL-CARD-FILE
|
|
# ASSIGN TO
|
|
#* "XXXXX058"
|
|
# "make_pop_linux.txt"
|
|
# ORGANIZATION LINE SEQUENTIAL
|
|
# ACCESS SEQUENTIAL.
|
|
sub process_file58_39 ()
|
|
{
|
|
$SubtStringIn1 = "004000 XXXXX058.";
|
|
$SubtStringOut1 = "004000* XXXXX058.";
|
|
$SubtStringIn2 = "004000 XXXXX058. ";
|
|
$SubtStringOut2 = "004001 ORGANIZATION LINE SEQUENTIAL";
|
|
$SubtStringOut3 = "004002 ACCESS SEQUENTIAL. ";
|
|
# "XXXXX058" "make_pop_linux.txt"
|
|
# $PrgmFileIn58 = "XXXXX058";
|
|
# $PrgmFileOut58 = ""make_pop_linux.txt"";
|
|
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn1/$SubtStringOut1/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$PrgmFileIn58\. /$PrgmFileOut58/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn2/$SubtStringOut2/;
|
|
output_PgmFile;
|
|
$InString = $_;
|
|
$InString =~ s/$SubtStringIn2/$SubtStringOut3/;
|
|
output_PgmFile;
|
|
}
|
|
|
|
# -------------------- main begins here -------------------- #
|
|
|
|
if ($#ARGV != 0) {
|
|
print "ERROR: invalid number of arguments " . ($#ARGV + 1) . " != 1\n";
|
|
die;
|
|
}
|
|
|
|
initialize_rtn;
|
|
|
|
#while ($SW_nistfile)
|
|
#read(NISTFILE, $inbuf, 81);
|
|
read(NISTFILE, $_, 81);
|
|
while ($SW_nistfile)
|
|
#while (<NISTFILE>)
|
|
#while ((<NISTFILE>) && ($SW_nistfile))
|
|
{
|
|
# $_ = $inbuf;
|
|
chop;
|
|
if ($SW_start) {
|
|
if (/^\*END-OF,/) {
|
|
print LOGFILE "tail :" . $_ . ":\n";
|
|
$SW_start = '';
|
|
if ($SW_output) {
|
|
close(PGMFILE);
|
|
}
|
|
$SW_nistfile = '';
|
|
close(NISTFILE);
|
|
}
|
|
else {
|
|
# $PrgmInCntr++;
|
|
if ($SW_output) {
|
|
$PrgmInCntr++;
|
|
# if (($PrgmInCntr > 23) && ($PrgmInCntr < 40)) {
|
|
if (($PrgmInCntr == 5) ||
|
|
($PrgmInCntr == 6) ||
|
|
($PrgmInCntr == 7) ||
|
|
($PrgmInCntr == 24) ||
|
|
($PrgmInCntr == 26) ||
|
|
($PrgmInCntr == 29) ||
|
|
($PrgmInCntr == 30) ||
|
|
($PrgmInCntr == 33) ||
|
|
($PrgmInCntr == 36) ||
|
|
($PrgmInCntr == 39)
|
|
) {
|
|
if ($PrgmInCntr == 24) {
|
|
process_file01_24;
|
|
# $InString = $_;
|
|
# process_line25($_);
|
|
# print PGMFILE $InString . "\n";
|
|
}
|
|
|
|
if ($PrgmInCntr == 5) {
|
|
process_line_06;
|
|
}
|
|
if ($PrgmInCntr == 6) {
|
|
process_line_07;
|
|
}
|
|
if ($PrgmInCntr == 7) {
|
|
process_line_08;
|
|
}
|
|
if ($PrgmInCntr == 26) {
|
|
process_file01_26;
|
|
}
|
|
if ($PrgmInCntr == 29) {
|
|
process_file02_29;
|
|
}
|
|
if ($PrgmInCntr == 30) {
|
|
process_file02_30;
|
|
}
|
|
if ($PrgmInCntr == 33) {
|
|
process_file03_33;
|
|
}
|
|
if ($PrgmInCntr == 36) {
|
|
process_file55_36;
|
|
}
|
|
if ($PrgmInCntr == 39) {
|
|
process_file58_39;
|
|
}
|
|
}
|
|
else {
|
|
print PGMFILE $_ . "\n";
|
|
}
|
|
}
|
|
# $PrgmInCntr++;
|
|
}
|
|
}
|
|
else {
|
|
if (/^\*HEADER,/) {
|
|
process_header;
|
|
determine_FileNameOut;
|
|
if ($SW_output) {
|
|
open (PGMFILE, "> $FileNameOut")
|
|
or die "unable to open output file \"$FileNameOut\"";
|
|
}
|
|
}
|
|
else {
|
|
print LOGFILE "* ---------------------------------------- *\n";
|
|
print LOGFILE "ignoring :" . $_ . ":\n";
|
|
}
|
|
}
|
|
# read(NISTFILE, $inbuf, 81);
|
|
read(NISTFILE, $_, 81);
|
|
}
|
|
|
|
print LOGFILE "* ---------------------------------------- *\n";
|
|
print LOGFILE "PrgmInCntr =" . $PrgmInCntr;
|
|
|
|
close(NISTFILE);
|
|
close(LOGFILE);
|
|
|
|
__END__
|