All,
My problem seems to be within the Net::FTP module. I have intentionally
modified my password so that my error routines can be tested, but once the
login
piece fails it continues on, when I would expect that it should die at the
code in red. The uninitialized value is $OHMONSTER, but the FTP piece is
not exiting.
Any help please?
thanks
derek
#!/usr/bin/perl
use strict;
use warnings;
use Net::FTP;
use MIME::Lite;
my ($ftplog,$fref);
my $OHMONSTER;
my $RENAMED = q/OhioHealth.xml/;
my ($monster_date,$passed_new_date) = 0;
sub new_date {
my ($year,$month,$day) = (localtime)[5,4,3];
sprintf ("%04d%02d%02d", ($year += 1900), $month+1,$day);
}
$passed_new_date = new_date();
sub new_date_append {
return $monster_date = "OhioHealth$passed_new_date";
}
$fref = \&new_date_append();
sub mailme {
my $sub = shift;
my $msg = MIME::Lite->new(
From => 'pshrapprd <[EMAIL PROTECTED]>',
To => 'Derek Smith <[EMAIL PROTECTED]>',
#To => 'PsoftHR Group <[EMAIL PROTECTED]>',
Subject => 'HRIS FTP Inbound to monster.com had
problems an,
Type => 'multipart/related');
$msg->attach(
Type => 'TEXT',
Disposition => 'attachment',
Path => "$ftplog",
Filename => "$ftplog");
$msg->send;
}
sub signal {
if ($? == -1) {
print "failed to execute: $!\n";
mailme($!);
}
elsif ($? & 127) {
printf "child dies with signal %d, %s coredump\n",
($? & 127), ($? & 128) ? 'with core' :
'without;
mailme($!);
}
elsif ( $? >> 8) {
printf "child exited with value %d\n", $? >> 8;
mailme($!);
}
else {
mailme();
}
}
sub ftpme {
my $RENAMED = q/OhioHealth.xml/;
my $OHMONSTER;
my $remotehost="ftp.monster.com";
my $remotedir="outbound";
my $user="xxxxxx";
my $pass="xxxxxxxx";
$ftplog="/psofthr/hr88prd/intf/monster/log/interface_monster.log;
print "step 1 open log\n";
open (FTPLOG, ">>$ftplog") || do {print FTPLOG "\ncould not
ope;
print "step 2 init ftp\n";
my $ftp = Net::FTP->new($remotehost, Debug => 10)
|| do {print FTPLOG "\nCannot connect to $remotehost: $!",
mail;
print "step 3 login\n";
$ftp->login($user, $pass) || do {print FTPLOG "\nLogin
failed!: ;
print "step 4 print login failed then set bin\n";
$ftp->binary();
print "step 5 cd directory\n";
$ftp->cwd($remotedir);
print "step 6 for loop\n";
foreach ($ftp->ls()) {
if (/${$fref}\d+\w+/) {
$OHMONSTER = $_;
last;
}
}
#$ftp->rename("$OHMONSTER", "$RENAMED") or do {print FTPLOG
"\n;
line 99 print "OHMONSTER:\t",$OHMONSTER,"\n","RENAMED\t:",$RENAMED,"\n";
line 100 $ftp->rename("$OHMONSTER","$RENAMED");
#signal($!), select( (select(FTPLOG), $|=1 ) [0] ); };
$ftp->quit;
}
if ( $passed_new_date and $$fref ) {
ftpme();
}
#else {
# mailme();
#
#}
_ERROR_
Net::FTP>>> Net::FTP(2.75)
Net::FTP>>> Exporter(5.566)
Net::FTP>>> Net::Cmd(2.26)
Net::FTP>>> IO::Socket::INET(1.26)
Net::FTP>>> IO::Socket(1.27)
Net::FTP>>> IO::Handle(1.21)
Net::FTP=GLOB(0x203f5560)<<< 220 ftp101 Microsoft FTP Service (Version
5.0).
Net::FTP=GLOB(0x203f5560)>>> user xohealthxftp
Net::FTP=GLOB(0x203f5560)<<< 331 Password required for xohealthxftp.
Net::FTP=GLOB(0x203f5560)>>> PASS ....
Net::FTP=GLOB(0x203f5560)<<< 530 User xohealthxftp cannot log in.
step 1 open log
step 2 init ftp
step 3 login
Net::FTP=GLOB(0x203f5560)>>> TYPE I
Net::FTP=GLOB(0x203f5560)<<< 530 Please login with USER and PASS.
Net::FTP=GLOB(0x203f5560)>>> CWD outbound
Net::FTP=GLOB(0x203f5560)<<< 530 Please login with USER and PASS.
Net::FTP=GLOB(0x203f5560)>>> PORT 192,168,97,144,169,122
Net::FTP=GLOB(0x203f5560)<<< 200 PORT command successful.
Net::FTP=GLOB(0x203f5560)>>> NLST
Net::FTP=GLOB(0x203f5560)<<< 530 Please login with USER and PASS.
Use of uninitialized value in print at interface_monster_IN2 line 99.
Use of uninitialized value in string at interface_monster_IN2 line 100.
Net::FTP=GLOB(0x203f5560)>>> RNFR
Net::FTP=GLOB(0x203f5560)<<< 530 Please login with USER and PASS.
Net::FTP=GLOB(0x203f5560)>>> QUIT
Net::FTP=GLOB(0x203f5560)<<< 221 Leaving Monster.Com
step 4 print login failed then set bin
step 5 cd directory
step 6 for loop
OHMONSTER:
RENAMED :OhioHealth.xml
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
