Thanks travs69!! Here is the code that I have working so far. The problem that I'm running into is it seems that the subroutines run into one another. When a "die" is issues from a failed database connection, the "warn" subroutine is executed as well as the die subroutine. How do you prevent fall through in code?
-Chris
use DBI qw( :sql_types );
use Getopt::Std;
use Net::FTP;
use MIME::Lite;
$SIG{__WARN__} = 'WARN_handler';
$SIG{__DIE__} = 'DIE_handler';
my $errlog = scalar ( @ARGV ) < 1 ? "C:\outmsg.txt" : "$ARGV[0]";
open( ERRLOG, ">>$errlog" );
my $DSN = q/dbi:ODBC
RIVER={SQL Server};Server=XXXXX;attr=database=EDIDB/;
my $username = "XXXXX";
my $passwrd = "XXXXX";
my $dbh = DBI->connect($DSN, $username, $passwrd) or die "$DBI::errstr\n";
#my $outfile = scalar ( @ARGV ) < 1 ? "C:\outmsg.txt" : "$ARGV[0]";
my $outfile = "";
my %opts = ();
my @one_line = ();
my @output = ();
my $receiver = "";
my $docs = 0;
my $cntlno = 0;
my $TP = "";
my $set = "";
my $ip = "";
my $user = "";
my $pass = "";
my $shipline = "";
my $chng_dir = "";
my $mode = 0;
my $putfile = "";
my $dirname = 'c:\EDI\outbound\ftp';
my $file = "";
my $timestamp = "";
my $good_read = "N";
my $counter = 0;
my $subject = "";
my $sec = 0;
my $min = 0;
my $hour = 0;
my $day = 0;
my $month = 0;
my $year = 0;
my $command = "";
my $sth = $dbh->prepare( "
SELECT server_ip, username, password, documents_sent, shipline, chng_dir, trans_mode, log_file
FROM db
utbound_FTP
WHERE FTP_key = ?
" );
my $sth_upd = $dbh->prepare( "
UPDATE db
utbound_FTP
SET documents_sent = ?,
last_sent = ?
WHERE FTP_key = ?
" );
opendir( DIR, $dirname );
#open( RESULTS, ">>$outfile" );
#print RESULTS ("\n");
#print RESULTS ("\n");
#print RESULTS scalar localtime();
#print RESULTS ("\n");
$/ = "~";
print STDOUT "Going to start the OUTER loop\n";
OUTER: while( defined( $file = readdir( DIR ))) {
next OUTER if(( $file eq "." ) || ( $file eq ".." ));
# print ERRLOG ("The file found is : $file\n");
$good_read = "N";
$command = "";
sleep 1;
print STDOUT "Going to start the INNER loop with file : $file\n";
open( IN, "$dirname/$file" ) or warn "can't open $file : $!";
INNER: while( <IN> ) {
chomp;
@one_line = ();
@one_line = split /\*/;
$_ = $one_line[0];
$_ =~ s/\s+$//;
next INNER if(( $one_line[0] !~ /GS/ ) && ( $one_line[0] !~ /ST/ ));
SWITCH: {
/GS/ && do {
$receiver = $one_line[3];
$receiver =~ s/^\s+$//;
$receiver =~ s/\s+$//;
$ip = "";
$pass = "";
$set = "";
$ftp_key = "";
$user = "";
$docs = 0;
last SWITCH;
};
/ST/ && do {
$set = $one_line[1];
$set =~ s/^\s+$//;
$set =~ s/\s$//;
$FTP_key = $receiver . $set;
print RESULTS ("FTP Key: $FTP_key\n");
$sth->bind_param( 1, $FTP_key );
$sth->execute();
( $ip, $user, $pass, $docs, $shipline, $chng_dir, $mode, $outfile )= $sth->fetchrow_array;
open( RESULTS, ">>$outfile" );
print RESULTS ("\n");
print RESULTS ("\n");
print RESULTS scalar localtime();
print RESULTS ("\n");
print RESULTS ("The file found is : $file\n");
print RESULTS ("IP Address is :$ip\n");
print RESULTS ("User ID is :$user\n");
print RESULTS ("Doc Type is :$set\n");
print RESULTS ("Shipline is :$shipline\n");
&datetime;
$ftp = Net::FTP->new( $ip, Debug => 0 )
or warn "Cannot connect to $ip :$@";
eval($command);
print STDOUT "eval after connection : $command\n";
$ftp->login( $user, $pass )
or warn "Cannot login ", $ftp->message;
eval($command);
print STDOUT "eval after login : $command\n";
if ($mode eq 1)
{
$ftp->binary;
}
elsif ($mode eq 2)
{
$ftp->ascii;
}
$putfile = $shipline . $set . '-' . $month . $day . $year . $hour . $min . $sec . '.EDI';
$putfile = "A".$day.$hour.$min.$sec if ($shipline =~ /NYKS/);
if ( $chng_dir )
{
$ftp->cwd($chng_dir) or warn "Cannot change directories ", $ftp->message;
}
$ftp->put( "$dirname/$file", $putfile );
print RESULTS "File sent : $putfile\n";
$ftp->binary;
@output = $ftp->dir;
$ftp->quit;
close( IN );
$docs++;
$good_read = "Y";
last SWITCH;
};
}; # switch
}
if ( $good_read =~ /Y/ )
{
print STDOUT "Going through first IF \n";
&datetime;
$timestamp = $year . $month . $day . " " . $hour . ":" . $min . ":00";
$sth_upd->bind_param( 1, $set );
$sth_upd->bind_param( 2, $timestamp, SQL_VARCHAR );
$sth_upd->bind_param( 3, $FTP_key );
$sth_upd->execute();
close( IN );
my $file = "$dirname/$file";
unlink( $file );
$counter = 0;
}
elsif ( $good_read =~ /N/ && $counter eq 0 )
{
print STDOUT "Going through first ELSE \n";
$/ = "\n";
$counter++;
close( IN );
redo OUTER;
}
else
{
print STDOUT "Going through second ELSE \n";
print STDOUT "Good Read Flag : $good_read\n";
print STDOUT "Counter Value : $counter\n";
warn "Cannot process file $dirname/$file" if ( $counter > 0 );
$counter = 0;
}
}
closedir( DIR );
undef $sth;
undef $sth_upd;
print STDOUT "Going to disconnect from the database\n";
$dbh->disconnect
or warn "Disconnection failed: $DBI::errstr\n";
foreach( @output ) {
print RESULTS "$_\n";
}
print RESULTS "Finished!";
close ( RESULTS );
close ( ERRLOG );
exit 0;
sub datetime
{
( $sec, $min, $hour, $day, $month, $year ) = ( localtime )[ 0 .. 5 ];
$month++;
$year += 1900;
$sec = "0" . $sec if( $sec < 10 );
$min = "0" . $min if( $min < 10 );
$hour = "0" . $hour if( $hour < 10 );
$day = "0" . $day if( $day < 10 );
$month = "0" . $month if( $month < 10 );
};
sub WARN_handler
{
my($signal) = @_;
warnToLogfile("WARN: $signal");
};
sub DIE_handler
{
my($signal) = @_;
sendToLogfile("DIE: $signal");
};
sub emailnotify
{
MIME::Lite->send('smtp', "XXXXX", timeout=>60);
$msg = MIME::Lite->new(
From =>'XXXXX',
# To =>'XXXXX',
To =>'XXXXX',
Subject =>$subject,
Data => "Please check the ftp logs and errlog for additional information"
);
$msg->send;
};
sub warnToLogfile
{
print STDOUT "Inside WARN subroutine\n";
my(@array) = @_;
print RESULTS (@array);
print ERRLOG ("\n");
print ERRLOG scalar localtime();
print ERRLOG (@array);
close( IN );
$subject = "Error occured during FTP Outbound Processing";
# &emailnotify;
&datetime;
print STDOUT "Going to rename the file : $file\n";
my $oldfile = "$dirname"."\\"."$file";
my $newfile = "$dirname"."\\"."send_failed"."_".$day.$hour.$min.$sec;
rename( $oldfile, "$newfile" ) or warn "Cound not rename file $!\n";
print STDOUT "Going to close the file in WARN subroutine\n";
$command = "next OUTER;";
$/ = "~";
$counter = 0;
};
sub sendToLogfile
{
my(@array) = @_;
print ERRLOG ("\n");
print ERRLOG scalar localtime();
print ERRLOG (@array);
$subject = "Problem encountered with database connection";
# &emailnotify;
close ( ERRLOG );
};
![[wiggle]](/data/assets/smilies/wiggle.gif "[wiggle] [wiggle]")
![[noevil]](/data/assets/smilies/noevil.gif "[noevil] [noevil]")
erlDesignPatterns)[/small]