Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

COBOL Killer

by johncoswell (Acolyte)
on May 03, 2000 at 20:19 UTC ( [id://10110]=sourcecode: print w/replies, xml ) Need Help??
Category:
Author/Contact Info John Bintz - johncoswell@SPAM.usa.net
Description:

This code processes a formatted text file into COBOL code. Ick. 8^) Running from the Web frontend (http://johnbintz.dragonfire.net/cobolkiller), it accepts one parameter - "cobolcode", a TEXTAREA input from HTML. The report format is pasted into the TEXTAREA then sent to the script. An example report file would look like this:

01234567890123456789
COBOL REPORT  999999
--------------------
CODE       COST
XXXXXXXXXX 999999999

TOTAL     9999999999

The first line of the report file is ignored. I use it to line up and measure across columns. After that, the file is processed word by word in this way:

  • If the word has two or more capital Xs, the number of Xs is counted and a PIC clause for X(length) is returned
  • If the word has two or more 9s, the number of 9s is counted and a PIC clause for 9(length) is returned.
  • If neither of these two occur, the word is placed into a FILLER (kinda like a constant) and the FILLER is assigned a PIC clause of X(length)

I also wrote a version to work with CICS BMS macros, which are even more longwinded. Enjoy!

#!/usr/bin/perl

# COBOL Killer
# Create PIC Clauses Fast!

  $input = <STDIN>;
  $input =~ tr/\+/ /;
  @attr_strings = split (/\&/, $input);

  foreach $out_str (@attr_strings) {
    @pair = split (/\=/, $out_str);
    $attr_value{$pair[0]} = $pair[1];
  }

  foreach $key (keys %attr_value) {
    $key =~ s/%(..)/pack("c",hex($1))/ge;
    $attr_value{$key} =~ s/%(..)/pack("c",hex($1))/ge;
  }

print "Content-type: text/html\n\n";

@file = split(/\n/,$attr_value{'cobolcode'});
chomp @file;

$linelength = (length $file[0]) - 1;

print <<"DONE";
<PRE>
       *
       * Code created with COBOL KILLER
       * http://johnbintz.dragonfire.net/cobolkiller/
       *
        WORKING-STORAGE SECTION.
        01 DATA-DEFINITIONS.
DONE

$time = 0;

for ($i = 1; $i < @file; $i++) {
  $file[$i] =~ s/\n//g;
  $file[$i] =~ s/\r//g;
  $file[$i] = substr($file[$i],0,80);
  for ($j = length $file[$i]; $j < $linelength; $j++) {
    $file[$i] .= ' ';
  }
  @words = split(/\b/,$file[$i]);
  chomp @words;
  print "          05 LINE-$i.\n";
  $time -= 60;
  foreach $word (@words) {
    $time += 20;
    if ($word =~ /XX/) {
      print "            10 ALPHA-FIELD       PIC X(";
      print length $word;
      print ").\n";
    } elsif ($word =~ /99/) {
      print "            10 NUMBER-FIELD      PIC 9(";
      print length $word;
      print ").\n";
    } else {
      print "            10 FILLER            PIC X(";
      print length $word;
      print ")\n";
      print "               VALUE \"$word\".\n";
    }
  }
}

$min = int($time / 60);
$sec = $time % 60;

print <<"DONE";
       *
       * Time saved: $min Min $sec Sec
       *
</PRE>
DONE
Replies are listed 'Best First'.
RE: COBOL Killer
by buzzcutbuddha (Chaplain) on May 04, 2000 at 16:32 UTC
    Good code, cool idea, but just thinking back to my time in school
    coding COBOL on the AS400 nearly sent me into fits.
      if i could have thought of this while i was learning cobol. . .

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (7)
As of 2024-03-28 08:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found