Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Get Progress OpenEdge ABL main block parameters from compiled object (.r) code (tested on Unix 10.1C compiles)
#!/usr/bin/perl
#-------------------------------------------------------------------------------
# File: getRcodeParams.pl
# Purpose: Decodes the main block parameters of compiled OpenEdge ABL r-code.
# Arguments: [0] File system location of an r-code file to parse
# Returns: List of parameters (newline-separated) from the main execution
# block. The parameters are in the form:
# [input/output type] [variable name] [datatype]
# Author(s): Abe Voelker
# Created: 2010-09-14
# Notes: * This code has only been tested on 10.1C Unix r-code. It may not
# be applicable to other environments, or all that stable even on
# 10.1C Unix due to there being no such thing as an OpenEdge ABL
# 'standard' - the parsing is done based purely upon guesswork.
# * It appears that the datatype for temp-tables is TABLE. Also,
# the names of classes are converted to uppercase.
# * Future work could easily get more signature information from the
# r-code based on my observations. For example, temp-table and
# forward-defined functions have information available in the
# section beginning shortly after this program finishes parsing...
#-------------------------------------------------------------------------------
#Validate argument
if (($#ARGV + 1) != 1) { die "You must pass in the location of the .r code to parse!"; }
#Read the entire file into memory
open FILE, $ARGV[0] or die $!;
binmode FILE;
my ($buf, $data, $n);
while (($n = read FILE, $data, 64) != 0) {
$buf .= $data;
}
close(FILE);
#Find the magic start token
$iStart = index($buf, "\0MAIN ");
if ($iStart == -1) { die "The magic start token was not found!"; }
$iStart += 6; #We don't want the MAIN piece in our string...
#Find the magic end token
$iEnd = index($buf, "\0", $iStart);
if ($iEnd == -1) { die "The magic end token was not found!"; }
#Store the parsed param results in an array
$parmChunk = substr($buf, $iStart, ($iEnd - $iStart));
@params = split (/,/, $parmChunk);
shift(@params); shift(@params); #The top two elements are useless
#Print results to stdout
foreach $param (@params) {
print "$param\n";
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment