#*********************************************************************
+********
#This perl script is used to parse ISA headers for EDI Transactions
#The transactions can then be forwarded to appropriate receivers by FT
+P
#or other means. In effect it is an EDI store and forward system.
#diskcrash Jan 24, 2002 
#*********************************************************************
+********
#Change History
#
#date      #Description                        #who did it     
#01/28/02  V1.0 Creation                      diskcrash
#02/06/02  V1.1 Added choice of sender or receiver for output     disk
+crash
#02/06/02  V1.2 Removed additional end of transaction LF chars    disk
+crash
#
#
#*********************************************************************
+********
#***definitions
my(@inlines);
my(@lines);
my($line);
my($slash)="/";

#****  Now set which directories are created, for senders vs. receiver
+s
#****  Generally the directories created are receivers of wxyz data

my($nameflag)="r";             #file set for receiver output

#***  now set the default device for the file system
$defdev="c:";

#*** now establish the default directories

$excpdir=$defdev."/wxyzprod/wxyzexcp/";        #dir to put exception f
+iles in
$logfile=$defdev."/wxyzprod/wxyzlog.txt";    #log file
$indir=$defdev."/wxyzprod/wxyzin/";        #input directory
$outdir=$defdev."/wxyzprod/suppliers/";        #top of suppliers dir t
+ree
$archive=$defdev."/wxyzprod/wxyzarch/";   #original files go here afte
+r processing

            #***********************************************
undef $/;        #this removes the default \n input line separator 
            #so that files shall be read
            #in as one giant string, regardless of embedded
            #line controls.
            #Note that this radically impacts all file reads
            #vs. normal "read by record" behavior.
            #***********************************************
            



#*********************************************************************
+*******
#Start this perl script on system boot
#It first writes a timestamp to the wxyzlog.txt file in /wxyzprod
#In this startup section we'll check to make sure the script can read 
+from
#the /wxyzprod/wxyzin directory, and stop if it can't
#The script also tests to see if the logfile is larger than 100 megaby
+tes
#if so it needs looking at or deleting. The logfile will be recreated 
+after
#deletion
#*********************************************************************
+*******

#******write start time  to logfile

open( LOGGER, ">>$logfile");

($sec,$min,$hour,$mday,$mon,$year,$wday,$ydat,$isdst)=localtime();


print LOGGER $hour , $min ,$sec , $mday , $mon , $year," wxyzprod star
+ted\n";

close (LOGGER);

#*******check for input directory and exception
#*******
if  (!opendir(PRODDIR,"$indir"))
{
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydat,$isdst)=localtime();

    $timestamp= $hour . $min .$sec . $mday . $mon . $year;
    open( LOGGER, ">>$logfile");
     print LOGGER $timestamp . "\wxyzprod\wxyzin 
    directory not found-stopped!\n";
    close(LOGGER);
     die("No wxyzprod/wxyz input directory found");   
}



#******check for logfile size and e-mail
#******if the log file got really huge, it should be at least inspecte
+d

($device,$inode,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctim
+e,
$blksize,$blocks) = stat(LOGGER);

if ($size > 100000000)  # if log file size over 100 meg stop!
{
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydat,$isdst)=localtime();

    $timestamp= $hour . $min .$sec . $mday . $mon . $year;
    open( LOGGER, ">>$logfile");
    print LOGGER $timestamp . "log file greater than 100Meg - WARNING!
+\n";
    close(LOGGER);
 
}    


#*********************************************************************
+*******
#The intro stuff is done, the main loop follows. It sleeps for 20 seco
+nds
#then checks for new files in the /wxyzprod/wxyzin directory.
#If it finds one or more, it gets the file list and then checks the fo
+llowing:

#     Is the file at least 10 seconds old since last modified, if not 
#    it throws it back to get processed 20 seconds later

#    Does the file have a string ISA in it? If not it copies it to the
#    wxyzprod/wxyzexcp directory, might have been a CAD file or someth
+ing.
#    It wasn't an EDI file, and there is no ISA header to decode it.

#    Does the file have a string IEA in it? (Same story, see above)

# If the file meets the above criteria, then its scanned for embedded 
+Line 
#Feeds - as in ASCII "0A". These are replaced by nulls. There is a sin
+gle 
#trailing LF.

#It is assumed there could be an unlimited number of ISA/IEA header 
#pairs. The file is scanned for each ISA and - Lordy Yes- fixed byte 
#count offsets are read in to reach the sender, receiver, date and tim
+e. 
#This practice of fixed offsets could, of course, be blown out of the 
+water 
#with a single change. Fortunately the ISA header structure
#has been relatively fixed and stable over the years. 
#Just be aware of this potential issue.  <<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+<<<<<<
#*********************************************************************
+*******


#***** main loop - the other end is at the bottom of the script
A:

#*****sleep 20 seconds, then check for files again

sleep(20);


#set deadman variable to 1
#stubbed out

#*********************************************************************
+**
#determine if any files exist in wxyzprod\wxyzin
#open the directory and get file list, then read files one by one 
#from the file list
#*********************************************************************
+***


opendir (FDIR,"$indir");
@filelist=readdir(FDIR);
close(FDIR);

#***********************************************************
# Now the first two "files" will be .  and ..  which we will skip
#**********************************************************

#**************************************************************
#So.. if the file list is null, the following loop is bypassed
#
# This next loop reads each filename from @filelist
#******************************************************************

foreach $infile (@filelist)  #*** This is the start of the file proces
+sing
                             #loop, which ends after the last file is 
+read
{

if ($infile eq "." || $infile eq "..")   #vestigial returned files-ign
+ore
{
goto escape1;
}

#******************************************************************
#we want to make sure the file is finished being written, so..
#determine if $mtime > 10 seconds and skip if not
#If its too young we'll get back to it next time
#******************************************************************

$getinfile=$indir.$infile;

($device,$inode,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctim
+e,
$blksize,$blocks) = stat($getinfile);

my($timenow)=time;
$delta=$timenow-$mtime;


if ($delta < 10)     #***file too young, wait a few seconds
{
next;              #***jump to the end of the loop
}

#***ok, its older than ten seconds
#***so read the whole file into an array at one time



open(INF,"<$getinfile");  #***open each file in turn

        #*************************************************************
$line=<INF>;      #This reads the whole input file at one time into th
+e $line. 
        #it will usually have only one entry (a single record)
        #, but if it has more and it is an EDI file, it will will need
        #all of the embedded LFs replaced by nulls.
        #This process has been tested for file sizes up to 50 Mbytes
        #on a 128 Mbyte Win2K system. I wouldn't really push this 
        #for files above 5 Mbytes, but then most EDI files are under
        # 10K bytes
        #*************************************************************


close(INF);        #***close the input file

#*****determine if ISA header exists and if not post a log event and t
+oss
#the file to the /wxyzproc/wxyzexcp exception directory

if (index($line,"ISA") == -1)
{                    #if we are here,there is no ISA header
                    # so its not an EDI file
                    #write to the exception area and 
                    #delete from wxyzin dir
                    #*********************

    ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydat,$isdst)=localtime();

    $timestamp= $hour . $min .$sec . $mday . $mon . $year;
    open(LOGGER,">>$logfile");
    print LOGGER "$timestamp , $infile , no ISA header found \n";
    close(LOGGER);

    $outfile=$excpdir . $infile;    
    open(IEXCP,">$outfile");
    print IEXCP "$line";
    close(IEXCP);

#****now delete the original file from the input directory
    unlink("$getinfile");


    goto escape1;   #exit from the file reading loop and look for next
+ file

}



#********determine if IEA trailer exists and exception
if (index($line,"IEA") == -1)
{                    #if you are here,it has no IEA trailer
                    # not an EDI file
                    #write to the exception area and 
                    #delete from wxyzin dir
                    #*******************

    ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydat,$isdst)=localtime();

    $timestamp= $hour . $min .$sec . $mday . $mon . $year;
    open(LOGGER,">>$logfile");
    print LOGGER "$timestamp . $infile . -no IEA trailer found\n";
    close(LOGGER);
    
    $outfile=$excpdir . $infile;    
    open(IEXCP,">$outfile");
    print IEXCP "$line";
    close(IEXCP);

#****now delete the original file from the input directory
    unlink("$getinfile");

    goto escape1;   #exit from the file reading loop and look for next
+ file
}



$origline=$line ;  #***keep a copy of the original line, before LF rem
+oval
           #This string will be written to the wxyz Arcive, as is
#*********************************************************************
+********
#strip embedded LFs


$line=~ s/\x0a//;      #this replaces line feeds with nulls, in the wh
+ole
            #file 



#*** (STUBBED OUT FOR NOW now put the trailing LF back in
#$line=$line.\x0a;
# the file is now built to  spec  - January,2002
#**********************



#*********************************************************************
+*****
#In this next loop we will cycle through the file looking for the star
+t of
#ISA headers. Each header represents a transaction, possibly from a un
+ique
#sender. Each one is parsed out and the transaction is written with a 
+unique
#file name to the /wxyzprod/supplier/"unique" directory.


$ipos=0;            #set initial scanning point in $line, in the file


#***find next ISA - This is the start of the transaction loop, within 
+a file

while (index($line,"ISA",$ipos) > -1)        #if false we have process
+ed all transactions
                #in the file, so skip forward to next file
{
$ipos=index($line,"ISA",$ipos);  #Use this position to get next variab
+les.

#***sender is 35 after ISA



#***get sender

$sender=substr($line,$ipos+35,5);

#***get receiver

$receiver=substr($line,$ipos+54, 5);

#*** based on the $nameflag being r or s, use the receiver or sender a
+s the key
#***name to used to make target directories

if ($nameflag eq "r")
    {
     $fname=$receiver;
     }
elsif ($nameflag eq "s")
    {
    $fname=$sender;
    }

#***get date

$edidate=substr($line,$ipos+70, 6);

#***get time

$editime=substr($line,$ipos+77, 4);


#***now check for the IEA position, near the end of the transaction
$ieapos=index($line,"IEA",$ipos+80);      #always at least 80 chars aw
+ay
$transend=$ieapos+14;            #14 chars after the IEA it ends
$tlength=$transend-$ipos+1;        #get length of the transaction

#**** Now, get just this transaction as a substring from the $line str
+ing
$transaction=substr($line,$ipos,$tlength);



$ipos=$transend;              #set up for next ISA scan
                    #as the start point for the next
                    #transaction (if there is one)

#***the following file counter is used if there are  ambiguous file na
+mes
$fcounter=1;

$outfile="EDI_".$sender.$receiver.$edidate.$editime.$fcounter.".txt";

#***check for sender or receiver directory as selected by $nameflag

if (!opendir(DIR,$outdir.$fname)) 
{
    mkdir($outdir.$fname,0777);
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydat,$isdst)=localtime();
    
    $timestamp= $hour . $min .$sec . $mday . $mon . $year;
    open(LOGGER,">>$logfile");
    print LOGGER "$timestamp . $infile . new dir made for $fname\n";
    close(LOGGER);
}    
close(DIR);

#***Check for unique file name and keep going until you get one

while (-e $outdir.$fname.$slash.$outfile)
{
    $fcounter=$fcounter+1;
    $outfile="EDI_".$sender.$receiver.$edidate.$editime.$fcounter.".tx
+t";
}

#***ok, there is now a unique file name
#***write new file to dir and filename, close it

$supname=$outdir . $fname . $slash . $outfile;


open (FOUT, ">$supname");
print FOUT "$transaction";
close(FOUT);



}    #******this is the end of the transaction loop, within a file


#********************************************************************
#so now we write the original data to the archive and make a note
#in the log file


#**write create date/time, process date/time, file size and trans coun
+t to log
    
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydat,$isdst)=localtime();
    $timestamp= $hour . $min .$sec . $mday . $mon . $year;
    open(LOGGER,">>$logfile");
    $flen=length($origline);
$outbuf=$timestamp ." " . $infile ." sender ".$sender." Receiver ".$re
+ceiver
    ." length ". $flen;
    
    print LOGGER "$outbuf\n";
    close(LOGGER);
    
#***write the original file into the archives, with original file name

$archname=$archive . $infile;
    open(ARCH, ">$archname");
    print ARCH "$origline\n";
    close(ARCH);

#****now delete the original file from the /wxyzprod/wxyzin directory


    unlink("$getinfile");
    
    
escape1:    #if file name is . or .. we got here and bypassed processs
+ing

}
    #***** This is the end of the file processing loop, all files
    #in the wxyzprod/wxyzin directory have been read and processed at 
+this 
    #point - so go back and sleep for a few seconds, then look for fil
+es
    #again


#*****back to the top
    
goto A;

#*********************************************************************
+*******
#This is the end of the wxyzprod perl script
#*********************************************************************
+******

#The Deadman process - stubbed out for now

#Every 20 seconds the wxyzprod sets a variable to 1
#Deadman runs every two minutes and sets it to zero
#If deadman detects two zeros in a row, send e-mail and log file it
[download]