# vim: ft=tcl ts=8 sts=2 sw=2
# Author Douglas Clowes (dcl@ansto.gov.au) 2014
#
# TCL utility functions for the SICS Unit Test Suite
#
namespace eval test_suite {
  variable version 1.0
}

# Send the config dictionary as an ini file image
#
proc test_suite::show_config {the_dict} {
  upvar 1 $the_dict my_dict
  if { ![info exists my_dict] } {
    clientput "\[config\]"
    clientput "missing = True"
    clientput "present = False"
    return
  }
  foreach s [config_reader::get_sections my_dict] {
    set section "$s"
    clientput "\[$section\]"
    foreach n [config_reader::get_variables my_dict $s] {
      set name "$n"
      set value "[config_reader::get_var my_dict $section $n]"
      clientput "$name = $value"
    }
    clientput ""
  }
}

# Send the hipadaba tree as an XML image
#
# Like getgumtreexml except it does the whole tree and does not split values
#
proc test_suite::getdataType {path} {
  return [lindex [split [hinfo $path] ,] 0]
}

proc test_suite::encode {str} {
    set result [string map -nocase {
      "\""  {"}
      {'}   {'}
      {<}   {&lt;}
      {>}   {&gt;}
      {&}   {&amp;}
      \u0   {}
      \u1   {}
      \u2   {}
      \u3   {}
      \u4   {}
      \u5   {}
      \u6   {}
      \u7   {}
      \u8   {}
      \u9   {&#x09;}
      \ua   {&#x0a;}
      \ub   {}
      \uc   {}
      \ud   {&#x0d;}
      \ue   {}
      \uf   {}
      \u10  {}
      \u11  {}
      \u12  {}
      \u13  {}
      \u14  {}
      \u15  {}
      \u16  {}
      \u17  {}
      \u18  {}
      \u19  {}
      \u1a  {}
      \u1b  {}
      \u1c  {}
      \u1d  {}
      \u1e  {}
      \u1f  {}
    } $str]
    return $result
}

proc test_suite::make_nodes {path result indent} {
  set nodename [file tail $path];
  set type [test_suite::getdataType $path]
  set prefix [string repeat " " $indent]
  set newIndent [expr $indent + 2]

  append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
  if {[string compare -nocase $type "none"] != 0} {
    if [ catch {
      set value [test_suite::encode [hval $path]]
    } message ] {
      set value "HVAL_ERROR:${message}"
    }
    append result "$prefix  <value>$value</value>\n"
  }
  foreach p [test_suite::property_elements $path $newIndent] {
    append result $p
  }
  foreach x [lsort [hlist $path]] {
    set result [test_suite::make_nodes [string map {// /} "$path/$x"] $result $newIndent]
  }
  append result  "$prefix</component>\n"
  return $result
}

proc test_suite::property_elements {path indent} {
  set prefix [string repeat " " $indent]
  foreach {key} [lsort [hlistprop $path tclnames]] {
    set value [test_suite::encode [hgetpropval $path $key]]
    lappend proplist "$prefix<property id=\"$key\">\n"
    lappend proplist "$prefix  <value>$value</value>\n"
    lappend proplist "$prefix</property>\n"
  }
  if [info exists proplist] {return $proplist}
}

proc test_suite::getsicsxml {path} {
  append result "<?xml version = \"1.0\" encoding = \"UTF-8\"?>\n"
  append result "<hipadaba:SICS xmlns:hipadaba=\"http://www.psi.ch/sics/hipadaba\" >\n"

  if {[string compare $path "/" ] == 0} {
    foreach n [lsort [hlist $path]] {
      set result [test_suite::make_nodes $n $result 2]
    }
  } else {
    set result [test_suite::make_nodes $path $result 2]
  }

  append result "</hipadaba:SICS>\n"
}