# ---------------------------------------------------------------------------
# 
# File:    GEN_STRING.pm
#
# Copyright (c) Programming Research, 2004.
#
# Version: 1.4
#
# Written: C.Waddingham 20-Jan-05
#
# Purpose: To provide utility functions for string handling.
#
# History  : 
#   Date      Version By   Comment
#   --------  ------- ---- ----------------------------------------------
#   30-Jan-12 1.4     CW   SPLIT_STRING_ALLOWING_SPECIFIC_QUOTED_TERMS
#                          updated for embedded \ space.
#   21-Mar-11 1.3     CW   SPLIT_COMMAND_LINE_STRING added.
#   20-Jun-07 1.2     CW   QUOTE_ARG now enquotes if arg contains \
#   19-Sep-05 1.1     CW   QUOTE_ARG corrected for $arg of ""
#
# ---------------------------------------------------------------------------

package GEN_STRING; #========================================================

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

BEGIN
{
   use integer;
   use strict;

   require GEN_SYS;

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

# ------------------------------------------------------- CAPITALIZE_WORD --

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

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

   return uc( substr( $str, 0, 1 ) ) . RIGHT2( $str, 1 );
}

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

sub COUNT_STRING
{
   # Usage: $count = COUNT_STRING( $str, $s );
   #
   # Counts the number of $s strings in $str
   #
   my $str = shift;
   my $s   = shift;

   my $s_len = length( $s );

   my $count = 0;
   my $pos   = index( $str, $s );

   while ( $pos != -1 )
   {
      ++$count;
      $pos = index( $str, $s, $pos + $s_len );
   }
   
   return $count;
}
   
#---------------------------------------------------------------------------

sub COUNT_STRING_ALLOWING_ESCAPES
{
   # Usage: $hash_count = COUNT_STRING_ALLOWING_ESCAPES( $str, $char );
   #
   # NB Cannot handle $char == '\n'
   #
   my $str  = shift;
   my $char = shift;

   if ( $char eq "\n" )
   {
     GEN_SYS::DIE( "::COUNT_STRING_ALLOWING_ESCAPES: Program error.  Illegal parameter '\\n'" );
   }

   # Replace all instances of escaped $char, e.g. for char = #, 
   # replace all \# with new line.
   #
   ( $str = $str ) =~ s/\\$char/\n/go;

   return COUNT_STRING( $str, $char );
}
   
#------------------------------------------------------------ EXPAND_TABS --

sub EXPAND_TABS
{
   # Usage: $tab_expanded_line = EXPAND_TABS( $line, $interval );
   #
   my $line     = shift;
   my $interval = shift;

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

   my $str = "";

   foreach my $ch ( split( //, $line ) )
   {
      if ( $ch eq "\t" )
      {
         # Insert spaces for tab
         #
   	 my $str_len = length( $str );
   	 my $new_len = int( ( $str_len + $interval ) / $interval ) * $interval;
   	 my $inc_len = $new_len - $str_len;
   	 $str .= FILL( " ", $inc_len );
      }
      else
      {
         $str .= $ch;
      }
   }

   return $str;
}

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

sub FILL
{
   # Usage: $str = FILL( $char, $nch );
   #
   my $char = shift;
   my $nch  = shift;

   if ( $nch < 1 )
   {
      return "";
   }

   return $char x $nch;
}

# --------------------------------------------------------- FILTER_STRING --

sub FILTER_STRING
{
   # Usage: $filtered_string = FILTER_STRING( $str, $filter );
   #
   # Returns all characters in str that are in filter
   #
   my $str    = shift;
   my $filter = shift;

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

   my $result;
   my $ch;

   for ( my $cursor = 0; $cursor < length( $str ); ++$cursor )
   {
      $ch = substr( $str, $cursor );

      if ( index( $filter, $ch ) != -1 )
      {
         $result .= $ch;
      }
   }

   return $result;
}

# ------------------------------------------------------ GET_QUOTED_ITEMS --

sub GET_QUOTED_ITEMS
{
   # Usage: @items = GET_QUOTED_ITEMS( $str, "<[", "]>" );
   #
   # Returns a list of items in $str that are quoted with 
   # $left_delimiter and $right_delimiter
   #
   my $str             = shift;
   my $left_delimiter  = shift;
   my $right_delimiter = shift;

   my $len_left  = length( $left_delimiter );

   my @items     = ();
   my $pos_right = 0;

   for (;;)
   {
      my $pos_left = index( $str, $left_delimiter, $pos_right );

      if ( $pos_left == -1 )
      {
         return @items;
      }

      $pos_right = index( $str, $right_delimiter, $pos_left );

      if ( $pos_right == -1 )
      {
         return @items;
      }

      my $item_start = $pos_left + $len_left;
      my $item_len   = $pos_right - $item_start;
      my $item       = substr( $str, $item_start, $item_len );

      push @items, $item;
   }
}

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

sub IS_QUOTED
{
   # Usage: $bool = IS_QUOTED( $item, "\'\"" );
   #
   my $item   = shift;
   my $quotes = shift;
   
   if ( length( $item ) < 2 )
   {
      return 0;  # False
   }

   my $first_ch = LEFT( $item, 1 );
   my $last_ch  = RIGHT( $item, 1 );

   my @quote_chars = split( //, $quotes );

   foreach my $ch ( @quote_chars )
   {
      if ( ( $first_ch eq $ch ) && ( $last_ch eq $ch ) )
      {
         return 1;  # true
      }
   }

   return 0;   # false
}

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

sub LEFT
{
   # Usage: $left_hand_str = LEFT( $str, $nch );
   #
   my $str = shift;
   my $nch = shift;

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

   return substr( $str, 0, $nch );
}

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

sub LPAD
{
   # Usage: $str = LPAD( $str, $nch );
   # Returns Str with leading space characters of overall length nch
   #
   my $str = shift;
   my $nch = shift;

   return LPAD_CH( $str, $nch, " " );
}

# --------------------------------------------------------------- LPAD_CH --

sub LPAD_CH
{
   # Usage: $str = LPAD_CH( $str, $nch, $ch );
   # Returns Str with leading ch characters of overall length nch
   #
   my $str = shift;
   my $nch = shift;
   my $ch  = shift;

   my $len_str = length( $str );
   
   if ( $len_str >= $nch )
   {
      return $str;
   }

   return substr( $ch, 0, 1 ) x ( $nch - $len_str ) . $str;
}

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

sub MID
{
   # Usage: $sub_str = MID( $str, $from, $nch );
   #
   my $str  = shift;
   my $from = shift;
   my $nch  = shift;

   my $len = length( $str );

   if ( $nch == 0 )
   {
      return "";
   }
   if ( $from > $len )
   {
      return "";
   }
   elsif ( $from + $nch > $len )
   {
      return RIGHT2( $str, $from );
   }
   else
   {
      return substr( $str, $from, $nch );
   }
}

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

sub QUOTE_ARG
{
   # Usage: $quoted_arg = QUOTE_ARG( $arg );
   #
   # Escapes any embedded quotes.
   # If $arg has embedded spaces or embedded \ , and $arg not already quoted,
   # quotes $arg.
   #
   my $arg_supplied = shift;

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

   # If $arg already quoted, remove quotes.
   #
   my $arg = UNQUOTE( $arg_supplied );

   my $need_quotes = $arg ne $arg_supplied;
   
   # Test for embedded \ in string that is NOT quoted.
   #
   if ( ( $arg eq $arg_supplied ) &&
        ( index( $arg_supplied, "\\" ) != -1 )
      )
   {
      # Here with arg_supplied is not quoted and has embedded \
      #
      # Set $need_quotes to true to force generation of surrounding quotes
      #
      $need_quotes = 1;  # true
   }

   # FvdB also need quotes when option contains single quotes CR12797
   if ( index( $arg, "\'" ) != -1 )
   {
      $need_quotes = 1;  # true
   }
   
   # Here with $arg as bare string that may need quotes if it has
   # embedded spaces.
   #

   # Need to maintain any \\ or \" already in string.
   # Hence separate $arg on \\ and \"
   #

   my @args;
   if ( $arg eq "" )
   {
      @args = ( "" );
   }
   else
   {
      @args = split( (/(\\\\|\\\")/o), $arg );
   }

   # Cannot allow $arg to end in ...\ as this will escape the 
   # applied quote and corrupt the command-line.
   # Similarly settings.via file does not allow paths that end in a
   # bare \
   # e.g. can't have -opC:\prqa\qac-5.0\temp\
   # settings.via can have -op"C:\prqa\qac-5.0\temp\" but this is not
   # suitable as an argument to a Perl program.
   # Achieve this by removing last term of @args if it is '\'.
   #

   my $last_arg = $args[ $#args ];

   if ( ( $last_arg ne "\\\\" ) &&
        ( $last_arg =~ /\\$/o )
      )
   {
      ( $args[ $#args ] = $last_arg ) =~ s/\\$//o;
   }

   SUB_ARG:
   foreach my $sub_arg ( @args )
   {
      next SUB_ARG if ( ( $sub_arg eq "\\\\" ) ||
                        ( $sub_arg eq "\\\"" )
                      );

      # Escape all embedded quotes
      #
      $sub_arg =~ s/\"/\\\"/go;
   }

   # Reinstate $arg by reassembling the components
   #
   $arg = join( "", @args );
   
   # Now quote if necessary.
   #
   if ( $need_quotes ||
        ( $arg =~ /[\s\"]/oi )
      )
   {
      return "\"$arg\"";
   }
   else
   {   
      # Here when no quoting necessary
      #
      return $arg;
   }
}

# ------------------------------------------ REMOVE_ANY_DUPLICATE_SPACES --

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

   my @words = split( " ", $text );

   if ( scalar( @words ) == 0 )
   {
      return "";
   }

   my $result = "";

   for ( my $cursor = 0; $cursor < $#words; ++$cursor )
   {
      $result .= "$words[ $cursor ] ";
   }

   $result .= $words[ $#words ];

   return $result;
}

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

sub RENDER_ARG
{
   # Usage: $rendered_arg = RENDER_ARG( $arg );
   #
   my $arg = shift;

   # Used to avoid passing eoln to errwrt 
   #
   ( $arg = $arg ) =~ s/\n|\r//go;

   return QUOTE_ARG( $arg );
}

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

sub RIGHT
{
   # Usage: $right_hand_str = RIGHT( $str, $nch );
   #
   my $str = shift;
   my $nch = shift;

   my $len_str = length( $str );
   
   if ( $len_str < $nch )
   {
      return $str;
   }

   return substr( $str, $len_str - $nch );
}

# ---------------------------------------------------------------- RIGHT2 --

sub RIGHT2
{
   # Usage: $right_hand_str = RIGHT2( $str, $pos );
   #
   my $str = shift;
   my $pos = shift;

   my $len_str = length( $str );
   
   if ( $len_str < $pos )
   {
      return $str;
   }

   return substr( $str, $pos );
}

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

sub RIGHT_FILL
{
   # Usage: $string = RIGHT_FILL( $template_string, $string_to_apply );
   # 
   my $template_string = shift;
   my $string_to_apply = shift;

   my $template_string_len = length( $template_string );
   my $string_to_apply_len = length( $string_to_apply );

   return substr( $template_string, 
                  0, 
                  $template_string_len - $string_to_apply_len ) .
          $string_to_apply;
}

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

sub RPAD
{
   # Usage: $padded_string = RPAD( $str, $nch );
   #
   # Returns Str with trailing spaces to length of nch
   #
   my $str = shift;
   my $nch = shift;

   my $len_str = length( $str );
   
   if ( $len_str >= $nch )
   {
      return $str;
   }
   
   my $n_pad_ch = $nch - $len_str;

   return $str .  " " x $n_pad_ch;
}

# --------------------------------------------------------------- RPAD_CH --

sub RPAD_CH
{
   # Usage: $str = RPAD_CH( $str, $nch, $ch );
   # Returns Str with trailing ch characters of overall length nch
   #
   my $str = shift;
   my $nch = shift;
   my $ch  = shift;

   my $len_str = length( $str );
   
   if ( $len_str >= $nch )
   {
      return $str;
   }

   return $str . substr( $ch, 0, 1 ) x ( $nch - $len_str );
}

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

sub R_TRIM
{
   # Usage: $trimmed_string = r_trim( $string, $character_to_trim );
   # Removes trailing characters that match $character_to_trim
   #
   my $str = shift;
   my $ch  = shift;

   while ( $str ne "" )
   {
      if ( RIGHT( $str, 1 ) eq $ch )
      {
         $str = LEFT( $str, length( $str ) - 1 )
      }
      else
      {
         last;
      }
   }
   return $str;
}

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

sub SPLIT_ON_QUOTED_ITEMS
{
   # Usage: ( $ar_items, $ar_kind ) = SPLIT_ON_QUOTED_ITEMS( $str, "<[", "]>" );
   #
   # Returns a list of items in $str that are quoted with 
   # $left_delimiter and $right_delimiter, plus the intermediate
   # non-quoted items.
   #
   # Also returns a 'parallel' array of 'kind' information which is one of:
   #  ( RAW_DATA 
   #  	LEFT_DELIMITER
   #  	QUOTED_DATA
   #  	RIGHT_DELIMITER
   #  	INCOMPLETE_QUOTED_DATA
   #  );
   #
   # e.g. Given:
   # $str             = "abcd efgh <![CDATA[klmno pqr ]]> s t <![CDATA[ uvw]]> x y z"
   # $left_delimiter  = "<![CDATA["
   # $right_delimiter = "]]>"
   #
   # Returns $ar_items,            $ar_kind:
   # $items[ 0 ] = "abcd efgh "    "RAW_DATA"
   # $items[ 1 ] = "<![CDATA["     "LEFT_DELIMITER"
   # $items[ 2 ] = "klmno pqr "    "QUOTED"
   # $items[ 3 ] = "]]>"           "RIGHT_DELIMITER"
   # $items[ 4 ] = " s t "         "RAW_DATA"
   # $items[ 5 ] = "<![CDATA["     "LEFT_DELIMITER"
   # $items[ 6 ] = " uvw"          "QUOTED"
   # $items[ 7 ] = "]]>"           "RIGHT_DELIMITER"
   # $items[ 8 ] = " x y z"        "RAW_DATA"
   #
   # Sets last $ar_kind element to "INCOMPLETE_QUOTED_DATA" if
   # $right_delimiter is not found after a $left_delimiter.
   #
   my $str             = shift;
   my $left_delimiter  = shift;
   my $right_delimiter = shift;

   my $ar_items  = [];
   my $ar_kind   = [];

   my $len_left  = length( $left_delimiter );
   my $len_right = length( $right_delimiter );

   # $pos_right is the location of the beginning of the next $right_delimiter.
   # Initially set this pretending that $str is prefixed with
   # $right_delimiter.
   #
   my $pos_right = - $len_right;

   for (;;)
   {
      my $pos_left = index( $str, $left_delimiter, $pos_right + $len_right );

      if ( $pos_left == -1 )
      {
         my $remainder = substr( $str, $pos_right + $len_right );

         if ( $remainder ne "" )
         {
            push @$ar_items, $remainder;
            push @$ar_kind, "RAW_DATA";
         }

         return ( $ar_items, $ar_kind );
      }

      my $raw_data_start = $pos_right + $len_right;
      my $raw_data_len   = $pos_left - $raw_data_start;
      my $raw_data       = substr( $str, $raw_data_start, $raw_data_len );
      push @$ar_items, $raw_data;
      push @$ar_kind, "RAW_DATA";

      push @$ar_items, $left_delimiter;
      push @$ar_kind, "LEFT_DELIMITER";

      $pos_right = index( $str, $right_delimiter, $pos_left );

      if ( $pos_right == -1 )
      {
         my $incomplete_quoted_data = substr( $str, $pos_left + $len_left );

         push @$ar_items, $incomplete_quoted_data;
         push @$ar_kind, "INCOMPLETE_QUOTED_DATA";

         return ( $ar_items, $ar_kind );
      }

      my $quoted_data_start = $pos_left + $len_left;
      my $quoted_data_len   = $pos_right - $quoted_data_start;
      my $quoted_data = substr( $str, $quoted_data_start, $quoted_data_len );
      push @$ar_items, $quoted_data;
      push @$ar_kind, "QUOTED_DATA";

      push @$ar_items, $right_delimiter;
      push @$ar_kind, "RIGHT_DELIMITER";
   }
}

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

sub SPLIT_STRING_ALLOWING_QUOTED_TERMS
{
   # Subroutine to split up a string of terms separated by characters in 
   # the supplied $separator list.  Where some of the terms may be quoted
   # strings that include separators.
   # Note that escaped separators may be embedded.  To do this the 
   # separator is prefixed with \ (backslash).
   #
   # Usage:
   #  @list_of_terms = SPLIT_STRING_ALLOWING_QUOTED_TERMS( $separators, $str );
   #
   my $separators = shift;
   my $str        = shift;

   # This sub has fixed quote character of "
   #
   return SPLIT_STRING_ALLOWING_SPECIFIC_QUOTED_TERMS( $separators, $str, "\"" );
}

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

sub SPLIT_STRING_ALLOWING_SPECIFIC_QUOTED_TERMS
{
   # Subroutine to split up a string of terms separated by characters in 
   # the supplied $separator list.  Where some of the terms may be quoted
   # strings that include separators.
   # Note that escaped separators may be embedded.  To do this the 
   # separator is prefixed with \ (backslash).
   #
   # Usage:
   #  @list_of_terms = SPLIT_STRING_ALLOWING_SPECIFIC_QUOTED_TERMS
   #                     ( $separators, $str, $quote_char );
   #
   my $separators = shift;
   my $str        = shift;
   my $quote_char = shift;

   if ( ( $str eq "" ) || ( $separators eq "" ) )
   {
      return ();
   }

   if ( $separators =~ /\\|$quote_char/ )
   {
      GEN_SYS::DIE( "::SPLIT_STRING_ALLOWING_SPECIFIC_QUOTED_TERMS: " .
               "Program error - '\\' and '$quote_char' cannot be used as the separator." );
   }

   my $in_quoted_term = 0;   # FALSE
   my $term           = "";
   my @list_of_terms  = ();
   my @characters     = split( //, $str );
   my $last_but_one   = $#characters - 1;
   my $ch_last        = RIGHT( $str, 1 );

   my $i_ch = 0;

   I_CH:
   while ( $i_ch <= $#characters )
   {
      my $ch = $characters[ $i_ch ];
      my $next_ch;

      # Fix for case where last term of str is quoted and
      # ends in  ...\"
      # Return term ending in \
      #
      if ( $in_quoted_term &&
           ( $i_ch == $last_but_one ) &&
           ( $ch eq "\\" ) &&
           ( $ch_last eq $quote_char )
         )
      {
         $term .= "\\";
         
         last I_CH;
      }

      if ( $i_ch < $#characters )
      {
         $next_ch = $characters[ $i_ch + 1 ];
      }
      else
      {
         $next_ch = "";
      }

      if ( ( $ch eq "\\" ) && ( $next_ch eq $quote_char ) )
      {
         $term .= $quote_char;
         ++$i_ch;
      }
      elsif ( ( $ch eq "\\" ) && ( index( $separators, $next_ch ) >= 0 ) )
      {
       $term .= "\\";
         $term .= $next_ch;
         ++$i_ch;
      }
      elsif ( $ch eq $quote_char )
      {
         $in_quoted_term = ! $in_quoted_term;
      }
      elsif ( index( $separators, $ch ) >= 0 )
      {
 	 if ( $in_quoted_term )
 	 {
 	    $term .= $ch;
 	 }
 	 else
 	 {
            if ( $term ne "" )
            {
 	       push @list_of_terms, $term;
 	       $term = "";
            }
 	 }
      }
      else
      {
 	 $term .= $ch;
      }

      ++$i_ch;
   }

   if ( $term ne "" )
   {
      push @list_of_terms, $term;
   }

   return @list_of_terms;
}

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

sub SPLIT_COMMAND_LINE_STRING
{
   # Subroutine to split up a string of terms separated by space or tab 
   # characters, where some of the terms may be quoted strings that include
   # spaces, according to OS command line semantics.
   # Note that escaped spaces may be embedded.  To do this the space 
   # is prefixed with \ (backslash).
   #
   # Usage:
   #  @list_of_terms = SPLIT_COMMAND_LINE_STRING( $str );
   #
   # Handling of escape char \ (backslash) is OS specific.
   # For the following 4 cases Unix and Windows produce 2 different sets of 
   # results.   (NB For the purposes of this sub Cygwin is treated as the same
   # as Unix as Cygwin uses the Unix version of Perl.  Our approach to Cygwin
   # is to use the wrapper.exe file which uses Windows Perl conventions.):
   #
   # 1. "abc\"def\\ghi\ jk\'l\x\y\z"
   # 2. 'abc\"def\\ghi\ jk\'l\x\y\z'
   # 3. 'abc\"def\\ghi\ jkl\x\y\z'  
   # 4. abc\"def\\ghi\ jk\'l\x\y\z  
   #
   # On Unix:
   # 1. "abc\"def\\ghi\ jk\'l\x\y\z" becomes -> abc"def\ghi\ jk\'l\x\y\z
   # 2. 'abc\"def\\ghi\ jk\'l\x\y\z' is illegal (unterminated)
   # 3. 'abc\"def\\ghi\ jkl\x\y\z'   becomes -> abc\"def\\ghi\ jkl\x\y\z
   # 4. abc\"def\\ghi\ jk\'l\x\y\z   becomes -> abc"def\ghi jk'lxyz
   #
   # On Windows:
   # 1. "abc\"def\\ghi\ jk\'l\x\y\z" becomes -> abc"def\\ghi\ jk\'l\x\y\z
   # 2. 'abc\"def\\ghi\ jk\'l\x\y\z' becomes -> 'abc"def\\ghi\
   #                                            jk\'l\x\y\z
   # 3. 'abc\"def\\ghi\ jkl\x\y\z'   becomes -> 'abc"def\\ghi\
   #                                            jkl\x\y\z
   # 4. abc\"def\\ghi\ jk\'l\x\y\z   becomes -> abc"def\\ghi\
   #                                            jk\'l\x\y\z
   #
   # Therefore rules are:
   # On Unix act on \\ and \" inside "
   # On Unix act on nothing inside '
   # On Unix act on \ all outside " and '
   #
   # On Windows act on \" inside "
   # On Windows act on \" inside '
   # On Windows act on \" outside " and '
   #

   my $str = shift;

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

   my $separator_char = " ";                             # Constant
   my $tab_char       = "\t";                            # Constant
   my $escape_char    = "\\";                            # Constant
   my $double_quote   = "\"";                            # Constant
   my $single_quote   = "'";                             # Constant
   my $quoting_chars  = $double_quote . $single_quote;   # Constant
   my $escaped_chars  = $double_quote . $escape_char;    # Constant

   my $in_quoted_term = 0;   # FALSE
   my $term           = "";
   my @list_of_terms  = ();
   my @characters     = split( //, $str );
   my $last_but_one   = $#characters - 1;
   my $ch_last        = RIGHT( $str, 1 );

   my $quote_char = "";
   my $i_ch = 0;

   I_CH:
   while ( $i_ch <= $#characters )
   {
      my $ch = $characters[ $i_ch ];
      my $next_ch;

      # Fix for case where last term of str is quoted and
      # ends in  ...\"
      # Return term ending in \
      #
      if ( $in_quoted_term &&
           ( $i_ch == $last_but_one ) &&
           ( $ch eq "\\" ) &&
           ( index( $quoting_chars, $ch_last ) != -1 )
         )
      {
         $term .= "\\";
         
         last I_CH;
      }

      if ( $i_ch < $#characters )
      {
         $next_ch = $characters[ $i_ch + 1 ];
      }
      else
      {
         $next_ch = "";
      }

      if ( index( $quoting_chars, $ch ) != -1 )
      {
         if ( $in_quoted_term )
         {
            if ( $ch eq $quote_char )
            {
               $in_quoted_term = 0;  # False
            }
            else
            {
               $term .= $ch;
            }
         }
         else
         {
            $in_quoted_term = 1;   # True
            $quote_char = $ch;
         }
      }
      elsif ( $ch eq $escape_char )
      {
         # Here with escape character, handle according to platform
         #
         if ( $platform_is_windows )
         {
            if ( $next_ch eq $double_quote )
            {
               # Drop the escape char and use the next char ie double quote
               #
               $term .= $next_ch;
               ++$i_ch;
            }
            else
            {
               # Treat as ordinary char
               #
               $term .= $ch;
            }
         }
         else
         {
            # Here when OS has Unix behaviour
            #
            if ( $in_quoted_term )
            {
               if ( ( $quote_char eq $double_quote ) &&
                    ( index( $escaped_chars, $next_ch ) != -1 )
                  )
               {
                  # Drop the escape char and use the next char
                  #
                  $term .= $next_ch;
                  ++$i_ch;
               }
               else
               {
                  # Treat as ordinary char
                  #
                  $term .= $ch;
               }
            }
            else
            {
               # Here when escape is outside quotes (on Unix)
               # Remove escape char in each case.
               #   
               # Drop the escape char and use the next char
               #
               $term .= $next_ch;
               ++$i_ch;
            }
         }
      }
      elsif ( ( $ch eq $separator_char ) ||
              ( $ch eq $tab_char )
            )
      {
         if ( $in_quoted_term )
         {
            $term .= $ch;
         }
         else
         {
            if ( $term ne "" )
            {
               push @list_of_terms, $term;
               $term = "";
            }
         }
      }
      else
      {
         $term .= $ch;
      }

      ++$i_ch;
   }

   if ( $term ne "" )
   {
      push @list_of_terms, $term;
   }

   return @list_of_terms;
}

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

sub STRING_FORM
{
   # Usage: $str = STRING_FORM( @token_array );
   #
   # Takes supplied array and returns as a string with single space separator
   # between elements.  If an element of the array contains embedded space
   # characters, that element is surrounded by quotes.
   #
   my @arg_list = @_;

   if ( $#arg_list == -1 )
   {
      return "";
   }

   my $last = pop @arg_list;
   my $result = "";
   my $arg;

   foreach $arg ( @arg_list )
   {
      $result .= QUOTE_ARG( $arg ) . " ";
   }

   return $result . QUOTE_ARG( $last );
}

# ---------------------------------------------------------- STRIP_NUMBER --

sub STRIP_NUMBER
{
   # Usage: $extracted_number = STRIP_NUMBER( $str );
   #
   # Returns the first string of numeric (integer) digits in str, ignoring
   # any preceding characters.  Last digit read is last consecutive digit
   # character that is numeric.  Returns the integer value of the sub-string
   # that is found.
   #
   my $str = shift;

   if ( $str eq "" )
   {
      return 0;
   }

   my $extracted_number;

   ( $extracted_number = $str ) =~ s/.*?([0-9]*)/$1/go;

   if ( $extracted_number eq "" )
   {
      return 0;
   }
   else
   {
      return $extracted_number;
   }
}

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

sub TRIM
{
   # Usage: $trimmed_string = TRIM( string );
   # Removes leading and trailing whitespace from string
   #
   my $str = shift;

   ( $str = $str ) =~ s/^\s*//o;
   ( $str = $str ) =~ s/\s*$//o;

   return $str;
}

# ---------------------------------------------------- TRIM_TRAILING_CHAR --

sub TRIM_TRAILING_CHAR
{
   # Usage: $trimmed_string = TRIM_TRAILING_CHAR( $string, $char_to_trim );
   #
   my $string = shift;
   my $char   = shift;

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

   my $len = length( $string );
   my $cursor = $len - 1;
   
   while ( substr( $string, $cursor, 1 ) eq $char )
   {
      --$cursor;
      if ( $cursor == -1 )
      {
         return "";
      }
   }

   return substr( $string, 0, $cursor + 1 );
}

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

sub UNQUOTE
{
   # Usage: $unquoted_string = UNQUOTE( $arg );
   #
   my $arg = shift;

   if ( IS_QUOTED( $arg, "\"" ) )
   {
      return substr( $arg, 1, length( $arg ) - 2 );
   }
   else
   {
      return $arg;
   }
}

#-- eof GEN_STRING.pm ------------------------------------------------------
