Read file and change delimiter 2

[campbellc]

I have an FTP Perl program that reads a records in a file to determine who to FTP the data file to. The problem is that not all the files are formatted the same. In one file the record can be terminated with CR/LF. So when you look at it in Notepad you have one records per line. I also could get a file that terminates the records with a tilda "~" so the data just wraps around when looking at it in Notepad. In the later case I set $/ = "~";

In my read I'm looking for a specific value. If I don't find that value I assume the $/ is set to the wrong delimiter. Is there a way to change the $/ and re-read the file from the top? Any way to set multiple delimiters?

 

[KevinADC]

maybe something like:

$/ = ($input =~ /~/) ? '~' : $?;

------------------------------------------
- Kevin, perl coder unexceptional!

 

[MillerH]

There is no magic bullet for this type of problem. You'll just have to loop through each of the different delimiters and apply logic that you devise to determine what the proper delimiter is. Here is one method that accepts a filename as a parameter, and simply uses the delimiter that provides the most records.

[url=http://perldoc.perl.org/functions/use.html][black][b]use[/b][/black][/url] [green]List::Util[/green] [red]qw([/red][purple]reduce[/purple][red])[/red][red];[/red]

[black][b]use[/b][/black] [green]strict[/green][red];[/red]

[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [blue]$file[/blue] = [url=http://perldoc.perl.org/functions/shift.html][black][b]shift[/b][/black][/url][red];[/red]

[gray][i]# Slurp File Contents[/i][/gray]
[url=http://perldoc.perl.org/functions/open.html][black][b]open[/b][/black][/url][red]([/red]FILE, [blue]$file[/blue][red])[/red] or [url=http://perldoc.perl.org/functions/die.html][black][b]die[/b][/black][/url] [red]"[/red][purple]Can't open [blue]$file[/blue]: [blue]$![/blue][/purple][red]"[/red][red];[/red]
[black][b]my[/b][/black] [blue]$data[/blue] = [url=http://perldoc.perl.org/functions/do.html][black][b]do[/b][/black][/url] [red]{[/red][url=http://perldoc.perl.org/functions/local.html][black][b]local[/b][/black][/url] [blue]$/[/blue][red];[/red] <FILE>[red]}[/red][red];[/red]
[url=http://perldoc.perl.org/functions/close.html][black][b]close[/b][/black][/url][red]([/red]FILE[red])[/red][red];[/red]

[gray][i]# List of Potential Delimiters[/i][/gray]
[black][b]my[/b][/black] [blue]@delimiters[/blue] = [red]([/red][red]"[/red][purple]~[/purple][red]"[/red], [red]"[/red][purple][purple][b]\r[/b][/purple][purple][b]\n[/b][/purple][/purple][red]"[/red], [red]"[/red][purple][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red][red];[/red]

[gray][i]# Data array by record (best match used)[/i][/gray]
[black][b]my[/b][/black] [blue]@data[/blue] = [url=http://perldoc.perl.org/functions/map.html][black][b]map[/b][/black][/url] [red]{[/red][blue]@$_[/blue][red]}[/red] reduce [red]{[/red][blue]@$a[/blue] >= [blue]@$b[/blue] ? [blue]$a[/blue] : [blue]$b[/blue][red]}[/red] [black][b]map[/b][/black] [red]{[/red][red][[/red][url=http://perldoc.perl.org/functions/split.html][black][b]split[/b][/black][/url] [red]/[/red][purple][blue]$_[/blue][/purple][red]/[/red], [blue]$data[/blue][red]][/red][red]}[/red] [blue]@delimiters[/blue][red];[/red]

[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [url=http://perldoc.perl.org/functions/join.html][black][b]join[/b][/black][/url] [red]"[/red][purple][purple][b]\n[/b][/purple][/purple][red]"[/red], [blue]@data[/blue][red];[/red]

[fuchsia]1[/fuchsia][red];[/red]

[teal]__END__[/teal]

[tt]------------------------------------------------------------
Pragmas (perl 5.8.8) used :
[ul]
[li]strict - Perl pragma to restrict unsafe constructs[/li]
[/ul]
Core (perl 5.8.8) Modules used :
[ul]
[li]List::Util - A selection of general-utility list subroutines[/li]
[/ul]
[/tt]

- Miller

 

[KevinADC]

My code has a typo in it:

$/ = ($input =~ /~/) ? '~' : $?;

should be:

$/ = ($input =~ /~/) ? '~' : $/;



------------------------------------------
- Kevin, perl coder unexceptional!

 

[campbellc]

Thanks for all your help. I have to say this is the first support forum that someone actually replied to a question. I've posted to others and they are dead!!!

Because of the looping structure I placed a "redo <loop tag>" along with a counter so I don't get caught in an endless loop as well as changing the delimiter value ($/).

Any comments on this approach? I'm still very new to Perl.

Thanks again for your posts!!!

-Chris

 

[travs69]

If it works I say Good for you!! If you want to post your code I'm sure a few people will look it over or even run it if your having problems.

And yeah.. this is a really good forum.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Travis - Those Who Say It Cannot Be Done Are Usually Interrupted by Someone Else Doing It; Give the wrong symptoms, get the wrong solutions;

 

[campbellc]

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:ODBCRIVER={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 dbutbound_FTP
WHERE FTP_key = ?
" );
my $sth_upd = $dbh->prepare( "
UPDATE dbutbound_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 );
};

 

[MillerH]

I sometimes dislike seeing other people's code. It calls out to me to refactor. Oh, the inefficiencies!

Anyway, I'll sate my obviously problem by pointing out only two things.

1) The second line here is probably malformed. You probably don't want the anchor for end of string.

[blue]$receiver[/blue] = [blue]$one_line[/blue][red][[/red][fuchsia]3[/fuchsia][red]][/red][red];[/red]
[blue]$receiver[/blue] =~ [red]s/[/red][purple]^[purple][b]\s[/b][/purple]+$[/purple][red]/[/red][purple][/purple][red]/[/red][red];[/red]
[blue]$receiver[/blue] =~ [red]s/[/red][purple][purple][b]\s[/b][/purple]+$[/purple][red]/[/red][purple][/purple][red]/[/red][red];[/red]

Also, You could simplify the assignment with either of hte following.

[red]([/red][blue]$receiver[/blue][red])[/red] = [blue]$one_line[/blue][red][[/red][fuchsia]3[/fuchsia][red]][/red] =~ [red]/[/red][purple]^[purple][b]\s[/b][/purple]*(.*?)[purple][b]\s[/b][/purple]*$[/purple][red]/[/red][red];[/red]
[red]([/red][blue]$receiver[/blue] = [blue]$one_line[/blue][red][[/red][fuchsia]3[/fuchsia][red]][/red][red])[/red] =~ [red]s/[/red][purple]^[purple][b]\s[/b][/purple]+|[purple][b]\s[/b][/purple]+$[/purple][red]/[/red][purple][/purple][red]/[/red][red]g[/red][red];[/red]

Although obviously "simplify" is qualitative.

2) Left padding numbers. Observe the following:

[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [blue]$sec[/blue] = [fuchsia]3[/fuchsia][red];[/red]
[blue]$sec[/blue] = [url=http://perldoc.perl.org/functions/sprintf.html][black][b]sprintf[/b][/black][/url] [red]"[/red][purple]%02d[/purple][red]"[/red], [blue]$sec[/blue][red];[/red]
[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [red]"[/red][purple][blue]$sec[/blue][/purple][red]"[/red][red];[/red]  [gray][i]# Outputs 03[/i][/gray]

This could simplify your datetime function on line 206 to the following

[url=http://perldoc.perl.org/functions/sub.html][black][b]sub[/b][/black][/url] [maroon]datetime[/maroon] [red]{[/red]
	[red]([/red][blue]$sec[/blue], [blue]$min[/blue], [blue]$hour[/blue], [blue]$day[/blue], [blue]$month[/blue], [blue]$year[/blue][red])[/red] = [url=http://perldoc.perl.org/functions/localtime.html][black][b]localtime[/b][/black][/url][red];[/red]
	[blue]$month[/blue]++[red];[/red]
	[blue]$year[/blue]  += [fuchsia]1900[/fuchsia][red];[/red]
	[blue]$_[/blue] = [url=http://perldoc.perl.org/functions/sprintf.html][black][b]sprintf[/b][/black][/url][red]([/red][red]"[/red][purple]%02d[/purple][red]"[/red], [blue]$_[/blue][red])[/red] [olive][b]for[/b][/olive] [red]([/red][blue]$sec[/blue], [blue]$min[/blue], [blue]$hour[/blue], [blue]$day[/blue], [blue]$month[/blue][red])[/red][red];[/red]
[red]}[/red]

3) Semicolon after sub block.

You included a semicolon after ever sub definition. These are entirely unnecessary.

4) Datetime formatting using POSIX qw(strftime);

Observe the following changes.

[url=http://perldoc.perl.org/functions/use.html][black][b]use[/b][/black][/url] [green]POSIX[/green] [red]qw([/red][purple]strftime[/purple][red])[/red][red];[/red]

[gray][i]# Line 138[/i][/gray]
[blue]$putfile[/blue] = [blue]$shipline[/blue] . [blue]$set[/blue] . [red]'[/red][purple]-[/purple][red]'[/red] . [blue]$month[/blue] . [blue]$day[/blue] . [blue]$year[/blue] . [blue]$hour[/blue] . [blue]$min[/blue] . [blue]$sec[/blue] . [red]'[/red][purple].EDI[/purple][red]'[/red][red];[/red]
[blue]$putfile[/blue] = [blue]$shipline[/blue] . [blue]$set[/blue] . [red]'[/red][purple]-[/purple][red]'[/red] . [maroon]strftime[/maroon][red]([/red][red]"[/red][purple]%m%d%Y%H%M%S[/purple][red]"[/red], [url=http://perldoc.perl.org/functions/localtime.html][black][b]localtime[/b][/black][/url][red])[/red] . [red]'[/red][purple].EDI[/purple][red]'[/red][red];[/red]

[gray][i]# Line 139[/i][/gray]
[blue]$putfile[/blue] = [red]"[/red][purple]A[/purple][red]"[/red].[blue]$day[/blue].[blue]$hour[/blue].[blue]$min[/blue].[blue]$sec[/blue] [olive][b]if[/b][/olive] [red]([/red][blue]$shipline[/blue] =~ [red]/[/red][purple]NYKS[/purple][red]/[/red][red])[/red][red];[/red]
[blue]$putfile[/blue] = [red]"[/red][purple]A[/purple][red]"[/red].[maroon]strftime[/maroon][red]([/red][red]"[/red][purple]%d%H%M%S[/purple][red]"[/red], [black][b]localtime[/b][/black][red])[/red] [olive][b]if[/b][/olive] [red]([/red][blue]$shipline[/blue] =~ [red]/[/red][purple]NYKS[/purple][red]/[/red][red])[/red][red];[/red]

[gray][i]# Line 160[/i][/gray]
[blue]$timestamp[/blue] = [blue]$year[/blue] . [blue]$month[/blue] . [blue]$day[/blue] . [red]"[/red][purple] [/purple][red]"[/red] . [blue]$hour[/blue] . [red]"[/red][purple]:[/purple][red]"[/red] . [blue]$min[/blue] . [red]"[/red][purple]:00[/purple][red]"[/red][red];[/red]
[blue]$timestamp[/blue] = [maroon]strftime[/maroon][red]([/red][red]"[/red][purple]%Y%m%d %H:%M:00[/purple][red]"[/red], [black][b]localtime[/b][/black][red])[/red][red];[/red]

[gray][i]# Line 257[/i][/gray]
[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [blue]$newfile[/blue] = [red]"[/red][purple][blue]$dirname[/blue][/purple][red]"[/red].[red]"[/red][purple][purple][b]\\[/b][/purple][/purple][red]"[/red].[red]"[/red][purple]send_failed[/purple][red]"[/red].[red]"[/red][purple]_[/purple][red]"[/red].[blue]$day[/blue].[blue]$hour[/blue].[blue]$min[/blue].[blue]$sec[/blue][red];[/red]
[black][b]my[/b][/black] [blue]$newfile[/blue] = [red]"[/red][purple][blue]$dirname[/blue][/purple][red]"[/red].[red]"[/red][purple][purple][b]\\[/b][/purple][/purple][red]"[/red].[red]"[/red][purple]send_failed[/purple][red]"[/red].[red]"[/red][purple]_[/purple][red]"[/red].[maroon]strftime[/maroon][red]([/red][red]"[/red][purple]%d%H%M%S[/purple][red]"[/red], [black][b]localtime[/b][/black][red])[/red][red];[/red]

[tt]------------------------------------------------------------
Core (perl 5.8.8) Modules used :
[ul]
[li]POSIX - Perl interface to IEEE Std 1003.1[/li]
[/ul]
[/tt]

Anyway, obviously that was 4 changes instead of just 2. But I couldn't help myself. It's obviously that you're still learning, so you'll get better with time. Good Luck.

- Miller

 

[campbellc]

Thank you Miller for all your help. Yes, as you pointed out, I am very new. Started writing Perl about a month ago. Some of your terminology is foreign to me, but I will look it up and learn what it means. Which of your examples point to the prevention of fall through logic? My code is still executing both the “warn” subroutine as well as the “die” subroutine when the “die” signal is evocated.

-Chris

 

[KevinADC]

a simple way to avoid the fall through in this situation is to explicitly call the exit() function:

sub DIE_handler
{
    my($signal) = @_;
    sendToLogfile("DIE: $signal");
    [b]exit();[/b] 
};

------------------------------------------
- Kevin, perl coder unexceptional!

 

[KevinADC]

Another concern,

my $errlog   = scalar ( @ARGV ) < 1 ? [b]"C:[red]\o[/red]utmsg.txt"[/b] : "$ARGV[0]";

perl will interpret \o as an escape sequence because of the double-quotes and throw a warning message (Unrecognized escape \o blah blah blah) if you have warnings on, which you should. Since there is no variable or meta character interpolation needed, you should use single-quotes around the string.

Two rules of thumb:

never quote variables unless necessary.
never double-quote strings unless necessary.

You have a lot of double-quoted strings that would be better written using single-quotes. This seems minor but it's not. Using quotes improperly can hide errors in your code that even "strict" and "warnings" will not be able to find.





------------------------------------------
- Kevin, perl coder unexceptional!

 

[MillerH]

This is a good point. Note that perl handles file and directory processing just file if you use a forward slash instead of a back slash, so it's a good idea to just stick with the forward slash even on windows systems.

[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [blue]$errlog[/blue] = [blue]@ARGV[/blue] ? [blue]$ARGV[/blue][red][[/red][fuchsia]0[/fuchsia][red]][/red] : [red]'[/red][purple]C:/outmsg.txt[/purple][red]'[/red][red];[/red]

- Miller

 

[stevexff]

While we're in constructive criticism mode, I've got a problem with the number of variables with global scope. For example, in the datetime subroutine, you set a number of globally-scoped variables that get used all over the place.

This kind of approach can make it hard to debug your program, as calling a sub can have undesirable side-effects elsewhere in the program. Generally it's better form to return a value or array of values from a sub, and let the caller do what they want with them, e.g.

use strict;
use warnings;

print 'Hello, ', world(), "\n";

sub world {
   return 'World!';
}

of course, if you adopt Miller's suggestions about Posix, then all this goes away...

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[MillerH]

Ok. Every once in a blue moon, a programmer such as myself comes by some code that calls to him, "Refactor me! Refactor me!" As much as he might try to resist the urge, the voice persists.

Me: "But it's not my job!"
Voice: "You know it's going to continue bugging you..."
Me: "But I have a million other things to do!"
Voice: "It's only a short script..."
Me: "But I don't even know what it's supposed to do! The code is that badly designed!"
Voice: "Are you saying that you can't do it?...."
Me: "Stop taunting me!"
Voice: "Maybe only some small changes?..."
Me: "Hmm.... well, I have already done some work..."

15 minutes later

Me: "God that was exhausting... I give up"
Voice: "Me too"

24 hours later:

Voice: "You know that script is still sitting there ..."
Me: "Grrrr!"
Voice: "You've already done a little work..."
Me: "And my real work just called with a failed mysql server. I'm busy!"
Voice: "Maybe for your break..."
Me: "Grrrrrr!"

Ok, to say the least, the little voice won out. 9 days later, and more breaks than I care to admit, here is the refactored script. I still don't know what it's trying to do exactly without real data. However, I've fixed all the major deficiencies and probably fixed most of the bugs that campbell was having.

Campbell, you owe me.

[gray][i]# What does this script do?  Damned if I know.[/i][/gray]
[gray][i]# [URL unfurl="true"]http://www.tek-tips.com/viewthread.cfm?qid=1384456[/URL][/i][/gray]

[url=http://perldoc.perl.org/functions/use.html][black][b]use[/b][/black][/url] [green]DBI[/green] [red]qw([/red][purple] :sql_types [/purple][red])[/red][red];[/red]
[black][b]use[/b][/black] [green]English[/green] [red]qw([/red][purple]-no_match_vars[/purple][red])[/red][red];[/red]
[black][b]use[/b][/black] [green]File::Copy[/green] [red]qw([/red][purple]move[/purple][red])[/red][red];[/red]
[black][b]use[/b][/black] [green]Getopt::Std[/green][red];[/red]
[black][b]use[/b][/black] [green]Net::FTP[/green][red];[/red]
[black][b]use[/b][/black] [green]MIME::Lite[/green][red];[/red]
[black][b]use[/b][/black] [green]POSIX[/green] [red]qw([/red][purple]strftime[/purple][red])[/red][red];[/red]

[black][b]use[/b][/black] [green]strict[/green][red];[/red]
[black][b]use[/b][/black] [green]warnings[/green][red];[/red]

[blue]$SIG[/blue][red]{[/red][purple]__WARN__[/purple][red]}[/red] = [red]'[/red][purple]WARN_handler[/purple][red]'[/red][red];[/red]
[blue]$SIG[/blue][red]{[/red][purple]__DIE__[/purple][red]}[/red]  = [red]'[/red][purple]DIE_handler[/purple][red]'[/red][red];[/red]

[gray][i]# Constants[/i][/gray]
[black][b]use[/b][/black] [green]Readonly[/green][red];[/red]
Readonly [url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [blue]$DIR_NAME[/blue] => [red]'[/red][purple]c:/EDI/outbound/ftp[/purple][red]'[/red][red];[/red]
Readonly [black][b]my[/b][/black] [blue]$DB_HOST[/blue] => [red]"[/red][purple]XXXXX[/purple][red]"[/red][red];[/red]
Readonly [black][b]my[/b][/black] [blue]$DB_NAME[/blue] => [red]'[/red][purple]EDIDB[/purple][red]'[/red][red];[/red]
Readonly [black][b]my[/b][/black] [blue]$DB_USER[/blue] => [red]"[/red][purple]XXXXX[/purple][red]"[/red][red];[/red]
Readonly [black][b]my[/b][/black] [blue]$DB_PASS[/blue] => [red]"[/red][purple]XXXXX[/purple][red]"[/red][red];[/red]

[gray][i]# Set Parameters[/i][/gray]
[url=http://perldoc.perl.org/functions/our.html][black][b]our[/b][/black][/url] [blue]$errlog[/blue] = [blue]@ARGV[/blue] ? [blue]$ARGV[/blue][red][[/red][fuchsia]0[/fuchsia][red]][/red] : [red]'[/red][purple]C:/outmsg.txt[/purple][red]'[/red][red];[/red]

[gray][i]# Connect to Database[/i][/gray]
[black][b]our[/b][/black] [blue]$dbh[/blue] = DBI->[maroon]connect[/maroon][red]([/red][red]"[/red][purple]dbi:ODBC:DRIVER={SQL Server};Server=[blue]$DB_HOST[/blue];attr=database=[blue]$DB_NAME[/blue][/purple][red]"[/red], [blue]$DB_USER[/blue], [blue]$DB_PASS[/blue][red])[/red]
	or [url=http://perldoc.perl.org/functions/die.html][black][b]die[/b][/black][/url] [blue]$DBI::errstr[/blue][red];[/red]

[gray][i]# Cache Statement Handles upon need.[/i][/gray]
[black][b]my[/b][/black] [blue]$sth_select[/blue] = [red]'[/red][purple][/purple][red]'[/red][red];[/red]
[black][b]my[/b][/black] [blue]$sth_update[/blue] = [red]'[/red][purple][/purple][red]'[/red][red];[/red]

[url=http://perldoc.perl.org/functions/print.html][black][b]print[/b][/black][/url] [red]"[/red][purple]Going to start the FILE loop[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]

[url=http://perldoc.perl.org/functions/opendir.html][black][b]opendir[/b][/black][/url][red]([/red]DIR, [blue]$DIR_NAME[/blue][red])[/red] or [black][b]die[/b][/black] [red]"[/red][purple]Can't open [blue]$DIR_NAME[/blue]: [blue]$![/blue][/purple][red]"[/red][red];[/red]
[black][b]my[/b][/black] [blue]@files[/blue] = [url=http://perldoc.perl.org/functions/grep.html][black][b]grep[/b][/black][/url] [red]{[/red]! [red]/[/red][purple]^[purple][b]\.[/b][/purple][purple][b]\.[/b][/purple]?$[/purple][red]/[/red][red]}[/red] [url=http://perldoc.perl.org/functions/readdir.html][black][b]readdir[/b][/black][/url][red]([/red]DIR[red])[/red][red];[/red]
[url=http://perldoc.perl.org/functions/closedir.html][black][b]closedir[/b][/black][/url][red]([/red]DIR[red])[/red][red];[/red]

[black][b]my[/b][/black] [blue]$successfulParse[/blue][red];[/red]

[maroon]FILE[/maroon][maroon]:[/maroon]
[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$file[/blue] [red]([/red][blue]@files[/blue][red])[/red] [red]{[/red]
	[black][b]print[/b][/black] [red]"[/red][purple]Begin file processing : [blue]$file[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]

	[url=http://perldoc.perl.org/functions/sleep.html][black][b]sleep[/b][/black][/url] [fuchsia]1[/fuchsia][red];[/red] [gray][i]# Take a breather[/i][/gray]
	[blue]$successfulParse[/blue] = [fuchsia]0[/fuchsia][red];[/red]
	
	[maroon]PARSE_METHOD[/maroon][maroon]:[/maroon]
	[olive][b]foreach[/b][/olive] [black][b]my[/b][/black] [blue]$seperator[/blue] [red]([/red][red]"[/red][purple]~[/purple][red]"[/red], [red]"[/red][purple][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red] [red]{[/red]
		[url=http://perldoc.perl.org/functions/local.html][black][b]local[/b][/black][/url] [blue]$INPUT_RECORD_SEPARATOR[/blue] = [blue]$seperator[/blue][red];[/red]
		
		[black][b]my[/b][/black] [blue]$receiver[/blue] = [red]'[/red][purple][/purple][red]'[/red][red];[/red]
		
		[url=http://perldoc.perl.org/functions/open.html][black][b]open[/b][/black][/url] [black][b]my[/b][/black] [blue]$fh[/blue], [red]'[/red][purple]<[/purple][red]'[/red], [red]"[/red][purple][blue]$DIR_NAME[/blue]/[blue]$file[/blue][/purple][red]"[/red] or [url=http://perldoc.perl.org/functions/warn.html][black][b]warn[/b][/black][/url][red]([/red][red]"[/red][purple]can't open [blue]$file[/blue] : [blue]$![/blue][/purple][red]"[/red][red])[/red], [olive][b]next[/b][/olive] FILE[red];[/red]
		
		[maroon]LINE[/maroon][maroon]:[/maroon]
		[olive][b]while[/b][/olive] [red]([/red]<[blue]$fh[/blue]>[red])[/red] [red]{[/red]
			[url=http://perldoc.perl.org/functions/chomp.html][black][b]chomp[/b][/black][/url][red];[/red]
			[black][b]my[/b][/black] [blue]@fields[/blue] = [url=http://perldoc.perl.org/functions/split.html][black][b]split[/b][/black][/url] [red]/[/red][purple][purple][b]\*[/b][/purple][/purple][red]/[/red][red];[/red]
			
			[black][b]my[/b][/black] [blue]$type[/blue] = [maroon]trimspaces[/maroon][red]([/red][blue]$fields[/blue][red][[/red][fuchsia]0[/fuchsia][red]][/red][red])[/red][red];[/red]
			
			[olive][b]if[/b][/olive] [red]([/red][blue]$type[/blue] =~ [red]/[/red][purple]GS[/purple][red]/[/red][red])[/red] [red]{[/red]
				[blue]$receiver[/blue] = [maroon]trimspaces[/maroon][red]([/red][blue]$fields[/blue][red][[/red][fuchsia]3[/fuchsia][red]][/red][red])[/red][red];[/red]
				
			[red]}[/red] [olive][b]elsif[/b][/olive] [red]([/red][blue]$type[/blue] =~ [red]/[/red][purple]ST[/purple][red]/[/red][red])[/red] [red]{[/red]
				[black][b]my[/b][/black] [blue]$documents_sent[/blue] = [maroon]trimspaces[/maroon][red]([/red][blue]$fields[/blue][red][[/red][fuchsia]1[/fuchsia][red]][/red][red])[/red][red];[/red]
				
				[black][b]my[/b][/black] [blue]$FTP_key[/blue] = [blue]$receiver[/blue] . [blue]$documents_sent[/blue][red];[/red]

				[blue]$sth_select[/blue] ||= [blue]$dbh[/blue]->[maroon]prepare[/maroon][red]([/red][red]q{[/red][purple][/purple]
[purple]SELECT server_ip, username, password, documents_sent, shipline, chng_dir, trans_mode, log_file[/purple]
[purple]FROM dbo.Outbound_FTP[/purple]
[purple]WHERE FTP_key=?[/purple][red]}[/red][red])[/red][red];[/red]
				[blue]$sth_select[/blue]->[maroon]bind_param[/maroon][red]([/red] [fuchsia]1[/fuchsia], [blue]$FTP_key[/blue] [red])[/red][red];[/red]
				[blue]$sth_select[/blue]->[maroon]execute[/maroon] or [black][b]die[/b][/black] [blue]$dbh[/blue]->[maroon]errstr[/maroon][red];[/red]
				[black][b]my[/b][/black] [red]([/red][blue]$ip[/blue], [blue]$user[/blue], [blue]$pass[/blue], [blue]$docs[/blue], [blue]$shipline[/blue], [blue]$chng_dir[/blue], [blue]$mode[/blue], [blue]$outfile[/blue] [red])[/red] = [blue]$sth_select[/blue]->[maroon]fetchrow_array[/maroon][red];[/red]

				[black][b]open[/b][/black] [black][b]my[/b][/black] [blue]$fh_results[/blue], [red]'[/red][purple]>>[/purple][red]'[/red], [blue]$outfile[/blue] or [black][b]die[/b][/black] [red]"[/red][purple]Can't open [blue]$outfile[/blue]: [blue]$![/blue][/purple][red]"[/red][red];[/red]
				[black][b]print[/b][/black] [blue]$fh_results[/blue] [red]([/red][red]"[/red][purple]FTP Key: [blue]$FTP_key[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red][red];[/red]
				[black][b]print[/b][/black] [blue]$fh_results[/blue] [red]([/red][red]"[/red][purple][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red][red];[/red]
				[black][b]print[/b][/black] [blue]$fh_results[/blue] [red]([/red][red]"[/red][purple][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red][red];[/red]
				[black][b]print[/b][/black] [blue]$fh_results[/blue] [url=http://perldoc.perl.org/functions/scalar.html][black][b]scalar[/b][/black][/url] [url=http://perldoc.perl.org/functions/localtime.html][black][b]localtime[/b][/black][/url][red]([/red][red])[/red][red];[/red]
				[black][b]print[/b][/black] [blue]$fh_results[/blue] [red]([/red][red]"[/red][purple][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red][red];[/red]
				[black][b]print[/b][/black] [blue]$fh_results[/blue] [red]([/red][red]"[/red][purple]The file found is : [blue]$file[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red][red];[/red]
				[black][b]print[/b][/black] [blue]$fh_results[/blue] [red]([/red][red]"[/red][purple]IP Address is :[blue]$ip[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red][red];[/red]
				[black][b]print[/b][/black] [blue]$fh_results[/blue] [red]([/red][red]"[/red][purple]User ID is :[blue]$user[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red][red];[/red]
				[black][b]print[/b][/black] [blue]$fh_results[/blue] [red]([/red][red]"[/red][purple]Doc Type is :[blue]$documents_sent[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red][red];[/red]
				[black][b]print[/b][/black] [blue]$fh_results[/blue] [red]([/red][red]"[/red][purple]Shipline is :[blue]$shipline[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red][red];[/red]

				[black][b]my[/b][/black] [blue]$ftp[/blue] = Net::FTP->[maroon]new[/maroon][red]([/red] [blue]$ip[/blue], [purple]Debug[/purple] => [fuchsia]0[/fuchsia] [red])[/red]
					or [black][b]warn[/b][/black][red]([/red][red]"[/red][purple]Cannot connect to [blue]$ip[/blue] :[blue]$@[/blue][/purple][red]"[/red][red])[/red], [olive][b]next[/b][/olive] FILE[red];[/red]

				[blue]$ftp[/blue]->[maroon]login[/maroon][red]([/red] [blue]$user[/blue], [blue]$pass[/blue] [red])[/red]
					or [black][b]warn[/b][/black][red]([/red][red]"[/red][purple]Cannot login [/purple][red]"[/red] . [blue]$ftp[/blue]->[maroon]message[/maroon][red])[/red], [olive][b]next[/b][/olive] FILE[red];[/red]

				[olive][b]if[/b][/olive] [red]([/red] [blue]$chng_dir[/blue] [red])[/red] [red]{[/red]
					[blue]$ftp[/blue]->[maroon]cwd[/maroon][red]([/red][blue]$chng_dir[/blue][red])[/red] or [black][b]warn[/b][/black][red]([/red][red]"[/red][purple]Cannot change directories [/purple][red]"[/red] . [blue]$ftp[/blue]->[maroon]message[/maroon][red])[/red], [olive][b]next[/b][/olive] FILE[red];[/red]
				[red]}[/red]

				[olive][b]if[/b][/olive] [red]([/red][blue]$mode[/blue] eq [fuchsia]1[/fuchsia][red])[/red] [red]{[/red]
					[blue]$ftp[/blue]->[maroon]binary[/maroon][red];[/red]
				[red]}[/red] [olive][b]elsif[/b][/olive] [red]([/red][blue]$mode[/blue] eq [fuchsia]2[/fuchsia][red])[/red] [red]{[/red]
					[blue]$ftp[/blue]->[maroon]ascii[/maroon][red];[/red]
				[red]}[/red]
				
				[black][b]my[/b][/black] [blue]$putfile[/blue] = [blue]$shipline[/blue] =~ [red]/[/red][purple]NYKS[/purple][red]/[/red]
					? [red]"[/red][purple]A[/purple][red]"[/red].[maroon]strftime[/maroon][red]([/red][red]"[/red][purple]%d%H%M%S[/purple][red]"[/red], [black][b]localtime[/b][/black][red])[/red]
					: [blue]$shipline[/blue] . [blue]$documents_sent[/blue] . [red]'[/red][purple]-[/purple][red]'[/red] . [maroon]strftime[/maroon][red]([/red][red]"[/red][purple]%m%d%Y%H%M%S[/purple][red]"[/red], [black][b]localtime[/b][/black][red])[/red] . [red]'[/red][purple].EDI[/purple][red]'[/red][red];[/red]

				[blue]$ftp[/blue]->[maroon]put[/maroon][red]([/red] [red]"[/red][purple][blue]$DIR_NAME[/blue]/[blue]$file[/blue][/purple][red]"[/red], [blue]$putfile[/blue] [red])[/red]
					or [black][b]warn[/b][/black][red]([/red][red]"[/red][purple]Cannot put file [/purple][red]"[/red] . [blue]$ftp[/blue]->[maroon]message[/maroon][red])[/red], [olive][b]next[/b][/olive] FILE[red];[/red]
				
				[black][b]print[/b][/black] [blue]$fh_results[/blue] [red]"[/red][purple]File sent : [blue]$putfile[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]

				[blue]$ftp[/blue]->[maroon]quit[/maroon][red];[/red]

				[black][b]my[/b][/black] [blue]$last_sent[/blue] = [maroon]strftime[/maroon][red]([/red][red]"[/red][purple]%Y%m%d %H:%M:00[/purple][red]"[/red], [black][b]localtime[/b][/black][red])[/red][red];[/red]
				[blue]$sth_update[/blue] ||= [blue]$dbh[/blue]->[maroon]prepare[/maroon][red]([/red][red]q{[/red][purple]UPDATE dbo.Outbound_FTP SET documents_sent=?, last_sent=? WHERE FTP_key=?[/purple][red]}[/red][red])[/red][red];[/red]
				[blue]$sth_update[/blue]->[maroon]bind_param[/maroon][red]([/red] [fuchsia]1[/fuchsia], [blue]$documents_sent[/blue] [red])[/red][red];[/red]
				[blue]$sth_update[/blue]->[maroon]bind_param[/maroon][red]([/red] [fuchsia]2[/fuchsia], [blue]$last_sent[/blue], SQL_VARCHAR [red])[/red][red];[/red]
				[blue]$sth_update[/blue]->[maroon]bind_param[/maroon][red]([/red] [fuchsia]3[/fuchsia], [blue]$FTP_key[/blue] [red])[/red][red];[/red]
				[blue]$sth_update[/blue]->[maroon]execute[/maroon] or [black][b]die[/b][/black] [blue]$dbh[/blue]->[maroon]errstr[/maroon][red];[/red]

				[blue]$successfulParse[/blue] = [fuchsia]1[/fuchsia][red];[/red]

				[gray][i]# Do you want to end now?  IF SO, do the following[/i][/gray]
				[gray][i]# next FILE;[/i][/gray]
			[red]}[/red]
		[red]}[/red] [gray][i]# END LINE[/i][/gray]
	[red]}[/red] [gray][i]# END PROCESS_METHOD[/i][/gray]

[gray][i]# Processing before next FILE[/i][/gray]
[red]}[/red] [url=http://perldoc.perl.org/functions/continue.html][black][b]continue[/b][/black][/url] [red]{[/red]
	
	[olive][b]if[/b][/olive] [red]([/red][blue]$successfulParse[/blue][red])[/red] [red]{[/red]
		[black][b]print[/b][/black] [red]"[/red][purple]File '[blue]$file[/blue]' succeeded[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
		[url=http://perldoc.perl.org/functions/unlink.html][black][b]unlink[/b][/black][/url][red]([/red][red]"[/red][purple][blue]$DIR_NAME[/blue]/[blue]$file[/blue][/purple][red]"[/red][red])[/red] or [black][b]die[/b][/black] [red]"[/red][purple]Can't unlink [blue]$file[/blue]: [blue]$![/blue][/purple][red]"[/red][red];[/red]
		
	[red]}[/red] [olive][b]else[/b][/olive] [red]{[/red]
		[black][b]print[/b][/black] [red]"[/red][purple]File '[blue]$file[/blue]' failed: Going to move[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]
		[black][b]my[/b][/black] [blue]$oldfile[/blue] = [red]"[/red][purple][blue]$DIR_NAME[/blue][/purple][red]"[/red].[red]"[/red][purple]/[/purple][red]"[/red].[red]"[/red][purple][blue]$file[/blue][/purple][red]"[/red][red];[/red]
		[black][b]my[/b][/black] [blue]$newfile[/blue] = [red]"[/red][purple][blue]$DIR_NAME[/blue][/purple][red]"[/red].[red]"[/red][purple]/[/purple][red]"[/red].[red]"[/red][purple]send_failed[/purple][red]"[/red].[red]"[/red][purple]_[/purple][red]"[/red].[maroon]strftime[/maroon][red]([/red][red]"[/red][purple]%d%H%M%S[/purple][red]"[/red], [black][b]localtime[/b][/black][red])[/red][red];[/red]
		[maroon]move[/maroon][red]([/red][blue]$oldfile[/blue], [blue]$newfile[/blue][red])[/red] or [black][b]warn[/b][/black] [red]"[/red][purple]Can't move: [blue]$![/blue][/purple][red]"[/red][red];[/red]
	[red]}[/red]
	
[red]}[/red] [gray][i]# END FILE[/i][/gray]

[url=http://perldoc.perl.org/functions/undef.html][black][b]undef[/b][/black][/url] [blue]$sth_select[/blue][red];[/red]
[black][b]undef[/b][/black] [blue]$sth_update[/blue][red];[/red]

[black][b]print[/b][/black] [red]"[/red][purple]Going to disconnect from the database[purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]

[blue]$dbh[/blue]->[maroon]disconnect[/maroon] or [black][b]die[/b][/black] [red]"[/red][purple]Disconnection failed: [blue]$DBI::errstr[/blue][purple][b]\n[/b][/purple][/purple][red]"[/red][red];[/red]

[url=http://perldoc.perl.org/functions/exit.html][black][b]exit[/b][/black][/url] [fuchsia]0[/fuchsia][red];[/red] [gray][i]# It's over!  Jump for joy![/i][/gray]

[gray][i]####################################################################[/i][/gray]
[gray][i]# Supporting Functions[/i][/gray]

[url=http://perldoc.perl.org/functions/sub.html][black][b]sub[/b][/black][/url] [maroon]trimspaces[/maroon] [red]{[/red]
	[black][b]my[/b][/black] [blue]$string[/blue] = [url=http://perldoc.perl.org/functions/shift.html][black][b]shift[/b][/black][/url][red];[/red]
	[blue]$string[/blue] =~ [red]s{[/red][purple]^[purple][b]\s[/b][/purple]+|[purple][b]\s[/b][/purple]+$[/purple][red]}[/red][red]{[/red][purple][/purple][red]}[/red][red]g[/red][red];[/red]
	[url=http://perldoc.perl.org/functions/return.html][black][b]return[/b][/black][/url] [blue]$string[/blue][red];[/red]
[red]}[/red]


[black][b]sub[/b][/black] [maroon]WARN_handler[/maroon] [red]{[/red]
	[black][b]my[/b][/black] [blue]$signal[/blue] = [black][b]shift[/b][/black][red];[/red]
	[maroon]logError[/maroon][red]([/red][red]"[/red][purple]WARN: [blue]$signal[/blue][/purple][red]"[/red][red])[/red][red];[/red]
[gray][i]#	emailnotify("$0 Warning: $signal");[/i][/gray]
[red]}[/red]

[black][b]sub[/b][/black] [maroon]DIE_handler[/maroon] [red]{[/red]
	[black][b]my[/b][/black] [blue]$signal[/blue] = [black][b]shift[/b][/black][red];[/red]
	[maroon]logError[/maroon][red]([/red][red]"[/red][purple]DIE: [blue]$signal[/blue][/purple][red]"[/red][red])[/red][red];[/red]
	[gray][i]# emailnotify("$0 DIE: $signal");[/i][/gray]
[red]}[/red]

[black][b]sub[/b][/black] [maroon]logError[/maroon] [red]{[/red]
	[black][b]open[/b][/black][red]([/red]ERRLOG, [red]"[/red][purple]>>[blue]$errlog[/blue][/purple][red]"[/red][red])[/red] or [black][b]die[/b][/black] [red]"[/red][purple]Can't open [blue]$errlog[/blue]: [blue]$![/blue][/purple][red]"[/red][red];[/red]
	[black][b]print[/b][/black] [maroon]ERRLOG[/maroon] [red]([/red][red]"[/red][purple][purple][b]\n[/b][/purple][/purple][red]"[/red][red])[/red][red];[/red]
	[black][b]print[/b][/black] ERRLOG [black][b]scalar[/b][/black] [black][b]localtime[/b][/black][red]([/red][red])[/red][red];[/red]
	[black][b]print[/b][/black] ERRLOG [blue]@_[/blue][red];[/red]
	[url=http://perldoc.perl.org/functions/close.html][black][b]close[/b][/black][/url][red]([/red]ERRLOG[red])[/red][red];[/red]
[red]}[/red]
	
[black][b]sub[/b][/black] [maroon]emailnotify[/maroon] [red]{[/red]
	[black][b]my[/b][/black] [blue]$subject[/blue] = [black][b]shift[/b][/black][red];[/red]
	
	[black][b]my[/b][/black] [blue]$msg[/blue] = MIME::Lite->[maroon]new[/maroon][red]([/red]
		[purple]From[/purple]		=> [red]'[/red][purple]XXXXX[/purple][red]'[/red],
		[purple]To[/purple]			=> [red]'[/red][purple]XXXXX[/purple][red]'[/red],
		[purple]Subject[/purple]		=> [blue]$subject[/blue],
		[purple]Data[/purple]		=> [red]"[/red][purple]Please check the ftp logs and errlog for additional information[/purple][red]"[/red],
	[red])[/red][red];[/red]
	[blue]$msg[/blue]->[maroon]send[/maroon][red];[/red]
[red]}[/red]

[fuchsia]1[/fuchsia][red];[/red]

[teal]__END__[/teal]

[tt]------------------------------------------------------------
Pragmas (perl 5.8.8) used :
[ul]
[li]strict - Perl pragma to restrict unsafe constructs[/li]
[li]warnings - Perl pragma to control optional warnings[/li]
[/ul]
Core (perl 5.8.8) Modules used :
[ul]
[li]English - use nice English (or awk) names for ugly punctuation variables[/li]
[li]File::Copy - Copy files or filehandles[/li]
[li]Getopt::Std - Process single-character switches with switch clustering[/li]
[li]Net::FTP - FTP Client class[/li]
[li]POSIX - Perl interface to IEEE Std 1003.1[/li]
[/ul]
Other Modules used :
[ul]
[li]DBI[/li]
[li]MIME::Lite[/li]
[li]Readonly[/li]
[/ul]
[/tt]

- Miller

 

[campbellc]

I'm speachless.

I have another thread open regarding the Debugger and was asked by Kevin to post the code. But I just could not bring my self to do it...

Your words kept coming back to me...

"I sometimes dislike seeing other people's code. It calls out to me to refactor. Oh, the inefficiencies!"

Again...

"I sometimes dislike seeing other people's code. It calls out to me to refactor. Oh, the inefficiencies!"

....and again

"I sometimes dislike seeing other people's code. It calls out to me to refactor. Oh, the inefficiencies!"

I will still study and memorize the golden rules of Perl Knowledge that you have bestowed upon me. Please let me know how I might return this great kindness.

 

[MillerH]

Please do not let my sly quip discourage you from posting code when requesting help. Seeing someone's code is ultimately the only way that we will truly be able to diagnose someone's problem. My comment was purely from a personal perspective to my fellow experts, and not something intended to make you feel bad.

I have only two wishes with regard to my above gift.

1) That you use it in some way. It may take you a while to understand what I did; why I did it; and finally adapt it to your purposes. But it's my hope that you do get some use out of it.

2) That you learn from it. You're obviously someone who has programming experience, but is still very new to perl. Before you start using advanced concepts, it would help to get some very simple coding conventions down. The biggest one is what stevexff already mentioned:

While we're in constructive criticism mode, I've got a problem with the number of variables with global scope. For example, in the datetime subroutine, you set a number of globally-scoped variables that get used all over the place.

Your script contained a huge list of variables declared at the very beginning of your script. Some of these you used in a global context (bad idea). And others were used in only one clause, but there was no way to know that given how they were declared. Always limit the scope of your variables to the exact level they are needed, and never use global variables (besides constants) if you can avoid it. Which you always can.

I would also advise against using global filehandles. You'll notice that all of the file handles have their scope limitted now. Even the logerror function does this by opening the filehandle and then closing it when finished. Only the filename parameter for it is global, and that is simply defined at the very beginning of the script.

Limiting the scope of your variables is the first step to making code self-documenting. It implicitly says this variable is set and processed within this scope and then is not needed. Therefore when you see variables declared outside of the a more limiting scope, you are clued into the fact that they have a broader context. For example the $receiver variable is declared outside of the file processing loop. This is because it is initialized in one interation, and then used in another. No other variable has that special quality so it's easy to verify what is going on.

Also, limiting the scope of your variables lets "use strict;" come to the rescue. If you use a variable outside of the scope that you initially expect, "use strict;" will give you a noogie. However, if everything is global "use strict;" will get very bored. Give it something to do. It's there to help you.

Anyway, this practice is so important that I'm reluctant to bother telling you anything else. Most of the other changes that I made require little explanation.

However, I will throw in one more. The "warn" and "die" functionality is meant for exactly what it says, warning and dying. Never add additional logic to these handlers. You'll see how I control logic from them and instead all they do is output to the log file. You allowed to change how they "warn" and "die", but don't make it so they do more than "warning" and "dying". This is an easy way to clue in that your code isn't designed well.

Finally, I tried to keep as much of your original design the same as possible. If I knew more of what you were trying to do, the format of your data files for example, I would most likely choose a different implementation method. Nevertheless, I left as much of the code the same as possible so that you would have the best chance of understanding it and recognizing how things were changed.

That's it for now. Hopefully this managed to fix some of the other problems that you were having. We'll see.

- Miller

 

[campbellc]

I appreciate all the work and words of wisdom. I have spent the weekend reviewing and have been testing. I'm getting errors with regards to the local and global variables that you used. Trying to look at what you coded and documented, I'm getting the following errors:

requires exlicit package name
I'm getting the above error on $type, @files, $file, @fields, $document_sent, $FTP_key, $sth_select

as well as

Possible unintended interpolation of @files (as well as @fields) in string

What do these error mean?

Thanks...
Chris

 

[MillerH]

The code that I provided you contained no compiling errors. If you changed the code, be sure to include the updated version in your question.

Also, be sure to include the literal error message, not just an approximation.

- Miller

 

[campbellc]

Possible unintended interpolation of @files in string at NAIP_Outbound_FTP.pl line 42.
Possible unintended interpolation of @fields in string at NAIP_Outbound_FTP.pl line 42.
syntax error at NAIP_Outbound_FTP.pl line 42, near "\."
  (Might be a runaway multi-line // string starting on line 30)
Global symbol "$successfulParse" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$file" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "@files" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$file" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$successfulParse" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$seperator" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$seperator" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$receiver" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$fh" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$file" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$file" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$fh" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "@fields" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$type" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "@fields" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$type" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$receiver" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "@fields" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$type" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$documents_sent" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "@fields" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$FTP_key" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$receiver" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$documents_sent" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Global symbol "$sth_select" requires explicit package name at NAIP_Outbound_FTP.pl line 42.
Unmatched right curly bracket at NAIP_Outbound_FTP.pl line 80, at end of line
  (Might be a runaway multi-line ?? string starting on line 42)
NAIP_Outbound_FTP.pl has too many errors.
'NAIP_Outbound_FTP.pl' had compilation errors.

# What does this script do?  Damned if I know.
# [URL unfurl="true"]http://www.tek-tips.com/viewthread.cfm?qid=1384456[/URL]

use DBI qw( :sql_types );
use English qw(-no_match_vars);
use File::Copy qw(move);
use Getopt::Std;
use Net::FTP;
use MIME::Lite;
use POSIX qw(strftime);

use strict;
use warnings;

$SIG{__WARN__} = 'WARN_handler';
$SIG{__DIE__}  = 'DIE_handler';

# Constants
use Readonly;
Readonly my $DIR_NAME => 'c:/EDI/outbound/ftp';
Readonly my $DB_HOST => "VIT32";
Readonly my $DB_NAME => 'EDIDB';
Readonly my $DB_USER => "VITNET\reports";
Readonly my $DB_PASS => "reports";

# Set Parameters
our $errlog = @ARGV ? $ARGV[0] : 'C:/outmsg.txt';

# Connect to Database
our $dbh = DBI->connect(q/dbi:ODBC:DRIVER={SQL Server};Server=$DB_HOST;attr=database=$DB_NAME, $DB_USER, $DB_PASS, {
    PrintError => 0,
    RaiseError => 1
    }) or die $DBI::errstr;

# Cache Statement Handles upon need.
my $sth_select = '';
my $sth_update = '';

print "Going to start the FILE loop\n";

opendir(DIR, $DIR_NAME) or die "Can't open $DIR_NAME: $!";
my @files = grep {! /^\.\.?$/} readdir(DIR);
closedir(DIR);

my $successfulParse;

FILE:
foreach my $file (@files) {
    print "Begin file processing : $file\n";

    sleep 1; # Take a breather
    $successfulParse = 0;
    
    PARSE_METHOD:
    foreach my $seperator ("~", "\n") {
        local $INPUT_RECORD_SEPARATOR = $seperator;
        
        my $receiver = '';
        
        open my $fh, '<', "$DIR_NAME/$file" or warn("can't open $file : $!"), next FILE;
        
        LINE:
        while (<$fh>) {
            chomp;
            my @fields = split /\*/;
            
            my $type = trimspaces($fields[0]);
            
            if ($type =~ /GS/) {
                $receiver = trimspaces($fields[3]);
                
            } elsif ($type =~ /ST/) {
                my $documents_sent = trimspaces($fields[1]);
                
                my $FTP_key = $receiver . $documents_sent;

                $sth_select ||= $dbh->prepare(q{
SELECT server_ip, username, password, documents_sent, shipline, chng_dir, trans_mode, log_file
FROM dbo.Outbound_FTP
WHERE FTP_key=?});
                $sth_select->bind_param( 1, $FTP_key );
                $sth_select->execute or die $dbh->errstr;
                my ($ip, $user, $pass, $docs, $shipline, $chng_dir, $mode, $outfile ) = $sth_select->fetchrow_array;

                open my $fh_results, '>>', $outfile or die "Can't open $outfile: $!";
                print $fh_results ("FTP Key: $FTP_key\n");
                print $fh_results ("\n");
                print $fh_results ("\n");
                print $fh_results scalar localtime();
                print $fh_results ("\n");
                print $fh_results ("The file found is : $file\n");
                print $fh_results ("IP Address is :$ip\n");
                print $fh_results ("User ID is :$user\n");
                print $fh_results ("Doc Type is :$documents_sent\n");
                print $fh_results ("Shipline is :$shipline\n");

                my $ftp = Net::FTP->new( $ip, Debug => 0 )
                    or warn("Cannot connect to $ip :$@"), next FILE;

                $ftp->login( $user, $pass )
                    or warn("Cannot login " . $ftp->message), next FILE;

                if ( $chng_dir ) {
                    $ftp->cwd($chng_dir) or warn("Cannot change directories " . $ftp->message), next FILE;
                }

                if ($mode eq 1) {
                    $ftp->binary;
                } elsif ($mode eq 2) {
                    $ftp->ascii;
                }
                
                my $putfile = $shipline =~ /NYKS/
                    ? "A".strftime("%d%H%M%S", localtime)
                    : $shipline . $documents_sent . '-' . strftime("%m%d%Y%H%M%S", localtime) . '.EDI';

                $ftp->put( "$DIR_NAME/$file", $putfile )
                    or warn("Cannot put file " . $ftp->message), next FILE;
                
                print $fh_results "File sent : $putfile\n";
                
                my @output =  $ftp->dir;
                foreach (@output) {
                   print $fh_results "$_\n";
                }

                $ftp->quit;

                my $last_sent = strftime("%Y%m%d %H:%M:00", localtime);
                $sth_update ||= $dbh->prepare(q{UPDATE dbo.Outbound_FTP SET documents_sent=?, last_sent=? WHERE FTP_key=?});
                $sth_update->bind_param( 1, $documents_sent );
                $sth_update->bind_param( 2, $last_sent, SQL_VARCHAR );
                $sth_update->bind_param( 3, $FTP_key );
                $sth_update->execute or die $dbh->errstr;

                $successfulParse = 1;

                # Do you want to end now?  IF SO, do the following
                # next FILE;
            }# END ST
        } # END LINE
    } # END PROCESS_METHOD

# Processing before next FILE
} continue {
    
    if ($successfulParse) {
        print "File '$file' succeeded\n";
        unlink("$DIR_NAME/$file") or die "Can't unlink $file: $!";
        
    } else {
        print "File '$file' failed: Going to move\n";
        my $oldfile = "$DIR_NAME"."/"."$file";
        my $newfile = "$DIR_NAME"."/"."send_failed"."_".strftime("%d%H%M%S", localtime);
        move($oldfile, $newfile) or warn "Can't move: $!";
    }
    
} # END FILE

undef $sth_select;
undef $sth_update;

print "Going to disconnect from the database\n";

$dbh->disconnect or die "Disconnection failed: $DBI::errstr\n";

exit 0; # It's over!  Jump for joy!

####################################################################
# Supporting Functions

sub trimspaces {
    my $string = shift;
    $string =~ s{^\s+|\s+$}{}g;
    return $string;
}


sub WARN_handler {
    my $signal = shift;
    logError("WARN: $signal");
#    emailnotify("$0 Warning: $signal");
}

sub DIE_handler {
    my $signal = shift;
    logError("DIE: $signal");
#    emailnotify("$0 DIE: $signal");
}

sub logError {
    open(ERRLOG, ">>$errlog") or die "Can't open $errlog: $!";
    print ERRLOG ("\n");
    print ERRLOG scalar localtime();
    print ERRLOG @_;
    close(ERRLOG);
}
    
sub emailnotify {
    my $subject = shift;
    
    MIME::Lite->send('smtp', "vit20", timeout=>60);
    my $msg = MIME::Lite->new( 
        From        => 'Gentran@vit.org',
        To            => 'ccampbell@vit.org',
        Subject        => $subject,
        Data        => "Please check the ftp logs and errlog for additional information",
    );
    $msg->send;
}

1;

__END__

 

[MillerH]

This is the error that you need to pay attention to.

syntax error at NAIP_Outbound_FTP.pl line 42, near "\."
  (Might be a runaway multi-line // string starting on line 30)

Whenever you suddenly get a large amount of errors and you see the "runaway multi-line" error, look for an unterminated string.

You'll see one where it indicates. Also, don't use q in this instance, use qq. You want interpolation of the configuration variables.

- Miller