Hey,
I've started writing Perl a little over a month ago with the help of the
awesome Llama (and this mailing list). I am only on Chapter 8 so don't
bruise my fragile ego too much with this script review. It's simple data
manipulation but as you'll see, I need a lot of help with the structure and
overall Perlness. Any comments appreciated (gulp).
Joel
#!c:\perl\perl.exe
#Substitute your favorite Shebang line above
#Name
# imanet.pl
#Description
# Parsing program made to take part of an 810 message from ***** Co. and
# make an xml version.
#Usage
# 'imanet.pl input_file'
# Invoked by a program that first separates the original input
# file by commercial invoice (ST-SE).
#Output
# File
# commerical_invoice_number.xml
# Display
# 'imanet.pl> Parsing ST_number.tmp'
# 'imanet.pl> File Created: commerical_invoice_number.xml'
# 'imanet.pl> Cannot open output file' (error message)
# 'imanet.pl> Cannot close output file' (error message)
# JRS 05/22/01
use strict;
#Parsing/Printing variables
my ($stno, @lines, $ref, $fill, $addrid, $x, $t, $cfile);
#Header variables
my ($cominv, $ship, $refno, $val, $shipdt, $trans, $gwght, $gwghtuom,
$curr, $gendesc, $clcode, $clname,
$vncode, $vnname, $vnaddr1, $vnaddr2, $vncity, $vnst, $vnco, $vnzip,
$cncode, $cnname, $cnaddr1, $cnaddr2, $cncity, $cnst, $cnzip,
$excode, $exname, $exaddr1, $exaddr2, $excity, $exst, $exco, $exzip,
$pucode, $puname, $puaddr1, $puaddr2, $pucity, $pust, $puzip,
$po, $podt, $bol, $dirship, $carcode, $carname, $framt, $tcin, $tcout,
$conval, $commamt, $duty, $tax, $dutytax, $royal, $spgood, $terms,
$disc,
$pkinc, $pkexc, $pkgs, $pkgsuom, $pktype, $cargo,
$ptypex, $poex, $ptypen, $poen, $rel);
#Detail arrays
my (@lntype, @pn, @desc, @hs, @qty, @uom, @price, @bxs, @mos, @mval, @rval,
@lnref, @co, @euse);
#Main Parsing Routine
$cfile = $ARGV[0];
print "imanet.pl> Parsing: $cfile\n";
while (<>) {
chomp;
testType ($_);
}
#Subroutines
sub testType {
if (/^BIG/) {
parseBIG ($_[0]);
} elsif (/^REF/) {
parseREF ($_[0]);
} elsif (/^TDS/) {
parseTDS ($_[0]);
} elsif (/^CAD/) {
parseCAD ($_[0]);
} elsif (/^ISS/) {
parseISS ($_[0]);
} elsif (/^CUR/) {
parseCUR ($_[0]);
} elsif (/^NTE/) {
parseNTE ($_[0]);
} elsif (/^N1/) {
parseN1 ($_[0]);
} elsif (/^N3/) {
parseN3 ($_[0]);
} elsif (/^N4/) {
parseN4 ($_[0]);
} elsif (/^AMT/) {
parseAMT ($_[0]);
} elsif (/^ITD/) {
parseITD ($_[0]);
} elsif (/^PKG/) {
parsePKG ($_[0]);
} elsif (/^R4/) {
parseR4 ($_[0]);
} elsif (/^IT1/) {
parseIT1 ($_[0]);
} elsif (/^PID/) {
parsePID ($_[0]);
} elsif (/^SE/) {
printResults();
}
}
sub parseBIG {
($ref, $shipdt, $cominv, $podt, $po) = split (/\*/, $_[0]);
}
sub parseREF {
my (@REFln);
@REFln = split (/\*/, $_[0]);
$ref = $REFln[1];
if ($ref eq "SN") {
$ship = $REFln[2];
} elsif ($ref eq "PO"){
$refno = $REFln[2];
} elsif ($ref eq "BL"){
$bol = $REFln[2];
} elsif ($ref eq "PS"){
$dirship = $REFln[2];
} elsif ($ref eq "DI"){
$duty = $REFln[2];
} elsif ($ref eq "TI"){
$tax = $REFln[2];
} elsif ($ref eq "RY"){
$royal = $REFln[2];
} elsif ($ref eq "SG"){
$spgood = $REFln[2];
} elsif ($ref eq "CC"){
$cargo = $REFln[2];
} elsif ($ref eq "RT"){
$rel = $REFln[2];
}
}
sub parseTDS {
($ref, $val) = split (/\*/, $_[0]);
}
sub parseCAD {
($ref, $trans, $fill, $fill, $carcode, $framt,
$fill, $fill, $carname) = split (/\*/, $_[0]);
}
sub parseISS {
($ref, $pkgs, $pkgsuom, $gwght, $gwghtuom) = split (/\*/, $_[0]);
}
sub parseCUR {
($ref, $fill, $curr) = split (/\*/, $_[0]);
}
sub parseNTE {
($ref, $fill, $gendesc) = split (/\*/, $_[0]);
}
sub parseN1 {
my (@N1ln);
@N1ln = split (/\*/, $_[0]);
$addrid = $N1ln[1]; #store id as current addr variable
if ($addrid eq "CL") { #subsequent lines don't id client type
$clcode = $N1ln[4];
$clname = $N1ln[2];
} elsif ($addrid eq "VN"){
$vncode = $N1ln[4];
$vnname = $N1ln[2];
} elsif ($addrid eq "CN"){
$cncode = $N1ln[4];
$cnname = $N1ln[2];
} elsif ($addrid eq "EX"){
$excode = $N1ln[4];
$exname = $N1ln[2];
} elsif ($addrid eq "PU"){
$pucode = $N1ln[4];
$puname = $N1ln[2];
}
}
sub parseN3 {
my (@N3ln);
@N3ln = split (/\*/, $_[0]);
if ($addrid eq "VN"){
$vnaddr1 = $N3ln[1];
$vnaddr2 = $N3ln[2];
} elsif ($addrid eq "CN"){
$cnaddr1 = $N3ln[1];
$cnaddr2 = $N3ln[2];
} elsif ($addrid eq "EX"){
$exaddr1 = $N3ln[1];
$exaddr2 = $N3ln[2];
} elsif ($addrid eq "PU"){
$puaddr1 = $N3ln[1];
$puaddr2 = $N3ln[2];
}
}
sub parseN4 {
my (@N4ln);
@N4ln = split (/\*/, $_[0]);
if ($addrid eq "VN"){
$vncity = $N4ln[1];
$vnst = $N4ln[2];
$vnzip = $N4ln[3];
$vnco = $N4ln[4];
} elsif ($addrid eq "CN"){
$cncity = $N4ln[1];
$cnst = $N4ln[2];
$cnzip = $N4ln[3];
#no Consignee Co in documentation
} elsif ($addrid eq "EX"){
$excity = $N4ln[1];
$exst = $N4ln[2];
$exzip = $N4ln[3];
$exco = $N4ln[4];
} elsif ($addrid eq "PU"){
$pucity = $N4ln[1];
$pust = $N4ln[2];
$puzip = $N4ln[3];
#no Purchaser Co in documentation
}
}
sub parseAMT {
my (@AMTln);
@AMTln = split (/\*/, $_[0]);
$ref = $AMTln[1];
if ($ref eq "TCI"){
$tcin = $AMTln[2];
} elsif ($ref eq "TCO"){
$tcout = $AMTln[2];
} elsif ($ref eq "CON"){
$conval = $AMTln[2];
} elsif ($ref eq "COM"){
$commamt = $AMTln[2];
} elsif ($ref eq "DTI"){
$dutytax = $AMTln[2];
} elsif ($ref eq "PKI"){
$pkinc = $AMTln[2];
} elsif ($ref eq "PKE"){
$pkexc = $AMTln[2];
}
}
sub parseITD {
($ref, $terms, $fill, $disc) = split (/\*/, $_[0]);
}
sub parsePKG {
($ref, $fill, $fill, $fill, $pktype) = split (/\*/, $_[0]);
}
sub parseR4 {
my (@R4ln);
@R4ln = split (/\*/, $_[0]);
$ref = $R4ln[2];
if ($ref eq "EN"){
$ptypen = $R4ln[1];
$poen = $R4ln[3];
} elsif ($ref eq "EX"){
$ptypex = $R4ln[1];
$poex = $R4ln[3];
}
}
sub parseIT1 {
my (@IT1ln);
@IT1ln = split (/\*/, $_[0]);
push (@lntype, $IT1ln[1]);
push (@pn, $IT1ln[7]);
push (@hs, $IT1ln[9]);
push (@qty, $IT1ln[2]);
push (@uom, $IT1ln[3]);
push (@price, $IT1ln[4]);
push (@bxs, $IT1ln[11]);
push (@mos, $IT1ln[13]);
push (@mval, $IT1ln[15]);
push (@rval, $IT1ln[17]);
push (@lnref, $IT1ln[19]);
push (@co, $IT1ln[21]);
push (@euse, $IT1ln[23]);
}
sub parsePID {
my (@PIDln);
@PIDln = split (/\*/, $_[0]);
push (@desc, $PIDln[5]);
}
sub printResults {
open (OUT, ">./$cominv.xml") || die "imanet.pl> Cannot open output file\n";
xmls ("I_810");
xmlt ("Com_Inv", $cominv, 1);
xmlt ("Ship_Dt", $shipdt, 1);
#...yada, yada, yada I'll spare you the rest of the Header but not the
Details...
for ($x = 0; $x <= $#lntype; $x++) {
xmls ("Detail_Line", 1);
xmlt ("Line_Cnt", ($x + 1), 2);
xmlt ("Line_Type", $lntype[$x], 2);
xmlt ("Part_No", $pn[$x], 2);
xmlt ("HS", $hs[$x], 2);
xmlt ("Qty", $qty[$x], 2);
xmlt ("UOM", $uom[$x], 2);
xmlt ("Price", $price[$x], 2);
xmlt ("Boxes", $bxs[$x], 2);
xmlt ("Months", $mos[$x], 2);
xmlt ("Media_Val", $mval[$x], 2);
xmlt ("Repair_Val", $rval[$x], 2);
xmlt ("Ref_No", $lnref[$x], 2);
xmlt ("CO", $co[$x], 2);
xmlt ("End_Use" , $euse[$x], 2);
xmlt ("Desc", $desc[$x], 2);
xmle ("Detail_Line", 1);
}
xmle ("I_810");
close (OUT) || die "imanet.pl> Cannot close output file";
print "imanet.pl> File created: $cominv.xml\n";
}
#xml 't'ag - I know I should be use::ing something else here
sub xmlt {
my ($rt);
tab ($_[2]);
$rt = xc ($_[1]);
print OUT "<$_[0]>$rt</$_[0]>\n";
}
#xml 's'tart tag
sub xmls {
my ($st);
tab ($_[1]);
$st = ($_[0]);
print OUT "<$st>\n";
}
#xml 'e'nd tag
sub xmle {
my ($et);
tab ($_[1]);
$et = ($_[0]);
print OUT "</$et>\n";
}
sub tab {
#for readability when looking at xml source
for ($t = 1; $t <= $_[0]; $t++) {
print OUT " ";
}
}
sub xc {
#returns text free of XML baddies - xc = xml clean
my ($data) = $_[0];
$data =~ s/&/&/g;
$data =~ s/</</g;
$data =~ s/>/>/g;
$data =~ s/'/'/g;
$data =~ s/"/"/g;
return $data;
}
