Path: utzoo!utgpu!news-server.csri.toronto.edu!mailrus!cs.utexas.edu!sdd.hp.com!elroy.jpl.nasa.gov!jpl-devvax!lwall
From: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall)
Newsgroups: comp.lang.perl
Subject: Re: source code
Message-ID: <8310@jpl-devvax.JPL.NASA.GOV>
Date: 6 Jun 90 21:29:59 GMT
References: <1990Jun6.004442.14479@uvaarpa.Virginia.EDU> <1990Jun6.022140.13168@iwarp.intel.com>
Reply-To: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall)
Organization: Jet Propulsion Laboratory, Pasadena, CA
Lines: 112

In article <1990Jun6.022140.13168@iwarp.intel.com> merlyn@iwarp.intel.com (Randal Schwartz) writes:
: In article <1990Jun6.004442.14479@uvaarpa.Virginia.EDU>, frech@mwraaa (Norman R. Frech CPLS) writes:
: | Greetings,
: | 
: | I am fairly new to perl and the following is a program which I
: | developed to read a file off an ibm and convert the packed values
: | to something usable.  It then writes the data down in delimited form
: | for dbaseiii.  The program seems to work but I have a feeling
: | it is a terrible hack and would appreciate some kind criticism
: | or possible improvements, etc.
: 
: Here's what I could do in 15 minutes.  Might be a few typos.  Caveat
: Executor.
: 
: I tried to keep your logic and order (had to, with that time limit),
: but part of the work is learning to "Think Perl".
: 
: ################################################## cut here
: @lookup = split(/ /,'{}0 AJ1 BK2 CL3 DM4 EN5 FO6 GP7 HQ8 IR9');

@code{ '{', 'A' .. 'I', '}', 'J' .. 'R', '0' .. '9' } = (0 .. 19, 0 .. 9);
 
 or

for (split(//, "{ABCDEFGHI}JKLMNOPQR0123456789")) { $code{$_} = $cnt++ % 20; }

 or even

%code = (
	'{',	0,	'}',	10,	'0',	0,
	'A',	1,	'J',	11,	'1',	1,
	'B',	2,	'K',	12,	'2',	2,
	'C',	3,	'L',	13,	'3',	3,
	'D',	4,	'M',	14,	'4',	4,
	'E',	5,	'N',	15,	'5',	5,
	'F',	6,	'O',	16,	'6',	6,
	'G',	7,	'P',	17,	'7',	7,
	'H',	8,	'Q',	18,	'8',	8,
	'I',	9,	'R',	19,	'9',	9,
};

: while (<>) {
: 	chop;
: 	($f1,$f2,$f3,$f4,$f5,$f6,$f7,$onhand,$stock_val,$f8,$f9,$f10) =
: 	/^(.{5})(.{13})(....)(.{40})(.)(.)(...)(.{9})(.{9})(.)(.{5})/;

more efficiently:

	unpack("c5 c13 c4 c40 c c c3 c9 c9 c c5", $_);

: 	# ship two values to be whack
: 	$onhand = &packibm($onhand);
: 	$stock_val = &packibm($stock_val);
: 	# print the values
: 	print '"', join('","', $f1, $f2, $f3, $f4, $f5, $f6, $f7,
: 		$onhand, $stock_val, $f8, $f9, $f10), '"', "\n";

I presume we don't need to check for embedded '"'?

: }
: 
: sub packibm {
: 	local($_) = @_;
: 	local($tend,$lval) = /(.*)(.)/;
: 	local($get) = &calval($lval);

local($tend) = @_;
local($get) = $code{ chop($tend) };

: 	if ($get < 10) { ## meant $get instead of $i, I hope
: 		return($tend * 10 + $get);  ## ditto
: 	} else {
: 		return($tend * 10 * -1 + (($get - 10) * -1));  ## ditto
: 	}
: }
: 
: ## there is something very non-perlish about the following code, but
: ## I couldn't reverse engineer it in the few minutes I had to do this.
: ## Larry?
: 
: sub calval {
: 	local($i,$j);
: 	for ($i = 0; $i < 10; $i++) {
: 		for ($j = 0; $j < 3; $j++) {
: 			$look = substr(@lookup[$i],$j,1);
: 			if ($lval =~ $look) { 
: 				if ($j == 1) {
: 					$i = $i + 10;
: 				}
: 				return $i;
: 			}
: 		}
: 	}
: }

This whole subroutine can be replaced by a single associative array lookup.
See $code{} above.

Actually, now that I glare at the whole thing, you can do packibm like this

    sub packibm {
	local($_) = @_;
	if (tr/}J-R/0-9/) {
	    $_ = -$_;
	}
	else {
	    tr/{A-I/0-9/;
	}
	$_;
    }

Larry