# ---------------------------------------------------------------------------
# 
# File:    GEN_PATH.pm
#
# Copyright (c) Programming Research, 2004.
#
# Version: 1.11
#
# Written: C.Waddingham 20-Jan-05
#
# Purpose: To provide utility functions for file path handling.
#
# History  : 
#   Date      Version By   Comment
#   --------  ------- ---- ----------------------------------------------
#   01-09-11  1.11    CW   WHICH handling of non-existant paths improved
#   06-05-11  1.11    CW   WHICH handling of ./ improved.
#   21-03-11  1.10    CW   WHICH handling of relative path arg improved.
#   31-01-11  1.9     CW   GET_GLOB_FILE_LIST_CW added.
#   12-01-11  1.8     CW   CR13793 Handle bad relative path in
#                          EVALUATE_RELATIVE_PATHS.
#   23-04-09  1.7     CW   IS_FILE_PATH_ABSOLUTE improved for Windows with Cygwin
#                          path case.
#   11-04-08  1.6     CW   IS_FILE_PATH_ABSOLUTE explicitly handles empty path.
#   07-02-08  1.5     CW   CR12691 - GET_GLOB_FILE_LIST improved for simple files.
#   24-10-06  1.4     CW   PWD() fixed. 
#   15-09-05  1.3     CW   WHICH fixed for prog of ./prog_name.
#   24-08-05  1.2     CW   GET_FILE_PATH_ABSOLUTE $expanded_home_path
#                          correctly declared.
#   24-04-05  1.1     CW   WHICH match on directory corrected.
#
# ---------------------------------------------------------------------------

package GEN_PATH; #==========================================================

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

BEGIN
{
   use integer;
   use strict;

   require GEN_SYS;
   require GEN_STRING;
   require File::Basename;
   require File::Path;
   require Cwd;

   our $path_separator = GEN_SYS::GET_PATH_SEPARATOR();
   our $path_delimiter = GEN_SYS::GET_PATH_DELIMITER();

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

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

sub APPLY_FINAL_SEP
{
   # e.g. $qabin = APPLY_FINAL_SEP( $QACBIN );
   #
   my $path = shift;

   my $path_separator = $GEN_PATH::path_separator;

   if ( ( $path ne "" ) &&
        ( GEN_STRING::RIGHT( $path, 1 ) ne $path_separator ) 
      )
   {
      return $path . $path_separator;
   }
   else
   {
      return $path;
   }
}

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

sub BASE_NAME
{
   # Usage: $stem_and_extension = BASE_NAME( $path );
   #
   my $path = shift;

   return File::Basename::basename( $path );
}

#------------------------------------------------------------- DIR_EXISTS --

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

   return -d $dir_name;
}

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

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;
   my $separator = $GEN_PATH::path_separator;
  
   # Allow both Unix and DOS separators
   #
   $path = NORMALISE_PATH_SEPARATORS( $path );

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

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

sub EVALUATE_RELATIVE_PATHS
{
   # Usage: $simple_path = EVALUATE_RELATIVE_PATHS( $path );
   #
   # Removes embedded .. (ie up one level) specifiers from $path, and
   # . (i.e. current directory)
   #
   my $path = shift;

   # Allow both Unix and DOS separators
   #
   my @path_elements = SPLIT_PATH( $path );

   # For case of empty path, return empty path
   #
   if ( $#path_elements == -1 )
   {
      return "";
   }

   my @result         = ();
   my $result_cursor  = 0;   # - points to one beyond last @result element.
   my $element_cursor = 0;   # - points to current @path_elements to process.

   # Always include leading ".."
   #
   LEADING_DOT_DOT:
   while ( $path_elements[ $element_cursor ] eq ".." )
   {
      $result[ $result_cursor ] = "..";
      ++$result_cursor;
 
      ++$element_cursor;
      last LEADING_DOT_DOT if ( $element_cursor > $#path_elements );
   }

   # Process the remaining elements of the path.
   # Append each non ".." element,
   # Remove from result for each "..".
   #
   REMAINDER:
   while ( $element_cursor <= $#path_elements )
   {
      my $element = $path_elements[ $element_cursor ];

      if ( $element eq ".." )
      {
         --$result_cursor;
      }
      elsif ( $element ne "." )
      {
         if ( $result_cursor < 0 )
         {
            GEN_SYS::DIE( "::EVALUATE_RELATIVE_PATHS: Path \"$path\" is illegal.\n" );
         }
           
         $result[ $result_cursor ] = $element;
         ++$result_cursor;
      }

      ++$element_cursor;
   }

   my $separator   = $GEN_PATH::path_separator;
   my $result_path = $result[ 0 ];

   for ( my $i = 1; $i < $result_cursor; ++$i )
   {
      $result_path .= $separator . $result[ $i ];
   }

   return $result_path;
}

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

sub EVALUATE_SYMBOLIC_LINK
{
   # Usage: $filename = EVALUATE_SYMBOLIC_LINK( $filename );
   #
   # If supplied $filename is a symbolic link, this sub returns the path
   # of the file that is linked.
   # If supplied $filename is a plain file, it is returned unchanged.
   #
   my $filename = shift;

   $filename = GET_FILE_PATH_ABSOLUTE( $filename );

   $filename = REMOVE_FINAL_SEP( $filename );

   while ( -l $filename )
   {
      # Here when $filename is a symbolic link.  Expand it.
      #
      $filename = readlink( $filename );

      $filename = GET_FILE_PATH_ABSOLUTE( $filename );
   }

   return $filename;
}

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

sub EXECUTABLE_EXISTS
{
   # Usage: $boolean_exists = EXECUTABLE_EXISTS( $name );
   #
   # Simply use return WHICH( $name ) ne "";
   # as WHICH() will find any matching executable on Unix,
   # or any program or non-executable matching $name in PATH.
   #
   my $name = shift;

   return WHICH( $name ) ne "";
}

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

sub EXECUTABLE_FULL_NAME
{
   # Usage: $full_program_name = EXECUTABLE_FULL_NAME( $program_name );
   #
   my $program_name = shift;

   my $executable_full_name = "";

   if ( $GEN_SYS::platform_is_unix )
   {
      $executable_full_name = $program_name;
   }
   else
   {
      if ( -e "$program_name.exe" )
      {
         $executable_full_name = "$program_name.exe";
      }
      if ( -e "$program_name.com" )
      {
         $executable_full_name = "$program_name.com";
      }
      elsif ( -e $program_name )
      {
         $executable_full_name = $program_name;
      }
   }

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

   $executable_full_name = GET_FILE_PATH_ABSOLUTE( $executable_full_name );
   $executable_full_name = EVALUATE_RELATIVE_PATHS( $executable_full_name );

   return $executable_full_name;
}

#------------------------------------------------------------ FILE_EXISTS --

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

   return -f $file_name;
}

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

sub FILE_EXTENSION
{
   # Usage: $extn = FILE_EXTENSION( $path );
   #
   # Given (say) "\user\local\stem.extn", returns ".extn"
   #
   my $path = shift;

   # Remove any leading DOS drive name
   #
   ( $path = $path ) =~ s/^[a-z]+://oi;

   my $base_name = BASE_NAME( $path );

   my $i_pos = rindex( $base_name, "." );

   if ( $i_pos == -1 )
   {
      return "";
   }
   else
   {
      return substr( $base_name, $i_pos );
   }
}

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

sub FILE_REF
{
   # Usage: $file_ref = GEN::FILE_REF( $filename );
   #
   # Returns SHORT_PATH_NAME for Windows files, or inode for Unix files.
   #
   my $filename = shift;

   if ( $GEN_PATH::platform_is_windows )
   {
      return GEN_SYS::SHORT_PATH_NAME( $filename );
   }
   else
   {
      return GEN_SYS::UNIX_FILE_INODE_VALUE( $filename );
   }
}

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

sub FORCE_SEPARATORS
{
   # e.g. $qabin = FORCE_SEPARATORS( $QACBIN, "/" );
   #
   my $path      = shift;
   my $separator = shift;

   ( $path = $path ) =~ s/\//$separator/g;
   ( $path = $path ) =~ s/\\/$separator/g;

   return $path;
}

# ---------------------------------------------- GET_ALL_SUB_DIR_PATHS_IN --

sub GET_ALL_SUB_DIR_PATHS_IN
{
   # Usage: @list_of_sub_paths_of_each_sub_dir = 
   #           GET_ALL_SUB_DIR_PATHS_IN( $dir_path );
   #
   my $dir_path = APPLY_FINAL_SEP( shift );

   my @dir_paths = GET_SUB_DIRECTORY_PATHS( $dir_path );
   my @sub_paths = @dir_paths;

   PATH:
   foreach my $path ( @dir_paths )
   {
      @sub_paths = ( @sub_paths, GET_ALL_SUB_DIR_PATHS_IN( $path ) );
   }

   return @sub_paths;
}

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

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

   if ( ! -e $dir_path )
   {
      GEN_SYS::DIE( "::GET_DIRECTORY_ENTRIES: Directory \"$dir_path\" does not exist.\n$!" );
   }

   my @entries = ();

   if ( opendir( DIR, $dir_path ) )
   {
      @entries = readdir DIR;

      closedir DIR;
   }

   return @entries;
}

# ------------------------------------------------------ GET_DIR_NAMES_IN --

sub GET_DIR_NAMES_IN
{
   # Usage: @list_of_names_of_each_sub_dir = GET_DIR_NAMES_IN( $dir_path );
   #
   my $dir_path = APPLY_FINAL_SEP( shift );

   if ( ! -e $dir_path )
   {
      return ();
   }

   my @entries = GET_DIRECTORY_ENTRIES( $dir_path );

   my @list_of_sub_dirs = ();

   ENTRY:
   foreach my $entry ( @entries )
   {
      next ENTRY if $entry eq ".";
      next ENTRY if $entry eq "..";
   
      if ( -d $dir_path . $entry )
      {
         push @list_of_sub_dirs, $entry;
      }
   }

   return @list_of_sub_dirs;
}

# ----------------------------------------------------- GET_FILE_NAMES_IN --

sub GET_FILE_NAMES_IN
{
   # Usage: @list_of_paths_to_each_file = GET_FILE_NAMES_IN( $dir_path );
   #
   my $dir_path = APPLY_FINAL_SEP( shift );

   if ( ! -e $dir_path )
   {
      return ();
   }

   my @entries = GET_DIRECTORY_ENTRIES( $dir_path );

   my @list_of_paths_to_each_file = ();

   ENTRY:
   foreach my $entry ( @entries )
   {
      if ( -f $dir_path . $entry )
      {
         push @list_of_paths_to_each_file, $dir_path . $entry;
      }
   }

   return @list_of_paths_to_each_file;
}

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

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 = NORMALISE_PATH_SEPARATORS( $path_param );

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

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

   if ( $GEN_PATH::platform_is_windows )
   {
      my $ch2_3 = substr( $path, 1, 2 );

      if ( ( $ch2_3 eq ":\\" ) ||
           ( $ch2_3 eq ":/" )
         )
      {
         # Have absolute path
         #
         return $path;
      }
      else
      {
         # Here when path is relative.
         # Calc absolute path.
         #

         # First check case like  A:fred
         # Check that drive is the drive of the current dir.
         # If same then make relative to current dir
         # Otherwise don't know what current dir is for specified
         # drive, so fail program
         #

         my $current_dir_path = PWD();
         $current_dir_path = GEN_STRING::TRIM( $current_dir_path );

         my $abs_path;
         
         if ( substr( $path, 1, 1 ) eq ":" )
         {
            # Here with drive spec in supplied parameter ( $path_param ).
            #
         
            # Get that drive spec.
            #
            my ( $drive_specified, $path_specified, $junk ) = split( ":", $path, 3 );
         
            # Get the currently logged drive.
            #
            my ( $current_drive, $rest ) = split( ":", $current_dir_path, 2 );
         
            # Can only resolve a relative path of a drive which is the current drive.
            # e.g. can do:
            #   current drive is C:
            #   path is          C:fred
            # Cannot do
            #   current drive is C:
            #   path is          D:fred
            # as don't know the current directory on D:
            #
         
            if ( lc( $drive_specified ) eq lc( $current_drive ) )
            {
               $abs_path = APPLY_FINAL_SEP( $current_dir_path ) . $path_specified;
            }
            else
            {
               GEN_SYS::DIE( "::GET_FILE_PATH_ABSOLUTE: Cannot derive absolute " .
                             "path for \"$path_param\".\n" );
            }
         }
         else
         {
            # Here with no drive spec in $path, i.e. $path_param.
            #
            $abs_path = APPLY_FINAL_SEP( $current_dir_path ) . $path;
         }
         
         # Remove any leading .\ pairs
         #
         ( $abs_path = $abs_path ) =~ s/^(\.\\)*//o;

         return $abs_path;
      }
   }
   else
   {
      if ( $GEN_PATH::platform_is_cygwin )
      {
   	 my $ch2_3 = substr( $path, 1, 2 );
   
   	 if ( ( $ch2_3 eq ":\\" ) ||
   	      ( $ch2_3 eq ":/" )
   	    )
   	 {
   	    # Have absolute path
   	    #
   	    return $path;
   	 }
      }

      # Platform is Unix ( possibly Cygwin )
      #

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

      # Test for path relative to login directory,
      # i.e. starts with '~'
      #
      if ( $ch1 eq "~" )
      {
         # Here with path relative to login directory
         # Get username e.g. ~fred/dir... or ~/dir... etc
         #
         my $home;
         ( $home = $path ) =~ s/^(~.*?)\/.*/$1/o;

         my $remainder = substr( $path, length( $home ) );

         # Evaluate the $home path
         #
         my $expanded_home_path = `ls -d $home`;
         $expanded_home_path = GEN_STRING::TRIM( $expanded_home_path );

         # Build the absolute path
         #
         return REMOVE_FINAL_SEP( $expanded_home_path ) . $remainder;
      }
      else
      {
   	 my $current_dir_path = PWD();
   	 $current_dir_path = GEN_STRING::TRIM( $current_dir_path );
   
   	 # Remove any leading ./ pairs
   	 #
   	 $path =~ s/^(\.\/)*//o;

   	 return APPLY_FINAL_SEP( $current_dir_path ) . $path;
      }
   }
}

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

sub GET_GLOB_FILE_LIST
{
   # Usage: ( $ar_file_list, $error_string ) = GET_GLOB_FILE_LIST( $filespec );
   #
   # If $filespec does not contain spaces, performs glob() on $filespec.
   #
   # NB glob() cannot handle filespec with spaces.
   #
   # Checks files exist and returns file_list and error status
   # error is returned true (1) if any errors are reported.
   #
   my $filespec_supplied = shift;

   my $no_error = "";  # false => no error

   if ( $filespec_supplied eq "" )
   {
      return ( [], $no_error );
   }

   # Check for case where filespec supplied has no wildcards.
   # If this is the case simply check whether the filespec exists.
   #
   if ( ( index( $filespec_supplied, "?" ) == -1 ) &&
        ( index( $filespec_supplied, "*" ) == -1 )
      )
   {
      # Here when filespec is not wildcarded
      #
      if ( -e $filespec_supplied )
      {
         return ( [ $filespec_supplied ], $no_error );
      }
      else
      {
         return ( [], "Cannot find file \"$filespec_supplied\"\n" );
      }
   }

   # Perl glob works for Unix paths, but has glitches with DOS paths,
   # e.g. C:\fred\--mks.
   # Hence if we are on a DOS platform, translate path separators to
   # Unix ones for the purposes of glob.  And then reverse the separators
   # of the result.
   #

   my $filespec = $filespec_supplied;

   if ( $GEN_PATH::platform_is_windows )
   {
      ( $filespec = $filespec ) =~ s/\\/\//go;
   }

   my @file_list = glob( GEN_STRING::QUOTE_ARG( $filespec ) );

   if ( scalar( @file_list ) == 0 )
   {
      return ( [], "Cannot find file \"$filespec_supplied\"\n" );
   }
   else
   {
      # Here with valid glob
      # 
      my @file_names = ();
      my $error      = $no_error;

      foreach my $file_name ( @file_list )
      {
         if ( $GEN_PATH::platform_is_windows )
         {
            # Reinstate the DOS path separators
            #
	    ( $file_name = $file_name ) =~ s/\//\\/go;
         }

         if ( -e $file_name )
         {
            push @file_names, $file_name;
         }
         else
         {
            $error .= "Cannot find file \"$file_name\"\n";
         }
      }

      return ( \@file_names, $error );
   }
}

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

sub GET_GLOB_FILE_LIST_CW
{
   # Usage: $ar_filepath_list = GET_GLOB_FILE_LIST_CW( $filepath_spec );
   #
   # Similar to Perl glob but only returns 'file' entries.
   #
   # NB glob() cannot handle filespec with spaces.
   # GET_GLOB_FILE_LIST_CW can handle filespec with spaces.
   #
   my $filepath_spec = shift;
  
   my @result_filepath_list = ();
 
   if ( $filepath_spec eq "" )
   {
      return @result_filepath_list;
   }
 
   if ( index( "\\/", GEN_STRING::RIGHT( $filepath_spec, 1 ) ) != -1 )
   {
      # Here when $filepath_spec specifies a directory path ie no files
      # so empty result.
      #
      return ();
   }
 
   $filepath_spec = GET_FILE_PATH_ABSOLUTE( $filepath_spec );

   # Test for no wildcards in entire path
   #
   if ( ( index( $filepath_spec, "*" ) == -1 ) &&
        ( index( $filepath_spec, "?" ) == -1 )
      )
   {
      # Here when filepath_spec is not ambiguous at all.
      # Therefore lookup file directly
      #
      if ( FILE_EXISTS( $filepath_spec ) )
      {
         return ( $filepath_spec );
      }
 
      return ();
   }
 
   my @path_elements_1 = SPLIT_PATH( $filepath_spec );
 
   # Prune any empty path elements
   #
   my @path_elements = ();
   for my $element ( @path_elements_1 )
   {
      if ( $element ne "" )
      {
         push @path_elements, $element;
      }
   }
 
   my @paths = ();
   my $drive = "/";
 
   if ( $GEN_PATH::platform_is_windows || $GEN_PATH::platform_is_cygwin )
   {
      my $first_element = $path_elements[ 0 ];
  
      if ( ( length( $first_element ) == 2 ) &&
           ( GEN_STRING::RIGHT( $first_element, 1 ) eq ":" )
         )
      {
         $drive = shift( @path_elements );
   
         $drive = APPLY_FINAL_SEP( $drive );
         @paths = ( $drive );
      }
      elsif ( $GEN_PATH::platform_is_windows )
      {
         # Here with path like /Program Files..
         # ie no drive.
         # Prepend drive of pwd
         # NB Don't want to do this on Cygwin as root is /
         #
         my $pwd = PWD();
         $drive = GEN_STRING::LEFT( $pwd, 2 );
  
         $drive = APPLY_FINAL_SEP( $drive );
         @paths = ( $drive );
      }
   }
 
   if ( scalar( @path_elements ) > 1 )
   {
      # Here when filepath_spec has a path component
  
      # Calc the list of partial paths of the root element
      #
      @paths = MATCH_SUB_DIRS( $drive, $path_elements[ 0 ] );
  
      PATH_ELEMENT:
      for ( my $i_dir = 1; $i_dir < $#path_elements; ++$i_dir )
      {
         my $dir = $path_elements[ $i_dir ];
         my @new_paths = ();
  
         PARTIAL_PATH:  
         for my $partial_path ( @paths )
         {
            my @matched_dirs = MATCH_SUB_DIRS( $partial_path, $dir );
  
            next PARTIAL_PATH if ( scalar( @matched_dirs ) == 0 );
  
            push @new_paths, @matched_dirs;
         }
  
         if ( scalar( @new_paths ) == 0 )
         {
            # Here when haven't reached full depth of supplied path in
            # $filepath_spec, so quit
            #
            return ();
         }
  
         @paths = @new_paths;
      }
   }
 
   # Here with @paths contains a list of paths resolved to the file level
   #
 
   my $leaf_file_spec = $path_elements[ $#path_elements ];
 
   if ( scalar( @path_elements ) == 0 )
   {
      # Here when no path, if windows may have a drive
      # Either way no files are specified
      #
      return ();
   }
   elsif ( scalar( @path_elements ) == 1 )
   {
      # Here when no path, just a filespec
      #
      @result_filepath_list = MATCH_FILES( $drive, $leaf_file_spec );
  
      return @result_filepath_list;
   }
   else
   {  
      @result_filepath_list = ();
  
      for my $dir_path ( @paths )
      {
         my @matched_files = MATCH_FILES( $dir_path, $leaf_file_spec );
  
         push @result_filepath_list, @matched_files;
      }
 
      return @result_filepath_list;
   }
}

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

sub MATCH_SUB_DIRS
{
   # Usage: @matched_dirs = MATCH_SUB_DIRS( $partial_path, $dir )
   #
   my $partial_path = shift;
   my $dir = shift;
 
   if ( ( index( $dir, "*" ) == -1 ) &&
        ( index( $dir, "?" ) == -1 )
      )
   {
      # Here when $dir has no wildcards ie is specific.
      #
      my $trial_path = $partial_path . $dir;
  
      if ( -d $trial_path )
      {
         return ( GEN::APPLY_FINAL_SEP( $trial_path ) );
      }
  
      return ();
    }
    elsif ( $dir eq "*" )
    {
       # Here when matching all sub-dirs in dir, hence no need to
       # check each, every one is applicable.
       #
       my @list_of_sub_dirs = ();
   
       my @entries = GET_DIRECTORY_ENTRIES( $partial_path );
   
       ENTRY_1:
       foreach my $entry ( @entries )
       {
          next ENTRY_1 if ( $entry eq "." );
          next ENTRY_1 if ( $entry eq ".." );

          my $trial_entry = $partial_path . $entry;

          if ( DIR_EXISTS( $trial_entry ) )
          {
             push @list_of_sub_dirs, APPLY_FINAL_SEP( $trial_entry );
          }
       }
   
       return @list_of_sub_dirs;
    }
    else
    {
      # Here when $dir does have wildcards
      #
  
      my $dir_match = $dir;

      # Escape everything except a-zA-Z_0-9?*
      #
      $dir_match =~ s/([^a-zA-Z0-9_\?\*])/\\$1/g;
      $dir_match =~ s/\?/\.\?/go;
      $dir_match =~ s/\*/\.\*/go;
      $dir_match = "^$dir_match\$";

      my @list_of_sub_dirs = ();
  
      my @entries = GEN::GET_DIRECTORY_ENTRIES( $partial_path );
  
      ENTRY_2:
      foreach my $entry ( @entries )
      {
         next ENTRY_2 if ( $entry eq "." );
         next ENTRY_2 if ( $entry eq ".." );
   
         my $trial_entry = $partial_path . $entry;
   
         if ( DIR_EXISTS( $trial_entry ) )
         {
            if ( $GEN_PATH::platform_is_windows || $GEN_PATH::platform_is_cygwin )
            {
               if ( $entry =~ /^$dir_match$/i )
               {
                  push @list_of_sub_dirs, APPLY_FINAL_SEP( $trial_entry );
               }
            }
            else
            {
               if ( $entry =~ /^$dir_match$/ )
               {
                  push @list_of_sub_dirs, APPLY_FINAL_SEP( $trial_entry );
               }
            }
         }
      }
  
      return @list_of_sub_dirs;
   }
}

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

sub MATCH_FILES
{
   # Usage: @matched_filepaths = MATCH_FILES( $dir_path, $leaf_file_spec )
   #
   my $dir_path = shift;
   my $leaf_file_spec = shift;
 
   if ( ( index( $leaf_file_spec, "*" ) == -1 ) &&
        ( index( $leaf_file_spec, "?" ) == -1 )
      )
   {
      # Here when $leaf_file_spec has no wildcards ie is specific.
      #
  
      my $trial_path = $dir_path . $leaf_file_spec;
  
      if ( -f $trial_path )
      {
         return ( $trial_path );
      }
  
      return ();
   }
   elsif ( $leaf_file_spec eq "*" )
   {
      # Here when matching all files in dir, hence no need to
      # check each, every one is applicable.
      #
  
      my @matched_filepaths = ();
  
      my @entries = GET_DIRECTORY_ENTRIES( $dir_path );
   
      ENTRY_1:
      foreach my $entry ( @entries )
      {
         next ENTRY_1 if ( $entry eq "." );
         next ENTRY_1 if ( $entry eq ".." );

         my $trial_entry = $dir_path . $entry;

         if ( FILE_EXISTS( $trial_entry ) )
         {
            push @matched_filepaths, $trial_entry;
         }
      }
  
      return @matched_filepaths;
   }
   else
   {
      # Here when $leaf_file_spec does have wildcards
      #
  
      my @matched_filepaths = ();
  
      my $leaf_file_spec_match = $leaf_file_spec;
  
      # Escape everything except a-zA-Z_0-9?*
      #
      $leaf_file_spec_match =~ s/([^a-zA-Z0-9_\?\*])/\\$1/go;
      $leaf_file_spec_match =~ s/\?/\.\?/go;
      $leaf_file_spec_match =~ s/\*/\.\*/go;

      my @entries = GET_DIRECTORY_ENTRIES( $dir_path );
    
      ENTRY_2:
      foreach my $entry ( @entries )
      {
         next ENTRY_2 if ( $entry eq "." );
         next ENTRY_2 if ( $entry eq ".." );
   
         my $trial_entry = $dir_path . $entry;
    
         if ( FILE_EXISTS( $trial_entry ) )
         {
            if ( $GEN_PATH::platform_is_windows || $GEN_PATH::platform_is_cygwin )
            {
               if ( $entry =~ /^$leaf_file_spec_match$/i )
               {
                  push @matched_filepaths, $trial_entry;
               }
            }
            else
            {
               if ( $entry =~ /^($leaf_file_spec_match)$/ )
               {
                  push @matched_filepaths, $trial_entry;
               }
            }
         }
      }
  
      return @matched_filepaths;
   }
}
# ----------------------------------------------- GET_SUB_DIRECTORY_PATHS --

sub GET_SUB_DIRECTORY_PATHS
{
   # Usage: @list_of_sub_dir_paths = GET_SUB_DIRECTORY_PATHS( $dir_path );
   #
   my $dir_path = APPLY_FINAL_SEP( shift );

   if ( ! -e $dir_path )
   {
      return ();
   }

   my @entries = GET_DIRECTORY_ENTRIES( $dir_path );

   my @list_of_sub_dir_paths = ();

   ENTRY:
   foreach my $entry ( @entries )
   {
      next ENTRY if $entry eq ".";
      next ENTRY if $entry eq "..";
   
      if ( -d $dir_path . $entry )
      {
         push @list_of_sub_dir_paths, $dir_path . $entry;
      }
   }

   return @list_of_sub_dir_paths;
}

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

sub IS_FILE_PATH_ABSOLUTE
{
   # Usage: $is_absolute_bool = IS_FILE_PATH_ABSOLUTE( $path );
   #
   # Returns true if path starts with \ or / or c:\
   #
   my $path = shift;

   if ( $path eq "" )
   {
       return 0;   # false
   }

   if ( $GEN_PATH::platform_is_windows )
   {
      # Does $path start with '\' ?
      #
      if ( ( GEN_STRING::LEFT( $path, 1 ) eq "\\" ) ||
           ( GEN_STRING::LEFT( $path, 1 ) eq "/" )
         )
      {
         # Have absolute path
         #
         return 1;   # true
      }
      elsif ( ( substr( $path, 1, 2 ) eq ":\\" ) ||
              ( substr( $path, 1, 2 ) eq ":/" )
            )
      {
         # Have absolute path
         #
	 return 1;   # true
      }
      else
      {
         # Here when path is relative.
         #
         return 0;  # false
      }
   }
   else
   {
      if ( $GEN_PATH::platform_is_cygwin )
      {
   	 my $ch2_3 = substr( $path, 1, 2 );
   
   	 if ( ( $ch2_3 eq ":\\" ) ||
   	      ( $ch2_3 eq ":/" )
   	    )
   	 {
   	    # Have absolute path
   	    #
   	    return 1;
   	 }
      }

      # Platform is Unix
      #
      if ( index( "~/", GEN_STRING::LEFT( $path, 1 ) ) != -1 )
      {
         # Have absolute path
         #
         return 1;   # true
      }
      else
      {
         # Here when path is relative.
         #
         return 0;  # false
      }
   }
}

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

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

   eval{ File::Path::mkpath( $path, 0, 0777 ) };

   if ( $@ )
   {
      GEN_SYS::DIE( "Cannot create \"$path\" $@\n" );
   }

   return;

   $path = REMOVE_FINAL_SEP( $path );

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

   my $separator = $GEN_PATH::path_separator;
   my @components_list;

   if ( $separator eq "\\" )
   {
      @components_list = split( /\\/, $path );
   }
   else
   {
      @components_list = split( /$separator/, $path );
   }

   my $z_path = "";
   if ( GEN_STRING::LEFT( $path, 1 ) eq $separator )
   {
      $z_path = $separator;
   }

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

      my $z = REMOVE_FINAL_SEP( $z_path );

      if ( index( $component, ":" ) == -1 )
      {
         if ( -f $z )
         {
            # Here when directory to be created already exists as a file
            #
            GEN_SYS::DIE( "::MK_PATH: cannot create directory \"$z\" - " .
                          "already exists as a file.\n" );
         }
         elsif ( ! -e $z_path )
         {
            mkdir $z_path, 0777;
	 }
      }
   }
}

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

sub NORMALISE_CYGWIN_PATH
{
   # Usage: $path_normalised = NORMALISE_CYGWIN_PATH( $path );
   #
   # If on CYGWIN, then need to ensure sepatators are normalised and
   # that the drive prefix is ok.
   #
   my $path = shift;

   $path = GEN_STRING::TRIM( $path );

   if ( $GEN_PATH::platform_is_cygwin )
   {   
      $path = NORMALISE_PATH_SEPARATORS( $path );
   }

   return $path;
}

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

sub NORMALISE_PATH_SEPARATORS
{
   # Usage: $path_normalised = NORMALISE_PATH_SEPARATORS( $path );
   #
   # Swaps all occurences of \ or / for true path separator.
   #
   my $path = shift;
   
   my $separator = $GEN_PATH::path_separator;

   ( $path = $path ) =~ s/\\/$separator/g;
   ( $path = $path ) =~ s/\//$separator/g;

   return $path;
}

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

sub PWD
{
   # Usage: $current_directory_path = GEN::PWD();
   #

   my $pwd = Cwd::getcwd();

   if ( $GEN_PATH::platform_is_windows )
   {
      $pwd =~ s/\//\\/go;
   }

   return $pwd;
}

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

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

   my $separator = $GEN_PATH::path_separator;
  
   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 GEN_STRING::LEFT( $file_path_str, $last + 1 )
}

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

sub SPLIT_PATH
{
   # Usage: @path_elements = SPLIT_PATH( $path );
   #
   # Separates all elements (directory names and filename) into a list.
   #
   my $path = shift;
   
   my @path_elements = split( /[\\\/]/o, $path );

   return @path_elements;
}

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

sub STEM_NAME
{
   # Usage: $stem = STEM_NAME( $path );
   #
   my $base_name = BASE_NAME( shift );

   my $dot_pos = rindex( $base_name, "." );

   if ( $dot_pos == -1 )
   {
      return $base_name;
   }
   elsif ( $dot_pos == 0 )
   {
      return "";
   }
   else
   {
      return GEN_STRING::LEFT( $base_name, $dot_pos );
   }
}

# --------------------------------------------------------- TEMP_DIR_PATH --

sub TEMP_DIR_PATH
{
   if ( $GEN_PATH::platform_is_windows )
   {
      return "C:" . $GEN_PATH::path_separator . APPLY_FINAL_SEP( "temp" );
   }
   else
   {
      return $GEN_PATH::path_separator . APPLY_FINAL_SEP( "tmp" );
   }
}

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

sub WHICH
{
   # Usage: $full_filename = WHICH( $program_name );
   #
   # Returns absolute path to $program_name or "" if not found.
   #
   # NB WHICH() has the limitation that for Windows, if the
   # supplied file is not an executable file, e.g. fred.txt,
   # then WHICH() will return the first full path of fred.txt in
   # PATH, whether it is executable or not.  It is the responsibility
   # of the user of WHICH() to ensure that a truely executable
   # filename is supplied.
   #
   # For Unix simply uses the 'which' utility.
   # For Windows:
   #    Gets all paths on PATH and for each path:
   #       Looks for $program_name . ( '.exe' | '.com' | '' ).
   #
   # NB For Windows, this sub will return the first file path in PATH
   # that matches $program_name . ( '.exe' | '.com' | '' )
   # This may be a non-executable file.
 
   my $program_name = shift;

   my $separator = $path_separator;

   if ( $program_name eq "" )
   {
      return "";
   }
 
   # No need to lookup if $program_name is absolute.
   #
   elsif ( IS_FILE_PATH_ABSOLUTE( $program_name ) )
   {
      if ( $GEN_SYS::platform_is_windows )
      {
         if ( -e "$program_name.exe" ||
              -e "$program_name.com" ||
              -e $program_name
            )
         {
            return EXECUTABLE_FULL_NAME( $program_name );
         }
         else
         {
            return "";
         }
      }
      else
      {
         if ( -e $program_name )
         {
           return EXECUTABLE_FULL_NAME( $program_name );
         }
         else
         {
           return "";
         }
      }
   }
   # If prog_name is a relative path, then can simply return pwd + path
   #
   elsif ( index( $program_name, $separator )  != -1 )
   {
      if ( $GEN_SYS::platform_is_windows )
      {
         # Here when on Windows.
         #
         if ( -e "$program_name.exe" ||
              -e "$program_name.com" ||
              -e $program_name
            )
         {
            return EXECUTABLE_FULL_NAME( APPLY_FINAL_SEP( PWD() ) . $program_name );
         }
         else
         {
            # Here when prog_name does not exist hence cannot be a valid path.
            #
            return "";
         }
      }
      else
      {
         if ( -e $program_name )
         {
            return EXECUTABLE_FULL_NAME( APPLY_FINAL_SEP( PWD() ) . $program_name );
         }
         else
         {
            return "";
         }
      }
   }
   elsif ( $GEN_SYS::platform_is_unix )
   {
      my $prog      = BASE_NAME( $program_name );
      my $exe_name  = $prog;

      my $path_delimiter = $GEN_PATH::path_delimiter;
      my $path_list      = $ENV{ 'PATH' };

      # Don't append PWD() to try to ensure that $program_name specified as ./name
      # can be found, as want to reflect true Unix behaviour.
      #
      # $path_list .= $path_delimiter . PWD();

      my @paths = split( $path_delimiter, $path_list );
  
      foreach my $path ( @paths )
      {
         $path = APPLY_FINAL_SEP( $path );

         my $try_name = $path . $exe_name;

         if ( -f $try_name )
         {
            # Test for ./ path
            #
            if ( $try_name =~ /^\.\//o )
            {
               # Replace ./ with absolute path of current directory.
               #
               $try_name = APPLY_FINAL_SEP( PWD() ) . substr( $try_name, 2 );
            }

            if ( $^O eq "cygwin" )
            {
               return $try_name;
            }
            elsif ( GEN_SYS::IS_FILE_EXECUTABLE( $try_name ) )
            {
               return $try_name;
            }
         }
      }
   }

   # Here when on Windows.
   #
   else
   {
      my $prog       = BASE_NAME( $program_name );
      my @exe_names = ( "$prog.exe", "$prog.com", $prog );

      my $path_delimiter = $GEN_SYS::path_delimiter;
      my $path_list      = $ENV{ 'PATH' };
      $path_list         = PWD() . $path_delimiter . $path_list;

      my @paths = split( $path_delimiter, $path_list );
  
      foreach my $path ( @paths )
      {
         $path = APPLY_FINAL_SEP( $path );

         foreach my $exe_name ( @exe_names )
         {
            my $try_name = $path . $exe_name;

            if ( -f $try_name )
            {
               # Test for .\ path
               #
               if ( $try_name =~ /^\.[\/\\]/o )
               {
                  # Replace .\ with absolute path of current directory.
                  #
                  $try_name = APPLY_FINAL_SEP( PWD() ) . substr( $try_name, 2 );
               }

               return EXECUTABLE_FULL_NAME( $try_name );
            }
         }
      }
   }

   return "";
}

#-- eof GEN_PATH.pm --------------------------------------------------------
