#########################################################################
#   $Date: 2008/04/22 $
#   $Revision: #4 $
#   $Build: 8.2.080618.1558 $
#
#########################################################################

package ImportLib::ImportLib;

require 5.6.0;

BEGIN{

   use strict;
   use File::Spec;
   use Config;
   use FindBin qw( $Bin );
   use ImportLib::Constants;
   require Exporter;

   our( $VERSION, @EXPORT, @ISA );
   $VERSION = '#4';

   @ISA = qw( Exporter );

   require ImportLib::Configuration;
   require ImportLib::Logging;
   require ImportLib::Utilities;

   if( $ENV{ 'CRIMS_PERL_ENV_INI' } ne '1' && !$::disableRestart ){

      local $SIG{ __WARN__ } = sub{};
      local $SIG{ __DIE__ } = sub{};

      my $cmd = join( '*', @ARGV );
      if( $cmd =~ /(\*|^)\-i\**(.+?)(\*|$)/ ){
         eval{ initConfig( $2 ); };
      } else {
         eval{ initConfig(); }
      }

      if( $@ ){
         print STDERR $@;
         $::die = $@;
      } else {

         if( getOS() eq 'WINDOWS' ){
            ( system( $Config{ 'perlpath' }, "-x", $0, map { "\"$_\"" } @ARGV ) == 0 ) || ( $::die = 1 );
         } else {
            ( system( $Config{ 'perlpath' }, $0, @ARGV ) == 0 ) ||  ( $::die = 1 );
         }

         if( !$::die ){
            exit;
         }
      }

   }

}

if( $::die ){
   exit 255;
}

use strict;
use File::Glob ':glob';
require ImportLib::Translation;

our( $VERSION, @EXPORT, $exceptions );
$VERSION = '#4';

push @EXPORT, qw( $exceptions );

# Initialize random number seed
srand();

#==========================================================================
#
# Set of routines to change and expand the initialization file
#
#==========================================================================

# Change or Set value in initialization file
#
# Parameter
#     iniFile     file name
#     sectionName name of section
#     keyName     name of key to set
#     value       value to set to
#
sub setProfileString{

   my( $iniFile, $sectionName, $keyName, $value ) = @_;
   my( @newContents, $curSection, $curKey, $curValue, $line, $comments, $done, $tmpFile );

   $tmpFile = $iniFile . '_' . randID();
   $sectionName = uc( $sectionName );

   open( IN, $iniFile ) ||
      exception( "Unable to open $iniFile: $!" );

   $curSection = '';
   $done = '';
   $comments = '';
   while( <IN> ){

      if( /^\s*#/ || /^\s*$/ ){
         $comments .= $_;
         next;
      }

      $line = $_;
      if( !$done ){

         s/#.*$//;                # remove comments
         s/^\s*//;
         s/\s*$//;

         if( m/^\s*\[\s*(\S*)\s*\]\s*$/ ){

            # At the beginning of new section and key was not found.
            if( $curSection eq $sectionName ){
               push @newContents, "$keyName=$value\n";
               $done = 1;
            } else {
               $curSection = uc $1;
            }

         } elsif ( $curSection eq $sectionName ){

            ($curKey, $curValue) = split /\s*=\s*/, $_, 2;
            if( $curKey && uc( $curKey ) eq uc( $keyName ) ){
               $line = "$keyName = $value\n";
               $done = 1;
            }
         }
      }

      push @newContents, $comments.$line;
      $comments = '';

   }


   # At End of File without finding key
   if( !$done ){

      # Section was not found, print section name before key value pair
      if( !( $curSection eq $sectionName ) ){
         push @newContents, "\n";
         push @newContents, "[$sectionName]\n";
      }

      # Currently in relevant section, only print the key, value pair.
      push @newContents, "$keyName = $value\n";
   }

   close IN ||
      exception( "Unable to close $iniFile: $!" );

   open( OUT, ">".$tmpFile ) ||
      exception( "Unable to open $tmpFile: $!" );
   print OUT @newContents;

   close OUT ||
      exception( "Unable to close $tmpFile: $!" );

   rename( $tmpFile, $iniFile );

}
push @EXPORT, qw( &setProfileString );

# Expands all perl values to constants in initialization file -- this is necessary for CTM app to properly run, but there should
# be some way to avoid placing the passwords into the file
#
# Parameters
#     iniFile        original file name
#     newIniFile     new file name
#
sub expandIniFile{

   my( $iniFile, $newIniFile ) = @_;
   my( $tmpFile, $newIni, $key, $value );

   $iniFile = makeFilePath( '', $iniFile );
   $newIniFile = makeFilePath( '', $newIniFile );
   $tmpFile = $newIniFile . '_' . randID();

   open( IN, $iniFile ) ||
      exception( "Unable to open $iniFile: $!" );
   open( OUT, ">".$tmpFile ) ||
      exception( "Unable to open $newIniFile: $!" );

   while( <IN> ){

      next if( /^\s*#/ || /^\s*$/ );

      s/#.*$//;                # remove comments
      s/^\s*//;
      s/\s*$//;

      if( /\=/ ){
         ($key, $value) = split( /\s*=\s*/, $_, 2 );
         $value = dynamicValue( $value, 1 );
         if( defined( $value ) && $value =~ /\S/ ){
            print OUT "$key = $value\n";
         }
      } else {
         print OUT $_, "\n";
      }
   }

   close IN ||
      exception( "Unable to close $iniFile: $!" );
   close OUT ||
      exception( "Unable to close $newIniFile: $!" );

   rename( $tmpFile, $newIniFile );

}
push @EXPORT, qw( &expandIniFile );


#==========================================================================
#
# Other routines
#
#==========================================================================

# Waits for specified file to appear
#
# Parameters
#     file        file path
#     timeout     how long to wait in seconds
#
sub waitForFile{
   my( $file, $timeout ) = @_;
   my( $time );

   return 1 if( -e $file );

   print "Waiting for file $file.";
   $| = 1;
   do{

      $file = getFileCase( $file );
      if( -e $file ){
         print "\n";
         $| = 0;
         return $time;
      }
      sleep 60;
      print ".";
      $time += 60;
   } until( $time > $timeout );

   print "\n";
   $| = 0;

   exception( "Timeout occured waiting for $file after $timeout seconds" );
}
push @EXPORT, qw( &waitForFile );

# This is a hack to match the table name to the stored procedure name
#
# Parameters
#     table          table name
#
# To Do:
#  These things should be consistent in the database
#
sub isProcEnabled{

   my( $table ) = @_;

   $table = uc $table;
   my $shortName = uc( getConfig( 'ImportTableShortNames', $table ) );

   # Default short name for non-import tables
   if( $shortName eq '' || !defined( $shortName ) ){
      $shortName = uc( $table );
      $shortName =~ s/^CSM_//;
      $shortName =~ s/^CS_//;
      $shortName =~ s/^TS_//;
      $shortName =~ s/^PMA_//;
      $shortName =~ s/^IMP_//;
      $shortName =~ s/^EXP_//;
   }

   if( $shortName eq "SECURITY_BLOOM" && ( getConfig( 'IMP_FEED_TABLE', 'SECURITY' ) || getConfig( 'IMP_FEED_TABLE', 'SECURITY_SOURCE' ) ) ){
      return 1;
   }

   # Run tax lot if delta or normal tax lot import is enabled
   if( $shortName eq 'TAX_LOT' && getConfig( 'IMP_FEED_TABLE', 'TAX_LOT_DELTA' ) ){
      return 1;
   }

   # Run position if delta or normal position import is enabled
   if( $shortName eq 'POSITION' && getConfig( 'IMP_FEED_TABLE', 'POSITION_DELTA' ) ){
      return 1;
   }


   return getConfig( 'IMP_FEED_TABLE', $shortName );

}
push @EXPORT, qw( &isProcEnabled );

# Format a value as specified, logging any major variances between value and specified format
#
# Parameters
#     column      column name
#     value       value to be formatted
#     typeRef     Array reference containing type, length, precision, and scale
#
sub formatValue {
   my( $column, $row, $value, $typeRef ) = @_;
   if( !defined( $typeRef ) || !$typeRef ){
      if( $value =~ /[+-]?\d*\.?\d*/ ){
         $value =~ s/(\.\d*?)0+$/$1/;  # rm trailing zeros
         $value =~ s/^\+//; # rm '+' sign
         $value =~ s/\.$//;  # rm trailing decimal point if now exposed
         $value =~ s/^\-0$/0/;  # change -0 to 0 (can occur with rounding)\
      }
      return $value;
   }

   if( $$typeRef[0] eq 'VARCHAR' && length( $value ) > $$typeRef[1] ){
      exception( "Data exception in $column row $row: String truncation, value '$value'", 'WRN', 'LD' );
      $value = substr( $value, 0, $$typeRef[1] );
      $exceptions++;
   } elsif( $$typeRef[0] eq 'NUMERIC' || $$typeRef[0] eq 'LONG' ){
      # Check to make sure value is numeric
      if( $value !~ /^\s*[+-]?\d*\.?\d*(e[+-]?\d+)?\s*$/i ){
         exception( "Data exception in $column row $row: Non-numeric data, value '$value'", 'WRN', 'LD' );
         $value = '';
         $exceptions++;
      } else {

         my $length = $$typeRef[2];

         if( $$typeRef[3] != 0 ){
            $length++;
         }

         if( $value < 0 ){
            $length++;
         }

         # Format to correct scale
         $value = sprintf( "%." . $$typeRef[3] . "f", $value );

         # Check Precision
         if( length( $value ) > $length ){
            exception( "Data exception in $column row $row: Numeric precision too large for column, value $value", 'WRN', 'LD' );
            $value = '';
            $exceptions++;
         } else {
            $value =~ s/(\.\d*?)0+$/$1/;  # rm trailing zeros
            $value =~ s/\.$//;  # rm trailing decimal point if now exposed
            $value =~ s/^\-0$/0/;  # change -0 to 0 (can occur with rounding)
         }
      }
   } elsif( $$typeRef[0] eq 'DATE' ){
      # Enforce format: YYYYMMDD HH:MM:SS
      if( $value !~ /^(\d{8})( \d\d:\d\d:\d\d)?$/ || $1 < 19000000 ){
         exception( "Data exception in $column row $row: Invalid date format, value '$value'", 'WRN', 'LD' );
         $value = '';
         $exceptions++;
      }
   } elsif( $$typeRef[0] eq 'REAL' ){
      if( $value !~ /^\s*[+-]?\d*\.?\d*(e[+-]?\d+)?\s*$/ ){
         exception( "Data exception in $column row $row: Non-numeric data, value '$value'", 'WRN', 'LD' );
         $value = '';
         $exceptions++;
      }
      $value =~ s/(\.\d*?)0+$/$1/;  # rm trailing zeros
      $value =~ s/^\+//; # rm '+' sign
      $value =~ s/^0+(\d+)/$1/;  # rm initial zeros
      $value =~ s/\.$//;  # rm trailing decimal point if now exposed
      $value =~ s/^\-0$/0/;  # change -0 to 0 (can occur with rounding)
   }

   return $value;

}
push @EXPORT, qw( &formatValue );

# Create CRD-default file name
#
# For Exports:
#     (customer_cd).(feedcode).(filetype).(sequencenumber)
# For Imports:
#     (feedcode).(filetype).(sequencenumber)
#
# Parameters:
#     type    import/export table name
#
sub standardFileName{
   my( $table ) = @_;
   my( $type, $feedCd, $sequenceId, $customerCd, $name );

   #
   # Retrieve loader file names from database -- this should be done once only
   #

   if( isTrue( getConfig( 'GLOBAL', 'EXPORT_RUN' ) ) ){
      $type = $table;
   } else {
      if( !%{ getConfigSection( 'LOADER_FILES' ) } ){
         addConfigDefinitionsFromDB( 'CRD', 'cs_dict_tables', "'LOADER_FILES'", 'table_name', 'loader_file', 'loader_file IS NOT NULL' );
      }
      $type = getConfig( 'LOADER_FILES', $table );
   }

   #
   # Default to table name minus any prefixes
   #

   if( !defined( $type ) || $type !~ /\S/ ){
      $type = lc( $table );
      $type =~ s/^csm_//;
      $type =~ s/^cs_//;
      $type =~ s/^ts_//;
      $type =~ s/^pma_//;
      $type =~ s/^imp_//;
      $type =~ s/^exp_//;
      $type =~ s/import_//;
      $type =~ s/(^|_)([a-z])/$1\U$2/g;
   }

   $feedCd = getConfig( 'GLOBAL', 'FEEDCODE' );
   $sequenceId = getConfig( 'GLOBAL', 'SequenceID' );
   $customerCd = getConfig( 'CSM_PARAMETER', 'CUSTOMER_CD' );
   $name = '';
   if( $customerCd && isTrue( getConfig( 'GLOBAL', 'EXPORT_RUN' ) ) ){
      $name = $customerCd.".";
   }
   if( $feedCd ){
      $name .= $feedCd.".";
   }
   $name .= $type;
   if( $sequenceId ){
      $name .= ".".$sequenceId;
   }
   return $name
}
push @EXPORT, qw( &standardFileName );

# Launch remote version of script
#
# Parameters:
#     type     type of run (COMPLIANCE, ...)
#     cmd      command
#     argv     argument list
#
sub launchRemote{
   my( $type, $cmd, $param_2, @argv ) = @_;
   my( $os, $rcp, $rsh, $remoteHost, $remoteLogId, $remoteDir, $remotePerl, $remoteIni, $logFile, $error );
   my( $dbWrapper, $dbh, $sql, $beginTime, $result, $param_2_abort, $time, $timeout );

   $dbWrapper = ImportLib::DBWrapper -> new();
   $dbh = $dbWrapper -> getHandle();

   ( undef, undef, $cmd ) = File::Spec -> splitpath( $cmd );

   $os = getOS();
   $remoteHost = requireParameter( $type, 'Host_Name' );
   $remoteLogId = requireParameter( $type, 'Host_User' );
   $remoteDir = requireParameter( $type, 'Host_Directory' );
   $remoteDir =~ s/\\/\\\\/g;
   $remotePerl = requireParameter( $type, 'Host_Perl' );
   $remotePerl =~ s/\\/\\\\/g;
   $remoteIni = getConfig( $type, 'Host_Ini_File' );
   $remoteIni =~ s/\\/\\\\/g;

   # determine correct remote shell command
   if( $os eq "HPUX" ){
      $cmd = "remsh $remoteHost -l $remoteLogId -n $remotePerl $remoteDir/bin/$cmd";
   } elsif( $os eq "SOLARIS" ){
      $cmd = "remsh $remoteHost -l $remoteLogId -n $remotePerl $remoteDir/bin/$cmd";
   } elsif( $os eq "WINDOWS" ){
      $cmd = "rsh.exe $remoteHost -l $remoteLogId -n $remotePerl $remoteDir\\bin\\$cmd";
   } else {
      exception( "Unknown operating system: $os" );
   }
   $cmd .=  " -l @argv";

   #
   # Remove specification of local cm_batch.ini and replace with remote version
   #

   $cmd =~ s/\s+\-i\s*\S+//g;
   if( $remoteIni ){
      $cmd .= " -i $remoteIni";
   }

   #
   # Get current server time
   #

   if( $dbWrapper -> isOracle() ){
      $sql = "SELECT 'to_date(' || to_char(sysdate,'YYYYMMDDHH24MISS') || ',''YYYYMMDDHH24MISS'')' FROM dual";
      $beginTime = $dbh -> selectrow_array( $sql );
   } else {
      $sql = "SELECT convert(varchar, getdate(), 109) FROM dual";
      $beginTime = $dbh -> selectrow_array( $sql );
      $beginTime = "'$beginTime'";
   }

   debug( "System Command", $cmd, 'cmd' );
   open( CMD, "$cmd -l |" ) ||
      exception( "Unable to execute remote run: $!" );

   $logFile = makeFilePath( getConfig( 'GLOBAL', 'DIRECTORY_LOG' ), getConfig( 'GLOBAL', 'LOG_FILE' ) );
   open( LOG, ">>$logFile" ) ||
      exception( "Unable to open $logFile: $!" );

   #
   # Log both to terminal and log file
   #

   $error = 2;
   while( <CMD> ){
      print;
      print LOG;
      if( $error == 2 ){
         $error = 0;
      }

      # Look for any explicit errors
      if( /Error\s*\:/ ){
         $error = 1;
      }
   }

   close CMD ||
      exception( "Error executing remote run: $!" );

   if( $error ){
      exception( "Error executing remote run" );
   }

   #
   # If no explicit errors, look for successful message from script
   # sometimes rsh exits before remote process exits
   #

   if( $param_2 ){

      $dbh = $dbWrapper -> getHandle();

      # Should probably be feeding this in as parameter, but don't want to touch
      # other scripts for now.
      $param_2_abort = $param_2;
      $param_2_abort =~ s/\_Finish//i;
      $param_2_abort .= '_Abort';
      $timeout = getConfig( $type, 'Remote_Timeout', 3600 );

      $time = 0;
      while( 1 ){
         # Look for success message in database for time after beginning timestamp
         $sql = "SELECT count(*) FROM cs_message_log WHERE param_2 = '$param_2' AND timestamp > $beginTime";
         $result = $dbh -> selectrow_array( $sql );
         if( $result >= 1 ){
            return 1;
         } else {
            $sql = "SELECT count(*) FROM cs_message_log WHERE param_2 = '$param_2_abort' AND timestamp > $beginTime";
            $result = $dbh -> selectrow_array( $sql );
            if( $result >= 1 ){
               exception( "Remote process aborted" );
            }
         }

         if( ( $time%300 ) == 0 ){
            report( "Checking for remote process status" );
         }

         $time += 30;
         sleep 30;

         if( $time > $timeout ){
             exception( "Timeout reached.  Remote process status is indetermidate" );
         }
      }
   }

}
push @EXPORT, qw( &launchRemote );

# Print out correct version of usage message
#
# Parameters:
#     msg         Usage message
#     type        ERR, WRN, or MSG  (optional)
#
sub usage{
   my( $msg, $type ) = @_;
   ( undef, undef, my $script ) = File::Spec -> splitpath( $0 );
   if( getOS() eq 'WINDOWS' ){
      $script =~ s/\.pl//;
   }
   $msg =~ s/\$0/$script/g;
   my $out;
   if( $type eq 'MSG' ){
      $out = 'S';
   } else {
      $out = 'SL';
   }
   exception( $msg, $type, $out );
   exit if( $type eq 'MSG' );
}
push @EXPORT, qw( &usage );

# Backup import/export files
#
# Parameters:
#     feedCode       feed code
#     sequenceID     file sequence number
#     files          array of additional files to backup
#
sub backupFiles{
   my( $feedCode, $sequenceID, @files ) = @_;
   my( $dbh, $maxDays, $dir, $backupDirectory, $currName, $currPath, $baseFileNameRE, $tgtPath, $error );

   $maxDays = getConfig( 'GLOBAL', 'MAXBAKDIRAGE', 7 );

   $baseFileNameRE = '^(\\w+\\.)?'.$feedCode."\\.\\w+";
   if( defined( $sequenceID ) && $sequenceID ne '' ){
      $sequenceID = "." . '0' x ( 10 - length( $sequenceID ) ) . $sequenceID;
      $baseFileNameRE .= $sequenceID;
   } else {
      $sequenceID = '';
   }
   $baseFileNameRE .= '(.delta)?$';

   if( isTrue( getConfig( 'GLOBAL', 'EXPORT_RUN' ) ) ){
      report( "Backing up export directories" );
      $dir = getConfig( 'GLOBAL', 'DIRECTORY_EXPORT' );
      $backupDirectory = makeFilePath( $dir, $feedCode.".EXPORT".$sequenceID.".bak" );
   } else {
      report( "Backing up import directories" );
      $dir = getConfig( 'GLOBAL', 'DIRECTORY_IMPORT' );
      $backupDirectory = makeFilePath( $dir, $feedCode.".IMPORT".$sequenceID.".bak" );
   }

   # Create the backup directory if necessary
   if( !( -d $backupDirectory ) ){
      mkdir( $backupDirectory ) ||
         exception( "Error making directory $backupDirectory: $!" );
   }

   # move the appropriate files and purge OLD backup directories
   opendir( DIR, $dir ) ||
       exception( "Unable to open directory $dir: $!" );

   while( defined( $currName = readdir( DIR ) ) ){

      # . or .. or .aaa...
      next if( $currName =~ m/^\./ );

      $currPath = makeFilePath( $dir, $currName );

      # don't delete directory we are to fill
      next if( $currPath eq $backupDirectory );

      if( -d $currPath ){
         # delete if it's an old backup directory
         if( ( -M $currPath ) > $maxDays && ( $currName =~ m/\.bak$/ ) && ( -w $currPath ) ){
            report( "Removing directory $currPath" );
            File::Path::rmtree( $currPath );
         }
      } elsif( -f $currPath && ( $currName =~ m!$baseFileNameRE!i ||
                  ( defined( $sequenceID ) && $currName =~ m!status$sequenceID$!i ) ) ){
         if( !-w $currPath ){
            $error++;
            next;
         }
         rename( $currPath, makeFilePath( $backupDirectory, $currName ) ) ||
            exception( "Error moving file $currName to backup directory: $!", 'WRN' );
     }
   }

   closedir DIR;

   # Move any additional files specified in function call
   foreach $currPath ( @files, @::BACKUP_FILES ){
      ( undef, undef, $currName ) = File::Spec -> splitpath( $currPath );
      $currPath = getFileCase( $currPath );

      if( -e $currPath ){

         if( !-w $currPath ){
            $error++;
            next;
         }

         $tgtPath = makeFilePath( $backupDirectory, $currName );
         if( -e $tgtPath ){
            $tgtPath .= '.2';
         }
         rename( $currPath, $tgtPath ) ||
               exception( "Error moving file $currPath to backup directory: $!.", 'WRN' );
      }
   }

   if( $error ){
      exception( 'Failed to backup one or more files', 'WRN' );
   }

}
push @EXPORT, qw( &backupFiles );

#  Adds a file to the list of files to be backed up
#
#  Parameters:
#   files
#
sub addBackupFile{
    push @::BACKUP_FILES, @_;
}
push @EXPORT, qw( &addBackupFile );

# Get correct case for a file name
#
# Input
#   filePath   path to file
#
sub getFileCase{
   my( $filePath ) = @_;
   my( $fileCase );

   # Case only matters for UNIX
   if( getOS() ne 'WINDOWS' ){
      my( $fileCase ) = bsd_glob( "$filePath*", GLOB_NOCASE );
      if( $fileCase && $filePath =~ /^$fileCase$/i ){
         return $fileCase
      }
   }

   # Return original case if file cannot be found
   return $filePath;

}
push @EXPORT, qw( &getFileCase );

# Log all system calls for debugging
#
# Parameters
#     cmd      Command
#     label    Label for debugging files
#
sub systemLogged{
   my( $cmd, $label ) = @_;
   $label = 'System Command' if( !$label );
   if( getConfig( 'GLOBAL', 'DEBUG' ) ){
      debug( $label, $cmd, 'cmd' );
   }
   $! = 0;
   my $ret = system( splitArgs( $cmd ) );
   if( $! && $ret != 0 ){
      exception( "Unable to execute '$cmd': $!" );
   }
   return $ret;

}
push @EXPORT, qw( &systemLogged );

1;