#!/usr/local/bin/perl
#----------------------------------------------------------------------------
# File    : setup.pl
# Version : 1.1
# Author  : C. Waddingham, PRL.
# Created : 9-November-2009
#	 
# Purpose : Installation script for QAR
#
# Usage   : perl setup.pl [ -trace ] [ -ver ]
#
# Notes   : This is a template which is read by 
#           pkg_qar_unix/build_qar_pkg_unix.pl
#
# History :
# Date       Ver  Init Comment
# 21-11-11   1.1  CW   Added GET_FILE_PATH_ABSOLUTE for user supplied location.
# 09-11-09   1.0  CW   Based on Compliance Modules System setup.pl version 1.6
#----------------------------------------------------------------------------

   use Config;
   use strict;
   use integer;

   $| = 1;

   my $version = "1.1";

   # Display version?
   #
   if ( grep( /^-(v|ver|version)$/io, @ARGV ) > 0 )
   {
      ECHO( "setup.pl version $version" );
      exit;
   }
 
   # Set $trace_on boolean for trace output.
   #
   our $trace_on = grep( /^-trace$/i, @ARGV ) > 0;

   #- Set global constants --------------------------------------------------
   #

   our $module_id  = "QAR-2.1";

   # for Custom Report parameters.
   #
   my @reports_config_data =
   (
      {  "<report_title>"        => "Code Review Report",
         "<report_program_name>" => "perl",
         "<report_param>"        => "xxQAR_HOMExx/bin/qar.pl %Q %P+ %L+ -po qar::report_type=Code\\ Review\\ Report -po qar::report_format=xhtml -po qar::project_name=%J -po qar::logo_file=file:///xxQAR_HOMExx/bin/prqa_logo.png",
      },
      {  "<report_title>"        => "Compliance Report",
         "<report_program_name>" => "perl",
         "<report_param>"        => "xxQAR_HOMExx/bin/qar.pl %Q %P+ %L+ -po qar::report_type=Compliance\\ Report -po qar::report_format=xhtml -po qar::project_name=%J -po qar::logo_file=file:///xxQAR_HOMExx/bin/prqa_logo.png",
      },
      {  "<report_title>"        => "Quality Report",
         "<report_program_name>" => "perl",
         "<report_param>"        => "xxQAR_HOMExx/bin/qar.pl %Q %P+ %L+ -po qar::report_type=Quality\\ Report -po qar::report_format=xhtml -po qar::project_name=%J -po qar::logo_file=file:///xxQAR_HOMExx/bin/prqa_logo.png",
      },
      {  "<report_title>"        => "Suppression Report",
         "<report_program_name>" => "perl",
         "<report_param>"        => "xxQAR_HOMExx/bin/qar.pl %Q %P+ %L+ -po qar::report_type=Suppression\\ Report -po qar::report_format=xhtml -po qar::project_name=%J -po qar::logo_file=file:///xxQAR_HOMExx/bin/prqa_logo.png",
      },
   );
   
   # Path separator:
   #
   our $separator = "/";

   # Installation parameters
   #
   #- Following constant allows for differences between versions of xqac[pp] -
   # 21-Jan-08: .xqacpprc uses 'Custom Report Settings' and '-customreport'
   # instead of 'Custom Reports' and '-customReport'.
   #
   
   our $custom_report_settings;
   our $custom_report;

   $custom_report_settings = "Custom Report Settings";
   $custom_report = "-customreport";

   ECHO( "" );
   ECHO( "" );
   ECHO( "*****************************************************************************" );
   ECHO( "    $module_id Installation Script for UNIX" );
   ECHO( "*****************************************************************************" );
   ECHO( "" );
   ECHO( "- This script must be run directly in the current working directory." );
   ECHO( "  (It should not be run using an absolute or relative path prefix.)" );
   ECHO( "" );
   ECHO( "- On entry to this script, the environment variable QACPATH or QACPPPATH" );
   ECHO( "  or both must be set." );
   ECHO( "" );
   ECHO( "1. This script will optionally create the $module_id home directory," );
   ECHO( "   or alternatively skip that creation step." );
   ECHO( "2. This script will configure the file \$QACPATH/.xqacrc and/or" );
   ECHO( "   \$QACPPPATH/.xqacpprc to allow the following reports to be run:" );
   ECHO( "   - Code Review Report" );
   ECHO( "   - Compliance Report" );
   ECHO( "   - Quality Report" );
   ECHO( "   - Suppression Report" );
   ECHO( "" );

   my $install_files_y_n = INPUT_YN( "Do you wish to install the $module_id fileset (y/n): " );
   my $target;

   if ( $install_files_y_n eq "y" )
   {
      my $install_home = INPUT( "Enter path to install $module_id into: " );

      $install_home = EXPAND_ANY_TILDE_PREFIX( $install_home );

      $install_home = GET_FILE_PATH_ABSOLUTE( $install_home );

      die "$install_home must exist\n" if ( ! -d $install_home );

      $install_home = APPLY_FINAL_SEP ($install_home );

      my $ok_yn = INPUT_YN( "Ok to create $install_home$module_id (y/n): " );

      die "Abandoned\n" if ( $ok_yn ne "y" );

      # Ensure component dirs exist
      # Note cwd is the temporary untarred directory which contains
      # QAR-1.0 (or whatever version) and setup.pl etc.
      #
      die "Script error QAR/bin not found.\n" if ( ! -d "bin" );
      die "Script error QAR/doc not found.\n" if ( ! -d "doc" );
      die "Script error QAR/prdf not found.\n" if ( ! -d "prdf" );
      die "Script error QAR/standard_reports not found.\n" if ( ! -d "standard_reports" );
      die "Script error QAR/Xalan not found.\n" if ( ! -d "Xalan" );
      die "Script error QAR/xerces not found.\n" if ( ! -d "xerces" );
   
      #-- Now copy all installation files to the users target area -------------
      #
      $target = $install_home . APPLY_FINAL_SEP( $module_id );

      # Write all files.
      # For text files in installed directories replace
      # DOS end-lines with Unix end-lines.
      #

      ECHO( "Installing..." );

      COPY_DOS_DIRECTORY( "bin", $target . "bin" );
      COPY_DOS_DIRECTORY( "doc", $target . "doc" );
      COPY_DOS_DIRECTORY( "prdf", $target . "prdf" );
      COPY_DOS_DIRECTORY( "standard_reports", $target . "standard_reports" );
      COPY_DOS_DIRECTORY( "Xalan", $target . "Xalan" );
      COPY_DOS_DIRECTORY( "xerces", $target . "xerces" );

      #-- Ensure qac[pp]user* and qac[pp]cm have a good Perl path --------------
      #
      my $perl_path = `which perl`;
      $perl_path =~ s/[\n\r]+$//go;
      GLOBALLY_EDIT_TEXT_FILES( $target . "bin", "#!/usr/bin/perl", "#!$perl_path" );

      #-- Ensure all files in new bin are executable ---------------------------
      #
      SET_EXECUTABLE_RIGHTS( $target . "bin" );
      SET_EXECUTABLE_RIGHTS( $target . APPLY_FINAL_SEP( "Xalan" ) . "bin" );
      SET_EXECUTABLE_RIGHTS( $target . APPLY_FINAL_SEP( "Xalan" ) . "lib" );
      SET_EXECUTABLE_RIGHTS( $target . APPLY_FINAL_SEP( "xerces" ) . "bin" );
      SET_EXECUTABLE_RIGHTS( $target . APPLY_FINAL_SEP( "xerces" ) . "lib" );
   }
   else
   {
      my $install_home = INPUT( "Enter path at which $module_id is installed: " );

      die "Abandoned\n" if ( $install_home eq "" );

      $install_home = EXPAND_ANY_TILDE_PREFIX( $install_home );

      $install_home = APPLY_FINAL_SEP( $install_home );

      if ( ! -d "$install_home$module_id" )
      {
         die "$install_home$module_id not found\n" ;
      }

      $target = $install_home . APPLY_FINAL_SEP( $module_id );
   }

   if ( ! exists( $ENV{ 'QACPATH' } ) &&
        ! exists( $ENV{ 'QACPPPATH' } )
      )
   {
      ECHO( "Neither QACPATH nor QACPPPATH set hence no configuration performed." );
      ECHO( "Source \$QACPATH/.profile (or \"source \$QACPATH/.cshrc\") or" );
      ECHO( "source \$QACPPPATH/.profile (or \"source \$QACPPPATH/.cshrc\")" );
      ECHO( "and try again." );
      ECHO( "" );

      exit;
   }


   for my $qaproduct ( "QAC", "QACPP" )
   {
      my $qapath      = $qaproduct . "PATH";
      my $dot_xqa_rc  = ".x" . lc( $qaproduct ) . "rc";
   
      # Ensure $qapath has a non-null value
      #
      if ( ( $qapath eq "" ) ||
           ( ! exists( $ENV{ $qapath } ) )
         )
      {
         ECHO( "" );
         ECHO( "\$$qaproduct" . "PATH is not set." );
      
         next;
      }
   
      my $qa_home = APPLY_FINAL_SEP( $ENV{ $qapath } );

      # Test for the $qaproduct Installation
      #
      if ( ! DIR_EXISTS( $qa_home ) )
      {
         ECHO( "" );
         ECHO( "$qaproduct home directory ie $qa_home not found." );
         ECHO( "" );
         ECHO( "Ensure directory exists (i.e. ensure $qaproduct is installed)" );
         ECHO( "and run the following initialisation script:" );
         ECHO( "" );
         ECHO( "    $qa_home" . ".profile   (if in bash, bourne or korn shells)" );
         ECHO( "or  $qa_home" . ".cshrc     (if in csh)" );
         ECHO( "" );
        
         exit;
      }
      elsif ( ! DIR_EXISTS( $qa_home . "bin" ) )
      {   
        ECHO( "" );
        ECHO( "$qaproduct bin directory ie $qa_home" . "bin not found" );
        ECHO( "" );
        ECHO( "This implies that the installation of $qaproduct has not been" );
        ECHO( "performed successfully." );
        ECHO( "" );
        ECHO( "Install $qaproduct and repeat this script." );
        ECHO( "" );
      
        exit;
      }
   
      #-- Add to report configuration if Global Checks report wanted: ----------
      #
      TRACE( "Configuring report(s)" );
   
      #-- Configure report(s) based on .properties etc. ------------------------
      #
      # nb GUI reads product .xqacrc then home .xqacrc
      #
      CONFIGURE_REPORTS( $target, $qa_home, $dot_xqa_rc, @reports_config_data );

      die "\$HOME not defined!\n" if ( ! exists( $ENV{ 'HOME' } ) );

      CONFIGURE_REPORTS( $target, $ENV{ 'HOME' }, $dot_xqa_rc, @reports_config_data );

      ECHO( "Reports configured for $qa_home" );
   }

   #-- End of script. -------------------------------------------------------
   #
   ECHO( "" );

   if ( $install_files_y_n eq "y" )
   {
      ECHO( "$module_id installation complete." );
   }
   else
   {
      ECHO( "$module_id configuration complete." );
   }

   ECHO( "" );

   exit;

#============================================================================

sub SET_EXECUTABLE_RIGHTS
{
   # Usage: SET_EXECUTABLE_RIGHTS( $target_dir );
   #
   my $target_dir = shift;

   TRACE( "Setting rights for $target_dir" );

   my $all = APPLY_FINAL_SEP( $target_dir );

   `chmod +x "$all"*`;

   if ( $? != 0 )
   {
      die "Failed to make $all executable. $!\n";
   }
}

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

sub GLOBALLY_EDIT_TEXT_FILES
{
   # Usage: GLOBALLY_EDIT_TEXT_FILES( $source_dir, $str_old, $str_new );
   #
   # Recursively visits all text files below $source_dir,
   # and applies s/$str_old/$str_new/ to each file.
   #
   my $source_dir = shift;
   my $str_old    = shift;
   my $str_new    = shift;

   $source_dir = APPLY_FINAL_SEP( $source_dir );

   TRACE( "Editing $source_dir files s/$str_old/$str_new/g" );

   if ( ! DIR_EXISTS( $source_dir ) )
   {
      # Here when source directory does not exist.
      #
      die "Program error. Directory $source_dir not found. $!\n";
   }

   my @entries = GET_DIRECTORY_ENTRIES( $source_dir );

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

      my $source_entry_name = $source_dir . $entry;

      if ( -f $source_entry_name )
      {
         if ( -T $source_entry_name )
         {
   	    # Here with text file, e.g. in bin dir may be Perl source.
   	    # Globally replace all $str_old with $str_new.
            # e.g. Replace #!/usr/local/bin/perl with actual perl path.
   	    #
            EDIT_FILE( $source_entry_name, $str_old, $str_new );
         }
      }
      elsif ( -d $source_entry_name )
      {
         GLOBALLY_EDIT_TEXT_FILES( $source_entry_name, $str_old, $str_new );
      }
   }
}

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

sub EDIT_FILE
{
   # Usage: EDIT_FILE( $source_filename, $str_old, $str_new );
   #
   my $source_filename = shift;
   my $str_old         = shift;
   my $str_new         = shift;

   if ( -T $source_filename )
   {
      # Here with text file.
      # Globally replace all $str_old with $str_new.
      # e.g. Replace #!/usr/local/bin/perl with actual perl path.
      #
      my $ar_data = LOAD_TEXT_FILE( $source_filename );
      
      foreach ( @$ar_data )
      {
     	 s/\Q$str_old\E/$str_new/g;
      }
      
      SAVE_TEXT_FILE( $ar_data, $source_filename );
   }
}

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

sub CONFIGURE_REPORTS
{
   # Usage: CONFIGURE_REPORTS( $target, @reports_config_data );
   #
   # Reads existing report definitions from <QACHOME>/.xqacrc.
   # Removes any of those definitions that are in @reports_config_data.
   # Writes @reports_config_data + remaining definitions read-in.
   # Replaces xxQAR_HOMExx with $target
   #
   my $target = shift;
   my $xqacrc_path = shift;
   my $dot_xqa_rc = shift;
   my @reports_config_data = @_;

   # Path to dir for qar.pl
   #
   my $report_programs_location = $target . APPLY_FINAL_SEP( "bin" );

   #-- Prepare new -customReport records ------------------------------------
   #

   my $ar_new_report_data = [];
   my %new_reports_set    = ();

   foreach my $hr_report_record ( @reports_config_data )
   {
      my $report_title        = $$hr_report_record{ "<report_title>" };
      my $report_program_name = $$hr_report_record{ "<report_program_name>" };
      my $report_param        = $$hr_report_record{ "<report_param>" };

      my $full_report_program_name = $report_program_name;

      my $target_t = REMOVE_FINAL_SEP( $target );

      # Escape any spaces in the path (ie in $target_t)
      #
      $target_t =~ s/ /\\ /go;

      $report_param =~ s/xxQAR_HOMExx/$target_t/g;

      my $custom_report_config_line =
         "$custom_report\"\'$report_title\' \'$report_param\' \'" .
         $full_report_program_name . "\' \"\n";
   
      # Add to list of custom report config records
      #
      push @$ar_new_report_data, $custom_report_config_line;

      # Add to lookup of new report names
      #
      $new_reports_set{ $report_title } = "any";
   }

   #-- Get .xqacrc file -----------------------------------------------------
   #

   # $config_file_name is .../qacpp-2.4/.xqacpprc or $HOME/.xqacrc etc
   #
   my $config_file_name = APPLY_FINAL_SEP( $xqacrc_path ) . $dot_xqa_rc;
   
   if ( -e $config_file_name )
   {
      # Here when .xqacrc exists.
      #

      #-- Load existing .xqacrc file ----------------------------------------
      #
      my $ar_config_file_data = LOAD_TEXT_FILE( $config_file_name );
   
      #-- Get the report records 
      #
      my $ar_config_file_rpts = [ grep( /^$custom_report/o, @$ar_config_file_data ) ];

      #-- Remove any existing report records that are in the new set --------
      #

      my @filtered_config_file_rpts = ();

      foreach my $config_file_rpt_record ( @$ar_config_file_rpts )
      {
         $config_file_rpt_record =~ s/[\n\r]+$//go;

         my $existing_report_name;
         ( $existing_report_name = $config_file_rpt_record ) =~ s/^.*$custom_report"'(.*?)'.*$/$1/oi;
   
         if  ( ! exists( $new_reports_set{ $existing_report_name } ) )
         {
            push @filtered_config_file_rpts, "$config_file_rpt_record\n";
         }
      }
   
      #-- Create full config file section: ----------------------------------
      #
      my $ar_config_section = [ @$ar_new_report_data,       # - New reports configuration data.
                                @filtered_config_file_rpts  # - Retained original report data.
                              ];
   
      #-- Write the config file section -------------------------------------
      #
      WRITE_CONFIG_FILE_SECTION( $custom_report_settings, $custom_report, $ar_config_section, $config_file_name );
   }      
   else
   {
      # Here with no existing .xqacrc file found
      #

      #-- Write new .xqacrc file section ------------------------------------
      #
      WRITE_CONFIG_FILE_SECTION( $custom_report_settings, $custom_report, $ar_new_report_data, $config_file_name );
   }
}

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

sub WRITE_CONFIG_FILE_SECTION
{
   # Usage: WRITE_CONFIG_FILE_SECTION( "Custom Reports",
   #                                   "-customReport",
   #                                   $ar_config_section,
   #                                   $config_file_name );
   #
   my $section_tag       = shift;
   my $record_tag        = shift;
   my $ar_config_section = shift;
   my $config_file_name  = shift;

   #-- Load config file -----------------------------------------------------
   #
   my $ar_config_file_data;

   if ( -e $config_file_name )
   {
      my $ar_data = LOAD_TEXT_FILE( $config_file_name );

      #-- Tidy config file --------------------------------------------------
      #
      # Now have all $record_tag records in memory, so expunge all 
      # $record_tag records from config file to ensure that when new section
      # is written that there are no spurious $record_tag records in the 
      # wrong parts of the file.
      #
      if ( $record_tag ne "" )
      {
         $ar_config_file_data = [ grep( ! /^\Q$record_tag\E/i, @$ar_data ) ];      
      }
      else
      {
         $ar_config_file_data = $ar_data;
      }
   }
   else
   {
      $ar_config_file_data = [];
   }
   
   #-- Find the specified section -------------------------------------------
   #
   # 1. Get all lines before the $section_tag in @preamble.
   # 2. Skip all lines in the $section_tag section.
   # 3. Get_all lines after the $section_tag in @postamble.
   #
   my @preamble  = ();
   my @postamble = ();

   my $section_tag_found = 0;  # false
   my $i_line = 0;

   LINE:
   while ( $i_line <= $#$ar_config_file_data )
   {
      # Test for first section heading line
      #
      my $line = $$ar_config_file_data[ $i_line ];

      $line =~ s/[\n\r]+$//go;

      if ( $line =~ /^\s*\*\s*$section_tag\s*$/ )
      {
         # Here when found first line of section heading.
         #
         $section_tag_found = 1;   # true

         # Save the * $section_tag line
         #
         push @preamble, "$line\n";

         # Add any following comment lines associated with the section heading.
         #
         ++$i_line;
         last LINE if ( $i_line == $#$ar_config_file_data );
         
         $line = $$ar_config_file_data[ $i_line ];
         $line =~ s/[\n\r]+$//go;

         while ( $line =~ /^\s*\*/o )
         {
            push @preamble, "$line\n";

            ++$i_line;
            last LINE if ( $i_line == $#$ar_config_file_data );

            $line = $$ar_config_file_data[ $i_line ];
            $line =~ s/[\n\r]+$//go;
         }

         # Here with $i_line points to first data line of section $section_tag
         # Skip to next section - this is marked by the next comment.
         #
         $line = $$ar_config_file_data[ $i_line ];
         $line =~ s/[\n\r]+$//go;

         while ( $line !~ /^\s*\*/o )
         {
            ++$i_line;
            last LINE if ( $i_line == $#$ar_config_file_data );

            $line = $$ar_config_file_data[ $i_line ]; 
            $line =~ s/[\n\r]+$//go;
         }

         # Here with $i_line points to first line after data part of 
         # section $section_tag.
         # Save the remainder of the file as the post-amble.
         #
         push @postamble, $$ar_config_file_data[ $i_line ];
         ++$i_line;

         while ( $i_line <= $#$ar_config_file_data )
         {
            my $line = $$ar_config_file_data[ $i_line ];

            push @postamble, $line;
            ++$i_line;
         }

         last LINE;
      }
      else
      {
         # Here when not yet reached section heading.
         #
         push @preamble, "$line\n";
         ++$i_line;
      }
   }

   # Here having read entire file.
   # Now have @preamble and @postamble, plus $section_tag_found == true
   # if last lines of @preamble contain $section_tag.
   # If $section_tag_found == false then entire file has been read into 
   # @preamble and @postamble must be empty.
   #

   my $ar_result_file;

   if ( $section_tag_found )
   {
      $ar_result_file = [ @preamble, @$ar_config_section, "\n", @postamble ];
   }
   else
   {
      $ar_result_file = [ @preamble, "* $section_tag\n", @$ar_config_section, "\n" ];
   }

   # Rewrite the file
   #
   SAVE_TEXT_FILE( $ar_result_file, $config_file_name );
}

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

sub COPY_DOS_DIRECTORY
{
   # Usage COPY_DOS_DIRECTORY( $source_dir, $target_dir );
   #
   # Copies all files and directories of $source_dir recursively to 
   # $target_dir.  However any sub-directory named "CVS" is not copied.
   #
   my $source_dir = APPLY_FINAL_SEP( shift );
   my $target_dir = APPLY_FINAL_SEP( shift );

   if ( ! -e $source_dir )
   {
      # Here when source directory does not exist.
      #
      die "Program error. Directory $source_dir not found.\n";
   }

   TRACE( "Copying $source_dir to $target_dir" );

   my @entries = GET_DIRECTORY_ENTRIES( $source_dir );

   MK_PATH( $target_dir );

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

      my $source_entry_name = $source_dir . $entry;
      my $target_entry_name = $target_dir . $entry;

      if ( -f $source_entry_name )
      {
         COPY_DOS_FILE( $source_entry_name, $target_entry_name );
      }
      elsif ( -d $source_entry_name )
      {
         COPY_DOS_DIRECTORY
            ( $source_entry_name, 
              $target_entry_name
    	    );
      }
   }
}

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

sub GET_DIRECTORY_ENTRIES
{
   # Usage @entries = GET_DIRECTORY_ENTRIES( $dir_path )
   #
   my $dir_path = shift;

   if ( ! -e $dir_path )
   {
      die "Directory $dir_path does not exist\n";
   }

   if ( ! opendir( DIR, $dir_path ) )
   {
      die "Cannot open $dir_path\n";
   }

   my @entries = readdir DIR;

   closedir DIR;

   return @entries;
}

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

sub APPLY_FINAL_SEP
{
   # 
   # Usage: $path = APPLY_FINAL_SEP( $file_path_str );
   #
   my $file_path_str = shift;
   
   if ( $file_path_str eq "" ) 
   {
      return "";
   }

   my $last_ch = substr( $file_path_str, length( $file_path_str ) - 1, 1 );

   if ( $last_ch eq $separator )
   {
      return $file_path_str;
   }
   else
   {
      return $file_path_str . $separator;
   }
}

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

sub REMOVE_FINAL_SEP
{
   # Usage: $path = REMOVE_FINAL_SEP( $file_path_str );
   #
   my $file_path_str = shift;
   
   if ( $file_path_str eq "" ) 
   {
      return "";
   }

   my $last = length( $file_path_str ) - 1;
   my $last_ch = substr( $file_path_str, $last, 1 );

   while ( $last_ch eq $separator )
   {
      --$last;

      if ( $last eq -1 )
      {
         return "";
      }

      $last_ch = substr( $file_path_str, $last, 1 );
   }

   return substr( $file_path_str, 0, $last + 1 )
}

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

sub DIR_EXISTS 
{
   # 
   # Usage: $true_false = DIR_EXISTS( $dir_name )
   #
   my $dir_name = shift;

   return ( ( -e $dir_name ) &&
            ( -d $dir_name )
          );
}

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

sub COPY_DOS_FILE
{
   # Usage COPY_DOS_FILE( $source_filename, $target_filename )
   #
   my $source_filename = shift;
   my $target_filename = shift;

   if ( -e $source_filename )
   {
      MK_PATH( DIR_NAME( $target_filename ) );
      TRACE( "Writing: $target_filename" );

      if ( ( -T $source_filename ) &&
           ( $source_filename !~ /\.pdf/oi )
         )
      {
         # Here when file is text
         # 
         open IN_FILE, "<$source_filename" or 
            die "$source_filename not found. $!\n";
         binmode IN_FILE;

         MK_PATH( DIR_NAME( $target_filename ) );

         open OUT_FILE, ">$target_filename" or 
            die "Cannot open $target_filename $!\n";

         TRACE( "Writing: $target_filename" );

         # Translate eolns
         #
         my $lf = chr( 10 );
         my $crlf = chr( 13 ) . $lf;

         while ( my $line = <IN_FILE> )
         {
            $line =~ s/$crlf/$lf/o;

            print OUT_FILE $line;
         }

         close IN_FILE;
         close OUT_FILE;
      }
      else
      {
   	 EXECUTE_SYSTEM_COMMAND
   	    ( "cp -f " .
   	      QUOTE_ARG( $source_filename ) . " " .
   	      QUOTE_ARG( $target_filename ) );
      }
   }
   else
   {
      die "File: $source_filename not found. $!\n";
   }
}

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

sub SAVE_TEXT_FILE
{
   # Usage: SAVE_TEXT_FILE( $ar_file_text, $target_filename );
   #
   # Takes supplied monolithic $file_text and saves in $target_filename with
   # Unix eolns
   #
   my $ar_file_text    = shift;
   my $target_filename = shift;

   MK_PATH( DIR_NAME( $target_filename ) );

   open FILE, ">$target_filename" or 
      die "Cannot open $target_filename $!\n";

   TRACE( "Writing: $target_filename" );

   print FILE @$ar_file_text;

   close FILE;
}

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

sub LOAD_TEXT_FILE
{
   #
   # Usage $ar_file_lines = LOAD_TEXT_FILE( $filename );
   #
   my $filename = shift;

   open FILE, "<$filename" or 
      die "$filename not found. $!\n";

   my @file_lines = ();

   while ( my $line = <FILE> )
   {
      push @file_lines, $line;
   }

   close( FILE );

   return \@file_lines;
}

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

sub DIR_NAME
{
   # Usage: $directory_of_file_path = DIR_NAME( $path );
   #
   my $path = shift;
   
   if ( $path eq "" )
   {
      return "";
   }

   my $n_pos = -1;
   my $keep_value;
  
   LOOP:
   for (;;)
   {
      $keep_value = $n_pos;
      $n_pos      = index( $path, $separator, $n_pos + 1 );
      last LOOP if ( $n_pos == -1 );
   }
    
   return substr( $path, 0, $keep_value + 1 );
}

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

sub MK_PATH
{
   # Usage  MK_PATH( $path_to_ensure_created )
   #
   my $path = shift;

   $path = REMOVE_FINAL_SEP( $path );

   if ( $path eq "" )
   {
      return;
   }

   my @components_list = split( /$separator/, $path );

   my $z_path = "";
   if ( substr( $path, 0, 1 ) eq $separator )
   {
      $z_path = $separator;
   }

   foreach my $component ( @components_list )
   {
      $z_path = APPLY_FINAL_SEP( $z_path ) . $component;

      if ( -f $z_path )
      {
         # Here when directory to be created already exists as a file
         #
         die "Cannot create directory $z_path - already exists as a file\n";
      }
      elsif ( ! -e $z_path )
      {
         mkdir $z_path, 0777;
      }
   }
}

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

sub QUOTE_ARG
{
   my $arg = shift;

   if ( index( $arg, " " ) != -1 )
   {
      # Here when $arg has embedded spaces.
      #
      # Must ensure that dont create ...\"
      #
      if ( $arg =~ /\\$/o )
      {
   	 # surround $arg in quotes and escape last \
   	 #
         return "\"$arg\\\"";
      }
      else
      {
   	 # surround $arg in quotes
   	 #
   	 return "\"$arg\"";
      }
   }
   else
   {
      # Here when $arg is simple
      #
      return $arg;
   }
}

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

sub TRACE
{
   # Usage: TRACE( $text );
   #
   my $text = shift;

   if ( $trace_on )
   {
      ECHO( $text );
   }
}

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

sub ECHO
{
   # Usage: ECHO( $text );
   #
   my $text = shift;

   print $text, "\n";
}

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

sub EXECUTE_SYSTEM_COMMAND
{
   my $command = shift;

   `$command`;

##    print qx( $command );
}

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

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

   print $prompt;

   my $value = <STDIN>;

   $value =~ s/[\n\r]+$//go;

   return $value;
}

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

sub INPUT_YN
{
   # Usage: $yn = INPUT_YN( $prompt );
   #
   my $prompt = shift;

   my $yn = INPUT( $prompt );

   while( $yn !~ /^[yn]$/oi )
   {
      $yn = INPUT( $prompt );
   }

   return lc( $yn );
}

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

sub GET_FILE_PATH_ABSOLUTE
{
   # Usage: $path_adjusted = GET_FILE_PATH_ABSOLUTE( $path );
   #
   # If $path is relative, returns as absolute. 
   # If absolute returns unchanged.
   #
   # NB Cannot call trace() or entry() in this routine as TRACE will not
   # be initialised at this routine is called at startup.
   #
   my $path_param = shift;

   # Make sure uniform separators are used.
   #
   ( my $path = $path_param ) =~ s/\\/$separator/g;

   # Test path is legal
   #
   if ( substr( $path, 0, 1 ) eq ":" )
   {
      die( "Illegal path \"$path_param\".\n" );
   }
  
   # Does $path start with '\' or '/'?
   # Allow DOS and Unix path separator of / or \
   #
   my $ch1 = substr( $path, 0, 1 );
   my $first_char_indicates_absolute = ( index( "\\\/" , $ch1 ) >= 0 );

   if ( $first_char_indicates_absolute )
   {
      # Have absolute path
      #
      return $path;
   }

   # Platform is Unix
   #

   # Here when path is relative.
   # Calc absolute path.
   #

   my $current_dir_path = `pwd`;
   $current_dir_path =~ s/[\n\r\t ]+$//go;

   # Remove any leading ./ pairs
   #
   $path =~ s/^(\.\/)*//o;

   return APPLY_FINAL_SEP( $current_dir_path ) . $path;
}

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

sub EXPAND_ANY_TILDE_PREFIX
{
   # Usage: $expanded_path = EXPAND_ANY_TILDE_PREFIX( $path );
   #
   # If $path starts with '~' then '~' is replaced with the users home 
   # directory path.
   #
   my $path = shift;

   if ( $path =~ /^\~\//o )
   {
      return APPLY_FINAL_SEP( $ENV{ 'HOME' } ) . substr( $path, 2 );
   }
   elsif ( $path =~ /^\~/o )
   {
      return APPLY_FINAL_SEP( $ENV{ 'HOME' } ) . substr( $path, 1 );
   }
   else
   {
      return $path;
   }
}

#- eof setup.pl -----------------------------------------------------------
