#!/usr/bin/expect --
################################################################################
#
# File:         stdlib
# RCS:          $Header: $
# @(#)          $Revision: $
# Description:  Standard library code for state machines
#		
#
# Routines:
#
#   use           -- Perl-like library use pragma
#   shift         -- list equivalent of array operation
#   unshift       -- list equivalent of array operation
#   pop           -- list equivalent of array operation
#   push          -- list equivalent of array operation
#   lreverse      -- reverse a list
#   split_csv     -- Create a list from a comma-separated list
#   hex2dec       -- Convert hexadecimal to decimal
#   dec2hex       -- Convert decimal input to hex
#   dec2bin       -- Convert decimal input to binary
#   bin2dec       -- Convert binary input to decimal
#   sort_numbers  -- Sort a list of numbers from smallest to largest
#   unique        -- Get the unique members of two lists
#   split_string  -- Split a string into given-sized chunks
#
#
#      -*- OpenSAF  -*-
#
# (C) Copyright 2008 The OpenSAF Foundation
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. This file and program are licensed
# under the GNU Lesser General Public License Version 2.1, February 1999.
# The complete license can be accessed from the following location:
# http://opensource.org/licenses/lgpl-license.php
# See the Copying file included with the OpenSAF distribution for full
# licensing terms.
#
# Author(s):
#           Hewlett-Packard Company
#
#
################################################################################


################################################################################
# Use pragma to load in another library module
################################################################################
# use <module>
# Input:    <module>	- name of expect module to import
# Output:   1 if successfully sources module
#	    0 if not
#
# Description:	use searches the PATH for the module to use.  If it
# finds the module, it is sourced.  If it is not found, it reports an
# error
################################################################################
proc use { module } {

    global env

    set sourced_file 0
    if { [string first "/" $module] != -1 } {
	if { [file exists $module] } {
	    source $module
	    set sourced_file 1
	}
    } else {
	foreach path_entry [split $env(PATH) ":"] {
	    set pathfile [join [list $path_entry $module] "/"]
	    if { [file exists $pathfile] } {
		source $pathfile
		set sourced_file 1
		break
	    }
	}
    }
    if { ! $sourced_file } {
	send_user "EXPECT ERROR: Couldn't find $module\n"
    }
    return $sourced_file
}

################################################################################
# Shift
################################################################################
# shift <list_name>
# Input:    <list_name>	- name of list to shift off  !!PASSED BY REFERENCE!!
# Output:   <item>	- item shifted off at the beginning of list
#
# Description:	Shifts off the first element in the list, shrinking the
# list by one element.  If the list is empty, it returns the empty
# string
################################################################################
proc shift { list_name } {

    upvar $list_name ref_list

    if { [info exists ref_list] } {
	set shift_item [lindex $ref_list 0]
	set ref_list [lreplace $ref_list 0 0]
    } else {
	set shift_item ""
    }

    return $shift_item
}

################################################################################
# Unshift
################################################################################
# shift <list_name>
# Input:    <list_name>	- name of list to prepend item onto  !!PASSED BY REFERENCE!!
#           <item>	- item placed onto the beginning of list
# Output:   list_length - length of the new list.
#
# Description:	Like Perl unshift.  Puts item at the front of a list.
# If the list is empty, creates a one-item list
################################################################################
proc unshift { list_name item } {

    upvar $list_name ref_list

    if { ! [info exists ref_list] } {
	set ref_list ""
    }
    set ref_list [linsert $ref_list 0 $item]

    return [llength $ref_list]
}

################################################################################
# Pop
################################################################################
# pop <list_name>
# Input:    <list_name>	- name of list to pop item off  !!PASSED BY REFERENCE!!
# Output:   <item>	- item popped off at the end of list
#
# Description:	Pops off the last element in the list, shrinking the
# list by one element.  If the list is empty, it returns the empty
# string
################################################################################
proc pop { list_name } {

    upvar $list_name ref_list

    if { [info exists ref_list] } {
	set last_index [expr [llength $ref_list] - 1]]
	set pop_item [lindex $ref_list $last_index]
	set ref_list [lreplace $ref_list $last_index $last_index]
    } else {
	send_user "List empty\n"
	set pop_item ""
    }

    return $pop_item
}

################################################################################
# Push
################################################################################
# push <list_name>
# Input:    <list_name>	- name of list to push item on  !!PASSED BY REFERENCE!!
#	    <item>	- item pushed on at the end of list
#
# Output:  length of the list 
#
# Description:	Pushes item on the end of the list.  If the list is
# empty, it creates the list with item at the start.  Note that item can
# be a list itself
################################################################################
proc push { list_name item } {

    upvar $list_name ref_list

    lappend ref_list $item

    return [llength $ref_list]
}

################################################################################
# lreverse
################################################################################
# lreverse <list_name>
# Input:   <list_name>	- Reference to a list
#	    
# Output:  returns the list in reverse order
#
# Description:	Reads the input list, returns a new list with items in
#               reverse order.
################################################################################
proc lreverse { list_name } {

    upvar $list_name rlist
    if {![llength $rlist]} {
       # Just return if the list is empty
       return
    }

    set lastIndex [expr [llength $rlist] - 1]
    for { set i $lastIndex } { $i >= 0 }  {decr i} {
       lappend reversed [lindex $rlist $i]
    }
    return $reversed
}

################################################################################
# Split_csv
################################################################################
# Inputs: ref_str	- string to convert
#
# Outputs: 1 if successful, 0 otherwise
#
# Takes a comma-separated value string and returns it as a
# space-separated value string
################################################################################
proc split_csv { ref_str } {
    upvar $ref_str str

    # Remove = from command line arguments
    set str [split $str {,}]

    return 1
}

################################################################################
# hex2dec
################################################################################
# Inputs: hexidecimal number
#
# Outputs: decimal equivalent
#          -1 if error
#
################################################################################
proc hex2dec {hexinput} {

    # Allow for input like 0xabc or abc
   set string [split $hexinput {\[x,X]}]
   if { [llength $string] == 1 } {
     set hex [lindex $string 0]
   } else {
     set hex [lindex $string 1]
   }

    # Break up the hex value into its constituent digits
    # compute the decimal value

   set dec 0
   for {set i 0} {$i < [string length $hex]} { incr i } {

      set hdigit [string index "$hex" $i]
      switch -regexp -- $hdigit \
         \[0-9]  { set ddigit $hdigit
      }  \[Aa]   { set ddigit 10
      }  \[Bb]   { set ddigit 11
      }  \[Cc]   { set ddigit 12
      }  \[Dd]   { set ddigit 13
      }  \[Ee]   { set ddigit 14
      }  \[Ff]   { set ddigit 15
      } default  {
          return -1
      }
      set dec [expr { 16 * $dec } + $ddigit]
   }
   return $dec
}

################################################################################
# dec2hex
################################################################################
# Inputs: decimal number
#
# Outputs: hexidecimal equivalent
#          -1 if error
#
################################################################################
proc dec2hex {decinput} {
   if {[regexp {^-} $decinput]} { return -1 }
   set hex [format "%x", $decinput]
   return hex
}

################################################################################
# dec2bin
################################################################################
# Inputs: decimal number
#
# Outputs: binary equivalent
#          -1 if error
#
################################################################################
proc dec2bin {decimal} {
     global VERBOSE
      # Check that the input is a valid number
     if {![regexp {^[0-9]+$} $decimal]} {
        send_user "\[SM] Bad input for dec2bin\n"
        return -1
     }
    
      # If the number is zero, return 0
     if {!$decimal} {
         return 0
     }

      # Get the highest power of two in the number
     set lg2 [expr log(2)]
     set lg [expr log($decimal)]
     set max [expr int(floor($lg/$lg2))]

      # Initialize bits, the bit string that we will return
      #  and mask, the 2^N mask for setting bits.
     set bits ""
     set mask 1
     for {set i 0} {$i <= $max} {incr i} {
         set bit [expr $decimal & $mask]
         if {$bit} {
            set bits "1$bits"
         } \
         else {
            set bits "0$bits"
         }
          # Increment the mask
         set mask [expr $mask << 1]
     }
     return "$bits"
}

################################################################################
# bin2dec
################################################################################
# Inputs: binary number
#
# Outputs: dec equivalent
#          -1 if error
#
################################################################################
proc bin2dec {binInput} {
     global VERBOSE

     if {[regexp {[^01]+$} $binInput]} {return -1}

     set digList [split $binInput ""]
     set start [expr [llength $digList] - 1]
     set dec 0
     set pwr2 1
     for {set i $start} {$i >= 0} {incr i -1} {
         incr dec [expr [lindex $digList $i] * $pwr2]
         set pwr2 [expr 2 * $pwr2]
     }
         
     return $dec
}

################################################################################
# sort_numbers
################################################################################
# Inputs: string of numbers
#
# Outputs: sorted string
#          -1 if error
#
################################################################################
proc sort_numbers {numbers} {

   # Uses Shell sort -- qsort is overkill for a short list
  set array_size [llength $numbers]
  set increment 3

  while {[expr $increment > 0]} {
     for { set i 0 } { $i < $array_size } { incr i } {
        set j $i
        set temp [lindex $numbers $i]
        while {[expr $j >= $increment] && \
               [expr [lindex $numbers [expr $j - $increment]] > $temp] } {
           set dummy [lindex $numbers [expr $j - $increment]]
           set numbers [lreplace $numbers $j $j $dummy]
           set j [expr $j - $increment]
        }
        set numbers [lreplace $numbers $j $j $temp]
     }
     if {[expr int([expr $increment/2]) != 0]} {
        set increment [expr int([expr $increment/2])]
     } \
     elseif { $increment == 1 } {
        set increment 0
     } \
     else {
        set increment 1
     }
  }
  return $numbers
}

################################################################################
# unique --  return elements that are unique to a list
################################################################################
# Inputs: rList1 -- reference to list1
#         rList2 -- reference to list2
#
# Outputs: list of elements that are unique to list1
#
################################################################################
proc unique {rList1 rList2} {
     global VERBOSE
     upvar $rList1 List1
     upvar $rList2 List2

     set ListOut ""

     foreach var1 $List1 {
        set found 0
        foreach var2 $List2 {
           if {$var2 == $var1} {
              set found 1
              break
           }
        }
        if {!$found} {
           lappend ListOut $var1
        }
     }
     return $ListOut
}

################################################################################
# split_string
################################################################################
# Inputs: chunk_size  - number of characters per chunk
#         string to split
#
# Outputs: list of chunk_size strings
#
################################################################################
proc split_string {chunk_size input} {

   set strLen [string length $input]
   set output ""
    # Initialize the output string with the first chunk of data
   lappend output [string range $input 0 [expr $chunk_size - 1]]
   set start $chunk_size
   set end $chunk_size

    # Now loop through the rest of the string
   while {$start < $strLen} {
      set end [expr $start + $chunk_size]
        # Make sure that we don't try to go past the end of the string
      if [expr $end >= $strLen] {
         set end [expr $strLen]
      }
      set chunk "[string range $input $start $end]"
      lappend output "$chunk"
         # Increment the starting position in the string for the next chunk
      set start [expr $end + 1]
   }

   return "$output"
}
