A very good morning to you all,

I asked this question yesterday in the Chatterbox, but unfortunately couldn't stay around long enough to get help from the other monks.

Besides, I am a relatively new Perl programmer, so I would be grateful for any coding improvements too.

Background:

a) This script is running on two systems on two sides of X corporate firewalls / network devices.

b) It is intended as a replacement for ClearCase MultiSite 'import/export'. So it runs every hour on both sites.

Script description:

a) The script gets files from specific folders, copies them to specific folders on the system running the script and then uploads the files. It then writes a dummy file 'upload_complete.txt' and uploads it to the FTP server.

b) Once upload is complete, it copies the files to a 'recyclebin'. It then deletes all files older than 48 hours from the 'recyclebin'.

c) It then changes directories and checks the 'download' location on the FTP server for the 'upload_complete.txt' file from the other site. If the file exists, it starts to download the files. Downloaded files are then deleted from the FTP server.

d) The files are destined for different servers. Each file '*' has its destination information is stored in a 'sh_o_*' file, using which the files are moved to the appropriate systems. the 'sh_o_*' files are then deleted.

Problems:

a) Everyday, at different times, some files are not available at the destination server. This happens at both sites.

b) Occasionally, a file gets corrupted. It may be 0 bytes or probably 20KB, when it is supposed to be 40KB.

c) Occasionally, the 'sh_o_*' files for the corresponding * file is missing and the * file cannot be sent to the destination system. But I think, this phenomenon is just a special case of 'Problem a' above.

I am sorry for the rather long email, but I have spent quite a long time, trying to figure out what I am doing wrong, or missing, but it eludes me. Also, I think with the complete code and background, the other monks would be able to understand what I am trying to do and hopefully help me better.

Thanks and regards

Sriram

## add more packages below this list
use strict;
use File::Find;
use IO::Handle qw(autoflush);
use Net::Ftp;

## global constants
### get current date
use constant TODAY => sprintf("%04d%02d%02d", ((localtime)[5] + 1900),
                                             (localtime)[4] + 1, (loca
+ltime)[3]);

##--------------------------------------------------------------------
+----------
## declare variables -- temporary variables preferrably in scope where
+ required.
## or at the end of this section
my $debugLevel = 0;
my $logFile = "";
my $cmd = "";
my $status = 0;
my $parametersFile = "";
my $partnerName = "";
my ($ftpInFolderLoc, $ftpOutFolderLoc, $ftpRecyclebinLoc) = ("", "", "
+");
my ($vobSrvInFolderLoc, $vobSrvOutFolderLoc) = ("", "");
my $ftp = "";
my (%parameterHash) = ();

##--------------------------------------------------------------------
+----------
## get commandline parameters
while((my $option = shift))
{
    CASE:{
        ($option =~ /-s/i) && do {        # parameters file location
               $parametersFile = shift, $option;
               last CASE;
           };

        ($option =~ /-p/i) && do {        # debug level
            $partnerName = shift, $option;
            last CASE;
        };

        ($option =~ /-d/i) && do {        # debug level
            $debugLevel = shift, $option;
            last CASE;
        };

        (($option =~ /-h/i) || ($option =~ /-x/i)) && do {
            printUsage();             # Help or Print usage
            exit 0;
        };
        print "Invalid usage.\n  For usage: $0 -h/-x";
        exit 1;
    }
}

## check if script is executed without any parameters
if($parametersFile eq "")
{
    printUsage();
    exit 1;
}

## setup logfile, if in debug mode
if($debugLevel)
{
    ### get logfile location and name
    $logFile = "$ENV{'TEMP'}\\" . TODAY . "_" . $$ . "_ftp\.log";
    print "Logfile : " . $logFile . "\n" if($debugLevel >= 2);

    ### open logfile
    open(LOGFILE, ">$logFile") or die "Error:Unable to open log file $
+logFile. $!\n";

    ### set output flush operator to 1, no output buffering
    LOGFILE->autoflush(1);
}

## get FTP transfer parameters
### open parameters file
open(PARAMFILE, "<$parametersFile") or 
                die "Error:Unable to open parameters file $parametersF
+ile. $!\n";

### read all parameters to hash
while(my $line = <PARAMFILE>)
{
    my ($key) = ("");
    chomp($line);
    next if((!$line) || ($line =~ /^;/));
    if($line =~ /^\s*(\S+)\s*=\s*(.+)/)
    {
        $key = uc($1);
        $parameterHash{$key} = $2;
    }
}
close(PARAMFILE);

## check if FTP client transfer folders exist.
my $ftpClientShippingBayLoc = $parameterHash{FTPCLIENTSHIPBAYLOC};

### shipping bay for specific partner; needed only on internal side
if($partnerName)
{
    $ftpClientShippingBayLoc .= "\\" . $partnerName;
}

### FTP client incoming folder
$ftpInFolderLoc = $ftpClientShippingBayLoc . "\\" . $parameterHash{LOC
+ALINCOMING};
                                                     unless(-d $ftpInF
+olderLoc);

### FTP client outgoing folder
$ftpOutFolderLoc = $ftpClientShippingBayLoc . "\\" . $parameterHash{LO
+CALOUTGOING};

unless(-d $ftpOutFolderLoc);

### temporary folder to store previously uploaded packets;
### will be cleaned up every 48 hours
$ftpRecyclebinLoc = $ftpClientShippingBayLoc . "\\" . $parameterHash{L
+OCALRECYCLEBIN};

unless(-d $ftpRecyclebinLoc);

## repeat for each VOB server
my @vobServerList = split(/,\s*/, $parameterHash{VOBSRVLIST});
foreach my $vobServer(@vobServerList)
{
    my $vobSrvShippingBayLoc = "\\\\" . $vobServer . "\\" . $parameter
+Hash{VOBSRVSHIPBAYLOC};

    ## check if local transfer folders exist.
    ### shipping bay folder
    
    ### shipping bay for specific partner; needed only on Siemens side
    if($partnerName)
    {
        $vobSrvShippingBayLoc .= "\\" . $partnerName;
    }
    
    ### incoming folder
    $vobSrvInFolderLoc = $vobSrvShippingBayLoc . "\\" . $parameterHash
+{LOCALINCOMING};
    
unless(-d $vobSrvInFolderLoc);
    
    ### outgoing folder
    $vobSrvOutFolderLoc = $vobSrvShippingBayLoc . "\\" . $parameterHas
+h{LOCALOUTGOING};
    
unless(-d $vobSrvOutFolderLoc);
    
    ## copy data from VOB Server to FTP client
    $cmd = "move $vobSrvOutFolderLoc\\* $ftpOutFolderLoc > NUL 2>&1";
    print LOGFILE $cmd . "\n";
    system($cmd);
}

## start FTP transfers
### open FTP connection
$ftp = Net::FTP->new($parameterHash{FTPSERVER}, Debug => 1, Passive =>
+ 1);
$ftp->login($parameterHash{FTPUSERNAME}, $parameterHash{FTPPASSWORD});

### set transfer mode to binary
$ftp->binary();
### upload data to FTP server
#### go to FTP partner folder to download data
$partnerName =~ s/_smallfiles$//i;
$ftp->cwd($partnerName);

#### go to FTP outgoing folder to upload data
$ftp->cwd($parameterHash{OUTGOING});
#### set FTP client upload folder
chdir($ftpOutFolderLoc);
#### upload data
my @transferFileList = glob "*.*";
foreach my $transferFile(@transferFileList)
{
    $ftp->put($transferFile);

    #### move uploaded files to local recycle bin
    $cmd = "move /Y $ftpOutFolderLoc\\$transferFile $ftpRecyclebinLoc 
+> NUL 2>&1";
    $status = system($cmd);
}

##### delete older packets from recycle bin
### open recycle bin folder
opendir(DIR, "$ftpRecyclebinLoc") or die "Error:Unable to open folder 
+$ftpRecyclebinLoc. $!";
while (my $filename = readdir(DIR))
{
    next if $filename =~ /^\./;
    $filename = $ftpRecyclebinLoc . "\\" . $filename;
    my ($mtime) = (stat($filename))[9];
    unlink $filename if($mtime < (time - 3600 * 48));
}

### upload dummy 'upload_complete' file to upload folder
#### create dummy 'upload_complete' file
system("echo upload complete > upload_complete\.txt");
#### upload dummy file
$ftp->put("upload_complete.txt");
#### delete dummy file
unlink("upload_complete.txt");

### GO TO download folder on FTP server
## do FTP data download
#### go one level up to FTP partner folder
$ftp->cwd("..");
#### go to FTP Server incoming folder to download data
$ftp->cwd($parameterHash{INCOMING});

#### set FTP client download folder
chdir($ftpInFolderLoc);

#### check for dummy file
my @fileList = $ftp->ls("upload_complete.txt");
#### if dummy file is found, upload from other site is complete. Start
+ download
if(scalar(@fileList) == 1)
{
    #### download data from partner company
    foreach my $transferFile($ftp->ls())
    {
        $ftp->get($transferFile);
    
        #### delete downloaded files from FTP server
        $ftp->delete($transferFile);
    }

    #### delete dummy file
    unlink("upload_complete.txt");

    ### move incoming packets to appropriate VOB servers
    ### list out received packets
    my @shippingOrderList = `dir $ftpInFolderLoc\\sh_o_* /b`;

    ### get destination info from the shipping orders
    foreach my $shippingOrder(@shippingOrderList)
    {
        $shippingOrder =~ s/\n*$//ig;
        my $shippingOrderFile = $ftpInFolderLoc . "\\". $shippingOrder
+;
    
        #### get correpsonding sync packet for the shipping order
        my ($syncPacketFile, $syncPacketFileLoc, $syncPacketDestSrv) =
+ ("", "", "");
        ($syncPacketFile = $shippingOrder) =~ s/^sh_o_(.+)$/$1/i;
        $syncPacketFileLoc = $ftpInFolderLoc . "\\" . $syncPacketFile;
    
        #### open shipping order file
        open(SHIPORDERFILE, "<$shippingOrderFile") or 
            die "Error:Unable to open shipping order file $shippingOrd
+erFile for read. $!\n";
    
        #### read out the shipping information into array
        undef $/;
        my $shippingOrderFileAsString = <SHIPORDERFILE>;
        #### close shipping order file
        close(SHIPORDERFILE);
    
        $shippingOrderFileAsString =~ s/\n[^%]/::/ig;
        my @shippingOrderFileAsArray = split(/\n/, $shippingOrderFileA
+sString);
        
        #### determine packet destination VOB server
        foreach my $line(@shippingOrderFileAsArray)
        {
            chomp($line);
            if($line =~ /^%DESTINATIONS\s*::\s*(.+)$/i)
            {
                $syncPacketDestSrv = $1;
                last;
            }
        }
    
        ### move packet to dest server, of FTP client and VOB server a
+re different systems
        
        if($ENV{'COMPUTERNAME'} ne uc($syncPacketDestSrv))
        {
            $cmd = "move " . $syncPacketFileLoc . " \\\\" . $syncPacke
+tDestSrv . "\\"
                 . $parameterHash{VOBSRVSHIPBAYLOC} . "\\" . $partnerN
+ame
                  . "\\" . $parameterHash{LOCALINCOMING} . " > NUL 2>&
+1";
            system($cmd);
        }
    }

    ## delete received shipping orders
    $cmd = "del " . $ftpInFolderLoc . '\sh_o_* > NUL 2>&1';
    print LOGFILE $cmd . "\n";
    system($cmd);
}
### close FTP connection
$ftp->quit;

### close log file
close(LOGFILE) if($debugLevel);

## done

sub printUsage
{
    my $helpMsg = <<EOT_USAGE;

USAGE:
EOT_USAGE

    print ${helpMsg};
}

##--------------------------------------------------------------------
+----------

[download]

Edited by planetscape - changed pre tags to sane formatting

( keep:1 edit:16 reap:0 )

In reply to Net::FTP corrupting files or timing problem by pattar_g

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.