Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

COBOL Killer

by johncoswell (Acolyte)
on May 03, 2000 at 20:19 UTC ( #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

Comment on COBOL Killer
Download Code
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. . .

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (5)
As of 2014-10-21 07:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (98 votes), past polls