# ---------------------------------------------------------------------------
# 
# File:    GEN_SYS.pm
#
# Copyright (c) Programming Research, 2004.
#
# Version: 1.10
#
# Written: C.Waddingham 23-Jan-05
#
# Purpose: To provide utility functions for execution control handling.
#
# History  : 
#   Date       Version By   Comment
#   --------   ------- ---- ----------------------------------------------
#   09-May-08  1.10    CW   Fixed $args typo in DIE in EXECUTE_ARGS_WITH_RESULT.
#   17-Apr-08  1.9     CW   EXECUTE_PROGRAM_WITH_RESULT improved.
#   10-Apr-08  1.8     CW   EXECUTE_ARGS_WITH_RESULT modified to improve
#                           handling of case where program and args have
#                           spaces.
#   24-Oct-06  1.7     CW   Fixed call to system() in EXECUTE_PROGRAM_WITH_RESULT
#                           and EXECUTE_PROGRAM.
#                           CR11593. EXECUTE_ARGS & EXECUTE_ARGS_WITH_RESULT added.
#   03-Mar-06  1.6     CW   system() used directly in EXECUTE_PROGRAM_.. subs
#   24-Sep-05  1.5     CW   EXECUTE_PROGRAM_FOR_STDOUT added.
#   24-Aug-05  1.4     CW   Module variable notation tidied.
#   11-May-05  1.3     CW   FLUSH_STDERR, FLUSH_STDOUT added.
#   05-May-05  1.2     CW   Trace added to DIEX.
#   25-Mar-05  1.1     CW   Exit codes brought in-line with QAC etc.
#
# ---------------------------------------------------------------------------

package GEN_SYS; #===========================================================

require Exporter;
our @ISA = qw( Exporter );

BEGIN
{
   if ( $^O =~ /^MSWin/o )
   {
      # Here when on Windows
      #
      require Win32;     # For Win32::GetShortPathName
   }

   require File::Temp;   # For File::Temp::tempdir

   require FileHandle;   # For FileHandle::autoflush

   FileHandle::autoflush( "STDOUT", 1 );
   FileHandle::autoflush( "STDERR", 1 );

   use integer;
   use strict;

   #-- Prefix for DIE output
   #
   our $die_prefix = "";

   #-- DIE output channels
   #
   our $die_use_stdout = 0;   # false - default, overridden by SET_DIE_STDOUT()
   our $die_use_stderr = 1;   # true  - default, overridden by SET_DIE_STDERR()

   #-- Set platform bools
   #
   our $platform_is_cygwin  = $^O eq "cygwin";
   our $platform_is_unix    = $^O !~ /^MSWin/;
   our $platform_is_windows = $^O =~ /^MSWin/;

   if ( ! $platform_is_cygwin  &&
        ! $platform_is_unix    &&
        ! $platform_is_windows )
   {
      print "Platform \"$^O\" not recognised.\n";
 
      my $configuration_error = 10;
      exit $configuration_error;
   }

   #-- Set path constants
   #
   our $path_delimiter;
   $path_delimiter = ";" if ( $platform_is_windows );
   $path_delimiter = ":" if ( $platform_is_unix );

   our $path_separator;
   $path_separator = "\\" if ( $platform_is_windows );
   $path_separator = "/"  if ( $platform_is_unix );

   #-- Trace file data
   #
   our $trace_filename;
   our $trace_open = 0;  # false
}

# --------------------------------------------------------------------------

sub CLOSE_TRACE
{
   # Usage: CLOSE_TRACE();
   #
   if ( $GEN_SYS::trace_open )
   {
      close TRACE_FILE;

      $GEN_SYS::trace_open = 0;   # false
   }
}

#----------------------------------------------------------------------------

sub CREATE_NEW_DIRECTORY
{
   # Usage: $dir_name = CREATE_NEW_DIRECTORY
   #            ( $name_template,
   #              $parent_directory );
   #
   # Creates a directory with name based on $name_template within
   # directory $parent_directory.
   # Returns the path of the created directory.
   #
   my $name_template    = shift;
   my $parent_directory = shift;

   my $dir_name = File::Temp::tempdir( $name_template . "XXXXXX",
                                       DIR => $parent_directory );

   return $dir_name;
}

#---------------------------------------------------------------------------

sub DIE
{
   # Usage: DIE( $str );
   #
   my $str = shift;

   my $program_termination_error = 19;

   DIEX( $str, $program_termination_error );
}

# --------------------------------------------------------------------------

sub DIEX
{
   # Usage: DIEX( $str, $return_code );
   #
   my $str         = shift;
   my $return_code = shift;

   if ( $GEN_SYS::die_use_stdout )
   {
      PRINT_STDOUT( "$GEN_SYS::die_prefix$str\n" );
   }
  
   if ( $GEN_SYS::die_use_stderr )
   {
      PRINT_STDERR( "$GEN_SYS::die_prefix$str\n" );
   }

   TRACE( "DIEX code=>$return_code - $str\n" );

   CLOSE_TRACE();

   EXIT( $return_code );
}

# --------------------------------------------------------------------------

sub EXECUTE_ARGS
{
   # Usage: EXECUTE_ARGS( @args );
   #
   my @args = @_;

   my $ignore_result = EXECUTE_ARGS_WITH_RESULT( @args );
}

# --------------------------------------------------------------------------

sub EXECUTE_ARGS_WITH_RESULT
{
   # Usage: $result_code = EXECUTE_ARGS_WITH_RESULT( @args );
   #
   my $prog_name = shift;
   my @args = @_;

   if ( $GEN_SYS::platform_is_windows )
   {
      my $a_parameter_has_space = 0;   # false

      foreach my $arg ( @args )
      {
         if ( index( $arg, " " ) != -1 )
         {
            $arg = GEN_SYS_QUOTE_ARG( $arg );
            $a_parameter_has_space = 1;   # true
         }
      }

      my $path = GEN_PATH::DIR_NAME( $prog_name );
      my $prog = GEN_PATH::BASE_NAME( $prog_name );

      if ( $path ne "" )
      {
         my $short_path = SHORT_PATH_NAME( $path );

         # Note that $short_path can still contain spaces
         # (see Win32::GetShortPathName documentation), if this is the
         # case die here.
         # 
         if ( ( index( $short_path, " " ) != -1 ) &&
              $a_parameter_has_space
            )
         {
            DIE( "::EXECUTE_ARGS_WITH_RESULT: Windows system limitation - " .
                 "Cannot execute \"$prog_name\" " . join( " ", @args ) );
         }

         $prog_name = $short_path . $prog;
      }
   }

   my $return_code = system( $prog_name, @args );

   return $return_code >> 8;

#!!!   # On PC need to put directory of program onto the path and then run the
#!!!   # program by submitting its name alone (ie without path).  This is due
#!!!   # to a bug in Windows whereby it is not possible to shell out to a 
#!!!   # program with parameters if both the program and the parameters have
#!!!   # embedded spaces.
#!!!   # For Unix this is not necessary so call with full path.
#!!!   #
#!!!   if ( $GEN_SYS::platform_is_windows )
#!!!   {
#!!!	  # Where possible use system directly.
#!!!	  #
#!!!	  if ( index( $prog_name, " " ) == -1 )
#!!!	  {   
#!!!	     $return_code = system( $prog_name, @args );
#!!!	  }
#!!!	  else
#!!!	  {
#!!!	     my $path = GEN_PATH::DIR_NAME( $prog_name );
#!!!	     my $prog = GEN_PATH::BASE_NAME( $prog_name );
#!!!	  
#!!!	     my $env_path = $ENV{ 'PATH' };
#!!!	  
#!!!	     $ENV{ 'PATH' } = $path . ";" . $ENV{ 'PATH' };
#!!!   
#!!!	     $return_code = system( $prog, @args );
#!!!	  
#!!!	     $ENV{ 'PATH' } = $env_path;
#!!!	  }
#!!!   }
#!!!   else
#!!!   {
#!!!	  $return_code = system( $prog_name, @args );
#!!!   }
#!!!
#!!!   return $return_code >> 8;
}

# --------------------------------------------------------------------------

sub EXECUTE_PROGRAM
{
   # Usage: EXECUTE_PROGRAM( $prog_name, $args );
   #
   my $prog_name = shift;
   my $args      = shift;

   # On PC need to put directory of program onto the path and then run the
   # program by submitting its name alone (ie without path).  This is due
   # to a bug in Windows whereby it is not possible to shell out to a 
   # program with parameters if both the program and the parameters have
   # embedded spaces.
   # For Unix this is not necessary so call with full path.
   #
   if ( $GEN_SYS::platform_is_windows )
   {
      # 3-3-06: Previous method (below) fails inexplicably for certain cases,
      #         so where possible use system directly.
      #
      if ( index( $prog_name, " " ) == -1 )
      {   
         # 24-10-06: Changed from system( $prog_name, $args ); to
         #           system( "$prog_name $args" );
         #           to solve problem passing args to SA.
         system( "$prog_name $args" );
    
         return;
      }

      my $path = GEN_PATH::DIR_NAME( $prog_name );
      my $prog = GEN_PATH::BASE_NAME( $prog_name );
   
      my $env_path = $ENV{ 'PATH' };
   
      $ENV{ 'PATH' } = $path . ";" . $ENV{ 'PATH' };

      EXECUTE_SYSTEM_COMMAND( $prog . " " . $args );
   
      $ENV{ 'PATH' } = $env_path;
   }
   else
   {
      EXECUTE_SYSTEM_COMMAND( GEN_SYS_QUOTE_ARG( $prog_name ) . " $args" );
   }
}
   
# ---------------------------------------------------------------------------

sub EXECUTE_PROGRAM_FOR_STDOUT
{
   # Usage: $stdout = EXECUTE_PROGRAM_FOR_STDOUT( $prog_name, $args );
   #
   my $prog_name = shift;
   my $args      = shift;

   # On PC need to put directory of program onto the path and then run the
   # program by submitting its name alone (ie without path).  This is due
   # to a bug in Windows whereby it is not possible to shell out to a 
   # program with parameters if both the program and the parameters have
   # embedded spaces.
   # For Unix this is not necessary so call with full path.
   #
 
   if ( $GEN_SYS::platform_is_windows )
   {
      my $path = GEN_PATH::DIR_NAME( $prog_name );
      my $prog = GEN_PATH::BASE_NAME( $prog_name );
   
      my $env_path = $ENV{ 'PATH' };
   
      $ENV{ 'PATH' } = $path . ";" . $ENV{ 'PATH' };

      my $stdout = `$prog $args`;
      
      $ENV{ 'PATH' } = $env_path;

      return $stdout;
   }
   else
   {
      my $command = GEN_SYS_QUOTE_ARG( $prog_name ) . " $args";

      return `$command`;
   }
}
   
# ---------------------------------------------------------------------------

sub EXECUTE_PROGRAM_WITH_RESULT
{
   # Usage: $result_code = EXECUTE_PROGRAM_WITH_RESULT( $prog_name, $args );
   #
   my $prog_name = shift;
   my $args      = shift;

   # On PC need to put directory of program onto the path and then run the
   # program by submitting its name alone (ie without path).  This is due
   # to a bug in Windows whereby it is not possible to shell out to a 
   # program with parameters if both the program and the parameters have
   # embedded spaces.
   # For Unix this is not necessary so call with full path.
   #
 
   my $return_code;

   if ( $GEN_SYS::platform_is_windows )
   {
      my $path = GEN_PATH::DIR_NAME( $prog_name );
      my $prog = GEN_PATH::BASE_NAME( $prog_name );
   
      # 3-3-06: Previous method (below) fails inexplicably for certain cases,
      #         so where possible use system directly.
      if ( index( $prog_name, " " ) == -1 )
      {
         # 24-10-06: Changed from system( $prog_name, $args ); to
         #           system( "$prog_name $args" );
         #           to solve problem passing args to SA.
	 return system( "$prog_name $args" ) >> 8;
      }
      elsif ( index( $path, " " ) != -1 )
      {
         # 17-04-08: Improved to attempt to ensure spaces in Windows
         #           $prog_name are removed.
         #
         my $short_path = SHORT_PATH_NAME( $path );
   
         $prog_name = $short_path . $prog;

         my $return_code = system( $prog_name, $args );

         return $return_code >> 8;
      }
      else
      {
         my $env_path = $ENV{ 'PATH' };
      
         $ENV{ 'PATH' } = $path . ";" . $ENV{ 'PATH' };
   
         $return_code = EXECUTE_SYSTEM_COMMAND_WITH_RESULT( "$prog $args" );
   
         $ENV{ 'PATH' } = $env_path;
      }
   }
   else
   {
      $return_code = EXECUTE_SYSTEM_COMMAND_WITH_RESULT( GEN_SYS_QUOTE_ARG( $prog_name ) . " $args" );
   }

   return $return_code;
}
   
# ---------------------------------------------------------------------------

sub EXECUTE_SYSTEM_COMMAND
{
   # Usage: EXECUTE_SYSTEM_COMMAND( $command );
   #
   my $command = shift;

   print qx( $command );
}

# -------------------------------------------------------------------------

sub EXECUTE_SYSTEM_COMMAND_WITH_RESULT
{
   # Usage: $return_code = EXECUTE_SYSTEM_COMMAND_WITH_RESULT( $command );
   #
   my $command = shift;

   # Execute the command and divide the result by 256 as the lower byte
   # has the signal number that killed the process (if any) and the eighth
   # bit indicates whether the process dumped core.
   #
   return system( $command ) >> 8; 
}

#---------------------------------------------------------------------------

sub EXIT
{
   # Usage: EXIT( $code );
   #
   my $code = shift;

   CLOSE_TRACE();

   exit( $code );
}

# --------------------------------------------------------------------------

sub FLUSH_STDERR
{
   FileHandle::autoflush( "STDOUT", 1 );
}

#----------------------------------------------------------------------------

sub FLUSH_STDOUT
{
   FileHandle::autoflush( "STDERR", 1 );
}

#----------------------------------------------------------------------------

sub GEN_SYS_QUOTE_ARG
{
   # Usage: $quoted_str = GEN_SYS_QUOTE_ARG( $arg );
   #
   my $arg = shift;

   if ( index( $arg, " " ) != -1 )
   {
      return "\"$arg\"";
   }
   else
   {
      return $arg;
   }
}

#----------------------------------------------------------------------------

sub GET_DIE_PREFIX
{
   # Usage: $prefix = GET_DIE_PREFIX();
   #
   # Return string ($prefix) currently prepended to DIE messages.
   #
   return $GEN_SYS::die_prefix;
}

# -------------------------------------------------------------------------

sub GET_PATH_DELIMITER
{
   # Usage: $delimiter = GET_PATH_DELIMITER();
   #
   # Returns either ; for dos, or : for unix.
   #
   return $GEN_SYS::path_delimiter;
}

# -------------------------------------------------------------------------

sub GET_PATH_SEPARATOR
{
   # Usage: $path_separator = GET_PATH_SEPARATOR();
   #
   return $GEN_SYS::path_separator;
}

# --------------------------------------------------------------------------

sub GET_TRACEFILE
{
   # Usage: $trace_filename = GET_TRACEFILE();
   #
   if ( $GEN_SYS::trace_open )
   {
      return $GEN_SYS::trace_filename;
   }
   else
   {
      return "";
   }
}

#------------------------------------------------------------------ INPUT --

sub INPUT
{
   # Usage: $continue = INPUT( $prompt );
   #
   my $prompt = shift;

   print $prompt;
   
   my $result = <STDIN>;
   
   return $result;
}

#---------------------------------------------------------- INPUT_CHOMPED --

sub INPUT_CHOMPED
{
   # Usage: $result = INPUT_CHOMPED( $prompt );
   #
   my $prompt = shift;

   my $result = INPUT( $prompt );

   chomp $result;

   return $result;
}

#----------------------------------------------------------------------------

sub IS_FILE_EXECUTABLE
{
   # Usage: $boolean_executable= IS_FILE_EXECUTABLE( $filename );
   #
   my $filename = shift;

   return ( -x $filename ) || ( -X $filename );
}

# --------------------------------------------------------------------------

sub OPEN_TRACE
{
   # Usage: OPEN_TRACE( $trace_file_name_stem );
   #
   my $trace_file_name_stem = shift;

   $GEN_SYS::trace_filename = "$trace_file_name_stem.trace";

   if ( $GEN_SYS::trace_open )
   {
      close( TRACE_FILE );
   }

   open TRACE_FILE, ">$GEN_SYS::trace_filename" or 
      DIE( "::OPEN_TRACE: Cannot open \"$GEN_SYS::trace_filename\" for writing." );

   $GEN_SYS::trace_open = 1;  # true
}

#----------------------------------------------------------------------------

sub PLATFORM_IS_CYGWIN
{
   return $GEN_SYS::platform_is_cygwin;
}

#----------------------------------------------------------------------------

sub PLATFORM_IS_UNIX
{
   return $GEN_SYS::platform_is_unix;
}

# --------------------------------------------------------------------------

sub PLATFORM_IS_WINDOWS
{
   return $GEN_SYS::platform_is_windows;
}

#----------------------------------------------------------------------------

sub PRINT_STDERR
{
   my $str = shift;

   print STDERR $str;
}

# --------------------------------------------------------------------------

sub PRINT_STDOUT
{
   my $str = shift;

   print $str;
}

# --------------------------------------------------------------------------

sub SET_DIE_PREFIX
{
   $GEN_SYS::die_prefix = shift;
}

# --------------------------------------------------------------------------

sub SET_DIE_STDERR
{
   $GEN_SYS::die_use_stderr = shift;
}

# --------------------------------------------------------------------------

sub SET_DIE_STDOUT
{
   $GEN_SYS::die_use_stdout = shift;
}

# --------------------------------------------------------------------------

sub SHORT_PATH_NAME
{
   # Usage: $windows_short_path = SHORT_PATH_NAME( $path );
   #
   my $path = shift;

   if ( ! defined( $path ) ||
        ( $path eq "" )
      )
   {
      return "";
   }
   elsif ( $GEN_SYS::platform_is_windows )
   {
      return Win32::GetShortPathName( $path );
   }
   else
   {
      return $path;
   }
}

#---------------------------------------------------------------------------

sub TRACE
{
   # Usage: e.g. TRACE( "Assumed platform $Config{'osname'}\n" );
   #
   my $text = shift;

   if ( $GEN_SYS::trace_open )
   {
      if ( exists $ENV{ TRACE } )
      {
         PRINT_STDOUT( $text );
      }

      print TRACE_FILE $text;
   }
}

#----------------------------------------------------------------------------

sub UNIX_FILE_INODE_VALUE
{
   # Usage: $inode = UNIX_FILE_INODE_VALUE( $filename );
   #
   my $filename = shift;

   if ( defined( $filename ) &&
        ( $filename ne "" )
      )
   {
      my ( $dev, $inode, $mode, $nlink, $uid, $gid, $rdev, $size, 
   	   $atime, $mtime, $ctime, $blksize, $blocks ) = stat $filename;

      return $inode;
   }
   else
   {
      return "";
   }
}

#----------------------------------------------------------------------------

sub WRITE_FILE
{
   # Usage: WRITE_FILE( $file_name, @text );
   #
   my $file_name = shift;
   my @text      = @_;

   open FILE, ">$file_name" or 
      DIE( "::WRITE_FILE: Cannot open \"$file_name\".\n$!" );

   foreach my $line ( @text )
   {
      print FILE $line, "\n";
   }

   close FILE;
}

# -- eof GEN_SYS.pm ---------------------------------------------------------
