use Config::IniFiles;
use Net::FTP;
use File::Basename;
use File::Compare;
use File::Find qw(find);
use File::Copy;
use English;
use File::stat;
use XML::Writer;
use IO::File;

use Perot::Guid;    # PHF20080930 

# prod:
my $dir = "d:\\config\\";
my $config_path = "$dir\\ini";   ###!!! my $config_path = 'config'; 
# test:
#my $dir = 'C:\projects\iesn\scrums\scrum5';
#my $config_path = 'C:\projects\iesn\scrums\scrum5\ini';
                
#<---- location of settings
tie my %settings, 'Config::IniFiles', (-file => "$config_path\\setting
+s.ini");
my $setup = \%{$settings{INBOUND}};
my $log = $setup->{ftp_inbound};

my $datestamp = localtime;
LogIt("------------------------------------------------");
LogIt("$datestamp");

my $ServerSetting="ServerSetting";
tie my %server_ini, 'Config::IniFiles', (-file => "$config_path\\serve
+r.ini");
my $ServerConfig = \%{$server_ini{$ServerSetting}};
my $server=$ServerConfig->{server};
# LogIt("server is $server");

my $root = InitializeIt("root");
my $config = InitializeIt("config");

my($account, $file, $DEBUG, $ftp, $sig, $type);
ARGUMENT:    foreach (@ARGV) {
            #$_ = lc ($_);
            # catches file names with spaces & replaces them w/ unders
+cores
            if ($_ =~ /(\s)/) {
                if ($_ =~ /^-f(.*)$/) {
                    s/ /_/g;
                } 
            }
            $account    = uc $1, next ARGUMENT if(/^-a(\S+)/);
            $file        = $1, next ARGUMENT if(/^-f(\S+)/);
            $DEBUG        = $1, next ARGUMENT if(/^-d(\S+)/);
}

tie my %ini, 'Config::IniFiles', (-file => "$config", -default => "def
+aults");

my $profile = \%{$ini{$account}};
my ($file_name,$directory_name) = fileparse($file, '\.[^\.]');

my $mapdir = $profile->{MapDIR};
if ($mapdir =~/true/)
 {
     $outputfile = $file;
     $outputfile =~ s/inbound/outbound/i;
     LogIt("MapDIR is true.Placing in appropriate subdirectory \n") if
+ ($DEBUG);
     my ($file_name,$directory_name) = fileparse($outputfile, '\.[^\.]
+');
     $output ="$directory_name$file_name";
 }
 else
 {
     $output = $profile->{Destination}. "\\$file_name";
 }

# print filesize on received file
my $inode = stat($file);
my $received = $inode->size;
LogIt ("---- Received file $file with $received bytes ----");# if ($DE
+BUG);

my $success = "
    Account        $account
    Sourcefile    $file
    Destination    $output
    "
    ;
    
## JHE 11/6/13  Fix a 0.1% intermittent failure problem w/ the system 
+call:     
#jhe    @args = ("move", $file, $output);
#jhe    if (system(@args) == 0) {
my $placing;
    if (move($file, $output)) {

        
    ### Log filesize on decrypted file
    my $inode1 = stat($output);
    $placing = $inode1->size;
    LogIt("---- Placing file $output with $placing bytes ----") if ($D
+EBUG);
    
    LogIt("$success");
    my $rvmessage = ("$datestamp, $account, $file, $output, $received,
+ $placing");
    LogIt("---- XML file created ----");
    createXML($rvmessage);
    unlink ($file);

    }

    else
    {
        my $errormove = "ERROR--MOVE";
        my $rverrormove = ("$errormove");
        LogIt ("Creating error message XML");
        createXML($rverrormove);
#jhe        LogIt ("NOTE : system @args failed: $?. \n Error detacted 
+: $!");
        LogIt ("***ERROR***  move($file, $output) call failed due to: 
+$!");
        unlink ($file);
        
    }
    #####does not change it....unlink $random;
finish();
    
    
        




# Subroutines 
# --------------------
sub finish{
           # Uses TASKKILL from Windows Resource Kit to Stop Applicati
+on
        LogIt("Here is the PID $PID") if $DEBUG;
        if ($PID) {
        close STDERR;
        my @args = ("taskkill /F /PID $PID");
        system(@args);
    }   
}

{
    my $fh = ''; 

    sub LogIt{
        
        unless ($fh) { 
            open $fh, ">> $log" or die "**** DIE **** Can't open log f
+ile '$log' due to: $!\n";
            open STDOUT, ">> $log" or die "**** DIE **** Can't redirec
+t STDOUT to log file '$log' due to: $!\n"; 
            open STDERR, ">> $log" or die "**** DIE **** Can't redirec
+t STDERR to log file '$log' due to: $!\n"; 
        }
        print $fh "[$$] @_\n";
    }
}


sub InitializeIt{
    local $_ = shift();
    LogIt("---- Initializing $setup->{$_} ----") if ($DEBUG);
    if (-e $setup->{$_}) {
        return ($setup->{$_});
    }
    else{
        LogIt("Can't find $setup->{$_}");
        die;
    }
}

sub ExtIt{
    local $_ = shift();
    local @_ = ();
    #LogIt("---- Loading $_ Configurations ----") if ($DEBUG);
    my $file_extensions = $setup->{$_};
    #LogIt("---- These are the file extensions $file_extensions ----")
+ if ($DEBUG);
    
    open(EXT, $file_extensions);
            while (<EXT>) {
            chomp;
            s/\#.*//;               # no comments
            s/^\s+//;               # no leading white
            s/\s+$//;               # no trailing white
            s/\./\\./;
            next unless length;     
            push(@_, $_);
           }
    close EXT;
    
    return(join ( '\.|', @_));
}

###_------------------------WORKING HERE
sub detainment{
    LogIt("---- Locking him up DETAINMENT ----") if ($DEBUG);
    my $Lockdown = \%{$ini{defaults}};
    foreach (@_) {
    my ($sec, $min, $hour, $mday, $mon, $year) = localtime(time);
    my ($inmate) = fileparse($_);
    my $inmate_name = ($account . "_" . $inmate . "_" . $mon. $mday . 
+$year . $hour . $min . $sec);
        $ftp = Net::FTP->new($Lockdown->{FTPServer}, Debug => 0) ||  f
+tp_error($_);
        $ftp->login($Lockdown->{FTPUsername},$Lockdown->{FTPPassword})
+ ||  ftp_error($_);
        $ftp->binary;
        $ftp->put($_, $inmate_name) ||  ftp_error($_);
        $ftp->quit;
        LogIt("
            The following file has been put into detainment:
            Account: $account
            File Name: $_ as $inmate_name    ");
        unlink ($_);
    }
    
finish();
}

sub ftp_error{
    LogIt("---- Problem moving file to detainment ----") if ($DEBUG);
    LogIt("ERROR--
        Could not move the following file to detainment
        Filename:     $_    ");
        LogIt($ftp->code() . " : " . $ftp->message());

    my $errormessage = "ERROR--FTP";
    my $rverrormessage = ("$errormessage");
    LogIt ("Creating error message XML");
    createXML($rverrormessage);
    
    die;
}

sub pgp_error{
    LogIt("---- There was a PGP error ----") if ($DEBUG);
    LogIt("ERROR-- 
        @_
        Account Name:  $account
        File Name:     $file");
        
        my $errormessage = "ERROR--PGP";
        my $rverrormessage = ("$errormessage");
        LogIt ("Creating Error message XML");
        createXML($rverrormessage);
        
    if ($sig) 
    {
        detainment($sig,$file);
    }
    else{
        unlink $output;
        detainment($file);
    }
}

    sub sig_check{
        if ($type)
        {
        my $lower=100; 
        my $upper=200000000;
        my $random = int(rand( 200000000-$lower+1 ) ) + $lower; 
        my @cmds = ("@_ $random");
        #LogIt("@cmds")if ($DEBUG);
        my @args = (@cmds);
        unless (system(@args) == 0) {
            unlink $random;
            pgp_error("GPG commands failed");
        } 
    
        LogIt("---- CMD is RUNNING ----") if ($DEBUG);
         my $gpgout;
         my $gpgin = join (" ",@args);
         #LogIt("GPGINPUT is $gpgin");
    
         open(SYSOUT, "$gpgin 2>&1|"); 
         close(SYSOUT); 

        open (STATUS, "< $random");
        local $/ = undef;
        $_ = <STATUS>;
        my $tempstore = $_;
        $tempstore = join ("\n", grep !/]/, split /\n/, $tempstore) ."
+\n";
            
        LogIt ("$tempstore");
    
        if ($_ !~ /VALIDSIG/gi)
        {
            close STATUS;
            unlink $random;
            pgp_error("File may not be signed");
         }
        close STATUS;
        unlink $random;
     }
     
     else
     {
     my @cmds = ("@_");
     LogIt(@cmds, "\n") if ($DEBUG);
     my @args = (@cmds);
     system(@args) == 0 || pgp_error("GPG commands failed");

     }
     unlink $random;
}


sub createXML
{

 $message=shift;

while( $message ne "" )
    {
    #$datestamp,$account,$file,$output,$received,$placing,$server,$mes
+sage,$guid
    
    my $guid_obj = Perot::Guid->new( file => $file );                #
+ PHF20080930
    my $guid = $guid_obj->guid;
    print STDERR "getting location\n";
    my $location = $setup->{ftp_inbound_xmllocation};
    print STDERR "location: $location\n";
    my $outputfilename=$location.$guid.'.xml';
    my $outputfile = IO::File->new("> $outputfilename");
    print STDERR "output file: $outputfile\n";
    
    my $writer = XML::Writer->new(OUTPUT => $outputfile);
       $writer->xmlDecl("UTF-8");
       $writer->startTag("root");
       $writer->dataElement( datestamp => $datestamp );
       $writer->dataElement( account => $account );
       $writer->dataElement( pgpfile => $file );
       $writer->dataElement( file => $output );
       $writer->dataElement( received => $received );
       $writer->dataElement( sending => $placing );
       $writer->dataElement( server => $server );
       $writer->dataElement( message => $message );
       $writer->dataElement( guid => $guid );
       $writer->endTag("root");
       $writer->end();
       #$output->close();

    $message=shift;
    }

}
[download]

This is an existing code and not written by me. Excuse for coding structure and alignments.There are few unused subroutines.I have pasted the script as it is for your investigation