# ---------------------------------------------------------------------------
# 
# File:    GEN_FILE.pm
#
# Copyright (c) Programming Research, 2004.
#
# Version: 1.5
#
# Written: C.Waddingham 20-Jan-05
#
# Purpose: To provide utility functions for file handling.
#
# History  : 
#  Date       Version By   Comment
#  ---------  ------- ---- ----------------------------------------------
#  06-May-11  1.5     CW   COPY_DIRECTORY_RECURSIVE added.
#  20-Jun-07  1.4     CW   TRUNCATE_FILE now handles dir not exists.
#  05-Dec-05  1.3     CW   TRUNCATE_FILE added.
#                          UNIX_2_DOS added.
#  16-Sep-05  1.2     CW   GEN_SYS:: prefix added to PRINT_STDOUT in 
#                          PRINT_FILE.
#  03-May-05  1.1     CW   Corrected case problem with FILES_ARE_SAME().
#
# ---------------------------------------------------------------------------

package GEN_FILE; #==========================================================

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

BEGIN
{
   use integer;
   use strict;

   require GEN_SYS;
   require GEN_STRING;
   require GEN_PATH;
   require GEN_TIME;
   require File::Copy;

   our $platform_is_windows = GEN_SYS::PLATFORM_IS_WINDOWS();
   our $platform_is_unix    = GEN_SYS::PLATFORM_IS_UNIX();
}

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

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

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

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

   close FILE;
}

#--------------------------------------------------------- COPY_DIRECTORY --

sub COPY_DIRECTORY
{
   # Usage: COPY_DIRECTORY( $source_dir, $target_dir );
   #
   # Copies every file in source_dir to target_dir.
   # Assumes that there are no nested directories, hence does not recurse.
   #
   my $source_dir = shift;
   my $target_dir = shift;

   if ( lc( $source_dir ) eq lc ( $target_dir ) )
   {
      return;
   }
   
   $source_dir = GEN_PATH::REMOVE_FINAL_SEP( $source_dir );
   $target_dir = GEN_PATH::REMOVE_FINAL_SEP( $target_dir );
   
   my $copy_command;

   if ( $GEN_FILE::platform_is_windows )
   {
      $copy_command = "copy/y ";
   }
   elsif ( $GEN_FILE::platform_is_unix )
   {
      $copy_command = "cp ";
   }
   else
   {
      GEN_SYS::DIE( "::COPY_DIRECTORY: Program error - Unknown platform." );
   }

   GEN_PATH::MK_PATH( $target_dir );

   GEN_SYS::EXECUTE_SYSTEM_COMMAND
      ( $copy_command . GEN_STRING::QUOTE_ARG( $source_dir ) . " " .
	   GEN_STRING::QUOTE_ARG( $target_dir ) );
}

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

sub COPY_DIRECTORY_RECURSIVE
{
   # Usage: COPY_DIRECTORY_RECURSIVE( $from_dir_path, $to_dir_path );
   #
   my $from_dir_path = shift;
   my $to_dir_path   = shift;
 
   if ( ( $from_dir_path eq "" ) ||
        ( ! -d $from_dir_path )  ||
        ( $to_dir_path eq "" )
      )
   {
      return;
   }
 
   $from_dir_path = GEN_PATH::APPLY_FINAL_SEP( $from_dir_path );
   $to_dir_path = GEN_PATH::APPLY_FINAL_SEP( $to_dir_path );
 
   my @entries = sort( GEN_PATH::GET_DIRECTORY_ENTRIES( $from_dir_path ) );
 
   ENTRY:
   foreach my $entry ( @entries )
   {
      next ENTRY if $entry eq ".";
      next ENTRY if $entry eq "..";
  
      my $from_entry = $from_dir_path . $entry;
      my $to_entry = $to_dir_path . $entry;
  
      if ( -f $from_entry )
      {
         COPY_FILE( $from_entry, $to_entry );
      }
      elsif ( -d $from_entry )
      {
         COPY_DIRECTORY_RECURSIVE( $from_entry, $to_entry );
      }
   }
}

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

sub COPY_FILE
{
   # Usage COPY_FILE( $source_file_name, $target_file_name );
   #
   my $source_file_name = shift;
   my $target_file_name = shift;

   if ( -e $source_file_name )
   {
      GEN_PATH::MK_PATH( GEN_PATH::DIR_NAME( $target_file_name ) );

      File::Copy::copy( $source_file_name, $target_file_name );
   }
   else
   {
      GEN_SYS::DIE( "::COPY_FILE: File \"$source_file_name\" not found.\n$!" );
   }
}

#------------------------------------------------- COPY_FILE_TO_DIRECTORY --

sub COPY_FILE_TO_DIRECTORY
{
   # Usage COPY_FILE_TO_DIRECTORY( $source_file_name, $target_dir_name );
   #
   my $source_file_name = shift;
   my $target_dir_name  = shift;

   my $target_file_name = GEN_PATH::APPLY_FINAL_SEP( $target_dir_name ) . 
                          GEN_PATH::BASE_NAME( $source_file_name );

   COPY_FILE( $source_file_name, $target_file_name )
}

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

sub DELETE_DIRECTORY_FILE_CONTENT
{
   # Usage: DELETE_DIRECTORY_FILE_CONTENT( $directory_name );
   #
   # Tidy up the supplied directory.
   # i.e. delete all files but no subdirectories nor directory itself.
   #
   my $dir_path = shift;

   my @entries = GEN_PATH::GET_DIRECTORY_ENTRIES( $dir_path );

   my $path = GEN_PATH::APPLY_FINAL_SEP( $dir_path );

   ENTRY:
   foreach my $entry ( @entries )
   {
      next ENTRY if ( $entry eq "." );
      next ENTRY if ( $entry eq ".." );

      DELETE_FILE( $path . $entry );
   }
}

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

sub DELETE_DIRECTORY_RECURSIVE
{
   my $subject_dir = shift;

   if ( ( $subject_dir eq "" ) || ( ! -d $subject_dir ) )
   {
      return;
   }

   $subject_dir = GEN_PATH::APPLY_FINAL_SEP( $subject_dir );

   my @entries = GEN_PATH::GET_DIRECTORY_ENTRIES( $subject_dir );

   ENTRY:
   foreach my $entry ( @entries )
   {
      next ENTRY if $entry eq ".";
      next ENTRY if $entry eq "..";

      my $subj_entry = $subject_dir . $entry;
   
      if ( -f $subj_entry )
      {
         unlink $subj_entry;
      }
      elsif ( -d $subj_entry )
      {
         DELETE_DIRECTORY_RECURSIVE( $subj_entry );
         rmdir $subj_entry;
      }
   }

   rmdir $subject_dir;
}

#----------------------------------------------------- DELETE_FILE --

sub DELETE_FILE
{
   # Usage: DELETE_FILE( $file_path );
   #
   my $file_path = shift;

   if ( -e $file_path )
   {
      unlink $file_path;
   }
}

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

sub DELETE_FILE_OR_DIRECTORY
{
   # Usage: DELETE_FILE_OR_DIRECTORY( $file_or_dir_name );
   #
   my $name = shift;

   return if ( ! -e $name );

   if ( -d $name )
   {
      DELETE_DIRECTORY_RECURSIVE( $name );
   }
   else
   {
      unlink( $name );
   }

   if ( -e $name ) 
   {
      GEN_SYS::DIE( "::DELETE_FILE_OR_DIRECTORY: Cannot delete \"$name\"." );
   }
}

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

sub DIRECTORY_EQUALITY
{
   # Usage: DIRECTORY_EQUALITY( $dir_a, $dir_b );
   #
   # Lists to standard output all files in $dir_a and $dir_b that are
   # different.  Is recursive.
   #
   my $dir_a = shift;
   my $dir_b = shift;

   my @a_entries = GEN_PATH::GET_DIRECTORY_ENTRIES( $dir_a );
   my @b_entries = GEN_PATH::GET_DIRECTORY_ENTRIES( $dir_b );

   my %entry_list = ();

   foreach my $a_entry ( @a_entries )
   {
      next if $a_entry eq ".";
      next if $a_entry eq "..";

      $entry_list{ $a_entry } = "A";
   }

   foreach my $b_entry ( @b_entries )
   {
      next if $b_entry eq ".";
      next if $b_entry eq "..";

      $entry_list{ $b_entry } .= "B";
   }

   my $dir_a_t = GEN_PATH::APPLY_FINAL_SEP( $dir_a );
   my $dir_b_t = GEN_PATH::APPLY_FINAL_SEP( $dir_b );

   foreach my $entry ( sort keys %entry_list )
   {
      my $value    = $entry_list{ $entry };
      my $a_exists = index( $value, "A" ) >= 0;
      my $b_exists = index( $value, "B" ) >= 0;

      my $a_entry_name = $dir_a_t . $entry;
      my $b_entry_name = $dir_b_t . $entry;

      my $a_entry_name_q = GEN_STRING::QUOTE_ARG( $a_entry_name );
      my $b_entry_name_q = GEN_STRING::QUOTE_ARG( $b_entry_name );

      if ( $a_exists && $b_exists )
      {
         if ( ( -f $a_entry_name ) && ( -f $b_entry_name ) )
         {
            if ( ! FILE_EQUALITY( $a_entry_name, $b_entry_name ) )
            {
               print "<> $a_entry_name_q, $b_entry_name_q\n";
            }
         }
         elsif ( ( -d $a_entry_name ) && ( -d $b_entry_name ) )
         {
            DIRECTORY_EQUALITY( $a_entry_name, $b_entry_name );
         }
         else
         {
            GEN_SYS::DIE( "::DIRECTORY_EQUALITY: Type mismatch " .
                          "\"$a_entry_name_q\", \"$b_entry_name_q\"." );
         }
      }
      elsif ( $a_exists )
      {
         print "MISSING: $b_entry_name_q\n";
      }
      else
      {
         print "MISSING: $a_entry_name_q\n";
      }
   }
}
 
# ------------------------------------------------------------ DOS_2_UNIX --

sub DOS_2_UNIX
{
   # Usage: DOS_2_UNIX( $full_file_name );
   #
   my $file_name = shift;

   if ( -e $file_name )
   {
      my $cr = chr( 13 );
      my $lf = chr( 10 );

      my $result = "";

      open FILE, "<$file_name";
      
      while ( my $line = <FILE> )
      {
         # chomp is affected by host system
         # hence cannot be used.
         #
         # chomp $line;

         ( $line = $line ) =~ s/$cr$lf$/$lf/o;

         $result .= $line;
      }
      
      close FILE;
      
      open FILE, ">$file_name";
      binmode FILE;
    
      syswrite( FILE, $result, length( $result ) );
      
      close FILE;
   }
   else
   {
      GEN_SYS::DIE( "::DOS_2_UNIX: \"$file_name\" not found." );
   }
}   

# ------------------------------------------------------------ UNIX_2_DOS --

sub UNIX_2_DOS
{
   # Usage: UNIX_2_DOS( $full_file_name );
   #
   my $file_name = shift;

   if ( -e $file_name )
   {
      my $cr = chr( 13 );
      my $lf = chr( 10 );

      my $result = "";

      open FILE, "<$file_name";
      
      while ( my $line = <FILE> )
      {
         ( $line = $line ) =~ s/$lf$/$cr$lf/o;

         $result .= $line;
      }
      
      close FILE;
      
      open FILE, ">$file_name";
      binmode FILE;
    
      syswrite( FILE, $result, length( $result ) );
      
      close FILE;
   }
   else
   {
      GEN_SYS::DIE( "::UNIX_2_DOS: \"$file_name\" not found." );
   }
}   

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

sub FILES_ARE_SAME
{
   # Usage: $are_same_bool = FILES_ARE_SAME( $filename_a, $filename_b );
   #
   # Uses 'stat' to get inode of each file, where files are specified by
   # their path.  Files are the same file if the inode for each is the same
   #
   my $filename_a = shift;
   my $filename_b = shift;

   # Can only compare if both files exist.
   #
   if ( ! -e $filename_a )
   {
      GEN_SYS::DIE( "::FILES_ARE_SAME: File \"$filename_a\" does not exist." );
   }
   if ( ! -e $filename_b )
   {
      GEN_SYS::DIE( "::FILES_ARE_SAME: File \"$filename_b\" does not exist." );
   }

   if ( $filename_a eq $filename_b )
   {
      return 1;  # true
   }
   else
   {
      if ( $GEN_FILE::platform_is_windows )
      {
         # Can't use Inode approach, however there is no problem with links or
         # equivalent paths to the same file on Windows anyway.
         #
         
         # NB Have to force to lower case as ShortPathName can return results
         # with case variation.
         # e.g.
         # c:\C-CODE_AUDITS\__QAC_TEST\yaz\Current\src\appli\servicereminder.c
         # yields:
         # c:\C-CODE~1\__QAC_~1\yaz\Current\src\appli\SERVIC~1.C
         # while:
         # c:\C-CODE_AUDITS\__QAC_TEST\YAZ\Current\src\appli\servicereminder.c
         # yields:
         # c:\C-CODE~1\__QAC_~1\YAZ\Current\src\appli\SERVIC~1.C
         # 
         # FvdB also evaluate relative paths
         return lc( GEN_PATH::EVALUATE_RELATIVE_PATHS(
                  GEN_SYS::SHORT_PATH_NAME( $filename_a ) )) eq
                lc( GEN_PATH::EVALUATE_RELATIVE_PATHS(
                  GEN_SYS::SHORT_PATH_NAME( $filename_b ) ))
      }
      else
      {
         # Here on Unix.  Use Inode to compare files.
         #
         return GEN_SYS::UNIX_FILE_INODE_VALUE( $filename_a ) == GEN_SYS::UNIX_FILE_INODE_VALUE( $filename_b );
      }
   }
}

# --------------------------------------------------------- FILE_EQUALITY --

sub FILE_EQUALITY
{
   # Usage: $true_if_equal = FILE_EQUALITY( $file_a, $file_b );
   #
   my $file_a = shift;
   my $file_b = shift;

   my $a_bytes = LOAD_FILE_AS_STRING( $file_a );
   my $b_bytes = LOAD_FILE_AS_STRING( $file_b );

   if ( length( $a_bytes ) == length( $b_bytes ) )
   {
      return $a_bytes eq $b_bytes;
   }
   else
   {
      return 0;  # false
   }
}

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

sub FILE_TIMESTAMP
{
   # Usage: $file_timestamp = FILE_TIMESTAMP( $file_name );
   #
   my $file_name = shift;

   my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime,
        $ctime, $blksize, $blocks ) = stat $file_name;

   return $mtime;
}

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

sub LOAD_FILE_AS_ARRAY
{
   # Usage @array_of_lines_of_file = LOAD_FILE_AS_ARRAY( $file_name );
   #
   my $file_name = shift;

   open FILE, "<$file_name" or       
      GEN_SYS::DIE( "::LOAD_FILE_AS_ARRAY: \"$file_name\" not found.\n$!" );
   
   my @file_lines = <FILE>;
 
   close( FILE );

   return @file_lines;
}

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

sub LOAD_FILE_AS_STRING
{
   # Usage $string_image_of_file = LOAD_FILE_AS_STRING( $file_name );
   #
   my $file_name = shift;

   if ( -e $file_name )
   {
      my @file_lines = LOAD_FILE_AS_ARRAY( $file_name );

      return join( "", @file_lines );
   }
   else
   {
      GEN_SYS::DIE( "::LOAD_FILE_AS_STRING: \"$file_name\" not found.\n$!" );
   }
}

# ------------------------------------------------------------------ LPAD --

sub PRINT_FILE
{
   # Usage: PRINT_FILE( $file_name );
   #
   my $file_name = shift;

   open P_FILE, "<$file_name" or 
      GEN_SYS::DIE( "::PRINT_FILE: Cannot open \"$file_name\".\n$!" );

   while ( my $line = <P_FILE> )
   {
      GEN_SYS::PRINT_STDOUT( $line );
   }

   close P_FILE;
}

#---------------------------------------------------------- RM_DIR --

sub RM_DIR
{
   # Usage: RM_DIR( $dir_path );
   #
   my $dir_path = shift;

   DELETE_DIRECTORY_RECURSIVE( $dir_path );
}

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

sub TRUNCATE_FILE
{
   # usage: TRUNCATE_FILE( $file_path );
   #
   my $file_path = shift;

   DELETE_FILE_OR_DIRECTORY( $file_path );

   my $dir = GEN::DIR_NAME( $file_path );

   if ( ! -e $dir )
   {
      GEN_PATH::MK_PATH( $dir );
   }

   open TRUNC_FILE, ">$file_path";

   print TRUNC_FILE "";

   close TRUNC_FILE;
}

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

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

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

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

   close FILE;
}

#-- eof GEN_FILE.pm --------------------------------------------------------
